Skip to content

Split implementation to a pure app #46

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Split implementation to a pure app #46

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 18 additions & 2 deletions app/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,29 @@
(library
(name prometheus_app)
(public_name prometheus-app)
(libraries prometheus lwt cohttp-lwt astring asetmap fmt re)
(libraries
prometheus
prometheus-reporter
lwt
cohttp-lwt
astring
asetmap
fmt
re)
(modules Prometheus_app)
(wrapped false))

(library
(name prometheus_app_unix)
(public_name prometheus-app.unix)
(libraries prometheus prometheus-app cmdliner cohttp-lwt cohttp-lwt-unix logs.fmt fmt.tty)
(libraries
prometheus
prometheus-app
prometheus-reporter.unix
cmdliner
cohttp-lwt
cohttp-lwt-unix
logs.fmt
fmt.tty)
(modules Prometheus_unix)
(wrapped false))
151 changes: 1 addition & 150 deletions app/prometheus_app.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,147 +1,4 @@
open Prometheus

let failf fmt =
Fmt.kstr failwith fmt

module TextFormat_0_0_4 = struct
let re_unquoted_escapes = Re.compile @@ Re.set "\\\n"
let re_quoted_escapes = Re.compile @@ Re.set "\"\\\n"

let quote g =
match Re.Group.get g 0 with
| "\\" -> "\\\\"
| "\n" -> "\\n"
| "\"" -> "\\\""
| x -> failf "Unexpected match %S" x

let output_metric_type f = function
| Counter -> Fmt.string f "counter"
| Gauge -> Fmt.string f "gauge"
| Summary -> Fmt.string f "summary"
| Histogram -> Fmt.string f "histogram"

let output_unquoted f s =
Fmt.string f @@ Re.replace re_unquoted_escapes ~f:quote s

let output_quoted f s =
Fmt.string f @@ Re.replace re_quoted_escapes ~f:quote s

(* Fmt.float by default prints floats using scientific exponential
* notation, which loses significant data on e.g. timestamp:
* Fmt.str "%a" Fmt.float 1575363850.57 --> 1.57536e+09 *)
let float_fmt f =
Fmt.pf f "%f"

let output_value f v =
match classify_float v with
| FP_normal | FP_subnormal | FP_zero -> float_fmt f v
| FP_infinite when v > 0.0 -> Fmt.string f "+Inf"
| FP_infinite -> Fmt.string f "-Inf"
| FP_nan -> Fmt.string f "Nan"

let output_pairs f (label_names, label_values) =
let cont = ref false in
let output_pair name value =
if !cont then Fmt.string f ", "
else cont := true;
Fmt.pf f "%a=\"%a\"" LabelName.pp name output_quoted value
in
List.iter2 output_pair label_names label_values

let output_labels ~label_names f = function
| [] -> ()
| label_values -> Fmt.pf f "{%a}" output_pairs (label_names, label_values)

let output_sample ~base ~label_names ~label_values f { Sample_set.ext; value; bucket } =
let label_names, label_values = match bucket with
| None -> label_names, label_values
| Some (label_name, label_value) ->
let label_value_str = Fmt.str "%a" output_value label_value in
label_name :: label_names, label_value_str :: label_values
in
Fmt.pf f "%a%s%a %a@."
MetricName.pp base ext
(output_labels ~label_names) label_values
output_value value

let output_metric ~name ~label_names f (label_values, samples) =
List.iter (output_sample ~base:name ~label_names ~label_values f) samples

let output f =
MetricFamilyMap.iter (fun metric samples ->
let {MetricInfo.name; metric_type; help; label_names} = metric in
Fmt.pf f
"# HELP %a %a@.\
# TYPE %a %a@.\
%a"
MetricName.pp name output_unquoted help
MetricName.pp name output_metric_type metric_type
(LabelSetMap.pp ~sep:Fmt.nop (output_metric ~name ~label_names)) samples
)
end

module Runtime = struct
let current = ref (Gc.quick_stat ())
let update () =
current := Gc.quick_stat ()

