diff --git a/memory_pressure.ml b/memory_pressure.ml index ee637e8..21e8b17 100644 --- a/memory_pressure.ml +++ b/memory_pressure.ml @@ -1,16 +1,49 @@ (* Copyright (C) 2015, Thomas Leonard 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 ) diff --git a/memory_pressure.mli b/memory_pressure.mli index f5774ea..c0d9f49 100644 --- a/memory_pressure.mli +++ b/memory_pressure.mli @@ -1,8 +1,12 @@ (* Copyright (C) 2015, Thomas Leonard 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. *) diff --git a/unikernel.ml b/unikernel.ml index 22b7f01..911bfe5 100644 --- a/unikernel.ml +++ b/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. *)