aboutsummaryrefslogtreecommitdiff
path: root/tools/obu-ping
diff options
context:
space:
mode:
Diffstat (limited to '')
-rwxr-xr-xtools/obu-ping126
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))))