simple on-board tools

these are just enough to send train positions to tracktrain with the
current API, but are somewhat brittle (e.g. will fail if not restarted
between trips, etc.)

6 files changed, 263 insertions, 0 deletions

diff --git a/tools/obu-config b/tools/obu-config
new file mode 100755
index 0000000..0cce2ee
--- /dev/null
+++ b/tools/obu-config
@@ -0,0 +1,59 @@
+#!/usr/bin/env gosh
+
+(use text.edn)
+(use file.util)
+(use scheme.mapping.hash)
+(use gauche.parseopt)
+
+(define (show-help progname)
+  (display (format
+"~a: tracktrain's onboard config-and-state manager.
+
+Usage: ~a [options] key [value]
+
+This is a very simple key-value store. Give both to set,
+give just the key to look something up
+
+Options:
+ -s --statefile: state file
+ -h --help: display this help
+" progname))
+  (exit 0))
+
+(define (main args)
+  (let-args
+   (cdr args)
+   ((statefile "s|state=s")
+    (help "h|help" => (cut show-help (car args)))
+   . restargs)
+
+  (define file
+    (if (equal? statefile #f)
+        "./obu-state.edn"
+        statefile))
+
+  (if (= (length restargs) 2)
+      (set file
+           (list-ref restargs 0)
+           (list-ref restargs 1))
+      (display
+       (get file
+            (list-ref restargs 0))))
+  (exit 0)))
+
+(define (set file key value)
+  (define data
+    (if (file-exists? file)
+        (call-with-input-file file parse-edn)
+        (edn-map)))
+  (define data2
+    (hashmap-set data (string->symbol key) value))
+  (call-with-output-file file
+    (cut construct-edn data2 <>)))
+
+(define (get file key)
+  (if (file-exists? file)
+      (hashmap-ref
+       (call-with-input-file file parse-edn)
+       (string->symbol key))
+      #f))
diff --git a/tools/obu-guess-trip b/tools/obu-guess-trip
new file mode 100755
index 0000000..478ba2b
--- /dev/null
+++ b/tools/obu-guess-trip
@@ -0,0 +1,75 @@
+#!/usr/bin/env gosh
+
+(use rfc.http)
+(use rfc.uri)
+(use rfc.json)
+(use file.util)
+(use srfi-19)
+(use gauche.collection)
+(use gauche.parseopt)
+(use gauche.process)
+
+
+(define (main args)
+  (let-args
+   (cdr args)
+   ((adir "d|dir=s")
+    (baseurl "u|url=s")
+    (statefile "s|statefile=s")
+    (help "h|help" => (cut show-help (car args)))
+    . restargs)
+   (if (equal? baseurl #f)
+       (show-help (car args))
+       (guesstimate
+        (if (equal? adir #f) "." adir)
+        baseurl
+        (if statefile statefile "./obu-state.edn")))
+   (exit 0)))
+
+
+(define (show-help progname)
+  (display (format
+"~a: tracktrain's on-board guesstimater for which trip you're on
+
+Arguments:
+ -u --url: base url of the tracktrain server [required]
+ -s --statefile: state file
+ -c --config: config file (default is /etc/tracktrain/obu.conf)
+ -h --help: display this help
+" progname))
+  (exit 0))
+
+(define (guesstimate dir url statefile)
+  (define stops (fetch-stations url))
+  (define pos
+    (with-input-from-process `(obu-ping -s ,statefile -n 1 -d) read))
+  (define trip (assoc-ref (closest-stop-to stops pos) 'trip))
+  (display trip))
+
+(define (closest-stop-to stops pos)
+  (define stops-by-station
+    (apply vector-append (vector->list
+      (vector-map (lambda (trip)
+                    (vector-map
+                     (lambda (stop) (cons `(trip . ,(assoc-ref trip 'trip)) stop))
+                     (assoc-ref trip 'stops)))
+                  stops))))
+  (find-min
+   stops-by-station
+   :key (lambda (stop)
+          (+ (square (- (assoc-ref pos 'lat) (assoc-ref stop 'lat)))
+             (square (- (assoc-ref pos 'lon) (assoc-ref stop 'lon)))))
+   :default (vector-ref stops 0)))
+
+(define (fetch-stations url)
+  (define day (date->string (current-date) "~1"))
+  (define tls
+    (equal? (uri-ref url 'scheme) 'https))
+  (parameterize
+      ; replace all json keys with symbols; everything else is confusing
+      ([json-object-handler
+        (cut map (lambda p `(,(string->symbol (car (car p))) . ,(cdr (car p)))) <>)])
+    (parse-json-string
+     (values-ref (http-get (uri-ref url 'host+port)
+                           (format "/api/timetable/stops/~a" day)
+                           :secure tls) 2))))
diff --git a/tools/obu-ping b/tools/obu-ping
new file mode 100755
index 0000000..ee75402
--- /dev/null
+++ b/tools/obu-ping
@@ -0,0 +1,126 @@
+#!/usr/bin/env gosh
+
+(use rfc.json)
+(use rfc.uri)
+(use rfc.http)
+(use srfi-19)
+(use file.util)
+(use util.match)
+(use gauche.parseopt)
+(use gauche.process)
+(use text.edn)
+(use scheme.mapping.hash)
+
+(define (show-help progname)
+  (display (format
+"~a: tracktrain's on-board reporting thing. Excepts input to be
+piped from gpsd's `gpspipe --json` onto stdin.
+
+Arguments:
+ -u --url: base url of the tracktrain server [required]
+ -n: number of positions to fetch (default is to loop forever)
+ -d --no-ping: just print the positions, don't send anything
+ -s --statefile: state file
+ -c --config: config file (default is /etc/tracktrain/obu.conf)
+ -h --help: display this help
+" progname))
+  (exit 0))
+
+(define (main args)
+  (let-args
+   (cdr args)
+   ((statefile "s|state=s")
+    (baseurl "u|url=s")
+    (n "n=i")
+    (no-ping "d|no-ping")
+    (help "h|help" => (cut show-help (car args)))
+    . restargs)
+   (if (and (equal? baseurl #f) (equal? no-ping #f))
+       (show-help (car args))
+       (with-input-from-process
+        '(gpspipe --json)
+        (cut report-position
+             (if (equal? statefile #f) "./obu-state.edn" statefile)
+             baseurl
+             n
+             no-ping)
+        :on-abnormal-exit :ignore))
+   (exit 0)))
+
+
+(define (try-get-current-pos)
+  (define json
+    (parameterize
+      ; replace all json keys with symbols; everything else is confusing
+      ([json-object-handler
+        (cut map (lambda p `(,(string->symbol (car (car p))) . ,(cdr (car p)))) <>)])
+      (parse-json)))
+  (define class
+    (assoc-ref json 'class))
+  (match class
+    ("TPV" `((lat . ,(assoc-ref json 'lat))
+                      (lon . ,(assoc-ref json 'lon))
+                      (time . ,(assoc-ref json 'time))))
+    (_ (try-get-current-pos))))
+
+(define json-symbol-key
+  (cut map (lambda p `(,(string->symbol (car (car p))) . ,(cdr (car p)))) <>))
+
+(define (report-position statefile url n no-ping)
+  (define trip
+    (if no-ping #f
+    (process-output->string `(obu-guess-trip -u ,url))))
+  (define token
+    (if no-ping #f (get-token url trip statefile)))
+  (if n
+    (dotimes (i n)
+      (ping-pos statefile url token))
+    (while #t
+      (ping-pos statefile url token))))
+
+(define (ping-pos dir url token)
+  (let ([pos (try-get-current-pos)])
+    (display (format "~a\n" pos))
+    (if (not (equal? token #f))
+        (display (format "server: ~a\n" (ping url token pos))))))
+
+(define (get-token url trip statefile)
+  (define cached?
+    (with-input-from-process `(obu-config -s ,statefile token) read))
+  (if cached?
+      (symbol->string cached?)
+      (let* ([token (fetch-token url trip)])
+        (do-process `(obu-config -s ,statefile token ,token))
+        token)))
+
+(define (fetch-token url trip)
+  (define tls
+    (equal? (uri-ref url 'scheme) 'https))
+  (display (format "fetching new token for trip ~a…\n" trip))
+  (parameterize
+      ; replace all json keys with symbols; everything else is confusing
+      ([json-object-handler json-symbol-key])
+    (parse-json-string
+     (values-ref (http-post
+                  (uri-ref url 'host+port)
+                  (format "/api/train/register/~a" trip)
+                  (construct-json-string '((agent . "onboard-unit")))
+                  :content-type "application/json"
+                  :secure tls)
+                 2))))
+
+(define (ping url token pos)
+  (define tls
+    (equal? (uri-ref url 'scheme) 'https))
+  (parameterize ([json-object-handler json-symbol-key])
+    (parse-json-string
+     (values-ref (http-post
+                  (uri-ref url 'host+port)
+                  "/api/train/ping"
+                  (construct-json-string `((token . ,token)
+                                           (lat . ,(assoc-ref pos 'lat))
+                                           (long . ,(assoc-ref pos 'lon))
+                                           (timestamp . ,(assoc-ref pos 'time))))
+                  :content-type "application/json"
+                  :secure tls)
+                 2))))
diff --git a/tools/obu-state.edn b/tools/obu-state.edn
new file mode 100644
index 0000000..db989c8
--- /dev/null
+++ b/tools/obu-state.edn
@@ -0,0 +1 @@
+{token "5ab95c26-367e-40fc-8d3e-2956af6f61e4"}
\ No newline at end of file
diff --git a/tools/other.edn b/tools/other.edn
new file mode 100644
index 0000000..b4b44d4
--- /dev/null
+++ b/tools/other.edn
@@ -0,0 +1 @@
+{a "b", c "b"}
\ No newline at end of file
diff --git a/tools/test.edn b/tools/test.edn
new file mode 100644
index 0000000..aa0da75
--- /dev/null
+++ b/tools/test.edn
@@ -0,0 +1 @@
+{token "string"}