Report current memory use to XenStore

memory_pressure.ml

@@ -1,16 +1,49 @@
 (* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
    See the README file for details. *)
 
-let total_pages = OS.MM.Heap_pages.total () |> float_of_int
+open Lwt
+
+let src = Logs.Src.create "memory_pressure" ~doc:"Memory pressure monitor"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let total_pages = OS.MM.Heap_pages.total ()
+let pagesize_kb = Io_page.page_size / 1024
+
+let meminfo ~used =
+  let mem_total = total_pages * pagesize_kb in
+  let mem_free = (total_pages - used) * pagesize_kb in
+  Log.info "Writing meminfo: free %d / %d kB (%.2f %%)"
+    (fun f -> f mem_free mem_total (float_of_int mem_free /. float_of_int mem_total *. 100.0));
+  Printf.sprintf "MemTotal: %d kB\n\
+                  MemFree: %d kB\n\
+                  Buffers: 0 kB\n\
+                  Cached: 0 kB\n\
+                  SwapTotal: 0 kB\n\
+                  SwapFree: 0 kB\n" mem_total mem_free
+
+let report_mem_usage used =
+  Lwt.async (fun () ->
+    let open OS in
+    Xs.make () >>= fun xs ->
+    Xs.immediate xs (fun h ->
+      Xs.write h "memory/meminfo" (meminfo ~used)
+    )
+  )
+
+let init () =
+  Gc.full_major ();
+  let used = OS.MM.Heap_pages.used () in
+  report_mem_usage used
 
 let status () =
   let used = OS.MM.Heap_pages.used () |> float_of_int in
-  let frac = used /. total_pages in
+  let frac = used /. float_of_int total_pages in
   if frac < 0.9 then `Ok
   else (
     Gc.full_major ();
-    let used = OS.MM.Heap_pages.used () |> float_of_int in
-    let frac = used /. total_pages in
+    let used = OS.MM.Heap_pages.used () in
+    report_mem_usage used;
+    let frac = float_of_int used /. float_of_int total_pages in
     if frac > 0.9 then `Memory_critical
     else `Ok
   )

memory_pressure.mli

@@ -1,8 +1,12 @@
 (* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
    See the README file for details. *)
 
+val init : unit -> unit
+(** Write current memory usage information to XenStore. *)
+
 val status : unit -> [ `Ok | `Memory_critical ]
 (** Check the memory situation. If we're running low, do a GC (work-around for
     http://caml.inria.fr/mantis/view.php?id=7100 and OCaml GC needing to malloc
     extra space to run finalisers). Returns [`Memory_critical] if memory is
-    still low - caller should take action to reduce memory use. *)
+    still low - caller should take action to reduce memory use.
+    After GC, updates meminfo in XenStore. *)

unikernel.ml

@@ -61,6 +61,8 @@ module Main (Clock : V1.CLOCK) = struct
     let shutdown_rq = OS.Lifecycle.await_shutdown () >>= fun (`Poweroff | `Reboot) -> return () in
     (* Set up networking *)
     let net_listener = network qubesDB in
+    (* Report memory usage to XenStore *)
+    Memory_pressure.init ();
     (* Run until something fails or we get a shutdown request. *)
     Lwt.choose [agent_listener; net_listener; shutdown_rq] >>= fun () ->
     (* Give the console daemon time to show any final log messages. *)