Skip to content
Permalink

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also or learn more about diff comparisons.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also . Learn more about diff comparisons here.
base repository: mirage/mirage
Failed to load repositories. Confirm that selected base ref is valid, then try again.
Loading
base: c1ac016326cf^
Choose a base ref
...
head repository: mirage/mirage
Failed to load repositories. Confirm that selected head ref is valid, then try again.
Loading
compare: 425a0ef9d525
Choose a head ref
  • 7 commits
  • 13 files changed
  • 2 contributors

Commits on Apr 20, 2016

  1. Add mirage_logs support

    talex5 authored and Thomas Leonard committed Apr 20, 2016
    Copy the full SHA
    c1ac016 View commit details

Commits on Apr 27, 2016

  1. Add configure/runtime keys to parse log patterns.

    `-l foo:debug,info` means "print all the info message and the debug message
    coming from the source named 'foo'"
    samoht committed Apr 27, 2016
    Copy the full SHA
    1470181 View commit details
  2. Add the --logs to Mirage_keys

    samoht committed Apr 27, 2016
    Copy the full SHA
    8c6efee View commit details
  3. Re-implement the logging support.

    The new solution is a bit less powerful, but hopefuly simpler to
    parametrise -- also it can now be configured using the command-line
    options both at configuration and runtime.
    samoht committed Apr 27, 2016
    Copy the full SHA
    5abdaa1 View commit details
  4. Copy the full SHA
    9d29c24 View commit details
  5. Update autogen code

    samoht committed Apr 27, 2016
    Copy the full SHA
    54a3a76 View commit details
  6. Copy the full SHA
    425a0ef View commit details
Showing with 244 additions and 41 deletions.
  1. +1 −1 .merlin
  2. +1 −1 .travis.yml
  3. +2 −2 _oasis
  4. +4 −1 _tags
  5. +3 −3 lib/META
  6. +83 −7 lib/mirage.ml
  7. +49 −20 lib/mirage.mli
  8. +33 −0 lib/mirage_key.ml
  9. +2 −0 lib/mirage_key.mli
  10. +44 −1 lib_runtime/mirage_runtime.ml
  11. +14 −0 lib_runtime/mirage_runtime.mli
  12. +1 −0 mirage.opam
  13. +7 −5 setup.ml
