diff --git a/scripts/licenses.ml b/scripts/licenses.ml index 279526527..8c12a1b31 100644 --- a/scripts/licenses.ml +++ b/scripts/licenses.ml @@ -785,7 +785,7 @@ All rights reserved. link = "https://github.com/mirage/mirage-protocols/blob/37aa4a86f9f423bb7fe1d70c8a71331060a45048/LICENSE.md"; text = isc; } - | "psq.0.2.0" -> { + | "psq.0.2.0" | "psq.0.2.1" -> { link = "https://github.com/pqwy/psq/blob/beeaf9396655d195f9a20243102c9773d826d3b0/LICENSE.md"; text = {| Copyright (c) 2016 David Kaloper Meršinjak @@ -1003,7 +1003,7 @@ might be covered by the GNU Lesser General Public License. |} ^ mit } - | "lru.0.3.0" -> { + | "lru.0.3.0" | "lru.0.3.1" -> { link = "https://github.com/pqwy/lru/blob/3a0b5f9effa86f6615501a648069b9a12c5096e5/LICENSE.md"; text = {| Copyright (c) 2016 David Kaloper Meršinjak diff --git a/src/bin/logging.ml b/src/bin/logging.ml index 123b7eb99..1adeebb5b 100644 --- a/src/bin/logging.ml +++ b/src/bin/logging.ml @@ -5,95 +5,28 @@ let s = Unix.gettimeofday () in let tm = Unix.gmtime s in let nsecs = Float.rem s Float.one *. 1e9 |> int_of_float in - Fmt.pf f "%04d-%02d-%02dT%02d:%02d:%02d.%09dZ" (tm.tm_year + 1900) (tm.tm_mon + 1) + Fmt.pf f "time=\"%04d-%02d-%02dT%02d:%02d:%02d.%09dZ\"" (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec nsecs -let process = Filename.basename Sys.argv.(0) - -let with_lock m f x = - Mutex.lock m; - try - let result = f x in - Mutex.unlock m; - result - with e -> - Mutex.unlock m; - raise e - -let buffer = Buffer.create 128 -let m = Mutex.create () -let c = Condition.create () -let shutdown_requested = ref false -let shutdown_done = ref false - -let shutdown () = - with_lock m - (fun () -> - shutdown_requested := true; - Buffer.add_string buffer "logging system has shutdown"; - Condition.broadcast c; - while not !shutdown_done do - Condition.wait c m; - done - ) () - let reporter = - let max_buffer_size = 65536 in - let dropped_bytes = ref 0 in - let (_: Thread.t) = Thread.create (fun () -> - let rec next () = match Buffer.contents buffer with - | "" -> - Condition.wait c m; - next () - | data -> - let dropped = !dropped_bytes in - dropped_bytes := 0; - Buffer.reset buffer; - data, dropped in - let should_continue () = match Buffer.contents buffer with - | "" -> - if !shutdown_requested then begin - shutdown_done := true; - Condition.broadcast c; - end; - not !shutdown_done - | _ -> true (* more logs to print *) in - let rec loop () = - let data, dropped = with_lock m next () in - (* Block writing to stderr without the buffer mutex held. Logging may continue into the buffer. *) - output_string stderr data; - if dropped > 0 then begin - output_string stderr (Printf.sprintf "%d bytes of logs dropped\n" dropped) - end; - flush stderr; - if with_lock m should_continue () then loop () in - loop () - ) () in - let buffer_fmt = Format.formatter_of_buffer buffer in - - let report src level ~over k msgf = let k _ = - Condition.broadcast c; over (); k () in let src = Logs.Src.name src in - msgf @@ fun ?header:_ ?tags:_ fmt -> + let with_stamp _h _tags k fmt = let level = Logs.level_to_string (Some level) in - with_lock m - (fun () -> - let destination = - if Buffer.length buffer > max_buffer_size then begin - Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()) - end else buffer_fmt in - Format.kfprintf k destination - ("[%a][%a][%a] %a: " ^^ fmt ^^ "@.") - pp_ptime () - Fmt.string process - Fmt.string level - Fmt.string src - ) () + + Fmt.kpf k Fmt.stderr + ("\r%a level=%a @[msg=\"%a: " ^^ fmt ^^ "\"@]@.") + pp_ptime () + Fmt.string level + Fmt.string src + + in + msgf @@ fun ?header ?tags fmt -> + with_stamp header tags k fmt in { Logs.report } diff --git a/src/hostnet/hostnet_dns.ml b/src/hostnet/hostnet_dns.ml index 80d55f9de..d7f2799fa 100644 --- a/src/hostnet/hostnet_dns.ml +++ b/src/hostnet/hostnet_dns.ml @@ -85,12 +85,12 @@ module Policy(Files: Sig.FILES) = struct Files.read_file resolv_conf >>= function | Error (`Msg m) -> - Log.info (fun f -> f "reading %s: %s" resolv_conf m); + Log.warn (fun f -> f "reading %s: %s" resolv_conf m); Lwt.return_unit | Ok txt -> begin match Dns_forward.Config.Unix.of_resolv_conf txt with | Error (`Msg m) -> - Log.err (fun f -> f "parsing %s: %s" resolv_conf m); + Log.warn (fun f -> f "parsing %s: %s" resolv_conf m); Lwt.return_unit | Ok servers -> add ~priority:2 ~config:(`Upstream servers); diff --git a/src/hostnet/hostnet_http.ml b/src/hostnet/hostnet_http.ml index 910bc5f8b..216b5411d 100644 --- a/src/hostnet/hostnet_http.ml +++ b/src/hostnet/hostnet_http.ml @@ -219,7 +219,7 @@ module Make with e -> Lwt.return (Error (`Msg (Printf.sprintf "parsing json: %s" (Printexc.to_string e)))) - let to_string t = Ezjsonm.to_string ~minify:true @@ to_json t + let to_string t = Ezjsonm.to_string ~minify:false @@ to_json t let create ?http ?https ?exclude ?(transparent_http_ports=[ 80 ]) ?(transparent_https_ports=[ 443 ]) ?(allow_enabled=false) ?(allow=[]) ?(allow_error_msg = default_error_msg) () = let http = match http with None -> None | Some x -> proxy_of_string x in diff --git a/src/hostnet/slirp.ml b/src/hostnet/slirp.ml index ec7daaf06..765064b61 100644 --- a/src/hostnet/slirp.ml +++ b/src/hostnet/slirp.ml @@ -1,7 +1,7 @@ open Lwt.Infix let src = - let src = Logs.Src.create "slirp" ~doc:"Mirage TCP/IP <-> socket proxy" in + let src = Logs.Src.create "usernet" ~doc:"Mirage TCP/IP <-> socket proxy" in Logs.Src.set_level src (Some Logs.Info); src