let simple_metric ~metric_type ~help name fn =
let info = {
MetricInfo.
name = MetricName.v name;
help;
metric_type;
label_names = [];
}
in
let collect () =
LabelSetMap.singleton [] [Sample_set.sample (fn ())]
in
info, collect

let ocaml_gc_allocated_bytes =
simple_metric ~metric_type:Counter "ocaml_gc_allocated_bytes" Gc.allocated_bytes
~help:"Total number of bytes allocated since the program was started."

let ocaml_gc_major_words =
simple_metric ~metric_type:Counter "ocaml_gc_major_words" (fun () -> (!current).Gc.major_words)
~help:"Number of words allocated in the major heap since the program was started."

let ocaml_gc_minor_collections =
simple_metric ~metric_type:Counter "ocaml_gc_minor_collections" (fun () -> float_of_int (!current).Gc.minor_collections)
~help:"Number of minor collection cycles completed since the program was started."

let ocaml_gc_major_collections =
simple_metric ~metric_type:Counter "ocaml_gc_major_collections" (fun () -> float_of_int (!current).Gc.major_collections)
~help:"Number of major collection cycles completed since the program was started."

let ocaml_gc_heap_words =
simple_metric ~metric_type:Gauge "ocaml_gc_heap_words" (fun () -> float_of_int (!current).Gc.heap_words)
~help:"Total size of the major heap, in words."

let ocaml_gc_compactions =
simple_metric ~metric_type:Counter "ocaml_gc_compactions" (fun () -> float_of_int (!current).Gc.compactions)
~help:"Number of heap compactions since the program was started."

let ocaml_gc_top_heap_words =
simple_metric ~metric_type:Counter "ocaml_gc_top_heap_words" (fun () -> float_of_int (!current).Gc.top_heap_words)
~help:"Maximum size reached by the major heap, in words."

let process_cpu_seconds_total =
simple_metric ~metric_type:Counter "process_cpu_seconds_total" Sys.time
~help:"Total user and system CPU time spent in seconds."

let metrics = [
ocaml_gc_allocated_bytes;
ocaml_gc_major_words;
ocaml_gc_minor_collections;
ocaml_gc_major_collections;
ocaml_gc_heap_words;
ocaml_gc_compactions;
ocaml_gc_top_heap_words;
process_cpu_seconds_total;
]
end
include Prometheus_reporter
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We should also be able to include it in the mli, to avoid duplication.


open Lwt.Infix

Expand All @@ -157,9 +14,3 @@ module Cohttp(Server : Cohttp_lwt.S.Server) = struct
Server.respond_string ~status:`OK ~headers ~body ()
| _ -> Server.respond_error ~status:`Bad_request ~body:"Bad request" ()
end

let () =
CollectorRegistry.(register_pre_collect default) Runtime.update;
let add (info, collector) =
CollectorRegistry.(register default) info collector in
List.iter add Runtime.metrics
99 changes: 1 addition & 98 deletions app/prometheus_unix.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,48 +1,4 @@
open Prometheus

module Metrics = struct
let namespace = "prometheus"

let subsystem = "logs"

let inc_messages =
let help = "Total number of messages logged" in
let c =
Counter.v_labels ~label_names:[ "level"; "src" ] ~help ~namespace
~subsystem "messages_total"
in
fun lvl src ->
let lvl = Logs.level_to_string (Some lvl) in
Counter.inc_one @@ Counter.labels c [ lvl; src ]
end

module Unix_runtime = struct
let start_time = Unix.gettimeofday ()

let simple_metric ~metric_type ~help name fn =
let info = {
MetricInfo.
name = MetricName.v name;
help;
metric_type;
label_names = [];
}
in
let collect () =
LabelSetMap.singleton [] [Sample_set.sample (fn ())]
in
info, collect

let process_start_time_seconds =
simple_metric ~metric_type:Counter "process_start_time_seconds" (fun () -> start_time)
~help:"Start time of the process since unix epoch in seconds."

let metrics = [
process_start_time_seconds;
]
end

