robur/mirage-monitoring
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

adapt to defunctorisation work

Browse source
This commit is contained in:
Hannes Mehnert 2025-02-10 15:50:40 +01:00
parent ca9bd2f4a3
commit 2fa98ae463
4 changed files with 9 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
mirage-monitoring.opam
View file

@ -14,11 +14,10 @@ depends: [
"metrics" {>= "0.4.0"} "metrics" {>= "0.4.0"}
"metrics-lwt" {>= "0.2.0"} "metrics-lwt" {>= "0.2.0"}
"metrics-influx" {>= "0.2.0"} "metrics-influx" {>= "0.2.0"}
"mirage-time" {>= "2.0.0"} "mirage-sleep" {>= "4.0.0"}
"tcpip" {>= "7.0.0"} "tcpip" {>= "7.0.0"}
"mirage-runtime" {>= "4.5.0"} "mirage-runtime" {>= "4.5.0"}
"memtrace-mirage" {>= "0.2.1.2.2"} "memtrace-mirage" {>= "0.2.1.2.3"}
"mirage-clock" {>= "4.0.0"}
] ]
conflicts: [ conflicts: [
"mirage-solo5" {< "0.9.2"} "mirage-solo5" {< "0.9.2"}
@ -34,3 +33,4 @@ description: """
Reporting metrics to Influx, Telegraf. Dynamic adjusting log level and metrics Reporting metrics to Influx, Telegraf. Dynamic adjusting log level and metrics
sources, memprof profiling. sources, memprof profiling.
""" """
x-maintenance-intent: [ "(latest)" ]

2
src/dune
View file

@ -2,5 +2,5 @@
(name mirage_monitoring) (name mirage_monitoring)
(public_name mirage-monitoring) (public_name mirage-monitoring)
(wrapped false) (wrapped false)
(libraries logs metrics metrics-lwt metrics-influx mirage-time mirage-clock (libraries logs metrics metrics-lwt metrics-influx mirage-sleep
memtrace-mirage tcpip mirage-runtime)) memtrace-mirage tcpip mirage-runtime))

8
src/mirage_monitoring.ml
View file

@ -165,8 +165,8 @@ let adjust_metrics s =
srcs ; srcs ;
Ok `Empty Ok `Empty
module Make (T : Mirage_time.S) (P : Mirage_clock.PCLOCK) (S : Tcpip.Stack.V4V6) = struct module Make (S : Tcpip.Stack.V4V6) = struct
module Memtrace = Memtrace.Make(P)(S.TCP) module Memtrace = Memtrace.Make(S.TCP)
let timer conn get host stack dst = let timer conn get host stack dst =
let datas = let datas =
@ -204,7 +204,7 @@ module Make (T : Mirage_time.S) (P : Mirage_clock.PCLOCK) (S : Tcpip.Stack.V4V6)
let rec one () = let rec one () =
Lwt.join [ Lwt.join [
timer conn get host stack dst; timer conn get host stack dst;
T.sleep_ns (Duration.of_sec interval) Mirage_sleep.ns (Duration.of_sec interval)
] >>= fun () -> ] >>= fun () ->
(one[@tailcall]) () (one[@tailcall]) ()
in in
@ -267,7 +267,7 @@ module Make (T : Mirage_time.S) (P : Mirage_clock.PCLOCK) (S : Tcpip.Stack.V4V6)
let get_cache, reporter = Metrics.cache_reporter () in let get_cache, reporter = Metrics.cache_reporter () in
Metrics.set_reporter reporter; Metrics.set_reporter reporter;
Metrics.enable_all (); Metrics.enable_all ();
Metrics_lwt.init_periodic (fun () -> T.sleep_ns (Duration.of_sec interval)); Metrics_lwt.init_periodic (fun () -> Mirage_sleep.ns (Duration.of_sec interval));
let host = match hostname with None -> [] | Some host -> [vmname host] in let host = match hostname with None -> [] | Some host -> [vmname host] in
Lwt.async (timer_loop get_cache host interval stack (dst, port)); Lwt.async (timer_loop get_cache host interval stack (dst, port));
create_listener stack listen_port create_listener stack listen_port

2
src/mirage_monitoring.mli
View file

@ -5,7 +5,7 @@ val counter_metrics : f:('a -> string) -> string ->
val vmname : string -> Metrics.field val vmname : string -> Metrics.field
(** [vmname name] creates a [tag] with the virtual machine name. *) (** [vmname name] creates a [tag] with the virtual machine name. *)
module Make (T : Mirage_time.S) (P : Mirage_clock.PCLOCK) (S : Tcpip.Stack.V4V6) : sig module Make (S : Tcpip.Stack.V4V6) : sig
val create : ?interval:int -> ?hostname:string -> Ipaddr.t -> ?port:int -> val create : ?interval:int -> ?hostname:string -> Ipaddr.t -> ?port:int ->
?listen_port:int -> ?memtrace_port:int -> ?sampling_rate:float -> S.t -> ?listen_port:int -> ?memtrace_port:int -> ?sampling_rate:float -> S.t ->