Skip to content

Commit abbb7fe

Browse files
rbjorklinrbjorklin
committed
Add option to allow specifying address to bind to
1 parent fb4f8b1 commit abbb7fe

File tree

1 file changed

+73
-35
lines changed

1 file changed

+73
-35
lines changed

‎app/prometheus_unix.ml‎

Lines changed: 73 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@ open Prometheus
22

33
module Metrics = struct
44
let namespace = "prometheus"
5-
65
let subsystem = "logs"
76

87
let inc_messages =
@@ -20,54 +19,85 @@ module Unix_runtime = struct
2019
let start_time = Unix.gettimeofday ()
2120

2221
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 ())]
22+
let info =
23+
{
24+
MetricInfo.name = MetricName.v name;
25+
help;
26+
metric_type;
27+
label_names = [];
28+
}
3329
in
34-
info, collect
30+
let collect () = LabelSetMap.singleton [] [ Sample_set.sample (fn ()) ] in
31+
(info, collect)
3532

3633
let process_start_time_seconds =
37-
simple_metric ~metric_type:Counter "process_start_time_seconds" (fun () -> start_time)
34+
simple_metric ~metric_type:Counter "process_start_time_seconds"
35+
(fun () -> start_time)
3836
~help:"Start time of the process since unix epoch in seconds."
3937

40-
let metrics = [
41-
process_start_time_seconds;
42-
]
38+
let metrics = [ process_start_time_seconds ]
4339
end
4440

45-
type config = int option
41+
type config = string option
4642

47-
module Server = Prometheus_app.Cohttp(Cohttp_lwt_unix.Server)
43+
module Server = Prometheus_app.Cohttp (Cohttp_lwt_unix.Server)
4844

49-
let serve = function
45+
let bind addr port =
46+
let open! Unix in
47+
let[@ocaml.warning "-partial-match"] (addrinfo :: _) =
48+
getaddrinfo addr port [ AI_SOCKTYPE SOCK_STREAM ]
49+
in
50+
let socket =
51+
socket ~cloexec:true addrinfo.ai_family addrinfo.ai_socktype
52+
addrinfo.ai_protocol
53+
in
54+
let () = setsockopt socket SO_REUSEADDR true in
55+
let callback = Server.callback in
56+
let () = bind socket addrinfo.ai_addr in
57+
let () = listen socket 20 in
58+
let mode = `TCP (`Socket (Lwt_unix.of_unix_file_descr socket)) in
59+
let thread =
60+
Cohttp_lwt_unix.Server.create ~mode
61+
(Cohttp_lwt_unix.Server.make ~callback ())
62+
in
63+
[ thread ]
64+
65+
let serve config =
66+
let addr = "0.0.0.0" in
67+
let port = "9090" in
68+
match config with
5069
| None -> []
51-
| Some port ->
52-
let mode = `TCP (`Port port) in
53-
let callback = Server.callback in
54-
let thread = Cohttp_lwt_unix.Server.create ~mode (Cohttp_lwt_unix.Server.make ~callback ()) in
55-
[thread]
70+
| Some config_s -> (
71+
try
72+
match String.split_on_char ':' config_s with
73+
| [] -> bind addr port
74+
| port :: [] -> bind addr port
75+
| [ addr; port ] -> bind addr port
76+
with Match_failure _ ->
77+
Printf.printf
78+
"ERROR: Incorrect addr:port pair specified, prometheus listener not \
79+
starting.\n";
80+
flush_all ();
81+
[])
82+
[@@ocaml.warning "-partial-match"]
5683

5784
let listen_prometheus =
5885
let open! Cmdliner in
5986
let doc =
60-
Arg.info ~docs:"MONITORING OPTIONS" ~docv:"PORT" ~doc:
61-
"Port on which to provide Prometheus metrics over HTTP."
62-
["listen-prometheus"]
87+
Arg.info ~docs:"MONITORING OPTIONS" ~docv:"ADDR_PORT"
88+
~doc:
89+
"Port or address and port on which to provide Prometheus metrics over \
90+
HTTP."
91+
[ "listen-prometheus" ]
6392
in
64-
Arg.(value @@ opt (some int) None doc)
93+
Arg.(value @@ opt (some string) None doc)
6594

6695
let opts = listen_prometheus
6796

6897
let () =
6998
let add (info, collector) =
70-
CollectorRegistry.(register default) info collector in
99+
CollectorRegistry.(register default) info collector
100+
in
71101
List.iter add Unix_runtime.metrics
72102

73103
module Logging = struct
@@ -81,26 +111,34 @@ module Logging = struct
81111

82112
let reporter formatter =
83113
let report src level ~over k msgf =
84-
let k _ = over (); k () in
114+
let k _ =
115+
over ();
116+
k ()
117+
in
85118
let src = Logs.Src.name src in
86119
Metrics.inc_messages level src;
87120
msgf @@ fun ?header ?tags:_ fmt ->
88-
Fmt.kpf k formatter ("%a %a %a @[" ^^ fmt ^^ "@]@.")
121+
Fmt.kpf k formatter
122+
("%a %a %a @[" ^^ fmt ^^ "@]@.")
89123
pp_timestamp (Unix.gettimeofday ())
90-
Fmt.(styled `Magenta string) (Printf.sprintf "%14s" src)
124+
Fmt.(styled `Magenta string)
125+
(Printf.sprintf "%14s" src)
91126
Logs_fmt.pp_header (level, header)
92127
in
93-
{ Logs.report = report }
128+
{ Logs.report }
94129

95130
let set_level (src, level) =
96131
let rec aux = function
97-
| [] -> Logs.warn (fun f -> f "set_level: logger %S not registered; ignoring" src)
132+
| [] ->
133+
Logs.warn (fun f ->
134+
f "set_level: logger %S not registered; ignoring" src)
98135
| x :: _ when Logs.Src.name x = src -> Logs.Src.set_level x (Some level)
99136
| _ :: xs -> aux xs
100137
in
101138
aux (Logs.Src.list ())
102139

103-
let init ?(default_level=Logs.Info) ?(levels=[]) ?(formatter=Fmt.stderr) () =
140+
let init ?(default_level = Logs.Info) ?(levels = []) ?(formatter = Fmt.stderr)
141+
() =
104142
Fmt_tty.setup_std_outputs ();
105143
Logs.set_reporter (reporter formatter);
106144
Logs.set_level (Some default_level);

0 commit comments

Comments
 (0)