1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
#!/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 statefile 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 statefile))))))
(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 statefile)
(define tls
(equal? (uri-ref url 'scheme) "https"))
(define anchor
(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))))
(define sequencelength
(guard [e (else 100000)]
(with-input-from-process `(obu-config -s ,statefile sequencelength) read)))
(if (> (assoc-ref anchor 'sequence) (sequencelength - 0.2))
(do-process `(obu-config -s ,statefile -d token))
#f)
anchor)
|
