dimitri/sncf-bot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add logs and fix issues where the server is crashing

Browse source
This commit is contained in:
Dimitri Lozeve 2022-09-20 19:36:01 +02:00
parent c21bbbb559
commit e223a736e1
1 changed files with 57 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

33
server.ss
View file

@ -2,8 +2,11 @@
(export main) (export main)
(import :std/getopt (import :std/format
:std/getopt
:std/iter :std/iter
:std/logger
:std/net/address
:std/net/httpd :std/net/httpd
:std/srfi/19 :std/srfi/19
:std/sugar :std/sugar
@ -19,23 +22,32 @@
(try (try
(let (opt (getopt-parse gopt args)) (let (opt (getopt-parse gopt args))
(run (hash-get opt 'address))) (parameterize ((current-logger-options 'DEBUG))
(start-logger!)
(run (hash-get opt 'address))))
(catch (getopt-error? exn) (catch (getopt-error? exn)
(getopt-display-help exn "server" (current-error-port)) (getopt-display-help exn "server" (current-error-port))
(exit 1)))) (exit 1))))
(def (run address) (def (run address)
(infof "Starting HTTP server on ~a" (inet-address->string address))
(let (httpd (start-http-server! address mux: (make-default-http-mux default-handler))) (let (httpd (start-http-server! address mux: (make-default-http-mux default-handler)))
(http-register-handler httpd "/" departures-handler) (http-register-handler httpd "/" departures-handler)
(thread-join! httpd))) (thread-join! httpd)))
;; / ;; /
(def (departures-handler req res) (def (departures-handler req res)
(let/cc return
(infof "~a ~a ~a"
(http-request-method req)
(http-request-path req)
(inet-address->string (http-request-client req)))
(def sncf-key (getenv "SNCF_AUTH_KEY" #f)) (def sncf-key (getenv "SNCF_AUTH_KEY" #f))
(unless sncf-key (unless sncf-key
(display "No SNCF API authentication key found. Set the SNCF_AUTH_KEY environment variable.\n" (errorf "No SNCF API authentication key found. Set the SNCF_AUTH_KEY environment variable.")
(current-error-port)) (http-response-write res 500 '(("Content-Type" . "text/plain; charset=utf-8"))
(exit 1)) "Missing SNCF API authentication key\n")
(return))
(def headers (http-request-headers req)) (def headers (http-request-headers req))
(def accept-header (assoc "Accept" headers)) (def accept-header (assoc "Accept" headers))
(when accept-header (set! accept-header (cdr accept-header))) (when accept-header (set! accept-header (cdr accept-header)))
@ -44,10 +56,17 @@
(when station (set! station (cdr station))) (when station (set! station (cdr station)))
(def datetime-str (assoc "datetime" params)) (def datetime-str (assoc "datetime" params))
(def datetime (if datetime-str (def datetime (if datetime-str
(try
(string->date (cdr datetime-str) "~Y~m~dT~H~M~S") (string->date (cdr datetime-str) "~Y~m~dT~H~M~S")
(catch _
(warnf "Badly formatted date string: ~a" (cdr datetime-str))
(http-response-write res 400 '(("Content-Type" . "text/plain; charset=utf-8"))
(format "Badly formatted date string, expected %Y%m%dT%H%M%S: ~a\n"
(cdr datetime-str)))
(return)))
#f)) #f))
(define-values (station-name station-id) (define-values (station-name station-id)
(if station (if (string? station)
(get-station-id sncf-key station) (get-station-id sncf-key station)
(values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604"))) (values "Vernon - Giverny (Vernon)" "stop_area:SNCF:87415604")))
(define-values (departures disruptions) (get-departures sncf-key station-id datetime)) (define-values (departures disruptions) (get-departures sncf-key station-id datetime))
@ -66,7 +85,7 @@
(lambda () (display-all departures disruptions station-name datetime (lambda () (display-all departures disruptions station-name datetime
style: 'unicode)))))) style: 'unicode))))))
(http-response-write res 200 '(("Content-Type" . "text/plain; charset=utf-8")) (http-response-write res 200 '(("Content-Type" . "text/plain; charset=utf-8"))
content)) content)))
(def (parse-request-params params) (def (parse-request-params params)
(if params (if params