unikernel/duniverse/mirage-logs/.gitignore

@@ -0,0 +1,6 @@
+_build
+*~
+\.\#*
+\#*#
+.merlin
+*.install

unikernel/duniverse/mirage-logs/.ocamlformat

@@ -0,0 +1,3 @@
+version = 0.26.0
+profile = conventional
+parse-docstrings = true

unikernel/duniverse/mirage-logs/CHANGES.md

@@ -0,0 +1,51 @@
+## v3.0.0 (2025-03-05)
+
+- Use mirage-ptime (a dune variant) instead of mirage-clock (#29 @hannesm)
+
+## v2.1.0 (2023-10-17)
+
+- use Logs.pp_level instead of a custom string_of_level (#23 @hannesm)
+- avoid global buffer, reuse Logs_fmt.pp_header for color (#25 @hannesm,
+  fixes #24)
+
+## v2.0.0 (2023-07-06)
+
+- Bump to Dune3 (#19, @samoht)
+- Remove `create` optional `ring_size` `console_threshold` parameters
+  (#21, @hannesm)
+- use Ptime.pp_rfc3339 for nicer output (esp. if time zone offset is
+  None) (#21, @hannesm)
+- Remove custom types (`type t` / `set_reporter` / `unset_reporter` /
+  `reporter`) (#21, @hannesm)
+- Add mirage-logs.cli to define Cmdliner terms (#20, @samoht)
+
+## v1.3.0 (2023-03-12)
+
+- Remove the mirage-profile dependency (#18 @hannesm)
+
+## v1.2.0 (2019-11-01)
+
+- Adapt to mirage-clock 3.0.0 interface changes (#17 @hannesm)
+
+## v1.1.0 (2019-07-12)
+
+- Emit log with a header value if present (#14 @talex5)
+
+## v1.0.0 (2019-04-14)
+
+- Port to dune (#13 @TheLortex @avsm)
+- Upgrade opam metadata to 2.0 format (#13 @TheLortex @avsm)
+- Test on OCaml 4.07 so that 4.04-4.07 is the supported matrix (@avsm).
+
+## 0.3.0 (2017-01-19)
+
+- Build against MirageOS 3, and drop support for earlier versions.
+- Port to topkg.
+
+## 0.2.0 (2016-04-28)
+
+- Add a `set_reporter` function (#1, @samoht)
+
+## 0.1 (2016-02-18)
+
+- Initial release (@talex5)

unikernel/duniverse/mirage-logs/LICENSE.md

@@ -0,0 +1,10 @@
+Copyright (c) 2016, Thomas Leonard
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

unikernel/duniverse/mirage-logs/README.md

@@ -0,0 +1,9 @@
+# Mirage-Logs
+
+A reporter for the [Logs][] library that writes log messages to `stderr`, using
+a Mirage `CLOCK` to add timestamps.
+
+See `mirage_logs.mli` for details.
+
+[Logs]: http://erratique.ch/software/logs
+

unikernel/duniverse/mirage-logs/dune-project

@@ -0,0 +1,3 @@
+(lang dune 3.0)
+(name mirage-logs)
+(version v3.0.0)

unikernel/duniverse/mirage-logs/mirage-logs.opam

@@ -0,0 +1,30 @@
+version: "3.0.0"
+opam-version: "2.0"
+maintainer: "talex5@gmail.com"
+authors: [ "Thomas Leonard" ]
+license: "ISC"
+homepage: "https://github.com/mirage/mirage-logs"
+dev-repo: "git+https://github.com/mirage/mirage-logs.git"
+bug-reports: "https://github.com/mirage/mirage-logs/issues"
+doc: "https://mirage.github.io/mirage-logs/"
+tags: ["org:mirage"]
+depends: [
+  "ocaml" { >= "4.08.0" }
+  "dune" {>= "3.0"}
+  "logs" { >= "0.5.0" }
+  "fmt" { >= "0.9.0" }
+  "ptime" { >= "0.8.1" }
+  "mirage-ptime" { >= "4.0.0" }
+  "cmdliner" { >= "1.1.0" }
+  "alcotest" {with-test}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name] {with-test}
+]
+synopsis: "A reporter for the Logs library that writes log messages to stderr, using a Mirage `CLOCK` to add timestamps"
+description: """
+The Logs reporter prefixes each entry with a timestamp, and writes it to stderr.
+"""
+x-maintenance-intent: [ "(latest)" ]

unikernel/duniverse/mirage-logs/src/dune

@@ -0,0 +1,11 @@
+(library
+ (name mirage_logs)
+ (public_name mirage-logs)
+ (modules mirage_logs)
+ (libraries logs mirage-ptime ptime logs.fmt fmt))
+
+(library
+ (name mirage_logs_cli)
+ (public_name mirage-logs.cli)
+ (modules mirage_logs_cli)
+ (libraries cmdliner logs logs.cli))

unikernel/duniverse/mirage-logs/src/mirage_logs.ml

@@ -0,0 +1,29 @@
+(* Copyright (C) 2016, Thomas Leonard <thomas.leonard@unikernel.com>
+   See the README file for details. *)
+
+let pp_tags f tags =
+  let pp tag () =
+    let (Logs.Tag.V (def, value)) = tag in
+    Format.fprintf f " %s=%a" (Logs.Tag.name def) (Logs.Tag.printer def) value;
+    ()
+  in
+  Logs.Tag.fold pp tags ()
+
+let create ?(ch = Format.err_formatter) () =
+  let report src level ~over k msgf =
+    let tz_offset_s = Mirage_ptime.current_tz_offset_s () in
+    let posix_time = Mirage_ptime.now () in
+    let src = Logs.Src.name src in
+    msgf @@ fun ?header ?tags fmt ->
+    let k _ =
+      over ();
+      k ()
+    in
+    Format.kfprintf k ch
+      ("%a:%a %a [%s] @[" ^^ fmt ^^ "@]@.")
+      (Ptime.pp_rfc3339 ?tz_offset_s ())
+      posix_time
+      Fmt.(option ~none:(any "") pp_tags)
+      tags Logs_fmt.pp_header (level, header) src
+  in
+  { Logs.report }

unikernel/duniverse/mirage-logs/src/mirage_logs.mli

@@ -0,0 +1,14 @@
+(* Copyright (C) 2016, Thomas Leonard <thomas.leonard@unikernel.com>
+   See the README file for details. *)
+
+(** MirageOS support for the Logs library.
+
+    This is the default log reporter used by MirageOS. *)
+
+val create : ?ch:Format.formatter -> unit -> Logs.reporter
+(** [create ~ch ()] is a Logs reporter that logs to [ch] (defaults to
+    [Format.err_formatter]), with time-stamps provided by [Clock].
+
+    If logs are written faster than the backend can consume them, the whole
+    unikernel will block until there is space (so log messages will not be lost,
+    but unikernels generating a lot of log output may run slowly). *)

unikernel/duniverse/mirage-logs/src/mirage_logs_cli.ml

@@ -0,0 +1,83 @@
+(*
+ * Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
+ * Copyright (c) 2023 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Cmdliner
+
+type threshold = [ `All | `Src of string ] * Logs.level option
+
+let err str = Error (`Msg ("Can't parse log threshold: " ^ str))
+
+module Conv = struct
+  let threshold =
+    let parser str =
+      let source = function "*" -> `All | s -> `Src s in
+      let level src s =
+        match Logs.level_of_string s with
+        | Ok s -> Ok (src, s)
+        | Error _ as e -> e
+      in
+      match String.split_on_char ':' str with
+      | [ src; "-" ] -> Ok (source src, None)
+      | [ src; lvl ] -> level (source src) lvl
+      | _ -> err str
+    in
+    let serialize ppf = function
+      | `All, l -> Format.pp_print_string ppf (Logs.level_to_string l)
+      | `Src s, l -> Format.fprintf ppf "%s:%s" s (Logs.level_to_string l)
+    in
+    Arg.conv (parser, serialize)
+end
+
+let set_levels ~default l =
+  let srcs = Logs.Src.list () in
+  let default =
+    try snd @@ List.find (function `All, _ -> true | _ -> false) l
+    with Not_found -> default
+  in
+  Logs.set_level default;
+  List.iter
+    (function
+      | `All, _ -> ()
+      | `Src src, level -> (
+          try
+            let s = List.find (fun s -> Logs.Src.name s = src) srcs in
+            Logs.Src.set_level s level
+          with Not_found ->
+            Format.printf "WARNING: %s is not a valid log source.\n%!" src))
+    l
+
+let env = Cmd.Env.info "LOGGING_LEVELS"
+
+let levels ?(env = env) ?docs () =
+  let logs = Arg.list Conv.threshold in
+  let doc =
+    "Be more or less verbose. $(docv) must be of the form \
+     $(b,'*:info,foo:debug') means that that the log threshold is set to \
+     $(b,'info') for every log sources but the $(b,'foo') which is set to \
+     $(b,'debug'). Use $(b,'quiet') or $(b,'-') to disable a souce. And \
+     $(b,'*') to consider all sources. For instance $(b, '*-,foo:debug') \
+     disable all sources but $(b,foo) which is set to $(b, debug).'"
+  in
+  let doc = Arg.info ~env ~docv:"LEVEL" ~doc ?docs [ "l"; "logging-levels" ] in
+  Arg.(value & opt logs [] doc)
+
+let docs = "DISPLAY OPTIONS"
+
+let setup =
+  Term.(
+    const (fun default levels -> set_levels ~default levels)
+    $ Logs_cli.level ~docs () $ levels ~docs ())

unikernel/duniverse/mirage-logs/src/mirage_logs_cli.mli

@@ -0,0 +1,77 @@
+(*
+ * Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
+ * Copyright (c) 2023 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** {2 Log Thresholds} *)
+
+open Cmdliner
+
+type threshold = [ `All | `Src of string ] * Logs.level option
+(** [threshold] type is used to control logging level and source.
+
+    The first element of the pair is a source pattern. It can be either [`All]
+    (representing all the existing and new sources) or [`Src src], representing
+    the specific logging source named [src].
+
+    The second element is the logging level. A log level of [None] indicates
+    that logging is disabled for this source. If the level is [Some l] then any
+    message whose level is smaller or equal to [l] is reported. *)
+
+val env : Cmd.Env.info
+(** [env] is the environment variable [LOGGING_LEVELS]. *)
+
+val levels : ?env:Cmd.Env.info -> ?docs:string -> unit -> threshold list Term.t
+(** [levels ~docs ~env ()] is a term that processes command-line arguments and
+    environment variables to produce a list of thresholds for logging.
+
+    [docs] is the title of the man page section in which the argument will be
+    listed. [env] defines the name of an environment variable which is looked up
+    for defining the argument if it is absent from the command line (default is
+    {!logging_levels_env}). See the description of [docs] and [env] in the
+    {{:https://erratique.ch/software/cmdliner/doc/Cmdliner/Arg/index.html#val-info}
+      Cmdliner manual} for more details.
+
+    The option work as follow:
+
+    - The parameters is split into groups on ','
+    - each group is turned into a threshold but splitting it on ':'
+    - the expected logging levels are ["app"], ["error"], ["warning"], ["info"]
+      and ["debug"]. The are translated into the equivalent [Some d] value.
+    - To disable a source, use ["quiet"] or ["-"] to get a [None] value.
+
+    For instance, [--logging-level '*:info,foo:debug,bar:-'] is evaluated as
+    follows.
+
+    - ["*:info"] is [(`All, Some Logs.Info)];
+    - ["foo:debug"] is [(`Src "foo", Some Logs.debug)]; and
+    - ["bar:-"] is [(`Src "bar", None)]
+
+    This means: use the default logging threshold [Logs.Info] for all sources,
+    apart from the source ["foo"] that should use [Logs.Debug] and the source
+    ["bar"] that should be disabled. *)
+
+val set_levels : default:Logs.level option -> threshold list -> unit
+(** [set_levels ~default l] configures the logging system to use all the log
+    sources that appear in the threshold list [l]. If a log source is not
+    present in [l], then the default logging level is applied.
+
+    If the default level is [Some l] then any message sent to a source not in
+    [l] and whose level is smaller or equal to [l] is reported. If the default
+    level is [None] no message other than the ones in [l] are ever reported. *)
+
+val setup : unit Term.t
+(** [setup] is a term that the init the logging system using [set_levels]. It
+    parses the command-line arguments with [levels] and {!Logs_cli.setup_log}.*)

unikernel/duniverse/mirage-logs/test/dune

@@ -0,0 +1,4 @@
+(test
+ (name test)
+ (libraries alcotest mirage-logs mirage-ptime.mock mirage-ptime.set)
+ (package mirage-logs))

unikernel/duniverse/mirage-logs/test/test.ml

@@ -0,0 +1,49 @@
+(* Copyright (C) 2016, Thomas Leonard <thomas.leonard@unikernel.com>
+   See the README file for details. *)
+
+let src = Logs.Src.create "test" ~doc:"mirage-logs test code"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let noisy_src = Logs.Src.create "noisy" ~doc:"mirage-logs test noisy library"
+
+module Noisy = (val Logs.src_log noisy_src : Logs.LOG)
+
+let src_tag = Logs.Tag.def "src" ~doc:"Source address" Format.pp_print_string
+let port_tag = Logs.Tag.def "port" ~doc:"Port number" Format.pp_print_int
+let tags ~src ~port = Logs.Tag.(empty |> add src_tag src |> add port_tag port)
+
+let with_pipe fn =
+  let r, w = Unix.pipe () in
+  let r = Unix.in_channel_of_descr r in
+  let w = Unix.out_channel_of_descr w in
+  fn ~r ~w;
+  close_out w;
+  try
+    Alcotest.fail (Printf.sprintf "Unexpected data in pipe: %S" (input_line r))
+  with End_of_file -> close_in r
+
+let test_console r =
+  Log.info (fun f -> f "Simple test");
+  Alcotest.(check string)
+    "Simple" "1970-01-01T00:00:00Z: [INFO] [test] Simple test" (input_line r);
+  Log.warn (fun f ->
+      f ~tags:(tags ~src:"localhost" ~port:7000) "Packet rejected");
+  Alcotest.(check string)
+    "Tags"
+    "1970-01-01T00:00:00Z: src=localhost port=7000 [WARNING] [test] Packet \
+     rejected"
+    (input_line r);
+  Log.debug (fun f -> f "Not shown")
+
+let test () =
+  with_pipe @@ fun ~r ~w ->
+  Mirage_ptime_set.set_tz_offset (Some 0);
+  Logs.(set_level (Some Info));
+  let reporter =
+    Mirage_logs.create ~ch:(Format.formatter_of_out_channel w) ()
+  in
+  Logs.set_reporter reporter;
+  test_console r
+
+let () = Alcotest.run "mirage-logs" [ ("Tests", [ ("Logging", `Quick, test) ]) ]