Report current memory use to XenStore

This commit is contained in:
Thomas Leonard 2016-01-02 15:59:59 +00:00
parent 425ba26286
commit f1ed6ffdd8
3 changed files with 44 additions and 5 deletions

View File

@ -1,16 +1,49 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com> (* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *) 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 status () =
let used = OS.MM.Heap_pages.used () |> float_of_int in 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 if frac < 0.9 then `Ok
else ( else (
Gc.full_major (); Gc.full_major ();
let used = OS.MM.Heap_pages.used () |> float_of_int in let used = OS.MM.Heap_pages.used () in
let frac = used /. total_pages in report_mem_usage used;
let frac = float_of_int used /. float_of_int total_pages in
if frac > 0.9 then `Memory_critical if frac > 0.9 then `Memory_critical
else `Ok else `Ok
) )

View File

@ -1,8 +1,12 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com> (* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *) See the README file for details. *)
val init : unit -> unit
(** Write current memory usage information to XenStore. *)
val status : unit -> [ `Ok | `Memory_critical ] val status : unit -> [ `Ok | `Memory_critical ]
(** Check the memory situation. If we're running low, do a GC (work-around for (** 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 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 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. *)

View File

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