+open Printf
+open Khatus
+
+let modul = __MODULE__
+
+let (/) = Filename.concat
+
+let mkdir_p dir =
+ match Sys.command("mkdir -p " ^ dir) with
+ | 0 -> ()
+ | n ->
+ failwith
+ (sprintf "Failed to create directory: %S. mkdir status: %d\n" dir n)
+
+let gzip path =
+ match Sys.command("gzip " ^ path) with
+ | 0 -> ()
+ | n ->
+ failwith
+ (sprintf "Failed to gzip path: %S. gzip status: %d\n" path n)
+
+let main ~node ~cache ~dump_interval:interval ~dump_directory =
+ mkdir_p dump_directory;
+ let dump_filename = dump_directory / "khatus-cache-dump.psv.gz" in
+ let rec loop ~time ~time_dumped =
+ (match read_line () with
+ | exception End_of_file ->
+ ()
+ | line ->
+ (match Msg_parser.parse_msg (Lexing.from_string line) with
+ | Ok msg ->
+ let time = Msg.next_time msg ~node ~time in
+ Cache.update_if_data cache ~msg ~time;
+ if (Time.Span.is_gt_or_eq (Time.diff time_dumped time) interval)
+ then
+ (
+ let (tmp_filename, oc) =
+ Filename.open_temp_file "khatus-cache" "dump"
+ in
+ Cache.dump cache ~node ~modul ~oc;
+ close_out oc;
+ gzip tmp_filename;
+ Sys.rename (tmp_filename ^ ".gz") dump_filename;
+ loop ~time ~time_dumped:time
+ )
+ else
+ loop ~time ~time_dumped
+ | Error e ->
+ let e =
+ match e with
+ | `Bad_format_of_msg_head -> "Bad_format_of_msg_head"
+ | `Bad_format_of_msg_content -> "Bad_format_of_msg_content"
+ in
+ eprintf
+ "%s\n%!"
+ Msg.(to_string
+ { node
+ ; modul
+ ; content = Log
+ { location = "main:loop"
+ ; level = `error
+ ; msg = sprintf "Parse error %s in %s" e line
+ }
+ });
+ loop ~time ~time_dumped
+ )
+ )
+ in
+ loop ~time:Time.init ~time_dumped:Time.init
+
+let () =
+ main
+ ~node:(Sys.argv.(1))
+ ~dump_interval:(Time.Span.of_string Sys.argv.(2))
+ ~dump_directory:(Sys.argv.(3))
+ ~cache:(Cache.create ())