initial metrics-rusage package

metrics-rusage.opam

@@ -0,0 +1,24 @@
+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"] {pinned}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+]
+
+depends: [
+  "ocaml" {>= "4.05.0"}
+  "dune" {>= "1.4"}
+  "metrics" {= version}
+  "logs"
+  "fmt"
+  "rresult"
+]
+synopsis: "Resource usage (getrusage) sources for the Metrics library"

src/rusage/dune

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

src/rusage/metrics_rusage.ml

@@ -0,0 +1,171 @@
+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 ;
+}
+
+let pp_rusage ppf r =
+  Fmt.pf ppf "utime %Lu.%06d stime %Lu.%06d maxrss %Lu ixrss %Lu idrss %Lu isrss %Lu minflt %Lu majflt %Lu nswap %Lu inblock %Lu outblock %Lu msgsnd %Lu msgrcv %Lu signals %Lu nvcsw %Lu nivcsw %Lu"
+    (fst r.utime) (snd r.utime) (fst r.stime) (snd r.stime) r.maxrss r.ixrss r.idrss r.isrss r.minflt r.majflt r.nswap r.inblock r.outblock r.msgsnd r.msgrcv r.nsignals r.nvcsw r.nivcsw
+
+let pp_rusage_mem ppf r =
+  Fmt.pf ppf "maxrss %Lu ixrss %Lu idrss %Lu isrss %Lu minflt %Lu majflt %Lu"
+    r.maxrss r.ixrss r.idrss r.isrss r.minflt r.majflt
+
+type kinfo_mem = {
+  vsize : int64 ;
+  rss : int64 ;
+  tsize : int64 ;
+  dsize : int64 ;
+  ssize : int64 ;
+  runtime : int64 ;
+  cow : int ;
+  start : (int64 * int) ;
+}
+
+let pp_kinfo_mem ppf t =
+  Fmt.pf ppf "virtual-size %Lu rss %Lu text-size %Lu data-size %Lu stack-size %Lu runtime %Lu cow %u start %Lu.%06d"
+    t.vsize t.rss t.tsize t.dsize t.ssize t.runtime t.cow (fst t.start) (snd t.start)
+
+open Rresult.R.Infix
+
+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 rec wrap f arg =
+  try Ok (f arg) with
+  | Unix.Unix_error (Unix.EINTR, _, _) -> wrap f arg
+  | 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 _ -> Rresult.R.error_msgf "Error reading file %S" filename
+
+let parse_proc_stat s =
+  let stats_opt =
+    match String.rindex_opt s ')' with
+    | None -> None
+    | Some idx -> 
+      let rest = String.sub s idx (String.length s - idx) in
+      Some (String.split_on_char ' ' rest)
+  in
+  Option.to_result ~none:(`Msg "unable to parse /proc/self/stat") stats_opt
+
+let linux_kinfo () =
+  (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") ) >>= fun start ->
+  (* reading /proc/self/stat - since it may disappear mid-time,
+     best to have it in memory *)
+  string_of_file "/proc/self/stat" >>= fun data ->
+  parse_proc_stat data >>= fun stat_vals ->
+  string_of_file "/proc/self/statm" >>= fun data ->
+  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 time_of_int64 t =
+    let clock_tick = Int64.of_int (sysconf_clock_tick ()) in
+    let ( * ) = Int64.mul and ( / ) = Int64.div in
+    (t / clock_tick, Int64.to_int (((Int64.rem t clock_tick) * 1_000_000L) / clock_tick))
+  in
+  if List.length stat_vals >= 50 && List.length statm_vals >= 7 then
+    i64 (List.nth stat_vals 11) >>= fun utime -> (* divide by sysconf(_SC_CLK_TCK) *)
+    i64 (List.nth stat_vals 12) >>= fun stime -> (* divide by sysconf(_SC_CLK_TCK) *)
+    let runtime = fst (time_of_int64 Int64.(add utime stime)) in
+    i64 (List.nth stat_vals 20) >>= fun vsize -> (* in bytes *)
+    i64 (List.nth stat_vals 21) >>= fun rss -> (* in pages *)
+    i64 (List.nth statm_vals 3) >>= fun tsize ->
+    i64 (List.nth statm_vals 5) >>= fun dsize -> (* data + stack *)
+    i64 (List.nth statm_vals 5) >>= fun ssize -> (* 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"
+

src/rusage/metrics_rusage.mli

@@ -0,0 +1,4 @@
+
+val rusage_src : tags:'a Metrics.Tags.t -> ('a, unit -> Metrics.data) Metrics.src
+
+val kinfo_mem_src : tags:'a Metrics.Tags.t -> ('a, unit -> Metrics.data) Metrics.src

src/rusage/metrics_rusage_stubs.c

@@ -0,0 +1,141 @@
+// (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);
+}
+
+#elif __linux__ /* FreeBSD */
+
+CAMLprim value metrics_sysctl_kinfo_proc (value pid_r) {
+  CAMLparam1(pid_r);
+  uerror("sysctl_kinfo_proc", Nothing);
+}
+
+#else /* Linux */
+
+/* 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