Skip to content

Commit 5acd350

Browse files
ulrikstridulrikstrid
committed
Split implementation to a reporter
1 parent 9bffcbe commit 5acd350

9 files changed

Lines changed: 387 additions & 250 deletions

‎app/dune‎

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,29 @@
11
(library
22
(name prometheus_app)
33
(public_name prometheus-app)
4-
(libraries prometheus lwt cohttp-lwt astring asetmap fmt re)
4+
(libraries
5+
prometheus
6+
prometheus-reporter
7+
lwt
8+
cohttp-lwt
9+
astring
10+
asetmap
11+
fmt
12+
re)
513
(modules Prometheus_app)
614
(wrapped false))
715

816
(library
917
(name prometheus_app_unix)
1018
(public_name prometheus-app.unix)
11-
(libraries prometheus prometheus-app cmdliner cohttp-lwt cohttp-lwt-unix logs.fmt fmt.tty)
19+
(libraries
20+
prometheus
21+
prometheus-app
22+
prometheus-reporter.unix
23+
cmdliner
24+
cohttp-lwt
25+
cohttp-lwt-unix
26+
logs.fmt
27+
fmt.tty)
1228
(modules Prometheus_unix)
1329
(wrapped false))

‎app/prometheus_app.ml‎

Lines changed: 1 addition & 150 deletions
Original file line numberDiff line numberDiff line change
@@ -1,147 +1,4 @@
1-
open Prometheus
2-
3-
let failf fmt =
4-
Fmt.kstr failwith fmt
5-
6-
module TextFormat_0_0_4 = struct
7-
let re_unquoted_escapes = Re.compile @@ Re.set "\\\n"
8-
let re_quoted_escapes = Re.compile @@ Re.set "\"\\\n"
9-
10-
let quote g =
11-
match Re.Group.get g 0 with
12-
| "\\" -> "\\\\"
13-
| "\n" -> "\\n"
14-
| "\"" -> "\\\""
15-
| x -> failf "Unexpected match %S" x
16-
17-
let output_metric_type f = function
18-
| Counter -> Fmt.string f "counter"
19-
| Gauge -> Fmt.string f "gauge"
20-
| Summary -> Fmt.string f "summary"
21-
| Histogram -> Fmt.string f "histogram"
22-
23-
let output_unquoted f s =
24-
Fmt.string f @@ Re.replace re_unquoted_escapes ~f:quote s
25-
26-
let output_quoted f s =
27-
Fmt.string f @@ Re.replace re_quoted_escapes ~f:quote s
28-
29-
(* Fmt.float by default prints floats using scientific exponential
30-
* notation, which loses significant data on e.g. timestamp:
31-
* Fmt.str "%a" Fmt.float 1575363850.57 --> 1.57536e+09 *)
32-
let float_fmt f =
33-
Fmt.pf f "%f"
34-
35-
let output_value f v =
36-
match classify_float v with
37-
| FP_normal | FP_subnormal | FP_zero -> float_fmt f v
38-
| FP_infinite when v > 0.0 -> Fmt.string f "+Inf"
39-
| FP_infinite -> Fmt.string f "-Inf"
40-
| FP_nan -> Fmt.string f "Nan"
41-
42-
let output_pairs f (label_names, label_values) =
43-
let cont = ref false in
44-
let output_pair name value =
45-
if !cont then Fmt.string f ", "
46-
else cont := true;
47-
Fmt.pf f "%a=\"%a\"" LabelName.pp name output_quoted value
48-
in
49-
List.iter2 output_pair label_names label_values
50-
51-
let output_labels ~label_names f = function
52-
| [] -> ()
53-
| label_values -> Fmt.pf f "{%a}" output_pairs (label_names, label_values)
54-
55-
let output_sample ~base ~label_names ~label_values f { Sample_set.ext; value; bucket } =
56-
let label_names, label_values = match bucket with
57-
| None -> label_names, label_values
58-
| Some (label_name, label_value) ->
59-
let label_value_str = Fmt.str "%a" output_value label_value in
60-
label_name :: label_names, label_value_str :: label_values
61-
in
62-
Fmt.pf f "%a%s%a %a@."
63-
MetricName.pp base ext
64-
(output_labels ~label_names) label_values
65-
output_value value
66-
67-
let output_metric ~name ~label_names f (label_values, samples) =
68-
List.iter (output_sample ~base:name ~label_names ~label_values f) samples
69-
70-
let output f =
71-
MetricFamilyMap.iter (fun metric samples ->
72-
let {MetricInfo.name; metric_type; help; label_names} = metric in
73-
Fmt.pf f
74-
"# HELP %a %a@.\
75-
# TYPE %a %a@.\
76-
%a"
77-
MetricName.pp name output_unquoted help
78-
MetricName.pp name output_metric_type metric_type
79-
(LabelSetMap.pp ~sep:Fmt.nop (output_metric ~name ~label_names)) samples
80-
)
81-
end
82-
83-
module Runtime = struct
84-
let current = ref (Gc.quick_stat ())
85-
let update () =
86-
current := Gc.quick_stat ()
87-
88-
let simple_metric ~metric_type ~help name fn =
89-
let info = {
90-
MetricInfo.
91-
name = MetricName.v name;
92-
help;
93-
metric_type;
94-
label_names = [];
95-
}
96-
in
97-
let collect () =
98-
LabelSetMap.singleton [] [Sample_set.sample (fn ())]
99-
in
100-
info, collect
101-
102-
let ocaml_gc_allocated_bytes =
103-
simple_metric ~metric_type:Counter "ocaml_gc_allocated_bytes" Gc.allocated_bytes
104-
~help:"Total number of bytes allocated since the program was started."
105-
106-
let ocaml_gc_major_words =
107-
simple_metric ~metric_type:Counter "ocaml_gc_major_words" (fun () -> (!current).Gc.major_words)
108-
~help:"Number of words allocated in the major heap since the program was started."
109-
110-
let ocaml_gc_minor_collections =
111-
simple_metric ~metric_type:Counter "ocaml_gc_minor_collections" (fun () -> float_of_int (!current).Gc.minor_collections)
112-
~help:"Number of minor collection cycles completed since the program was started."
113-
114-
let ocaml_gc_major_collections =
115-
simple_metric ~metric_type:Counter "ocaml_gc_major_collections" (fun () -> float_of_int (!current).Gc.major_collections)
116-
~help:"Number of major collection cycles completed since the program was started."
117-
118-
let ocaml_gc_heap_words =
119-
simple_metric ~metric_type:Gauge "ocaml_gc_heap_words" (fun () -> float_of_int (!current).Gc.heap_words)
120-
~help:"Total size of the major heap, in words."
121-
122-
let ocaml_gc_compactions =
123-
simple_metric ~metric_type:Counter "ocaml_gc_compactions" (fun () -> float_of_int (!current).Gc.compactions)
124-
~help:"Number of heap compactions since the program was started."
125-
126-
let ocaml_gc_top_heap_words =
127-
simple_metric ~metric_type:Counter "ocaml_gc_top_heap_words" (fun () -> float_of_int (!current).Gc.top_heap_words)
128-
~help:"Maximum size reached by the major heap, in words."
129-
130-
let process_cpu_seconds_total =
131-
simple_metric ~metric_type:Counter "process_cpu_seconds_total" Sys.time
132-
~help:"Total user and system CPU time spent in seconds."
133-
134-
let metrics = [
135-
ocaml_gc_allocated_bytes;
136-
ocaml_gc_major_words;
137-
ocaml_gc_minor_collections;
138-
ocaml_gc_major_collections;
139-
ocaml_gc_heap_words;
140-
ocaml_gc_compactions;
141-
ocaml_gc_top_heap_words;
142-
process_cpu_seconds_total;
143-
]
144-
end
1+
include Prometheus_reporter
1452

