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
|
#!/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))))
|