2 changes: 1 addition & 1 deletion .merlin
Original file line number Diff line number Diff line change
@@ -3,7 +3,7 @@ S lib/*
S lib_runtime/*
S lib_test/*
PKG ipaddr unix dynlink lwt cmdliner mirage-types.lwt functoria rresult fmt
PKG astring
PKG astring logs

FLG -w +A-4-6-7-9-40-42-44-48
FLG -strict_sequence -safe_string
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
@@ -4,7 +4,7 @@ install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/ma
script: bash -ex .travis-ci.sh
env:
global:
- PINS="mirage-skeleton.dev:https://github.com/yomimono/mirage-skeleton.git#charrua-0.3 tcpip:https://github.com/mirage/mirage-tcpip.git mirage-types:https://github.com/mirage/mirage.git mirage:https://github.com/mirage/mirage.git"
- PINS="functoria mirage-skeleton.dev:https://github.com/yomimono/mirage-skeleton.git#dev mirage-types:https://github.com/mirage/mirage.git mirage:https://github.com/mirage/mirage.git mirage-logs:https://github.com/sammoht/mirage-logs.git"
matrix:
- UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.02 PACKAGE=mirage
- UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.02 PACKAGE=mirage-types
4 changes: 2 additions & 2 deletions _oasis
Original file line number Diff line number Diff line change
@@ -12,15 +12,15 @@ Library "mirage-runtime"
Findlibparent: mirage
Findlibname: runtime
Modules: Mirage_runtime, Mirage_info
BuildDepends: functoria.runtime, ipaddr, astring
BuildDepends: functoria.runtime, ipaddr, astring, logs

Library mirage
CompiledObject: best
Path: lib
Findlibname: mirage
Modules: Mirage, Mirage_key
InternalModules: Mirage_version
BuildDepends: ipaddr, functoria, mirage.runtime, functoria.app
BuildDepends: ipaddr, functoria, mirage.runtime, functoria.app, logs

Executable mirage
CompiledObject: best
5 changes: 4 additions & 1 deletion _tags
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: 4e91f4fbdf06d99d4c740d67793a5f80)
# DO NOT EDIT (digest: 1a42a65f41f3b4dd1e37a462f0e017cf)
# Ignore VCS directories, you can use the same kind of rule outside
# OASIS_START/STOP if you want to exclude directories that contains
# useless stuff for the build process
@@ -19,6 +19,7 @@ true: annot, bin_annot
<lib_runtime/*.ml{,i,y}>: pkg_astring
<lib_runtime/*.ml{,i,y}>: pkg_functoria.runtime
<lib_runtime/*.ml{,i,y}>: pkg_ipaddr
<lib_runtime/*.ml{,i,y}>: pkg_logs
# Library mirage
"lib/mirage.cmxs": use_mirage
# Executable mirage
@@ -27,13 +28,15 @@ true: annot, bin_annot
<lib/main.{native,byte}>: pkg_functoria.app
<lib/main.{native,byte}>: pkg_functoria.runtime
<lib/main.{native,byte}>: pkg_ipaddr
<lib/main.{native,byte}>: pkg_logs
<lib/main.{native,byte}>: use_mirage
<lib/main.{native,byte}>: use_mirage-runtime
<lib/*.ml{,i,y}>: pkg_astring
<lib/*.ml{,i,y}>: pkg_functoria
<lib/*.ml{,i,y}>: pkg_functoria.app
<lib/*.ml{,i,y}>: pkg_functoria.runtime
<lib/*.ml{,i,y}>: pkg_ipaddr
<lib/*.ml{,i,y}>: pkg_logs
<lib/*.ml{,i,y}>: use_mirage
<lib/*.ml{,i,y}>: use_mirage-runtime
# OASIS_STOP
6 changes: 3 additions & 3 deletions lib/META
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
# OASIS_START
# DO NOT EDIT (digest: 371d216c898653b3bb6e1e62ec252d5a)
# DO NOT EDIT (digest: ab220cb895cf759b43882124f815d3d4)
version = "2.8.0"
description = "Mirage configuration tool"
requires = "ipaddr functoria mirage.runtime functoria.app"
requires = "ipaddr functoria mirage.runtime functoria.app logs"
archive(byte) = "mirage.cma"
archive(byte, plugin) = "mirage.cma"
archive(native) = "mirage.cmxa"
@@ -11,7 +11,7 @@ exists_if = "mirage.cma"
package "runtime" (
version = "2.8.0"
description = "Mirage configuration tool"
requires = "functoria.runtime ipaddr astring"
requires = "functoria.runtime ipaddr astring logs"
archive(byte) = "mirage-runtime.cma"
archive(byte, plugin) = "mirage-runtime.cma"
archive(native) = "mirage-runtime.cmxa"
90 changes: 83 additions & 7 deletions lib/mirage.ml
Original file line number Diff line number Diff line change
@@ -949,9 +949,68 @@ let argv_xen = impl @@ object

let argv_dynamic = if_impl Key.is_xen argv_xen argv_unix

(** Log reporting *)

type reporter = job
let reporter = job

let pp_level ppf = function
| Logs.Error -> Fmt.string ppf "Logs.Error"
| Logs.Warning -> Fmt.string ppf "Logs.Warning"
| Logs.Info -> Fmt.string ppf "Logs.Info"
| Logs.Debug -> Fmt.string ppf "Logs.Debug"
| Logs.App -> Fmt.string ppf "Logs.App"

let mirage_log ?ring_size ~default =
let logs = Key.logs in
impl @@ object
inherit base_configurable
method ty = clock @-> reporter
method name = "mirage_logs"
method module_name = "Mirage_logs.Make"
method packages = Key.pure ["mirage-logs"]
method libraries = Key.pure ["mirage-logs"]
method keys = [ Key.abstract logs ]
method connect info modname _ =
let pp_console_threshold ppf () =
match Key.get (Info.context info) logs with
| [] -> Fmt.string ppf "None"
| _ ->
Fmt.pf ppf "Some (Mirage_runtime.threshold ~default:%a %a)"
pp_level default pp_key logs
in
let pp_ring_buffer ppf () =
match ring_size with
| None -> Fmt.string ppf "None"
| Some i -> Fmt.pf ppf "Some %d" i
in
Fmt.strf
"@[<v 2>\
let console_threshold =@,@[<v 2>%a@]@,in@ \
let ring_size = %a in@ \
let reporter = %s.create ?ring_size ?console_threshold () in@ \
let level = match %a with@ \
\ | [] -> None@ \
\ | l -> Some (Mirage_runtime.log_level l)@ \
in@ \
Logs.set_level level;@ \
%s.set_reporter reporter;@ \
Lwt.return (`Ok ())"
pp_console_threshold ()
pp_ring_buffer ()
modname
pp_key logs
modname
end

let default_reporter
?(clock=default_clock) ?ring_size ?(level=Logs.Warning) () =
mirage_log ?ring_size ~default:level $ clock

(** Tracing *)

type tracing = job impl
type tracing = job
let tracing = job

let mprof_trace ~size () =
let unix_trace_file = "trace.ctf" in
@@ -1470,7 +1529,7 @@ module Project = struct
"open Lwt\n\
let run = OS.Main.run"
let driver_error = driver_error
let argv = argv_dynamic
let init = [Functoria_app.keys argv_dynamic]

let create jobs = impl @@ object
inherit base_configurable
@@ -1503,6 +1562,18 @@ end

include Functoria_app.Make (Project)

let in_parallel = function
| [singleton] -> singleton
| jobs ->
impl @@ object
inherit base_configurable
method ty = job
method name = "group"
method module_name = "Functoria_runtime"
method connect _ _mod _names = "Lwt.return (`Ok ())"
method deps = List.map abstract jobs
end

(** {Deprecated functions} *)

let get_mode () = Key.(get (get_base_context ()) target)
@@ -1517,12 +1588,17 @@ let add_to_opam_packages l =

(** {Custom registration} *)

let register ?tracing ?keys ?(libraries=[]) ?(packages=[]) name jobs =
let register
?tracing ?(reporter=Some (default_reporter ()))
?keys ?(libraries=[]) ?(packages=[])
name jobs =
let libraries = !libraries_ref @ libraries in
let packages = !packages_ref @ packages in
let jobs = match tracing with
| None -> jobs
| Some tracing ->
tracing :: jobs
let jobs = in_parallel jobs in
let jobs = match reporter, tracing with
| None , None -> [jobs]
| None , Some t -> [t; jobs]
| Some r, None -> [r; jobs]
| Some r, Some t -> [r; t; jobs]
in
register ?keys ~libraries ~packages name jobs
69 changes: 49 additions & 20 deletions lib/mirage.mli
Original file line number Diff line number Diff line change
@@ -30,29 +30,16 @@ include Functoria_app.DSL
(** {2 General mirage devices} *)

type tracing
(** The type for tracing. *)

val mprof_trace : size:int -> unit -> tracing
(** Use mirage-profile to trace the unikernel.
On Unix, this creates and mmaps a file called "trace.ctf".
On Xen, it shares the trace buffer with dom0.
@param size: size of the ring buffer to use
*)

(** {3 Application registering} *)
val tracing: tracing typ
(** Implementation of the {!tracing} type. *)

val register :
?tracing:tracing ->
?keys:Key.t list ->
?libraries:string list ->
?packages:string list -> string -> job impl list -> unit
(** [register name jobs] registers the application named by [name]
which will executes the given [jobs].
@param libraries The ocamlfind libraries needed by this module.
@param packages The opam packages needed by this module.
@param keys The keys related to this module.
val mprof_trace : size:int -> unit -> tracing impl
(** Use mirage-profile to trace the unikernel. On Unix, this creates
and mmaps a file called "trace.ctf". On Xen, it shares the trace
buffer with dom0. @param size: size of the ring buffer to use. *)

@param tracing Enable tracing and give a default depth.
*)


(** {2 Time} *)
@@ -81,6 +68,25 @@ val default_clock: clock impl



(** {2 Log reporters} *)

type reporter
(** The type for log reporters. *)

val reporter: reporter typ
(** Implementation of the log {!reporter} type. *)

val default_reporter:
?clock:clock impl -> ?ring_size:int -> ?level:Logs.level ->
unit -> reporter impl
(** [default_reporter ?clock ?level ()] is the log reporter that
prints log messages to the console, timestampted with [clock]. If
not provided, the default clock is {!default_clock]}. [level] is
the default log threshold. It is [Logs.Warning] is not
specified. *)



(** {2 Random} *)

type random
@@ -93,6 +99,7 @@ val default_random: random impl
(** Passthrough to the OCaml Random generator. *)



(** {2 Consoles} *)

type console
@@ -432,6 +439,28 @@ val add_to_ocamlfind_libraries : string list -> unit
@deprecated Use the [~libraries] argument from {!register}.
*)


(** {2 Application registering} *)

val register :
?tracing:tracing impl ->
?reporter:reporter impl option ->
?keys:Key.t list ->
?libraries:string list ->
?packages:string list -> string -> job impl list -> unit
(** [register name jobs] registers the application named by [name]
which will executes the given [jobs].
@param libraries The ocamlfind libraries needed by this module.
@param packages The opam packages needed by this module.
@param keys The keys related to this module.
@param tracing Enable tracing.
@param reporter Configure logging. The default log reporter is
[Some {!default_reporter}]. To disable logging, use the [None].
*)


(**/**)

