aboutsummaryrefslogtreecommitdiff
path: root/tools
diff options
context:
space:
mode:
authorstuebinm2023-03-11 01:36:35 +0100
committerstuebinm2023-03-11 01:37:54 +0100
commit7798666c81b390183e2e227232d936abf0cc4a65 (patch)
treea9ecbe352d7dc28faf7f74720022e27640edea5b /tools
parent99463395ee9497256b794f4ad2c94b490ca5d0fd (diff)
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.)
Diffstat (limited to '')
-rwxr-xr-xtools/obu-config59
-rwxr-xr-xtools/obu-guess-trip75
-rwxr-xr-xtools/obu-ping126
-rw-r--r--tools/obu-state.edn1
-rw-r--r--tools/other.edn1
-rw-r--r--tools/test.edn1
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"}