log: use logfmt for access logs instead of apache format, when requested

it pollutes the service's logs with non-structured data otherwise. This
is more consistent.

Author: c-cube

httpev.ml

@@ -326,10 +326,42 @@ let log_access_apache ch code size ?(background=false) req =
   with exn ->
     log #warn ~exn "access log : %s" (show_request req) ~structured_pairs:(pairs_of_request req)
 
-let log_status_apache ch status size req =
-  match status with
-  | `No_reply -> () (* ignore *)
-  | #reply_status as code -> log_access_apache ch (status_code code) size req
+let log_access_logfmt ch code size ?(background=false) req =
+  try
+    let now = Time.now () in
+    let msg = Logfmt.to_string [
+      "time", Time.to_string ~gmt:!Log.State.utc_timezone ~ms:true now;
+      "msg", "httpev.serve";
+      "req_id", string_of_int req.id;
+      "client_addr", show_client_addr req;
+      "http_duration", sprintf "%.4f" (now -. req.conn);
+      "http_recv_duration", sprintf "%.4f" (req.recv -. req.conn);
+      "http_host", header_safe req "host";
+      "url", req.url;
+      "http_user_agent", header_safe req "user-agent";
+      "http_req_id", header_safe req "x-request-id";
+      "http_request_line", req.line;
+      "http_status", string_of_int code;
+      "size", string_of_int size;
+      "http_referer", header_referer req;
+      "background", string_of_bool background;
+    ] in
+    fprintf ch "%s\n%!" msg
+  with exn ->
+    log #warn ~exn "access log : %s" (show_request req) ~structured_pairs:(pairs_of_request req)
+
+let emit_accesslog ch status size ?background req =
+  let code = match status with
+    | `No_reply -> None
+    | `Code code -> Some code
+    | #reply_status as code -> Some (status_code code)
+  in
+  match code with
+  | None -> ()
+  | Some code ->
+    if Log.State.is_structured_format ()
+    then log_access_logfmt ch code size ?background req
+    else log_access_apache ch code size ?background req
 
 (** Wait until [fd] becomes readable and close it (for eventfd-backed notifications) *)
 let wait base fd k =
@@ -439,7 +471,7 @@ let send_reply_user c req (code,hdrs,body) =
     (* hack for answer_forked, which logs on its own *)
     | ("X-Disable-Log", "true") :: hs -> hs
     | _ ->
-      if c.server.config.access_log_enabled then log_status_apache !(c.server.config.access_log) code (String.length body) req;
+      if c.server.config.access_log_enabled then emit_accesslog !(c.server.config.access_log) code (String.length body) req;
       hdrs
   in
   let hdrs = maybe_allow_cors c hdrs in
@@ -849,7 +881,7 @@ let answer_blocking ?(debug=false) srv req answer k =
       -1, None
   in
   if srv.config.access_log_enabled then
-    log_access_apache !(srv.config.access_log) code (Int64.to_int !count) ~background:(continue <> None) req;
+    emit_accesslog !(srv.config.access_log) (`Code code) (Int64.to_int !count) ~background:(continue <> None) req;
   call_me_maybe continue ()
 
 let stats = new Var.typ "httpev.forks" "k"
@@ -917,7 +949,7 @@ let send_reply c cout reply =
   begin match c.req with
   | Ready req ->
     let size = match body with `Body s -> String.length s | `Chunks _ -> 0 in
-    if c.server.config.access_log_enabled then log_status_apache !(c.server.config.access_log) code size req
+    if c.server.config.access_log_enabled then emit_accesslog !(c.server.config.access_log) code size req
   | _ -> () (* this can happen when sending back error reply on malformed HTTP input *)
   end;
   (* filter headers *)

web.ml

@@ -6,7 +6,7 @@ open Prelude
 open Control
 open Ocamlnet_lite
 
-let log = Log.self
+let log = Log.from "devkit.web"
 
 (** percent-encode (convert space into %20) *)
 let rawurlencode = Netencoding.Url.encode ~plus:false