val run : unit -> unit
33 changes: 33 additions & 0 deletions lib/mirage_key.ml
Original file line number Diff line number Diff line change
@@ -264,6 +264,39 @@ module V6 = struct

end

let pp_level ppf = function
| Logs.Error -> Fmt.string ppf "Logs.Error"
| Logs.Warning -> Fmt.string ppf "Logs.Warning"
| Logs.Info -> Fmt.string ppf "Logs.Info"
| Logs.Debug -> Fmt.string ppf "Logs.Debug"
| Logs.App -> Fmt.string ppf "Logs.App"

let pp_pattern ppf = function
| `All -> Fmt.string ppf "`All"
| `Src s -> Fmt.pf ppf "`Src %S" s

let pp_threshold ppf (pattern, level) =
Fmt.pf ppf "(%a,@ %a)" pp_pattern pattern pp_level level

let logs =
let env = "MIRAGE_LOGS" in
let docs = unikernel_section in
let conv = Cmdliner.Arg.list Mirage_runtime.Arg.log_threshold in
let serialize ppf levels =
Fmt.(pf ppf "[%a]" (list ~sep:(const string ";@ ") pp_threshold) levels)
in
let runtime_conv = "(Cmdliner.Arg.list Mirage_runtime.Arg.log_threshold)" in
let doc =
strf "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)."
in
let logs = Key.Arg.conv ~conv ~serialize ~runtime_conv in
let info = Key.Arg.info ~env ~docv:"LEVEL" ~doc ~docs ["l";"logs"] in
let arg = Key.Arg.(opt logs []) info in
Key.create "logs" arg

(* FIXME: this is a crazy *)
include (Key: module type of struct include Functoria_key end
with module Arg := Arg and module Alias := Alias)
2 changes: 2 additions & 0 deletions lib/mirage_key.mli
Original file line number Diff line number Diff line change
@@ -121,3 +121,5 @@ module V6 : sig
(** A list of gateways. *)

end

val logs: Mirage_runtime.log_threshold list key
Loading