diff options
Diffstat (limited to 'tools')
| -rwxr-xr-x | tools/obu-config | 59 | ||||
| -rwxr-xr-x | tools/obu-guess-trip | 75 | ||||
| -rwxr-xr-x | tools/obu-ping | 126 | ||||
| -rw-r--r-- | tools/obu-state.edn | 1 | ||||
| -rw-r--r-- | tools/other.edn | 1 | ||||
| -rw-r--r-- | tools/test.edn | 1 |
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"} |