type config = int option
include Prometheus_reporter_unix

module Server = Prometheus_app.Cohttp(Cohttp_lwt_unix.Server)

Expand All @@ -53,56 +9,3 @@ let serve = function
let callback = Server.callback in
let thread = Cohttp_lwt_unix.Server.create ~mode (Cohttp_lwt_unix.Server.make ~callback ()) in
[thread]

let listen_prometheus =
let open! Cmdliner in
let doc =
Arg.info ~docs:"MONITORING OPTIONS" ~docv:"PORT" ~doc:
"Port on which to provide Prometheus metrics over HTTP."
["listen-prometheus"]
in
Arg.(value @@ opt (some int) None doc)

let opts = listen_prometheus

let () =
let add (info, collector) =
CollectorRegistry.(register default) info collector in
List.iter add Unix_runtime.metrics

module Logging = struct
let inc_counter = Metrics.inc_messages

let pp_timestamp f x =
let open Unix in
let tm = localtime x in
Fmt.pf f "%04d-%02d-%02d %02d:%02d.%02d" (tm.tm_year + 1900) (tm.tm_mon + 1)
tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec

let reporter formatter =
let report src level ~over k msgf =
let k _ = over (); k () in
let src = Logs.Src.name src in
Metrics.inc_messages level src;
msgf @@ fun ?header ?tags:_ fmt ->
Fmt.kpf k formatter ("%a %a %a @[" ^^ fmt ^^ "@]@.")
pp_timestamp (Unix.gettimeofday ())
Fmt.(styled `Magenta string) (Printf.sprintf "%14s" src)
Logs_fmt.pp_header (level, header)
in
{ Logs.report = report }

let set_level (src, level) =
let rec aux = function
| [] -> Logs.warn (fun f -> f "set_level: logger %S not registered; ignoring" src)
| x :: _ when Logs.Src.name x = src -> Logs.Src.set_level x (Some level)
| _ :: xs -> aux xs
in
aux (Logs.Src.list ())

let init ?(default_level=Logs.Info) ?(levels=[]) ?(formatter=Fmt.stderr) () =
Fmt_tty.setup_std_outputs ();
Logs.set_reporter (reporter formatter);
Logs.set_level (Some default_level);
List.iter set_level levels
end
33 changes: 33 additions & 0 deletions prometheus-reporter.opam
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
opam-version: "2.0"
synopsis: "Client library for Prometheus monitoring"
description: """\
Applications can enable metric reporting using the `prometheus-reporter` opam package.

The `prometheus-reporter.unix` ocamlfind library provides the `Prometheus_reporter_unix` module,
which includes a cmdliner option.
See the `examples/example.ml` program for an example, which can be run as:
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Missing text here?


Unikernels can use `Prometheus_reporter` instead of `Prometheus_reporter_unix` to avoid the `Unix` dependency."""
maintainer: "talex5@gmail.com"
authors: ["Thomas Leonard" "David Scott"]
license: "Apache-2.0"
homepage: "https://github.com/mirage/prometheus"
doc: "https://mirage.github.io/prometheus/"
bug-reports: "https://github.com/mirage/prometheus/issues"
depends: [
"ocaml" {>= "4.02.3"}
"dune" {>= "1.0"}
"prometheus" {= version}
"fmt" {>= "0.8.7"}
"re"
"lwt" {>= "2.5.0"}
"cmdliner"
"alcotest" {with-test}
"astring"
"logs" {>= "0.6.0"}
]
build: [
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
dev-repo: "git+https://github.com/mirage/prometheus.git"
13 changes: 13 additions & 0 deletions reporter/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
(library
(name prometheus_reporter)
(public_name prometheus-reporter)
(libraries prometheus lwt astring fmt re)
(modules Prometheus_reporter)
(wrapped false))

(library
(name prometheus_reporter_unix)
(public_name prometheus-reporter.unix)
(libraries prometheus cmdliner logs.fmt fmt.tty)
(modules Prometheus_reporter_unix)
(wrapped false))
Loading