1463
open Lwt.Infix
1474

@@ -157,9 +14,3 @@ module Cohttp(Server : Cohttp_lwt.S.Server) = struct
15714
Server.respond_string ~status:`OK ~headers ~body ()
15815
| _ -> Server.respond_error ~status:`Bad_request ~body:"Bad request" ()
15916
end
160-
161-
let () =
162-
CollectorRegistry.(register_pre_collect default) Runtime.update;
163-
let add (info, collector) =
164-
CollectorRegistry.(register default) info collector in
165-
List.iter add Runtime.metrics

‎app/prometheus_unix.ml‎

Lines changed: 1 addition & 98 deletions
Original file line numberDiff line numberDiff line change
@@ -1,48 +1,4 @@
1-
open Prometheus
2-
3-
module Metrics = struct
4-
let namespace = "prometheus"
5-
6-
let subsystem = "logs"
7-
8-
let inc_messages =
9-
let help = "Total number of messages logged" in
10-
let c =
11-
Counter.v_labels ~label_names:[ "level"; "src" ] ~help ~namespace
12-
~subsystem "messages_total"
13-
in
14-
fun lvl src ->
15-
let lvl = Logs.level_to_string (Some lvl) in
16-
Counter.inc_one @@ Counter.labels c [ lvl; src ]
17-
end
18-
19-
module Unix_runtime = struct
20-
let start_time = Unix.gettimeofday ()
21-
22-
let simple_metric ~metric_type ~help name fn =
23-
let info = {
24-
MetricInfo.
25-
name = MetricName.v name;
26-
help;
27-
metric_type;
28-
label_names = [];
29-
}
30-
in
31-
let collect () =
32-
LabelSetMap.singleton [] [Sample_set.sample (fn ())]
33-
in
34-
info, collect
35-
36-
let process_start_time_seconds =
37-
simple_metric ~metric_type:Counter "process_start_time_seconds" (fun () -> start_time)
38-
~help:"Start time of the process since unix epoch in seconds."
39-
40-
let metrics = [
41-
process_start_time_seconds;
42-
]
43-
end
44-
45-
type config = int option
1+
include Prometheus_reporter_unix
462

