[OCaml] High Intensity Training Online
feat Add Common Log Format access logging
Replace Dream's default request logger with Common Log Format-style lines that include the client, UTC timestamp, request line, response status, and response bytes. Escape request fields before writing them to stderr.
bin/main.ml
@@ -1,3 +1,5 @@
1
Added:
open Lwt.Infix
2
Added:
1
3
(* The production server. State is durable: trainees, their active routine,
2
4
the workout in progress, and history all live in SQLite. There is no
3
5
server-wide in-memory state.
@@ -48,6 +50,44 @@
48
50
Hito_app.Trainee.pp_username_error e;
49
51
exit 1)
50
52
53
Added:
let clf_month = function
54
Added:
| 1 -> "Jan"
55
Added:
| 2 -> "Feb"
56
Added:
| 3 -> "Mar"
57
Added:
| 4 -> "Apr"
58
Added:
| 5 -> "May"
59
Added:
| 6 -> "Jun"
60
Added:
| 7 -> "Jul"
61
Added:
| 8 -> "Aug"
62
Added:
| 9 -> "Sep"
63
Added:
| 10 -> "Oct"
64
Added:
| 11 -> "Nov"
65
Added:
| 12 -> "Dec"
66
Added:
| _ -> "???"
67
Added:
68
Added:
let clf_escape text =
69
Added:
String.map (function '"' -> '\'' | '\n' | '\r' | '\t' -> ' ' | c -> c) text
70
Added:
71
Added:
let clf_time () =
72
Added:
let tm = Unix.gmtime (Unix.gettimeofday ()) in
73
Added:
Printf.sprintf "%02d/%s/%04d:%02d:%02d:%02d +0000" tm.Unix.tm_mday
74
Added:
(clf_month (tm.Unix.tm_mon + 1))
75
Added:
(tm.Unix.tm_year + 1900) tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
76
Added:
77
Added:
let common_log_format inner request =
78
Added:
inner request >|= fun response ->
79
Added:
let bytes =
80
Added:
Option.value (Dream.header response "Content-Length") ~default:"-"
81
Added:
in
82
Added:
Printf.eprintf "%s - - [%s] \"%s %s HTTP/1.1\" %d %s\n%!"
83
Added:
(clf_escape (Dream.client request))
84
Added:
(clf_time ())
85
Added:
(Dream.method_to_string (Dream.method_ request))
86
Added:
(clf_escape (Dream.target request))
87
Added:
(Dream.status_to_int (Dream.status response))
88
Added:
bytes;
89
Added:
response
90
Added:
51
91
let () =
52
92
let db_uri = getenv "HITO_DB" "sqlite3:hito.sqlite" in
53
93
let port = int_of_string (getenv "HITO_PORT" "8080") in
@@ -73,12 +113,13 @@
73
113
prerr_endline
74
114
"hito: HITO_SEED_PASSWORD is not set; refusing to seed the \
75
115
account with a default. Set it and restart.";
116
Added:
76
117
exit 1
77
118
in
78
119
Lwt_main.run (seed_single_user repo ~password:seed_password);
79
120
let handlers = Handlers.make ~repo () in
80
121
Dream.run ~interface:"localhost" ~port
81
122
~error_handler:Handlers.error_handler
82
Removed:
@@ Dream.logger @@ Dream.set_secret secret @@ Dream.sql_pool db_uri
123
Added:
@@ common_log_format @@ Dream.set_secret secret @@ Dream.sql_pool db_uri
83
124
@@ Dream.sql_sessions
84
125
@@ Dream.router (Handlers.routes handlers)