qubes-mirage-firewall/memory_pressure.ml

71 lines
2.1 KiB
OCaml

(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
open Lwt
let src = Logs.Src.create "memory_pressure" ~doc:"Memory pressure monitor"
module Log = (val Logs.src_log src : Logs.LOG)
let wordsize_in_bytes = Sys.word_size / 8
let fraction_free stats =
let { Xen_os.Memory.free_words; heap_words; _ } = stats in
float free_words /. float heap_words
let meminfo stats =
let { Xen_os.Memory.free_words; heap_words; _ } = stats in
let mem_total = heap_words * wordsize_in_bytes in
let mem_free = free_words * wordsize_in_bytes in
Log.info (fun f -> f "Writing meminfo: free %a / %a (%.2f %%)"
Fmt.bi_byte_size mem_free
Fmt.bi_byte_size mem_total
(fraction_free stats *. 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 / 1024) (mem_free / 1024)
let report_mem_usage stats =
Lwt.async (fun () ->
let open Xen_os in
Xs.make () >>= fun xs ->
Xs.immediate xs (fun h ->
Xs.write h "memory/meminfo" (meminfo stats)
)
)
let print_mem_usage =
let rec aux () =
let stats = Xen_os.Memory.quick_stat () in
let { Xen_os.Memory.free_words; heap_words; _ } = stats in
let mem_total = heap_words * wordsize_in_bytes in
let mem_free = free_words * wordsize_in_bytes in
Log.info (fun f -> f "Memory usage: free %a / %a (%.2f %%)"
Fmt.bi_byte_size mem_free
Fmt.bi_byte_size mem_total
(fraction_free stats *. 100.0));
Xen_os.Time.sleep_ns (Duration.of_f 600.0) >>= fun () ->
aux ()
in
aux ()
let init () =
Gc.full_major ();
let stats = Xen_os.Memory.quick_stat () in
report_mem_usage stats
let status () =
let stats = Xen_os.Memory.quick_stat () in
if fraction_free stats > 0.5 then `Ok
else (
Gc.full_major ();
Xen_os.Memory.trim ();
let stats = Xen_os.Memory.quick_stat () in
if fraction_free stats < 0.6 then begin
report_mem_usage stats;
`Memory_critical
end else `Ok
)