473
module Server = Prometheus_app.Cohttp(Cohttp_lwt_unix.Server)
484

@@ -53,56 +9,3 @@ let serve = function
539
let callback = Server.callback in
5410
let thread = Cohttp_lwt_unix.Server.create ~mode (Cohttp_lwt_unix.Server.make ~callback ()) in
5511
[thread]
56-
57-
let listen_prometheus =
58-
let open! Cmdliner in
59-
let doc =
60-
Arg.info ~docs:"MONITORING OPTIONS" ~docv:"PORT" ~doc:
61-
"Port on which to provide Prometheus metrics over HTTP."
62-
["listen-prometheus"]
63-
in
64-
Arg.(value @@ opt (some int) None doc)
65-
66-
let opts = listen_prometheus
67-
68-
let () =
69-
let add (info, collector) =
70-
CollectorRegistry.(register default) info collector in
71-
List.iter add Unix_runtime.metrics
72-
73-
module Logging = struct
74-
let inc_counter = Metrics.inc_messages
75-
76-
let pp_timestamp f x =
77-
let open Unix in
78-
let tm = localtime x in
79-
Fmt.pf f "%04d-%02d-%02d %02d:%02d.%02d" (tm.tm_year + 1900) (tm.tm_mon + 1)
80-
tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec
81-
82-
let reporter formatter =
83-
let report src level ~over k msgf =
84-
let k _ = over (); k () in
85-
let src = Logs.Src.name src in
86-
Metrics.inc_messages level src;
87-
msgf @@ fun ?header ?tags:_ fmt ->
88-
Fmt.kpf k formatter ("%a %a %a @[" ^^ fmt ^^ "@]@.")
89-
pp_timestamp (Unix.gettimeofday ())
90-
Fmt.(styled `Magenta string) (Printf.sprintf "%14s" src)
91-
Logs_fmt.pp_header (level, header)
92-
in
93-
{ Logs.report = report }
94-
95-
let set_level (src, level) =
96-
let rec aux = function
97-
| [] -> Logs.warn (fun f -> f "set_level: logger %S not registered; ignoring" src)
98-
| x :: _ when Logs.Src.name x = src -> Logs.Src.set_level x (Some level)
99-
| _ :: xs -> aux xs
100-
in
101-
aux (Logs.Src.list ())
102-
103-
let init ?(default_level=Logs.Info) ?(levels=[]) ?(formatter=Fmt.stderr) () =
104-
Fmt_tty.setup_std_outputs ();
105-
Logs.set_reporter (reporter formatter);
106-
Logs.set_level (Some default_level);
107-
List.iter set_level levels
108-
end

‎prometheus-reporter.opam‎

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
opam-version: "2.0"
2+
synopsis: "Client library for Prometheus monitoring"
3+
description: """\
4+
Applications can enable metric reporting using the `prometheus-reporter` opam package.
5+
6+
The `prometheus-reporter.unix` ocamlfind library provides the `Prometheus_reporter_unix` module,
7+
which includes a cmdliner option.
8+
See the `examples/example.ml` program for an example, which can be run as:
9+
10+
Unikernels can use `Prometheus_reporter` instead of `Prometheus_reporter_unix` to avoid the `Unix` dependency."""
11+
maintainer: "talex5@gmail.com"
12+
authors: ["Thomas Leonard" "David Scott"]
13+
license: "Apache-2.0"
14+
homepage: "https://github.com/mirage/prometheus"
15+
doc: "https://mirage.github.io/prometheus/"
16+
bug-reports: "https://github.com/mirage/prometheus/issues"
17+
depends: [
18+
"ocaml" {>= "4.02.3"}
19+
"dune" {>= "1.0"}
20+
"prometheus" {= version}
21+
"fmt" {>= "0.8.7"}
22+
"re"
23+
"lwt" {>= "2.5.0"}
24+
"cmdliner"
25+
"alcotest" {with-test}
26+
"astring"
27+
"logs" {>= "0.6.0"}
28+
]
29+
build: [
30+
["dune" "build" "-p" name "-j" jobs]
31+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
32+
]
33+
dev-repo: "git+https://github.com/mirage/prometheus.git"

‎reporter/dune‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
(library
2+
(name prometheus_reporter)
3+
(public_name prometheus-reporter)
4+
(libraries prometheus lwt astring fmt re)
5+
(modules Prometheus_reporter)
6+
(wrapped false))
7+
8+
(library
9+
(name prometheus_reporter_unix)
10+
(public_name prometheus-reporter.unix)
11+
(libraries prometheus cmdliner logs.fmt fmt.tty)
12+
(modules Prometheus_reporter_unix)
13+
(wrapped false))

0 commit comments

Comments
 (0)