swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

6
unikernel/duniverse/metrics/.gitignore vendored Normal file
View file

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

6
unikernel/duniverse/metrics/.ocamlformat Normal file
View file

@ -0,0 +1,6 @@
version=0.27.0
cases-exp-indent=2
break-infix = fit-or-vertical
parse-docstrings = true
indicate-multiline-delimiters=no
nested-match=align

50
unikernel/duniverse/metrics/CHANGES.md Normal file
View file

@ -0,0 +1,50 @@
## v0.5.0 (2025-06-16)
- Cache_reporter: add a get_cache function, remove the returned get_cache
function, document get_cache depends on cache_reporter (#63 @reynir @hannesm)
- Cache_reporter: add a callback function for pushing updates (#63 @hannesm)
- Cache_reporter: preserve a list of (tags, data), fixes #59 (#68 @hannesm)
- Update uuidm (#61 @reynir)
- Fix documentation link (reported in #62 by @reynir, fixed #69 by @hannesm)
- Fix documentation of Src.v (reported in #64 by @reynir, fixed #69 by @hannesm)
## v0.4.1 (2023-06-08)
- metrics-unix: adapt to mtime 2.0.0 changes (remove dependency on mtime.clock)
(#58 @adatario)
## v0.4.0 (2022-01-28)
- metrics-influx: remove astring dependency (#52 @hannesm)
- metrics-rusage: remove rresult dependency (#52 @hannesm)
- metrics-mirage: remove this package (unused, #53 @hannesm)
- metrics: provide tags_enabled and all_enabled to allow introspection what
sources are enabled (#55 @hannesm, requested by @reynir in #54)
## v0.3.0 (2021-06-02)
- Add a metrics-rusage opam package that collects data from getrusage and
/proc/self/stat (and /proc/self/statm). (#50, @reynir and @hannesm)
- Update ocamlformat to 0.18.0
- "pinned" is now "dev" in opam files
## 0.2.0 (2020-05-03)
- Add mirage layer and influxdb reporter (#28, @hannesm)
- Gnuplot: namespacing improvements (#34, @CraigFe)
- Gnuplot: optional graph generation (#35, @CraigFe)
- Support OCaml 4.08 (#37, @CraigFe)
- Use OCamlFormat 0.14.1 (#38, #45, @CraigFe and @samoht)
- opam: remove the 'build' directive on dune dependency (#43, @CraigFe)
- introduce Metrics.cache_reporter -- a reporter holding the most recent
measurement from each reporting sources (#42, @hannesm)
- Influx: expose the "encode_line_protocol" function (#42, @hannesm)
- Metrics_lwt: provide a source based on Logs.warn_count and
Logs.error_count (#42, @hannesm)
- Metrics_lwt: provide a function to periodically poll a source
(used e.g. for GC stats etc.) (#42, @hannesm)
- Mirage: fix the mirage subpackage for newer mirage APIs (#42, @hannesm)
## 0.1.0 (2018-10-19)
Initial version

13
unikernel/duniverse/metrics/LICENSE.md Normal file
View file

@ -0,0 +1,13 @@
## ISC License
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.

10
unikernel/duniverse/metrics/Makefile Normal file
View file

@ -0,0 +1,10 @@
.PHONY: all clean test
all:
dune build
clean:
dune clean
test:
dune runtest

31
unikernel/duniverse/metrics/README.md Normal file
View file

@ -0,0 +1,31 @@
### Metrics -- Metrics infrastructure for OCaml
Metrics provides a basic infrastructure to monitor and gather runtime
metrics for OCaml program. Monitoring is performed on sources, indexed
by tags, allowing users to enable or disable at runtime the gathering
of data-points. As disabled metric sources have a low runtime cost
(only a closure allocation), the library is designed to instrument
production systems.
Metric reporting is decoupled from monitoring and is handled by a
custom reporter. A few reporters are (will be) provided by default.
Metrics is heavily inspired by
[Logs](http://erratique.ch/software/logs).
## Installation
Metrics can be installed with `opam`:
opam install metrics
If you don't use `opam` consult the [`opam`](opam) file for build
instructions.
## Documentation
The documentation and API reference is automatically generated by
`odoc` from the interfaces. It can be consulted [online][5].
[5]: https://ocaml.org/p/metrics/latest/doc/Metrics/index.html

4
unikernel/duniverse/metrics/dune-project Normal file
View file

@ -0,0 +1,4 @@
(lang dune 1.4)
(name metrics)
(version v0.5.0)
(using fmt 1.0)

26
unikernel/duniverse/metrics/metrics-influx.opam Normal file
View file

@ -0,0 +1,26 @@
version: "0.5.0"
opam-version: "2.0"
maintainer: "thomas@gazagnaire.org"
authors: ["Hannes Mehnert"]
license: "ISC"
homepage: "https://github.com/mirage/metrics"
bug-reports: "https://github.com/mirage/metrics/issues"
dev-repo: "git+https://github.com/mirage/metrics.git"
doc: "https://mirage.github.io/metrics/"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.05.0"}
"dune" {>= "1.4"}
"metrics" {= version}
"fmt" {>= "0.8.7"}
"duration"
"lwt" {>= "2.4.7"}
]
synopsis: "Influx reporter for the Metrics library"
x-maintenance-intent: [ "(latest)" ]

25
unikernel/duniverse/metrics/metrics-lwt.opam Normal file
View file

@ -0,0 +1,25 @@
version: "0.5.0"
opam-version: "2.0"
maintainer: "thomas@gazagnaire.org"
authors: ["Thomas Gazagnaire"]
license: "ISC"
homepage: "https://github.com/mirage/metrics"
bug-reports: "https://github.com/mirage/metrics/issues"
dev-repo: "git+https://github.com/mirage/metrics.git"
doc: "https://mirage.github.io/metrics/"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.05.0"}
"dune" {>= "1.4"}
"metrics" {= version}
"lwt" {>= "2.4.7"}
"logs"
]
synopsis: "Lwt backend for the Metrics library"
x-maintenance-intent: [ "(latest)" ]

26
unikernel/duniverse/metrics/metrics-rusage.opam Normal file
View file

@ -0,0 +1,26 @@
version: "0.5.0"
opam-version: "2.0"
maintainer: "team@robur.coop"
authors: ["Reynir Bjoernsson" "Hannes Mehnert"]
license: "ISC"
homepage: "https://github.com/mirage/metrics"
bug-reports: "https://github.com/mirage/metrics/issues"
dev-repo: "git+https://github.com/mirage/metrics.git"
doc: "https://mirage.github.io/metrics/"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.08.0"}
"dune" {>= "1.4"}
"metrics" {= version}
"logs"
"fmt" {>= "0.8.7"}
]
conflicts: [ "result" {< "1.5"} ]
synopsis: "Resource usage (getrusage) sources for the Metrics library"
x-maintenance-intent: [ "(latest)" ]

29
unikernel/duniverse/metrics/metrics-unix.opam Normal file
View file

@ -0,0 +1,29 @@
version: "0.5.0"
opam-version: "2.0"
maintainer: "thomas@gazagnaire.org"
authors: ["Thomas Gazagnaire"]
license: "ISC"
homepage: "https://github.com/mirage/metrics"
bug-reports: "https://github.com/mirage/metrics/issues"
dev-repo: "git+https://github.com/mirage/metrics.git"
doc: "https://mirage.github.io/metrics/"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.05.0"}
"dune" {>= "1.4"}
"uuidm" {>= "0.9.9"}
"metrics" {= version}
"mtime" {>= "1.0.0"}
"lwt" {>= "2.4.7"}
"metrics-lwt" {= version & with-test}
"conf-gnuplot"
"fmt" {>= "0.8.7"}
]
synopsis: "Unix backend for the Metrics library"
x-maintenance-intent: [ "(latest)" ]

38
unikernel/duniverse/metrics/metrics.opam Normal file
View file

@ -0,0 +1,38 @@
version: "0.5.0"
opam-version: "2.0"
maintainer: "thomas@gazagnaire.org"
authors: ["Thomas Gazagnaire"]
license: "ISC"
homepage: "https://github.com/mirage/metrics"
bug-reports: "https://github.com/mirage/metrics/issues"
dev-repo: "git+https://github.com/mirage/metrics.git"
doc: "https://mirage.github.io/metrics/"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.04.0"}
"dune" {>= "1.4"}
"fmt" {>= "0.8.7"}
"alcotest" {with-test}
]
synopsis: "Metrics infrastructure for OCaml"
description: """
Metrics provides a basic infrastructure to monitor and gather runtime
metrics for OCaml program. Monitoring is performed on sources, indexed
by tags, allowing users to enable or disable at runtime the gathering
of data-points. As disabled metric sources have a low runtime cost
(only a closure allocation), the library is designed to instrument
production systems.
Metric reporting is decoupled from monitoring and is handled by a
custom reporter. A few reporters are (will be) provided by default.
Metrics is heavily inspired by
[Logs](http://erratique.ch/software/logs).
"""
x-maintenance-intent: [ "(latest)" ]

3
unikernel/duniverse/metrics/src/core/dune Normal file
View file

@ -0,0 +1,3 @@
(library
(public_name metrics)
(libraries fmt))

527
unikernel/duniverse/metrics/src/core/metrics.ml Normal file
View file

@ -0,0 +1,527 @@
(*
* Copyright (c) 2018 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.
*)
module Keys = Set.Make (String)
type key = string
type 'a ty =
| String : string ty
| Bool : bool ty
| Float : float ty
| Int : int ty
| Int32 : int32 ty
| Int64 : int64 ty
| Uint : int ty
| Uint32 : int32 ty
| Uint64 : int64 ty
| Other : 'a Fmt.t -> 'a ty
type 'a v = { ty : 'a ty; v : 'a }
let eq_v : type a b. a v -> b v -> bool =
fun a b ->
match (a.ty, b.ty, a.v, b.v) with
| String, String, sa, sb -> String.equal sa sb
| Bool, Bool, ba, bb -> Bool.equal ba bb
| Float, Float, fa, fb -> Float.equal fa fb
| Int, Int, ia, ib -> Int.equal ia ib
| Int32, Int32, ia, ib -> Int32.equal ia ib
| Int64, Int64, ia, ib -> Int64.equal ia ib
| Uint, Uint, ia, ib -> Int.equal ia ib
| Uint32, Uint32, ia, ib -> Int32.equal ia ib
| Uint64, Uint64, ia, ib -> Int64.equal ia ib
| Other ppa, Other ppb, oa, ob ->
String.equal (Fmt.to_to_string ppa oa) (Fmt.to_to_string ppb ob)
| _, _, _, _ -> false
type graph = int
type field =
| F : {
key : string;
unit : string option;
doc : string option;
graphs : int list option;
v : 'a v;
}
-> field
let eq_field (F f1) (F f2) = String.equal f1.key f2.key && eq_v f1.v f2.v
module Tags = struct
type 'a v = { k : string; pp : Format.formatter -> 'a -> unit }
let v pp k = { k; pp }
let string = v Fmt.string
let float = v Fmt.float
let int = v Fmt.int
let uint = v Fmt.uint
let int32 = v Fmt.int32
let uint32 = v Fmt.uint32
let int64 = v Fmt.int64
let uint64 = v Fmt.uint64
let bool = v Fmt.bool
type 'a t = [] : field list t | ( :: ) : 'a v * 'b t -> ('a -> 'b) t
let rec domain : type a. a t -> Keys.t = function
| [] -> Keys.empty
| h :: t -> Keys.add h.k (domain t)
end
let key (F { key; _ }) = key
let doc (F { doc; _ }) = doc
let unit (F { unit; _ }) = unit
let graphs (F { graphs; _ }) = graphs
module Data = struct
type timestamp = string
type t = { timestamp : string option; fields : field list }
let keys t = List.map key t.fields
let timestamp t = t.timestamp
let fields t = t.fields
let cons h t = { t with fields = h :: t.fields }
let v ?timestamp fields = { timestamp; fields }
end
let index_key ~fields f =
let rec aux n = function
| [] -> raise Not_found
| h :: t -> if h = f then n else aux (n + 1) t
in
aux 0 fields
let index ~fields (F f) = index_key ~fields f.key
type tags = field list
type data = Data.t
module Src = struct
(* inspiration from From logs/Src *)
type predicate = { mutable all : bool; mutable tags : Keys.t }
let _tags = { all = false; tags = Keys.empty }
type ('a, 'b) src = {
uid : int;
name : string;
doc : string;
dom : Keys.t;
tags : 'a Tags.t;
data : 'b;
mutable active : bool;
duration : bool;
status : bool;
mutable data_fields : string list option;
}
type t = Src : ('a, 'b) src -> t
let uid =
let id = ref (-1) in
fun () ->
incr id;
!id
let list = ref []
let active tags =
if _tags.all then true else not (Keys.is_empty (Keys.inter _tags.tags tags))
let v ?(doc = "undocumented") ?(duration = false) ?(status = false) ~tags
~data name =
let dom = Tags.domain tags in
let active = active dom in
let src =
{
duration;
status;
dom;
uid = uid ();
name;
doc;
tags;
data;
active;
data_fields = None;
}
in
list := Src src :: !list;
src
let is_active (Src s) = s.active
let enable (Src s) = s.active <- true
let disable (Src s) = s.active <- false
let name (Src s) = s.name
let doc (Src s) = s.doc
let tags (Src s) = Keys.elements s.dom
let equal (Src src0) (Src src1) = src0.uid = src1.uid
let compare (Src src0) (Src src1) = compare src0.uid src1.uid
let duration (Src s) = s.duration
let status (Src s) = s.status
let data (Src s) = match s.data_fields with None -> [] | Some l -> l
let pp_strings ppf l =
Fmt.pf ppf "@[<1>(%a)@]" Fmt.(list ~sep:(any " ") string) l
let pp ppf (Src src) =
let tags = Keys.elements (Tags.domain src.tags) in
let data = match src.data_fields with None -> [] | Some l -> l in
Format.fprintf ppf
"@[<1>(src@ @[<1>(name %S)@]@ @[<1>(uid %d)@] @[<1>(doc %S)@]) \
@[<1>(tags (%a))@] @[<1>(data (%a))@] @]"
src.name src.uid src.doc pp_strings tags pp_strings data
let list () = !list
let update () = List.iter (fun (Src s) -> s.active <- active s.dom) (list ())
end
module Fields = Set.Make (struct
type t = Src.t * field
let compare (a, F x) (b, F y) =
match Src.compare a b with 0 -> String.compare x.key y.key | i -> i
end)
type ('a, 'b) src = ('a, 'b) Src.src
module Graph = struct
type t = int
type v = {
title : string option;
ylabel : string option;
yunit : string option;
id : int;
mutable active : bool;
mutable fields : Fields.t;
}
let tbl = Hashtbl.create 27
let v ?title ?ylabel ?yunit () =
let id = Oo.id (object end) in
let t =
{ id; yunit; title; ylabel; active = false; fields = Fields.empty }
in
Hashtbl.add tbl id t;
id
let get id = Hashtbl.find tbl id
let title t = (get t).title
let ylabel t = (get t).ylabel
let yunit t = (get t).yunit
let id t = (get t).id
let enable t = (get t).active <- true
let disable t = (get t).active <- false
let is_active t = (get t).active
let list () = Hashtbl.fold (fun x _ acc -> x :: acc) tbl []
let fields g = Fields.fold (fun f acc -> f :: acc) (get g).fields []
let add_field g src f =
let g = get g in
g.fields <- Fields.add (src, f) g.fields
let remove_field g src f =
let g = get g in
g.fields <-
Fields.filter
(fun (x, y) -> not (Src.equal x src && String.equal f (key y)))
g.fields
end
let init t data =
match t.Src.data_fields with
| Some _ -> ()
| None ->
let df = List.map key data.Data.fields in
t.data_fields <- Some df;
List.iter
(fun (F f) ->
match f.graphs with
| None -> ()
| Some gs -> List.iter (fun g -> Graph.add_field g (Src t) (F f)) gs)
data.Data.fields
type 'a field_f =
?doc:string ->
?unit:string ->
?graph:graph ->
?graphs:graph list ->
key ->
'a ->
field
let field ?doc ?unit ?graph ?graphs key ty v =
let graphs =
match (graph, graphs) with
| None, None -> None
| Some g, None -> Some [ g ]
| None, Some gs -> Some gs
| Some g, Some gs -> Some (g :: gs)
in
F { key; doc; unit; v = { ty; v }; graphs }
let ff ty ?doc ?unit ?graph ?graphs k v = field ?doc ?unit ?graph ?graphs k ty v
let string = ff String
let bool = ff Bool
let float = ff Float
let int = ff Int
let int32 = ff Int32
let int64 = ff Int64
let uint = ff Uint
let uint32 = ff Uint32
let uint64 = ff Uint64
type status = [ `Ok | `Error ]
let string_of_status = function `Ok -> "ok" | `Error -> "error"
module Key = struct
let duration = "duration"
let status = "status"
let minor_words = "minor words"
let promoted_words = "promoted words"
let major_words = "major words"
let minor_collections = "minor collections"
let major_collections = "major collections"
let heap_words = "heap words"
let heap_chunks = "heap chunks"
let compactions = "compactions"
let live_words = "live words"
let live_blocks = "live blocks"
let free_words = "free words"
let free_blocks = "free blocks"
let largest_free = "largest free"
let fragments = "fragments"
let top_heap_words = "top heap words"
let stack_size = "stack size"
end
let status v = field Key.status (Other (Fmt.of_to_string string_of_status)) v
let duration i = int64 Key.duration i
let pp : type a. a ty -> a Fmt.t =
fun ty ppf v ->
match ty with
| String -> Fmt.string ppf v
| Bool -> Fmt.bool ppf v
| Int -> Fmt.int ppf v
| Int32 -> Fmt.int32 ppf v
| Int64 -> Fmt.int64 ppf v
| Float -> Fmt.float ppf v
| Uint -> Fmt.uint ppf v
| Uint32 -> Fmt.uint32 ppf v
| Uint64 -> Fmt.uint64 ppf v
| Other pp -> pp ppf v
type value = V : 'a ty * 'a -> value
let pp_key ppf f = Fmt.string ppf (key f)
let pp_value ppf (F { v = { ty; v }; _ }) = pp ty ppf v
let value (F { v = { ty; v }; _ }) = V (ty, v)
let tag : type a b. (a, b) Src.src -> a =
fun src ->
let rec aux : type a. tags -> a Tags.t -> a =
fun tags -> function
| Tags.[] -> List.rev tags
| Tags.(h :: t) ->
fun a ->
let tags = field h.k (Other h.pp) a :: tags in
aux tags t
in
aux [] src.Src.tags
(* Reporters *)
type reporter = {
now : unit -> int64;
at_exit : unit -> unit;
report :
'a.
tags:tags -> data:data -> over:(unit -> unit) -> Src.t -> (unit -> 'a) -> 'a;
}
let nop_reporter =
{
at_exit = (fun () -> ());
now = (fun () -> 0L);
report =
(fun ~tags:_ ~data:_ ~over _ k ->
over ();
k ());
}
let _reporter = ref nop_reporter
let set_reporter r = _reporter := r
let reporter () = !_reporter
let () = at_exit (fun () -> !_reporter.at_exit ())
let now () = !_reporter.now ()
module SM = Map.Make (Src)
let _cache = ref SM.empty
let get_cache () = !_cache
let eq_tags t1 t2 =
List.length t1 = List.length t2 && List.for_all2 eq_field t1 t2
let cache_reporter ?cb () =
let call = match cb with Some f -> f | None -> fun _ _ _ -> () in
let report ~tags ~data ~over src k =
let others = Option.value ~default:[] (SM.find_opt src !_cache) in
let v =
(tags, data)
:: List.filter (fun (tags', _) -> not (eq_tags tags tags')) others
in
_cache := SM.add src v !_cache;
over ();
call src tags data;
k ()
in
{ report; now; at_exit = (fun () -> ()) }
let report src ~over ~k tags f =
let tags = tags (tag src) in
f src.Src.data (fun data -> !_reporter.report ~tags ~data ~over (Src src) k)
let over () = ()
let kunit _ = ()
let add_no_check src ?duration ?status tags f =
report src ~over ~k:kunit tags (fun data k ->
let data = f data in
let data =
match (duration, status) with
| None, None -> data
| Some d, None | None, Some d -> Data.cons d data
| Some x, Some y -> Data.cons x (Data.cons y data)
in
init src data;
k data)
let is_active src = src.Src.active
let add src tags data = if is_active src then add_no_check src tags data
let mk t f v = if t then Some (f v) else None
let run src tags g =
if not (is_active src) then g ()
else
let d0 = now () in
let r = try Ok (g ()) with e -> Error e in
let duration = mk src.duration duration (Int64.sub (now ()) d0) in
let status x = mk src.status status x in
match r with
| Ok x ->
add_no_check src tags ?duration ?status:(status `Ok) (fun f -> f r);
x
| Error e ->
add_no_check src tags ?duration ?status:(status `Error) (fun f -> f r);
raise e
type ('a, 'b) rresult = ('a, [ `Exn of exn | `Error of 'b ]) result
let rrun src tags g =
if not (is_active src) then g ()
else
let d0 = now () in
let r = try Ok (g ()) with e -> Error (`Exn e) in
let duration = mk src.duration duration (Int64.sub (now ()) d0) in
let status x = mk src.status status x in
match r with
| Ok (Ok _ as x) ->
add_no_check src tags ?duration ?status:(status `Ok) (fun f -> f x);
x
| Ok (Error e as x) ->
add_no_check src tags ?duration ?status:(status `Error) (fun f ->
f (Error (`Error e)));
x
| Error (`Exn e as x) ->
add_no_check src tags ?duration ?status:(status `Error) (fun f ->
f (Error x));
raise e
let tags_enabled () = Keys.elements Src._tags.tags
let all_enabled () = Src._tags.all
let enable_tag t =
Src._tags.tags <- Keys.add t Src._tags.tags;
Src.update ()
let disable_tag t =
Src._tags.tags <- Keys.remove t Src._tags.tags;
Src.update ()
let enable_all () =
Src._tags.all <- true;
Src.update ()
let disable_all () =
Src._tags.all <- false;
Src._tags.tags <- Keys.empty;
Src.update ()
let gc_quick_stat ~tags =
let doc = "OCaml memory management counters (quick)" in
let graph = Graph.v ~title:doc ~ylabel:"words" () in
let data () =
let stat = Gc.quick_stat () in
Data.v
[
float Key.minor_words ~graph stat.Gc.minor_words;
float Key.promoted_words ~graph stat.Gc.promoted_words;
float Key.major_words ~graph stat.Gc.major_words;
uint Key.minor_collections ~graph stat.Gc.minor_collections;
uint Key.major_collections ~graph stat.Gc.major_collections;
uint Key.heap_words ~graph stat.Gc.heap_words;
uint Key.heap_chunks ~graph stat.Gc.heap_chunks;
uint Key.compactions ~graph stat.Gc.compactions;
uint Key.top_heap_words ~graph stat.Gc.top_heap_words;
uint Key.stack_size ~graph stat.Gc.stack_size;
]
in
Src.v ~doc ~tags ~data "gc quick"
let gc_stat ~tags =
let doc = "OCaml memory management counters" in
let graph = Graph.v ~title:doc ~ylabel:"words" () in
let data () =
let stat = Gc.stat () in
Data.v
[
float Key.minor_words ~graph stat.Gc.minor_words;
float Key.promoted_words ~graph stat.Gc.promoted_words;
float Key.major_words ~graph stat.Gc.major_words;
uint Key.minor_collections ~graph stat.Gc.minor_collections;
uint Key.major_collections ~graph stat.Gc.major_collections;
uint Key.heap_words ~graph stat.Gc.heap_words;
uint Key.heap_chunks ~graph stat.Gc.heap_chunks;
uint Key.compactions ~graph stat.Gc.compactions;
uint Key.live_words ~graph stat.Gc.live_words;
uint Key.live_blocks ~graph stat.Gc.live_blocks;
uint Key.free_words ~graph stat.Gc.free_words;
uint Key.free_blocks ~graph stat.Gc.free_blocks;
uint Key.largest_free ~graph stat.Gc.largest_free;
uint Key.fragments ~graph stat.Gc.fragments;
uint Key.top_heap_words ~graph stat.Gc.top_heap_words;
uint Key.stack_size ~graph stat.Gc.stack_size;
]
in
Src.v ~doc ~tags ~data "gc"

517
unikernel/duniverse/metrics/src/core/metrics.mli Normal file
View file

@ -0,0 +1,517 @@
(*
* Copyright (c) 2018 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.
*)
(** Metrics Monitoring.
[Metrics] provides a basic infrastructure to monitor metrics using time
series. {{!func} Monitoring} is performed on {{!srcs} sources}, indexed by
{{!tags} tags}. Tags allow users to select at runtime which metric sources
are producing data points. Disabled data-sources have a low runtime cost
(only a closure allocation) which make [Metrics] suitable to instrument
production systems.
Both sources tags and data-points are built using dictionaries of typed
entries called {{!fields} fields}.
[Metrics] is heavily inspired by {{:http://erratique.ch/software/logs} Logs}
as it decouples metric reporting from metric monitoring. This is handled by
custom {{!reporter} reporters}.
{e v0.5.0 - {{:https://github.com/mirage/metrics} homepage}} *)
(** {2:fields Fields} *)
type graph
(** The type for metric {{!graphs} graphs}. *)
type field
(** The type for metric fields. *)
type key = string
(** The type for field keys. *)
type 'a field_f =
?doc:string ->
?unit:string ->
?graph:graph ->
?graphs:graph list ->
key ->
'a ->
field
(** The type for field functions. *)
val string : string field_f
(** [string ?doc k v] is the field whose key is [k] and value is [v]. *)
val int : int field_f
(** [int ?doc k i] is the field whose key is [k] and value is [i]. *)
val uint : int field_f
(** [uint ?doc k i] is the field whose key is [k] and value is [i]. *)
val int32 : int32 field_f
(** [int32 k i] is the field whose key is [k] and value is [i]. *)
val uint32 : int32 field_f
(** [uint32 ?doc k i] is the field whose key is [k] and value is [i]. *)
val int64 : int64 field_f
(** [int64 ?doc k i] is the field whose key is [k] and value is [i]. *)
val uint64 : int64 field_f
(** [uint64 ?doc k i] is the field whose key is [k] and value is [i]. *)
val float : float field_f
(** [uint ?doc k f] is the field whose key is [k] and value is [i]. *)
val bool : bool field_f
(** [uint ?doc k b] is the field whose key is [k] and value is [i]. *)
val duration : int64 -> field
(** [duration t] is the field [("duration", t, "ns")]. *)
type status = [ `Ok | `Error ]
(** The type for process status. *)
val status : status -> field
(** [status t] is the field [("status", "ok")] or [("status", "error")]. *)
(** {3 Custom fields} *)
(** The type of supported values in metric fields. *)
type 'a ty =
| String : string ty
| Bool : bool ty
| Float : float ty
| Int : int ty
| Int32 : int32 ty
| Int64 : int64 ty
| Uint : int ty
| Uint32 : int32 ty
| Uint64 : int64 ty
| Other : 'a Fmt.t -> 'a ty
val field :
?doc:string ->
?unit:string ->
?graph:graph ->
?graphs:graph list ->
string ->
'a ty ->
'a ->
field
(** [field ?doc ?unit k ty v] is the field whose key is [k], value type is [ty]
and value is [v]. *)
(** {3 Reading Fields} *)
val key : field -> string
(** [key f] is [f]'s key. *)
val doc : field -> string option
(** [doc f] is [f]'s documentation. *)
val unit : field -> string option
(** [unit t] are [t]'s units. *)
val graphs : field -> graph list option
(** [graphs t] is the graphs where [t] appears. *)
type value = V : 'a ty * 'a -> value (** Type for values. *)
val value : field -> value
(** [value f] is [f]'s value. *)
val index : fields:string list -> field -> int
(** [index ~fields f] is [f]'s index in the list of field keys [fields]. Raise
[Not_found] if [f] is not a field of [t]. *)
val index_key : fields:string list -> string -> int
(** Same as {!index} but using field keys instead. *)
(** {3 Pretty-printing Fields} *)
val pp_key : field Fmt.t
(** [pp_key] is the pretty-printer for field keys. *)
val pp_value : field Fmt.t
(** [pp_value] is the pretty-printer for field values, using sensible default.
*)
(** {2:data Data points} *)
(** [Data] defines what is stored in the time series. *)
module Data : sig
(** {2 Data}
[Metric]'s data points are a list of typed fields with an optional
timestamp. They are created with the {!v} and {{!fields} field}
constructors.
For instance, to create a data point with two values ["%CPU"] and ["MEM"],
respectively of type [float] and [int]:
{[
let x = Data.v [ float "%CPU" 0.42; int "MEM" 27_000 ]
]} *)
type t
(** The type for data points. *)
type timestamp = string
(** The type for timestamp. A timestamp shows the date and time, in RFC3339
UTC, associated with particular data. *)
val timestamp : t -> timestamp option
(** [timestamp t] is [t]'s timestamp (if any). If it is [None], then the
reporter will add a new timestamp automatically. *)
val v : ?timestamp:timestamp -> field list -> t
(** [v ?timestamp f] is the measure [f], as a the list metric name and value,
and the timestamp [timestamp]. If [timestamp] is not provided, it will be
set be the reporter. Raise [Invalid_argument] is a key or a value contains
an invalid character. *)
val keys : t -> key list
(** [keys t] is [t]'s keys. *)
val fields : t -> field list
(** [fields t] is [t]'s fields. *)
val cons : field -> t -> t
(** [cons f t] is the new data having the same timestamp as [t] and the fields
[f :: fields t]. *)
end
type data = Data.t
(** The type for data points. *)
(** {2:tags Tags} *)
(** [Tags] indexes metric sources, and allow to enable/disable data collection
at runtime. *)
module Tags : sig
(** {2 Tags}
[Tags] are heterogeneous {{!t} lists} of key names and type of values,
which are associated to data sources. Filters on key names allow to select
which data sources is {{!enabling} enabled} at runtime. Disabled data
sources have a very low cost -- only allocating a closure.
For instance, to define the tags "PID", "IP" and "host", respectively of
type [int], [Ipaddr.t]:
{[
let ipaddr = Tags.v Ipaddr.pp_hum in
let t = Tags.[ int "PID" ; ipaddr "IP" ; string "host"; ]
]} *)
type 'a v
(** The type for tag values. *)
(** The type tags: an heterogeneous list of names and types. *)
type 'a t = [] : field list t | ( :: ) : 'a v * 'b t -> ('a -> 'b) t
(** {3 Tag Values} *)
val v : 'a Fmt.t -> string -> 'a v
(** [ty pp] is a new typed tag. *)
val string : string -> string v
val float : string -> float v
val int : string -> int v
val uint : string -> int v
val int32 : string -> int32 v
val uint32 : string -> int32 v
val int64 : string -> int64 v
val uint64 : string -> int64 v
val bool : string -> bool v
end
type tags = field list
(** The type for metric tags. Used to distinguish the various entities that are
being measured. *)
val tags_enabled : unit -> key list
(** [tags_enabled ()] is the list of tags that are enabled. *)
val all_enabled : unit -> bool
(** [all_enabled ()] is true if all metric sources are enabled. *)
val enable_tag : key -> unit
(** [enable_tag t] enables all the registered metric sources having the tag [t].
*)
val disable_tag : key -> unit
(** [disable_tag t] disables all the registered metric sources having the tag
[t]. *)
val enable_all : unit -> unit
(** [enable_all ()] enables all registered metric sources. *)
val disable_all : unit -> unit
(** [disable_all ()] disables all registered metric sources. *)
(** {2:srcs Sources} *)
type ('a, 'b) src
(** The type for metric sources. A source defines a named unit for a time
series. ['a] is the type of the function used to create new
{{!data} data points}. ['b] is the type for {!tags}. *)
(** Metric sources. *)
module Src : sig
(** {2 Sources} *)
val v :
?doc:string ->
?duration:bool ->
?status:bool ->
tags:'a Tags.t ->
data:'b ->
string ->
('a, 'b) src
(** [v ?doc ?duration ?status ~tags ~data name] is a new source, accepting
arbitrary data points - which are specified using [data]. [name] is the
name of the source; it doesn't need to be unique but it is good practice
to prefix the name with the name of your package or library (e.g.
["mypkg.network"]). [doc] is a documentation string describing the source,
defaults to ["undocumented"]. The [duration] and [status] specify whether
this source takes durations of an event, or a return status. Both are by
default false. [tags] is the collection if (typed) tags which will be used
to tag and index the measure and are used identify the various metrics.
The source will be enabled on creation iff one of tag in [tags] has been
enabled with {!enable_tag}.
For instance, to create a metric to collect CPU and memory usage on
various machines, indexed by [PID], [host] name and [IP] address:
{[
let src =
let ipaddr = Tags.v Ipaddr.pp_hum in
let tags = Tags.[string "host"; ipaddr "IP" ; int "PID" ; ] in
let data () = Data.v [float "%CPU" (...); int "MEM" (...); ] in
Src.v "top" ~tags ~data ~doc:"Information about processess"
]} *)
(** {3 Listing Sources} *)
type t = Src : ('a, 'b) src -> t (** The type for metric sources. *)
val list : unit -> t list
(** [list ()] is the current exisiting source list. *)
val name : t -> string
(** [name src] is [src]'s name. *)
val doc : t -> string
(** [doc src] is [src]'s documentation string. *)
val tags : t -> string list
(** [tags src] is the list of [src]'s tag names. *)
val data : t -> string list
(** [fields src] is the list of [src]'s data field names. Note that these are
updated dynamically, so a monitoring function has to be called first. *)
val equal : t -> t -> bool
(** [equal src src'] is [true] iff [src] and [src'] are the same source. *)
val compare : t -> t -> int
(** [compare src src'] is a total order on sources. *)
val duration : t -> bool
(** [duration t] is true iff [t] is a {!fn} source and [t] requires automatic
duration recording. *)
val status : t -> bool
(** [status t] is true iff [t] is a {!fn} source and [t] requires automatic
duration recording. *)
val pp : t Fmt.t
(** [pp ppf src] prints an unspecified representation of [src] on [ppf]. *)
val is_active : t -> bool
(** [is_active t] is true iff [t] is enabled. *)
val enable : t -> unit
(** [enable src] enables the metric source [src]. *)
val disable : t -> unit
(** [disable src] disables the metric source [src]. *)
end
(** {2:graphs Metric Graphs} *)
module Graph : sig
type t = graph
(** The type for graphs. *)
val title : t -> string option
(** [title t] is [t]'s title. *)
val ylabel : t -> string option
(** [title t] is [t]'s Y label. *)
val yunit : t -> string option
(** [unit t] is [t]'s Y unit. *)
val id : t -> int
(** [id t] is [t]'s unit. *)
val v : ?title:string -> ?ylabel:string -> ?yunit:string -> unit -> t
(** [v ()] is a new graph. *)
val list : unit -> t list
(** [list ()] is the list of graphs. *)
val fields : t -> (Src.t * field) list
(** [fields t] is the list of [t]'s fields. Field names are unique for a given
source. *)
val add_field : t -> Src.t -> field -> unit
(** [add_field t src f] adds the field [f], generated by the source [src], to
the graph [t]. *)
val remove_field : t -> Src.t -> string -> unit
(** [remove_field t src f] removes the field named [f], generated from the
source [src], out of the graph [t]. *)
val enable : t -> unit
val disable : t -> unit
val is_active : t -> bool
end
module Key : sig
val duration : string
val status : string
val minor_words : string
val promoted_words : string
val major_words : string
val minor_collections : string
val major_collections : string
val heap_words : string
val heap_chunks : string
val compactions : string
val live_words : string
val live_blocks : string
val free_words : string
val free_blocks : string
val largest_free : string
val fragments : string
val top_heap_words : string
val stack_size : string
end
(** {2:func Monitoring} *)
val is_active : ('a, 'b) src -> bool
(** [is_active src] is true iff [src] monitoring is enabled. *)
val add : ('a, 'b) src -> ('a -> tags) -> ('b -> Data.t) -> unit
(** [add src t f] adds a new data point to [src] for the tags [t]. *)
val run :
('a, ('b, exn) result -> Data.t) src -> ('a -> tags) -> (unit -> 'b) -> 'b
(** [run src t f] runs [f ()] and add a new data points.
Depending on [src] configuration, new data points might have duration
information (e.g. how long [g ()] took, in nano-seconds) and status
information (e.g. to check if an exception has been raised). *)
type ('a, 'b) rresult = ('a, [ `Exn of exn | `Error of 'b ]) result
(** The type for extended results. *)
val rrun :
('a, ('b, 'c) rresult -> Data.t) src ->
('a -> tags) ->
(unit -> ('b, 'c) result) ->
('b, 'c) result
(** Same as {!run} but also record if the result is [Ok] or [Error]. *)
(** {2:reporter Reporters}
TODO: explain and give an example *)
type reporter = {
now : unit -> int64;
at_exit : unit -> unit;
report :
'a.
tags:tags -> data:data -> over:(unit -> unit) -> Src.t -> (unit -> 'a) -> 'a;
}
(** The type for reporters. *)
val nop_reporter : reporter
(** [nop_reporter] is the initial reporter returned by {!reporter}, it does
nothing if a metric gets reported. *)
val reporter : unit -> reporter
(** [reporter ()] is the current reporter. *)
val set_reporter : reporter -> unit
(** [set_reporter r] sets the current reporter to [r]. *)
module SM : Map.S with type key = Src.t
val cache_reporter : ?cb:(Src.t -> tags -> data -> unit) -> unit -> reporter
(** [cache_reporter ?cb ()] is a reporter that stores the last measurement from
each source in a map (which can be retrieved by {!get_cache} below). This
overcomes the push vs pull interface. Each measurement _event_ is sent at an
arbitrary point in time, while reporting over a communication channel may be
rate-limited (i.e. report every 10 seconds statistics, rather than whenever
they appear). The optional [cb] function is called for each measurement that
gets reported.
This is only a good idea for counters, histograms etc. may be useful for
other numbers (such as time consumed between receive and send - the
measurement should provide the information whether it's a counter or sth
else). *)
val get_cache : unit -> (tags * data) list SM.t
(** [get_cache ()] is the current data of the cache reporter. The cache is only
filled if [cache_reporter ?cb ()] is set as a reporter. *)
(** {2:runtime OCaml Gc sources}
The {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html} Gc} module
of the OCaml system provides
{{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#TYPEstat}
counters} of the memory management via
{{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALquick_stat}
Gc.quick_stat} and
{{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALstat}
Gc.stat} function. Both are provided here. *)
val gc_stat : tags:'a Tags.t -> ('a, unit -> data) src
(** [gc_stat ~tags] is the source of OCaml's [Gc.stat ()] memory management
counters. *)
val gc_quick_stat : tags:'a Tags.t -> ('a, unit -> data) src
(** [gc_quick_stat ~tags] is the source of OCaml's [Gc.quick_stat ()] memory
management counters. *)
val report :
('a, 'b) src ->
over:(unit -> unit) ->
k:(unit -> 'c) ->
('a -> tags) ->
('b -> (data -> 'c) -> 'd) ->
'd
(**/*)
val init : ('a, 'b) src -> data -> unit
val now : unit -> int64

4
unikernel/duniverse/metrics/src/influx/dune Normal file
View file

@ -0,0 +1,4 @@
(library
(name metrics_influx)
(public_name metrics-influx)
(libraries metrics fmt lwt duration))

176
unikernel/duniverse/metrics/src/influx/metrics_influx.ml Normal file
View file

@ -0,0 +1,176 @@
(*
* Copyright (c) 2018 Hannes Mehnert <hannes@mehnert.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.
*)
(*************)
(* influxdb line protocol reporter *)
(* from https://docs.influxdata.com/influxdb/v1.5/write_protocols/line_protocol_reference/ *)
(* example line: weather,location=us-midwest temperature=82 1465839830100400200 *)
(*************)
module S = Set.Make (String)
let avoid_keyword =
let keywords =
S.of_list
[
"ALL";
"ALTER";
"ANY";
"AS";
"ASC";
"BEGIN";
"BY";
"CREATE";
"CONTINUOUS";
"DATABASE";
"DATABASES";
"DEFAULT";
"DELETE";
"DESC";
"DESTINATIONS";
"DIAGNOSTICS";
"DISTINCT";
"DROP";
"DURATION";
"END";
"EVERY";
"EXPLAIN";
"FIELD";
"FOR";
"FROM";
"GRANT";
"GRANTS";
"GROUP";
"GROUPS";
"IN";
"INF";
"INSERT";
"INTO";
"KEY";
"KEYS";
"KILL";
"LIMIT";
"SHOW";
"MEASUREMENT";
"MEASUREMENTS";
"NAME";
"OFFSET";
"ON";
"ORDER";
"PASSWORD";
"POLICY";
"POLICIES";
"PRIVILEGES";
"QUERIES";
"QUERY";
"READ";
"REPLICATION";
"RESAMPLE";
"RETENTION";
"REVOKE";
"SELECT";
"SERIES";
"SET";
"SHARD";
"SHARDS";
"SLIMIT";
"SOFFSET";
"STATS";
"SUBSCRIPTION";
"SUBSCRIPTIONS";
"TAG";
"TO";
"USER";
"USERS";
"VALUES";
"WHERE";
"WITH";
"WRITE";
]
in
fun m -> if S.mem (String.uppercase_ascii m) keywords then "o" ^ m else m
let escape =
List.fold_right (fun e m' ->
String.concat ("\\" ^ Char.escaped e) (String.split_on_char e m'))
let escape_measurement m = escape [ ','; ' ' ] (avoid_keyword m)
let escape_name m = escape [ ','; ' '; '=' ] (avoid_keyword m)
let pp_value (str : string Fmt.t) ppf f =
let open Metrics in
match value f with
| V (String, s) -> str ppf s
| V (Int, i) -> Fmt.pf ppf "%di" i
| V (Int32, i32) -> Fmt.pf ppf "%ldi" i32
| V (Int64, i64) -> Fmt.pf ppf "%Ldi" i64
| V (Uint, u) -> Fmt.pf ppf "%ui" u
| V (Uint32, u32) -> Fmt.pf ppf "%lui" u32
| V (Uint64, u64) -> Fmt.pf ppf "%Lui" u64
| _ -> pp_value ppf f
(* we need to:
- avoid keywords
- escape comma and space in measurement name
- escape comma, space and equal in tag key, tag value, field key of type string
- double-quote field value of type string
- data type number is a float, suffix i for integers *)
let encode_line_protocol tags data name =
let data_fields = Metrics.Data.fields data in
let pp_field_str ppf s = Fmt.pf ppf "%S" s in
let pp_field ppf f =
Fmt.(pair ~sep:(any "=") string (pp_value pp_field_str))
ppf
(escape_name (Metrics.key f), f)
in
let pp_fields = Fmt.(list ~sep:(any ",") pp_field) in
let pp_tag_str ppf s = Fmt.string ppf (escape_name s) in
let pp_tag ppf f =
Fmt.(pair ~sep:(any "=") string (pp_value pp_tag_str))
ppf
(escape_name (Metrics.key f), f)
in
let pp_tags = Fmt.(list ~sep:(any ",") pp_tag) in
Fmt.str "%s,%a %a\n" (escape_measurement name) pp_tags tags pp_fields
data_fields
module SM = Map.Make (Metrics.Src)
let lwt_reporter ?tags:(more_tags = []) ?interval send now =
let m = ref SM.empty in
let i = match interval with None -> 0L | Some s -> Duration.of_ms s in
let report ~tags ~data ~over src k =
let send () =
m := SM.add src (now ()) !m;
let str =
encode_line_protocol (more_tags @ tags) data (Metrics.Src.name src)
in
let unblock () =
over ();
Lwt.return_unit
in
Lwt.finalize (fun () -> send str) unblock |> Lwt.ignore_result;
k ()
in
match SM.find_opt src !m with
| None -> send ()
| Some last ->
if now () > Int64.add last i then send ()
else (
over ();
k ())
in
{ Metrics.report; now; at_exit = (fun () -> ()) }

34
unikernel/duniverse/metrics/src/influx/metrics_influx.mli Normal file
View file

@ -0,0 +1,34 @@
(*
* Copyright (c) 2018 Hannes Mehnert <hannes@mehnert.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.
*)
val encode_line_protocol : Metrics.tags -> Metrics.data -> string -> string
(** [encode_line_protocol tags data name] encodes the [tags] and [data] to the
{{:https://docs.influxdata.com/influxdb/v1.5/write_protocols/line_protocol_reference/}
influx line protocol}, using [name] as measurement. *)
val lwt_reporter :
?tags:Metrics.tags ->
?interval:int ->
(string -> unit Lwt.t) ->
(unit -> int64) ->
Metrics.reporter
(** [lwt_reporter ~tags ~interval send clock] is a metrics reporter that encodes
a measurement in
{{:https://docs.influxdata.com/influxdb/v1.5/write_protocols/line_protocol_reference/}
influxdb line protocol} and reports it via [send]. A measurement can be
prefixed by an optional list of [tags]. If [~interval] is specified and a
positive amount of milliseconds, each source measurement is reported only
once within this interval. *)

4
unikernel/duniverse/metrics/src/lwt/dune Normal file
View file

@ -0,0 +1,4 @@
(library
(name metrics_lwt)
(public_name metrics-lwt)
(libraries lwt metrics logs))

110
unikernel/duniverse/metrics/src/lwt/metrics_lwt.ml Normal file
View file

@ -0,0 +1,110 @@
(*
* Copyright (c) 2018 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 Metrics
open Lwt.Infix
let add_no_check_lwt src ?duration ?status tags f =
let ret, unblock = Lwt.wait () in
let k () = ret in
let over () = Lwt.wakeup unblock () in
report src ~over ~k tags (fun data k ->
f data >>= fun data ->
let data =
match (duration, status) with
| None, None -> data
| Some d, None | None, Some d -> Data.cons d data
| Some x, Some y -> Data.cons x (Data.cons y data)
in
init src data;
k data)
let add src tags f =
if is_active src then add_no_check_lwt src tags f else Lwt.return ()
let mk t f v = if t then Some (f v) else None
let run src tags g =
if not (is_active src) then g ()
else
let d0 = now () in
Lwt.catch (fun () -> g () >|= fun x -> Ok x) (fun e -> Lwt.return (Error e))
>>= fun r ->
let duration =
mk (Src.duration (Src src)) duration (Int64.sub (now ()) d0)
in
let status x = mk (Src.status (Src src)) status x in
match r with
| Ok x ->
add_no_check_lwt src tags ?duration ?status:(status `Ok) (fun f ->
Lwt.return (f r))
>|= fun () -> x
| Error e ->
add_no_check_lwt src tags ?duration ?status:(status `Error) (fun f ->
Lwt.return (f r))
>|= fun () -> raise e
let rrun src tags g =
if not (is_active src) then g ()
else
let d0 = now () in
Lwt.catch
(fun () -> g () >|= fun x -> Ok x)
(fun e -> Lwt.return (Error (`Exn e)))
>>= fun r ->
let duration =
mk (Src.duration (Src src)) duration (Int64.sub (now ()) d0)
in
let status x = mk (Src.status (Src src)) status x in
match r with
| Ok (Ok _ as x) ->
add_no_check_lwt src tags ?duration ?status:(status `Ok) (fun f ->
Lwt.return (f x))
>|= fun () -> x
| Ok (Error e as x) ->
add_no_check_lwt src tags ?duration ?status:(status `Error) (fun f ->
Lwt.return (f (Error (`Error e))))
>|= fun () -> x
| Error (`Exn e as x) ->
add_no_check_lwt src tags ?duration ?status:(status `Error) (fun f ->
Lwt.return (f (Error x)))
>|= fun () -> raise e
let periodic = ref []
let periodically src = periodic := src :: !periodic
let log_stats ~tags =
let doc = "Statistics of the Logs library" in
let data () =
let warnings, errors = (Logs.warn_count (), Logs.err_count ()) in
Data.v [ int "warnings" warnings; int "errors" errors ]
in
Src.v ~doc ~tags ~data "logs"
let init_periodic ?(gc = `Full) ?(logs = true) sleeper =
(match gc with
| `None -> ()
| `Quick -> periodically (gc_quick_stat ~tags:Tags.[])
| `Full -> periodically (gc_stat ~tags:Tags.[]));
if logs then periodically (log_stats ~tags:Tags.[]);
let collect () =
List.iter
(fun src -> Metrics.add src (fun x -> x) (fun d -> d ()))
!periodic;
Lwt.return_unit
in
let rec loop () = Lwt.join [ sleeper (); collect () ] >>= loop in
Lwt.async loop

57
unikernel/duniverse/metrics/src/lwt/metrics_lwt.mli Normal file
View file

@ -0,0 +1,57 @@
(*
* Copyright (c) 2018 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.
*)
(** {!Lwt} monitoring.
The monitoring functions of this module return [Lwt] threads that proceed
only when the metric operation is over, as defined by the current
{!Metrics.reporter}.
{e v0.5.0 - {{:https://github.com/mirage/metrics} homepage}} *)
(** {1 Metric Monitoring} *)
open Metrics
val add : ('a, 'b) src -> ('a -> tags) -> ('b -> data Lwt.t) -> unit Lwt.t
(** [add src t f] adds a new data point to [src]. *)
val run :
('a, ('b, exn) result -> Data.t) src ->
('a -> tags) ->
(unit -> 'b Lwt.t) ->
'b Lwt.t
(** [run src f] runs [f ()] and records in a new data point the time it took.
[run] will also record the status of the computation, e.g. whether an
exception has been raised. *)
val rrun :
('a, ('b, [ `Exn of exn | `Error of 'c ]) result -> Data.t) src ->
('a -> tags) ->
(unit -> ('b, 'c) result Lwt.t) ->
('b, 'c) result Lwt.t
(** Same as {!run} but also record if the result is [Ok] or [Error]. *)
val periodically : (field list, unit -> data) src -> unit
(** [periodically src] registers [src] for periodic collection. *)
val init_periodic :
?gc:[ `None | `Quick | `Full ] -> ?logs:bool -> (unit -> unit Lwt.t) -> unit
(** [init_periodic ~gc ~logs sleeper] starts a task which {!Lwt.join} [sleeper]
and all registered {!periodically} sources. [gc] is by default [`Full],
collecting full GC stats - other options are [`None] and [`Quick]. If [logs]
is provided and [true] (the default), the error and warning count from the
Logs library are registered to be periodically reported. *)

5
unikernel/duniverse/metrics/src/rusage/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name metrics_rusage)
(public_name metrics-rusage)
(libraries metrics fmt logs unix)
(c_names metrics_rusage_stubs))

162
unikernel/duniverse/metrics/src/rusage/metrics_rusage.ml Normal file
View file

@ -0,0 +1,162 @@
type rusage = {
utime : int64 * int;
stime : int64 * int;
maxrss : int64;
ixrss : int64;
idrss : int64;
isrss : int64;
minflt : int64;
majflt : int64;
nswap : int64;
inblock : int64;
outblock : int64;
msgsnd : int64;
msgrcv : int64;
nsignals : int64;
nvcsw : int64;
nivcsw : int64;
}
type kinfo_mem = {
vsize : int64;
rss : int64;
tsize : int64;
dsize : int64;
ssize : int64;
runtime : int64;
cow : int;
start : int64 * int;
}
let ( let* ) = Result.bind
external sysconf_clock_tick : unit -> int = "metrics_sysconf_clock_tick"
external sysctl_kinfo_proc : int -> kinfo_mem = "metrics_sysctl_kinfo_proc"
external getrusage : unit -> rusage = "metrics_rusage"
external uname : unit -> string = "metrics_uname"
let wrap f arg = try Ok (f arg) with e -> Error (`Msg (Printexc.to_string e))
let string_of_file filename =
try
let fh = open_in filename in
let content = input_line fh in
close_in_noerr fh;
Ok content
with _ -> Error (`Msg (Fmt.str "Error reading file %S" filename))
let parse_proc_stat s =
match String.rindex_opt s ')' with
| None -> Error (`Msg "unable to parse /proc/self/stat")
| Some idx ->
let rest = String.sub s idx (String.length s - idx) in
Ok (String.split_on_char ' ' rest)
let linux_kinfo () =
let* start =
match Unix.stat "/proc/self" with
| { Unix.st_ctime = start; _ } ->
let frac = Float.rem start 1. in
Ok (Int64.of_float start, int_of_float (frac *. 1_000_000.))
| exception Unix.Unix_error (Unix.ENOENT, _, _) ->
Error (`Msg "failed to stat process")
in
(* reading /proc/self/stat - since it may disappear mid-time,
best to have it in memory *)
let* data = string_of_file "/proc/self/stat" in
let* stat_vals = parse_proc_stat data in
let* data = string_of_file "/proc/self/statm" in
let statm_vals = String.split_on_char ' ' data in
let i64 s =
try Ok (Int64.of_string s)
with Failure _ -> Error (`Msg "couldn't parse integer")
in
let us_of_int64 t =
let clock_tick = Int64.of_int (sysconf_clock_tick ()) in
let ( * ) = Int64.mul and ( / ) = Int64.div in
t * 1_000_000L / clock_tick
in
if List.length stat_vals >= 50 && List.length statm_vals >= 7 then
let* utime = i64 (List.nth stat_vals 11) in
(* divide by sysconf(_SC_CLK_TCK) *)
let* stime = i64 (List.nth stat_vals 12) in
(* divide by sysconf(_SC_CLK_TCK) *)
let runtime = us_of_int64 Int64.(add utime stime) in
let* vsize = i64 (List.nth stat_vals 20) in
(* in bytes *)
let* rss = i64 (List.nth stat_vals 21) in
(* in pages *)
let* tsize = i64 (List.nth statm_vals 3) in
let* dsize = i64 (List.nth statm_vals 5) in
(* data + stack *)
let* ssize = i64 (List.nth statm_vals 5) in
(* data + stack *)
Ok { vsize; rss; tsize; dsize; ssize; runtime; cow = 0; start }
else Error (`Msg "couldn't read /proc/self/stat")
let tv (sec, usec) = Int64.to_float sec +. (float_of_int usec /. 1_000_000.)
open Metrics
let rusage_src ~tags =
let doc = "System rusage counters" in
let graph = Graph.v ~title:doc ~ylabel:"value" () in
let data () =
match wrap getrusage () with
| Error (`Msg _) -> Data.v []
| Ok ru ->
Data.v
[
float "utime" ~graph (tv ru.utime);
float "stime" ~graph (tv ru.stime);
uint64 "maxrss" ~graph ru.maxrss;
uint64 "ixrss" ~graph ru.ixrss;
uint64 "idrss" ~graph ru.idrss;
uint64 "isrss" ~graph ru.isrss;
uint64 "minflt" ~graph ru.minflt;
uint64 "maxflt" ~graph ru.majflt;
uint64 "nswap" ~graph ru.nswap;
uint64 "inblock" ~graph ru.inblock;
uint64 "outblock" ~graph ru.outblock;
uint64 "msgsnd" ~graph ru.msgsnd;
uint64 "msgrcv" ~graph ru.msgrcv;
uint64 "nsignals" ~graph ru.nsignals;
uint64 "nvcsw" ~graph ru.nvcsw;
uint64 "nivcsw" ~graph ru.nivcsw;
]
in
Src.v ~doc ~tags ~data "resource_usage"
let kinfo_mem_src ~tags =
let doc = "System kernel information" in
let graph = Graph.v ~title:doc ~ylabel:"value" () in
let uname = uname () and pid = Unix.getpid () in
let kinfo () =
match uname with
| "FreeBSD" -> wrap sysctl_kinfo_proc pid
| "Linux" -> linux_kinfo ()
| s -> Error (`Msg ("unsupported operating system " ^ s))
in
(match kinfo () with
| Error (`Msg msg) ->
Logs.err (fun m -> m "error while collecting kinfo: %s" msg)
| Ok _ -> ());
let data () =
match kinfo () with
| Error _ -> Data.v []
| Ok mem ->
let now = Unix.gettimeofday () in
let uptime = now -. tv mem.start in
Data.v
[
uint64 "vsize" ~graph mem.vsize;
uint64 "rss" ~graph mem.rss;
uint64 "tsize" ~graph mem.tsize;
uint64 "dsize" ~graph mem.dsize;
uint64 "ssize" ~graph mem.ssize;
uint "cow_faults" ~graph mem.cow;
uint64 "runtime" ~graph mem.runtime;
float "uptime" ~graph uptime;
]
in
Src.v ~doc ~tags ~data "kinfo_mem"

14
unikernel/duniverse/metrics/src/rusage/metrics_rusage.mli Normal file
View file

@ -0,0 +1,14 @@
val rusage_src :
tags:'a Metrics.Tags.t -> ('a, unit -> Metrics.data) Metrics.src
(** [rusage_src ~tags] is a metrics source that reports data gathered from
[getrusage]. *)
val kinfo_mem_src :
tags:'a Metrics.Tags.t -> ('a, unit -> Metrics.data) Metrics.src
(** [kinfo_mem_src ~tags] is a metrics source which reports data gathered from
sysctl ctl_kern.kern_proc.kern_proc_pid.pid on FreeBSD (which returns a
kinfo_proc (see [sys/user.h])), on Linux [/proc/self/stat] and
[/proc/self/statm] are used for the collection.
The data provided are virtual size, resident set size, text, data, and stack
size, copy-on-write fauls, running time (in microseconds), and uptime. *)

134
unikernel/duniverse/metrics/src/rusage/metrics_rusage_stubs.c Normal file
View file

@ -0,0 +1,134 @@
// (c) 2017, 2018 Hannes Mehnert, all rights reserved
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/fail.h>
#include <caml/unixsupport.h>
#include <sys/param.h>
#include <sys/types.h>
#include <sys/time.h>
#include <sys/resource.h>
#include <sys/user.h>
#define Val32 caml_copy_int32
#define Val64 caml_copy_int64
#include <sys/utsname.h>
CAMLprim value metrics_uname(value unit) {
CAMLparam1(unit);
CAMLlocal1(sys);
struct utsname u;
int res;
res = uname(&u);
if (res < 0) uerror("uname", Nothing);
sys = caml_copy_string(u.sysname);
CAMLreturn(sys);
}
/* We only use sysconf(_SC_CLK_TCK) in Linux only, but it's well-defined in FreeBSD as well. */
#include <unistd.h>
CAMLprim value metrics_sysconf_clock_tick(value unit) {
CAMLparam1(unit);
long r;
r = sysconf(_SC_CLK_TCK);
if (r == 1)
uerror("sysconf", Nothing);
CAMLreturn(Val_long(r));
}
CAMLprim value metrics_rusage(value unit) {
CAMLparam1(unit);
CAMLlocal2(res, time);
struct rusage ru;
int r;
r = getrusage(RUSAGE_SELF, &ru);
if (r < 0)
uerror("getrusage", Nothing);
if (ru.ru_utime.tv_usec < 0 || ru.ru_utime.tv_usec > 999999999 ||
ru.ru_stime.tv_usec < 0 || ru.ru_stime.tv_usec > 999999999)
uerror("getrusage", Nothing);
res = caml_alloc(16, 0);
time = caml_alloc(2, 0);
Store_field (time, 0, Val64(ru.ru_utime.tv_sec));
Store_field (time, 1, Val_int(ru.ru_utime.tv_usec));
Store_field (res, 0, time);
time = caml_alloc(2, 0);
Store_field (time, 0, Val64(ru.ru_stime.tv_sec));
Store_field (time, 1, Val_int(ru.ru_stime.tv_usec));
Store_field (res, 1, time);
Store_field (res, 2, Val64(ru.ru_maxrss));
Store_field (res, 3, Val64(ru.ru_ixrss));
Store_field (res, 4, Val64(ru.ru_idrss));
Store_field (res, 5, Val64(ru.ru_isrss));
Store_field (res, 6, Val64(ru.ru_minflt));
Store_field (res, 7, Val64(ru.ru_majflt));
Store_field (res, 8, Val64(ru.ru_nswap));
Store_field (res, 9, Val64(ru.ru_inblock));
Store_field (res, 10, Val64(ru.ru_oublock));
Store_field (res, 11, Val64(ru.ru_msgsnd));
Store_field (res, 12, Val64(ru.ru_msgrcv));
Store_field (res, 13, Val64(ru.ru_nsignals));
Store_field (res, 14, Val64(ru.ru_nvcsw));
Store_field (res, 15, Val64(ru.ru_nivcsw));
CAMLreturn(res);
}
#ifdef __FreeBSD__
#include <sys/sysctl.h>
CAMLprim value metrics_sysctl_kinfo_proc (value pid_r) {
CAMLparam1(pid_r);
CAMLlocal2(res, time);
int name[4];
int error;
size_t len;
struct kinfo_proc p;
struct rusage ru;
len = sizeof(p);
name[0] = CTL_KERN;
name[1] = KERN_PROC;
name[2] = KERN_PROC_PID;
name[3] = Int_val(pid_r);
error = sysctl(name, nitems(name), &p, &len, NULL, 0);
if (error < 0)
uerror("sysctl ctl_kern.kern_proc.kern_proc_pid", Nothing);
if (p.ki_start.tv_usec < 0 || p.ki_start.tv_usec > 999999999)
uerror("sysctl ctl_kern.kern_proc.kern_proc_pid", Nothing);
res = caml_alloc(8, 0);
Store_field (res, 0, Val64(p.ki_size));
Store_field (res, 1, Val64(p.ki_rssize));
Store_field (res, 2, Val64(p.ki_tsize));
Store_field (res, 3, Val64(p.ki_dsize));
Store_field (res, 4, Val64(p.ki_ssize));
Store_field (res, 5, Val64(p.ki_runtime));
Store_field (res, 6, Val_int(p.ki_cow));
time = caml_alloc(2, 0);
Store_field (time, 0, Val64(p.ki_start.tv_sec));
Store_field (time, 1, Val_int(p.ki_start.tv_usec));
Store_field (res, 7, time);
CAMLreturn(res);
}
#else /* FreeBSD */
/* stub symbols for OS currently not supported */
CAMLprim value metrics_sysctl_kinfo_proc (value pid_r) {
CAMLparam1(pid_r);
uerror("sysctl_kinfo_proc", Nothing);
}
#endif

5
unikernel/duniverse/metrics/src/unix/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name metrics_gnuplot)
(public_name metrics-unix)
(wrapped false)
(libraries lwt.unix metrics fmt uuidm unix mtime mtime.clock.os))

299
unikernel/duniverse/metrics/src/unix/metrics_gnuplot.ml Normal file
View file

@ -0,0 +1,299 @@
(*
* Copyright (c) 2018 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.
*)
(* The structure is as follows:
- Every tagged source has its own file:
"<src_name>-<tag1>-...<tagn>.data"
- A data-point is a newline in that file.
- There's a toplevel gnuplot script per graph, which plots all the source
belonging to that same graph together.
- There's a toplevel global script which plots all the graphs. *)
(* Unix++ *)
let safe_mkdir path =
try
if not (Sys.is_directory path) then Fmt.failwith "mkdir: %s: is a file" path
with Sys_error _ -> Unix.mkdir path 0o755
let split_dirs path =
let rec aux acc path =
match Filename.dirname path with
| "." -> Filename.basename path :: acc
| "/" -> "" :: Filename.basename path :: acc
| s -> aux (Filename.basename path :: acc) s
in
match Filename.basename path with "/" -> [ ""; "" ] | _ -> aux [] path
let mkdir path =
let rec aux parent = function
| [] -> ()
| h :: t ->
let path = Filename.concat parent h in
safe_mkdir path;
aux path t
in
match split_dirs path with "" :: xs -> aux "/" xs | xs -> aux "." xs
(* /Unix++ *)
open Metrics
let ( / ) = Filename.concat
type file = {
name : string;
ppf : Format.formatter;
data_fields : field list;
close : unit -> unit;
}
let escape s =
let b = Buffer.create (String.length s) in
let e = ref false in
String.iter
(function
| '\n' | '\t' | '\r' | ':' | '(' | ')' -> ()
| ('a' .. 'z' | '0' .. '9' | 'A' .. 'Z' | '.') as x ->
if !e then Buffer.add_char b '_';
e := false;
Buffer.add_char b x
| _ -> e := true)
s;
Buffer.contents b
let filename (src, tags) =
let pp_tags = Fmt.(list ~sep:(any "-") pp_value) in
let name = Src.name src in
let file = Fmt.str "%a" pp_tags (string "" name :: tags) in
escape file ^ ".data"
module Raw = struct
type t = Src.t * tags
module Tbl = Hashtbl.Make (struct
type nonrec t = t
let hash t = Hashtbl.hash (filename t)
let equal a b = filename a = filename b
end)
end
module Lonely = struct
type t = Src.t * string
module Tbl = Hashtbl.Make (struct
type nonrec t = t
let hash (s, n) = Hashtbl.hash (Src.name s ^ n)
let equal (a, b) (c, d) = Src.equal a c && String.equal b d
end)
end
type t = { dir : string; raw : file Raw.Tbl.t; lly : Graph.t Lonely.Tbl.t }
let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) ()
let default_dir = Unix.getcwd () / "_metrics" / Uuidm.to_string uuid
let empty ?(dir = default_dir) () =
{ dir; raw = Raw.Tbl.create 8; lly = Lonely.Tbl.create 17 }
let register_lonely_fields t src data_fields =
List.iter
(fun f ->
let k = key f in
if graphs f = None && k <> Key.duration && k <> Key.status then
match Lonely.Tbl.find t.lly (src, k) with
| _ -> ()
| exception Not_found ->
let g = Graph.v ~title:(key f) ~ylabel:(key f) ?yunit:(unit f) () in
Lonely.Tbl.add t.lly (src, k) g;
Graph.add_field g src f)
data_fields
let file t src ~data_fields ~tags =
try Raw.Tbl.find t.raw (src, tags)
with Not_found ->
mkdir t.dir;
let file = t.dir / filename (src, tags) in
let oc = open_out file in
let ppf = Format.formatter_of_out_channel oc in
let close () =
Format.fprintf ppf "%!";
close_out oc
in
let file = { name = file; ppf; close; data_fields } in
Raw.Tbl.add t.raw (src, tags) file;
file
let write t src ~data_fields ~tags fmt =
let f = file t src ~data_fields ~tags in
Fmt.pf f.ppf fmt
let pp_tags =
let e pp ppf x = Fmt.string ppf (escape (Fmt.to_to_string pp x)) in
let pp_tag ppf t = Fmt.pf ppf "%a=%a" (e pp_key) t (e pp_value) t in
Fmt.(list ~sep:(any ", ") pp_tag)
let read_file file =
let ic = open_in file in
let r = ref [] in
try
while true do
r := input_line ic :: !r
done;
assert false
with End_of_file ->
close_in ic;
String.concat "\n" (List.rev !r)
let read_output cmd =
let temp_file = Filename.temp_file "metrics" "gnuplot" in
let fd = Unix.openfile temp_file [ O_WRONLY; O_TRUNC ] 0 in
let pid = Unix.create_process "sh" [| "sh"; "-c"; cmd |] Unix.stdin fd fd in
Unix.close fd;
let read () = read_file temp_file in
match snd (Unix.waitpid [] pid) with
| exception Unix.(Unix_error (EINTR, _, _)) -> Ok (read ())
| WEXITED 0 -> Ok (read ())
| _ -> Error (read ())
let plots_of_field t xlabel acc (src, field) =
Raw.Tbl.fold
(fun (src_r, tags) file acc ->
if Src.equal src src_r then
let fields = Src.data src in
let i = index ~fields field + 2 in
let label =
match tags with
| [] -> key field
| _ -> Fmt.str "%a (%s)" pp_tags tags (key field)
in
match xlabel with
| `Timestamp -> (file.name, 1, i, label) :: acc
| `Duration -> (
let duration =
try Some (index_key ~fields Key.duration + 2)
with Not_found -> None
in
match duration with
| None -> acc
| Some d -> (file.name, d, i, label) :: acc)
else acc)
t.raw acc
let scatter_plot oc ~plots ~title ~xlabel ~ylabel ~yunit ~output =
let ppf = Format.formatter_of_out_channel oc in
let xlabel =
match xlabel with `Timestamp -> "Time (ns)" | `Duration -> "Duration (ns)"
in
let pp_plots ppf (file, i, j, label) =
Fmt.pf ppf "'%s' using %d:%d t \"%s\"" file i j label
in
match plots with
| [] -> ()
| _ ->
Fmt.pf ppf
{|
set title '%s'
set xlabel '%s'
set ylabel "%s%s"
set datafile separator ","
set grid
set term png
set output '%s'
plot %a
|}
title xlabel ylabel yunit output
Fmt.(list ~sep:(any ", ") pp_plots)
plots
let render_graph ~dir ~out ~script_file =
let out_dir = dir / out in
if not (Sys.file_exists out_dir) then Unix.mkdir out_dir 0o755;
Fmt.str "cd %s && gnuplot %s" dir script_file |> read_output
let plot_graph ~output_format ~xlabel t g =
let fields = Graph.fields g in
let plots = List.fold_left (plots_of_field t xlabel) [] fields in
let ylabel =
match Metrics.Graph.ylabel g with
| Some t -> t
| None -> match fields with [] -> "" | h :: _ -> key (snd h)
in
let yunit =
match Metrics.Graph.yunit g with
| Some u -> Fmt.str " (%s)" u
| None ->
match fields with
| [] -> ""
| h :: _ ->
match unit (snd h) with None -> "" | Some u -> Fmt.str " (%s)" u
in
let title = match Metrics.Graph.title g with Some t -> t | None -> ylabel in
let suffix = match xlabel with `Timestamp -> "" | `Duration -> ".d" in
let basename = Fmt.str "%s-%d%s" (escape title) (Graph.id g) suffix in
let output = ("out" / basename) ^ ".png" in
let file = (t.dir / basename) ^ ".gp" in
mkdir (Filename.dirname file);
let oc = open_out file in
scatter_plot oc ~plots ~title ~xlabel ~ylabel ~yunit ~output;
flush oc;
close_out oc;
match output_format with
| `Script -> Fmt.pr "%s has been created.\n%!" file
| `Image -> (
render_graph ~dir:t.dir ~out:"out" ~script_file:file |> function
| Ok _ -> Fmt.pr "%s has been created.\n%!" (t.dir / output)
| Error e -> Fmt.failwith "Cannot generate %s: %s" output e)
let set_reporter ?dir ?(output = `Image) () =
let t = empty ?dir () in
let report ~tags ~data ~over src k =
let data_fields = Data.fields data in
(* TODO: quote values *)
let pp = Fmt.(list ~sep:(any ", ") pp_value) in
let timestamp =
match Data.timestamp data with
| Some ts -> ts
| None -> Int64.to_string (Mtime_clock.elapsed_ns ())
in
let pp_timestamp ppf () =
match data_fields with
| [] -> Fmt.string ppf timestamp
| _ -> Fmt.pf ppf "%s, " timestamp
in
write ~data_fields ~tags t src "%a%a\n" pp_timestamp () pp data_fields;
register_lonely_fields t src data_fields;
over ();
k ()
in
let now () = Mtime_clock.now () |> Mtime.to_uint64_ns in
let at_exit () =
let graphs = Graph.list () in
(* Close all the raw data files *)
Raw.Tbl.iter (fun _ f -> f.close ()) t.raw;
match output with
| `Datafile ->
Raw.Tbl.iter (fun _ f -> Fmt.pr "%s has been created.\n%!" f.name) t.raw
| `Script ->
List.iter (plot_graph t ~output_format:`Script ~xlabel:`Timestamp) graphs;
List.iter (plot_graph t ~output_format:`Script ~xlabel:`Duration) graphs
| `Image ->
List.iter (plot_graph t ~output_format:`Image ~xlabel:`Timestamp) graphs;
List.iter (plot_graph t ~output_format:`Image ~xlabel:`Duration) graphs
in
Metrics.set_reporter { Metrics.report; now; at_exit }

18
unikernel/duniverse/metrics/src/unix/metrics_gnuplot.mli Normal file
View file

@ -0,0 +1,18 @@
(*
* Copyright (c) 2018 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.
*)
val set_reporter :
?dir:string -> ?output:[ `Image | `Script | `Datafile ] -> unit -> unit

41
unikernel/duniverse/metrics/src/unix/metrics_unix.ml Normal file
View file

@ -0,0 +1,41 @@
(*
* Copyright (c) 2018 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 Metrics
open Lwt.Infix
let gc_quick_stat = gc_quick_stat ~tags:Tags.[]
let gc_stat = gc_stat ~tags:Tags.[]
let monitor_gc ?(quick = true) delay =
let id x = x in
let f () =
if quick then add gc_quick_stat id (fun d -> d ())
else add gc_stat id (fun d -> d ())
in
let rec loop () =
f ();
Lwt_unix.sleep delay >>= fun () -> loop ()
in
Lwt.async loop
let disable_gc_stat () =
Src.(disable (Src gc_quick_stat));
Src.(disable (Src gc_stat))
let enable_gc_stat () =
Src.(enable (Src gc_quick_stat));
Src.(enable (Src gc_stat))

23
unikernel/duniverse/metrics/src/unix/metrics_unix.mli Normal file
View file

@ -0,0 +1,23 @@
(*
* Copyright (c) 2018 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.
*)
val monitor_gc : ?quick:bool -> float -> unit
(** [monitor_gc f] starts a monitoring threads which adds new entries every [f]
seconds. If [quick] is set (the default) [Gc.quick_stats ()] is called,
otherwise it's [Gc.stats ()]. *)
val disable_gc_stat : unit -> unit
val enable_gc_stat : unit -> unit

4
unikernel/duniverse/metrics/test/core/dune Normal file
View file

@ -0,0 +1,4 @@
(test
(name test)
(package metrics)
(libraries metrics alcotest unix))

154
unikernel/duniverse/metrics/test/core/test.ml Normal file
View file

@ -0,0 +1,154 @@
(*
* Copyright (c) 2018 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.
*)
(*************)
(* Reporters *)
(*************)
let data_ = Queue.create ()
let data () = Queue.pop data_
let now =
let n = ref ~-1 in
fun () ->
incr n;
Int64.of_int !n
let set_mem_reporter () =
let report ~tags ~data ~over src k =
let data_fields = Metrics.Data.fields data in
let name = Metrics.Src.name src in
let field f =
(Fmt.to_to_string Metrics.pp_key f, Fmt.to_to_string Metrics.pp_value f)
in
let fields = List.map field in
let timestamp =
match Metrics.Data.timestamp data with
| Some ts -> ts
| None -> Int64.to_string (now ())
in
let d = (name, fields tags, fields data_fields, timestamp) in
Queue.push d data_;
over ();
k ()
in
let at_exit () = () in
Metrics.set_reporter { Metrics.report; now; at_exit }
(*************)
(* Tests *)
(*************)
let src =
let open Metrics in
let tags = Tags.[ int "foo"; string "bar" ] in
let data i =
Data.v [ string "toto" ("XXX" ^ string_of_int i); int "titi" i ]
in
Src.v "test" ~tags ~data
let f tags =
Metrics.add src tags (fun m -> m 42);
Metrics.add src tags (fun m -> m 43)
let i0 t = t 42 "hi!"
let i1 t = t 12 "toto"
let timer =
let open Metrics in
let tags = Tags.[ string "truc" ] in
let data (_ : (unit, string) rresult) = Data.v [] in
Src.v "sleep" ~tags ~data ~duration:true ~status:true
let m1 t = t "foo"
let m2 t = t "bar"
let status =
let open Metrics in
let tags = Tags.[] in
let data (_ : (unit, unit) rresult) = Data.v [] in
Src.v "status" ~tags ~data ~duration:false ~status:true
let d =
let pp_string = Fmt.fmt "%S" in
let pp_field = Fmt.Dump.pair pp_string pp_string in
let pp ppf (n, t, f, x) =
Fmt.pf ppf "(%S, %a, %a, %S)" n
Fmt.(Dump.list pp_field)
t
Fmt.(Dump.list pp_field)
f x
in
Alcotest.testable pp ( = )
let test_f () =
f i0;
Alcotest.check d "i0" (data ())
( "test",
[ ("foo", "42"); ("bar", "hi!") ],
[ ("toto", "XXX42"); ("titi", "42") ],
"0" );
Alcotest.check d "i0" (data ())
( "test",
[ ("foo", "42"); ("bar", "hi!") ],
[ ("toto", "XXX43"); ("titi", "43") ],
"1" );
f i1;
Alcotest.check d "i0" (data ())
( "test",
[ ("foo", "12"); ("bar", "toto") ],
[ ("toto", "XXX42"); ("titi", "42") ],
"2" );
Alcotest.check d "i1" (data ())
( "test",
[ ("foo", "12"); ("bar", "toto") ],
[ ("toto", "XXX43"); ("titi", "43") ],
"3" )
let test_timer () =
let _ = Metrics.rrun timer m1 (fun () -> Ok (Unix.sleep 1)) in
Alcotest.check d "m1-ok" (data ())
("sleep", [ ("truc", "foo") ], [ ("duration", "1"); ("status", "ok") ], "6");
let _ =
try Metrics.rrun timer m1 (fun () -> raise Not_found)
with Not_found -> Ok ()
in
Alcotest.check d "m1-error" (data ())
( "sleep",
[ ("truc", "foo") ],
[ ("duration", "1"); ("status", "error") ],
"9" )
let test_status () =
let _ = Metrics.rrun status (fun t -> t) (fun () -> Ok ()) in
Alcotest.check d "status" (data ()) ("status", [], [ ("status", "ok") ], "12");
let _ = Metrics.rrun status (fun t -> t) (fun () -> Error ()) in
Alcotest.check d "status" (data ())
("status", [], [ ("status", "error") ], "15");
()
let () =
Metrics.enable_all ();
set_mem_reporter ();
Alcotest.run "metrics"
[
( "base",
[
("f", `Quick, test_f);
("timer", `Quick, test_timer);
("status", `Quick, test_status);
] );
]

4
unikernel/duniverse/metrics/test/unix/dune Normal file
View file

@ -0,0 +1,4 @@
(test
(name test)
(package metrics-unix)
(libraries metrics-lwt metrics-unix mtime.clock.os unix))

90
unikernel/duniverse/metrics/test/unix/test.ml Normal file
View file

@ -0,0 +1,90 @@
(*
* Copyright (c) 2018 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.
*)
(*************)
(* Tests *)
(*************)
let src =
let open Metrics in
let tags = Tags.[ int "pid"; string "hostname" ] in
let data i =
Data.v
[ float "CPU" ~unit:"%" (float_of_int i ** 2.); int "MEM" ~unit:"KiB" i ]
in
Src.v "test" ~tags ~data
let i0 t = t 42 "foo.local"
let i1 t = t 12 "toto.com"
let f tags i = Metrics.add src tags (fun m -> m i)
let run () =
for i = 0 to 100 do
f i0 i;
f i1 (2 * i)
done
let src =
let open Metrics in
let tags = Tags.[ string "truc" ] in
let graph = Graph.v ~title:"Nice graph!" ~yunit:"yay" ~ylabel:"toto" () in
let data i =
Data.v [ float "CPU" ~graph (float_of_int i ** 2.); int "MEM" ~graph i ]
in
Src.v "test" ~tags ~data
let i0 t = t "foo"
let i1 t = t "bar"
let f tags i = Metrics.add src tags (fun m -> m i)
let run2 () =
for i = 0 to 100 do
f i0 i;
f i1 (2 * i)
done
let timer =
let open Metrics in
let tags = Tags.[] in
let graph = Graph.v ~title:"Timers!!" () in
let data = function
| Ok t ->
Data.v [ int ~graph "timer" (int_of_float @@ (t *. 1_000_000_000.)) ]
| Error _ -> Data.v [ float ~graph "timer" 0. ]
in
Src.v "sleep" ~tags ~data ~duration:true ~status:false
let run3 () =
let open Lwt.Infix in
let rec aux = function
| 0 -> Lwt.return ()
| i ->
Metrics_lwt.run timer
(fun x -> x)
(fun () ->
let t = Random.float 1. in
Lwt_unix.sleep t >|= fun _ -> t)
>>= fun _ -> aux (i - 1)
in
aux 10
let () =
Metrics.enable_all ();
Metrics_gnuplot.set_reporter ();
Metrics_unix.monitor_gc 0.1;
run ();
run2 ();
Lwt_main.run (run3 ())