Log websocket connection starts

This commit is contained in:
Tony Garnock-Jones 2016-11-21 17:38:41 +13:00
parent b2c795c57a
commit 9d34ffea4f
1 changed files with 30 additions and 21 deletions

View File

@ -335,27 +335,36 @@
(define start-ms (current-inexact-milliseconds)) (define start-ms (current-inexact-milliseconds))
(send-ground-message (web-raw-request id listen-port conn req control-ch)) (send-ground-message (web-raw-request id listen-port conn req control-ch))
(sync (handle-evt control-ch (sync (handle-evt control-ch
(match-lambda (lambda (msg)
[(list 'websocket reply-headers ws-ch) (define delay-ms (inexact->exact
(with-handlers ((exn:dispatcher? (truncate
(lambda (_e) (bad-request conn req)))) (- (current-inexact-milliseconds) start-ms))))
((make-general-websockets-dispatcher (match msg
(websocket-connection-main id ws-ch) [(list 'websocket reply-headers ws-ch)
(lambda _args (values reply-headers (void)))) (log-syndicate/drivers/web-info
conn req))] "~s"
[(list 'response resp) `((method ,(request-method req))
(define delay-ms (inexact->exact (url ,(url->string (request-uri req)))
(truncate (headers ,(request-headers req))
(- (current-inexact-milliseconds) start-ms)))) (port ,(request-host-port req))
(log-syndicate/drivers/web-info (websocket)
"~s" (delay-ms ,delay-ms)))
`((method ,(request-method req)) (with-handlers ((exn:dispatcher?
(url ,(url->string (request-uri req))) (lambda (_e) (bad-request conn req))))
(headers ,(request-headers req)) ((make-general-websockets-dispatcher
(port ,(request-host-port req)) (websocket-connection-main id ws-ch)
(code ,(response-code resp)) (lambda _args (values reply-headers (void))))
(delay-ms ,delay-ms))) conn req))]
(output-response/method conn resp (request-method req))]))) [(list 'response resp)
(log-syndicate/drivers/web-info
"~s"
`((method ,(request-method req))
(url ,(url->string (request-uri req)))
(headers ,(request-headers req))
(port ,(request-host-port req))
(code ,(response-code resp))
(delay-ms ,delay-ms)))
(output-response/method conn resp (request-method req))]))))
(do-request)))))) (do-request))))))
;; D-: uck barf ;; D-: uck barf