diff options
Diffstat (limited to '')
-rwxr-xr-x | tools/obu-ping | 126 |
1 files changed, 126 insertions, 0 deletions
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)))) |