Merge branch 'cache-dumper'

diff --git a/.gitignore b/.gitignore
index f01981c..271527f 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,22 +1,3 @@
+_build/
+bin/
 data/
-bin/khatus_bar
-bin/khatus_actuate_alert_to_notify_send
-bin/khatus_actuate_device_add_to_automount
-bin/khatus_actuate_status_bar_to_xsetroot_name
-bin/khatus_monitor_devices
-bin/khatus_monitor_energy
-bin/khatus_monitor_errors
-bin/khatus_parse_bluetoothctl_show
-bin/khatus_parse_df_pcent
-bin/khatus_parse_fan_file
-bin/khatus_parse_free
-bin/khatus_parse_ip_addr
-bin/khatus_parse_iwconfig
-bin/khatus_parse_loadavg_file
-bin/khatus_parse_metar_d_output
-bin/khatus_parse_mpd_status_currentsong
-bin/khatus_parse_pactl_list_sinks
-bin/khatus_parse_ps
-bin/khatus_parse_sys_block_stat
-bin/khatus_parse_udevadm_monitor_block
-bin/khatus_parse_upower

diff --git a/Makefile b/Makefile
index 1f39234..e001dd0 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,3 +1,5 @@
+MAKEFLAGS := --no-builtin-rules
+
 PREFIX := $(HOME)
 PATH_TO_AWK := /usr/bin/awk
 AWK_EXECUTABLES := \
@@ -22,6 +24,30 @@ AWK_EXECUTABLES := \
        bin/khatus_parse_sys_block_stat \
        bin/khatus_parse_udevadm_monitor_block \
        bin/khatus_parse_upower
+BASH_EXECUTABLE_NAMES := \
+       khatus \
+       khatus_gen_bar_make_status \
+       khatus_sensor_bluetooth_power \
+       khatus_sensor_datetime \
+       khatus_sensor_devices \
+       khatus_sensor_disk_io \
+       khatus_sensor_disk_space \
+       khatus_sensor_energy \
+       khatus_sensor_fan \
+       khatus_sensor_loadavg \
+       khatus_sensor_memory \
+       khatus_sensor_mpd \
+       khatus_sensor_net_addr_io \
+       khatus_sensor_net_wifi_status \
+       khatus_sensor_procs \
+       khatus_sensor_screen_brightness \
+       khatus_sensor_temperature \
+       khatus_sensor_volume \
+       khatus_sensor_weather
+BASH_EXECUTABLES := $(foreach exe,$(BASH_EXECUTABLE_NAMES),bin/$(exe))
+OCAML_EXECUTABLES := \
+       bin/khatus_cache_dumper
+EXECUTABLES := $(AWK_EXECUTABLES) $(BASH_EXECUTABLES) $(OCAML_EXECUTABLES)
 
 define BUILD_AWK_EXE
        echo '#! $(PATH_TO_AWK) -f'                                > $@ && \
@@ -31,19 +57,42 @@ define BUILD_AWK_EXE
        chmod +x $@
 endef
 
+define BUILD_BASH_EXE
+       cat $^ > $@ && \
+       chmod +x $@
+endef
+
+define GEN_BASH_EXE_RULE
+bin/$(1) : src/bash/exe/$(1).sh
+       $$(BUILD_BASH_EXE)
+endef
+
 .PHONY: \
        build \
        install \
        clean
 
-build: $(AWK_EXECUTABLES)
+build: | bin
+build: $(EXECUTABLES)
 
 install:
        $(foreach filename,$(wildcard bin/*),cp -p "$(filename)" "$(PREFIX)/$(filename)"; )
 
 clean:
-       rm -f $(AWK_EXECUTABLES)
+       rm -rf bin
+       ocamlbuild -clean
+
+bin:
+       mkdir -p bin
 
+#-----------------------------------------------------------------------------
+# Bash
+#-----------------------------------------------------------------------------
+$(foreach exe,$(BASH_EXECUTABLE_NAMES),$(eval $(call GEN_BASH_EXE_RULE,$(exe))))
+
+#-----------------------------------------------------------------------------
+# AWK
+#-----------------------------------------------------------------------------
 bin/khatus_bar: \
        src/awk/exe/bar.awk \
        src/awk/lib/cache.awk \
@@ -164,3 +213,11 @@ bin/khatus_parse_upower: \
        src/awk/exe/parse_upower.awk \
        src/awk/lib/msg_out.awk
        $(BUILD_AWK_EXE)
+
+#-----------------------------------------------------------------------------
+# OCaml
+#-----------------------------------------------------------------------------
+bin/khatus_cache_dumper: src/ocaml/exe/khatus_cache_dumper.ml
+       ocamlbuild -cflags '-w A' -pkg unix -I src/ocaml/exe -I src/ocaml/lib khatus_cache_dumper.byte
+       mv _build/src/ocaml/exe/khatus_cache_dumper.byte bin/khatus_cache_dumper
+       rm -f khatus_cache_dumper.byte

diff --git a/sanity_check b/sanity_check
index 09fc142..8fb8a8a 100755 (executable)
--- a/sanity_check
+++ b/sanity_check
@@ -13,6 +13,7 @@
                 -v Status_Args='@energy_percent,@memory_percent,@processes_count_all,@processes_count_r,@processes_count_d,@processes_count_t,@processes_count_i,@processes_count_z,@cpu_loadavg,@cpu_temp,@cpu_fan_speed,@disk_space,@disk_io_w,@disk_io_r,@net_wifi:wlp3s0,@net_io_w:wlp3s0,@net_io_r:wlp3s0,@bluetooth_power,@backlight_percent,@volume_pa_sink:0,@mpd,@weather_temp_f,@datetime' \
             ) \
     ) \
+    >(stdbuf -o L ./bin/khatus_cache_dumper $(hostname) 5 "$PWD/data") \
     >(stdbuf -o L ./bin/khatus_monitor_energy) \
     >(stdbuf -o L ./bin/khatus_monitor_errors) \
     >(stdbuf -o L ./bin/khatus_monitor_devices) \

diff --git a/src/awk/exe/actuate_alert_to_notify_send.awk b/src/awk/exe/actuate_alert_to_notify_send.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/actuate_device_add_to_automount.awk b/src/awk/exe/actuate_device_add_to_automount.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/actuate_status_bar_to_xsetroot_name.awk b/src/awk/exe/actuate_status_bar_to_xsetroot_name.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/bar.awk b/src/awk/exe/bar.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/monitor_devices.awk b/src/awk/exe/monitor_devices.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/monitor_energy.awk b/src/awk/exe/monitor_energy.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/monitor_errors.awk b/src/awk/exe/monitor_errors.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_bluetoothctl_show.awk b/src/awk/exe/parse_bluetoothctl_show.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_df_pcent.awk b/src/awk/exe/parse_df_pcent.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_fan_file.awk b/src/awk/exe/parse_fan_file.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_free.awk b/src/awk/exe/parse_free.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_ip_addr.awk b/src/awk/exe/parse_ip_addr.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_iwconfig.awk b/src/awk/exe/parse_iwconfig.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_loadavg_file.awk b/src/awk/exe/parse_loadavg_file.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_metar_d_output.awk b/src/awk/exe/parse_metar_d_output.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_mpd_status_currentsong.awk b/src/awk/exe/parse_mpd_status_currentsong.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_pactl_list_sinks.awk b/src/awk/exe/parse_pactl_list_sinks.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_ps.awk b/src/awk/exe/parse_ps.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_sys_block_stat.awk b/src/awk/exe/parse_sys_block_stat.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_udevadm_monitor_block.awk b/src/awk/exe/parse_udevadm_monitor_block.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/exe/parse_upower.awk b/src/awk/exe/parse_upower.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/lib/cache.awk b/src/awk/lib/cache.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/lib/msg_in.awk b/src/awk/lib/msg_in.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/lib/msg_out.awk b/src/awk/lib/msg_out.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/lib/num.awk b/src/awk/lib/num.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/src/awk/lib/str.awk b/src/awk/lib/str.awk
old mode 100755 (executable)
new mode 100644 (file)

diff --git a/bin/khatus b/src/bash/exe/khatus.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus
rename to src/bash/exe/khatus.sh

diff --git a/bin/khatus_gen_bar_make_status b/src/bash/exe/khatus_gen_bar_make_status.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_gen_bar_make_status
rename to src/bash/exe/khatus_gen_bar_make_status.sh

diff --git a/bin/khatus_sensor_bluetooth_power b/src/bash/exe/khatus_sensor_bluetooth_power.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_bluetooth_power
rename to src/bash/exe/khatus_sensor_bluetooth_power.sh

diff --git a/bin/khatus_sensor_datetime b/src/bash/exe/khatus_sensor_datetime.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_datetime
rename to src/bash/exe/khatus_sensor_datetime.sh

diff --git a/bin/khatus_sensor_devices b/src/bash/exe/khatus_sensor_devices.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_devices
rename to src/bash/exe/khatus_sensor_devices.sh

diff --git a/bin/khatus_sensor_disk_io b/src/bash/exe/khatus_sensor_disk_io.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_disk_io
rename to src/bash/exe/khatus_sensor_disk_io.sh

diff --git a/bin/khatus_sensor_disk_space b/src/bash/exe/khatus_sensor_disk_space.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_disk_space
rename to src/bash/exe/khatus_sensor_disk_space.sh

diff --git a/bin/khatus_sensor_energy b/src/bash/exe/khatus_sensor_energy.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_energy
rename to src/bash/exe/khatus_sensor_energy.sh

diff --git a/bin/khatus_sensor_fan b/src/bash/exe/khatus_sensor_fan.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_fan
rename to src/bash/exe/khatus_sensor_fan.sh

diff --git a/bin/khatus_sensor_loadavg b/src/bash/exe/khatus_sensor_loadavg.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_loadavg
rename to src/bash/exe/khatus_sensor_loadavg.sh

diff --git a/bin/khatus_sensor_memory b/src/bash/exe/khatus_sensor_memory.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_memory
rename to src/bash/exe/khatus_sensor_memory.sh

diff --git a/bin/khatus_sensor_mpd b/src/bash/exe/khatus_sensor_mpd.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_mpd
rename to src/bash/exe/khatus_sensor_mpd.sh

diff --git a/bin/khatus_sensor_net_addr_io b/src/bash/exe/khatus_sensor_net_addr_io.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_net_addr_io
rename to src/bash/exe/khatus_sensor_net_addr_io.sh

diff --git a/bin/khatus_sensor_net_wifi_status b/src/bash/exe/khatus_sensor_net_wifi_status.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_net_wifi_status
rename to src/bash/exe/khatus_sensor_net_wifi_status.sh

diff --git a/bin/khatus_sensor_procs b/src/bash/exe/khatus_sensor_procs.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_procs
rename to src/bash/exe/khatus_sensor_procs.sh

diff --git a/bin/khatus_sensor_screen_brightness b/src/bash/exe/khatus_sensor_screen_brightness.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_screen_brightness
rename to src/bash/exe/khatus_sensor_screen_brightness.sh

diff --git a/bin/khatus_sensor_temperature b/src/bash/exe/khatus_sensor_temperature.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_temperature
rename to src/bash/exe/khatus_sensor_temperature.sh

diff --git a/bin/khatus_sensor_volume b/src/bash/exe/khatus_sensor_volume.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_volume
rename to src/bash/exe/khatus_sensor_volume.sh

diff --git a/bin/khatus_sensor_weather b/src/bash/exe/khatus_sensor_weather.sh
old mode 100755 (executable)
new mode 100644 (file)
similarity index 100%
rename from bin/khatus_sensor_weather
rename to src/bash/exe/khatus_sensor_weather.sh

diff --git a/src/ocaml/exe/khatus_cache_dumper.ml b/src/ocaml/exe/khatus_cache_dumper.ml
new file mode 100644 (file)
index 0000000..e51243e
--- /dev/null
+++ b/src/ocaml/exe/khatus_cache_dumper.ml
@@ -0,0 +1,76 @@
+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 ())

diff --git a/src/ocaml/exe/khatus_cache_dumper.mli b/src/ocaml/exe/khatus_cache_dumper.mli
new file mode 100644 (file)
index 0000000..e69de29

diff --git a/src/ocaml/lib/khatus.ml b/src/ocaml/lib/khatus.ml
new file mode 100644 (file)
index 0000000..bd01385
--- /dev/null
+++ b/src/ocaml/lib/khatus.ml
@@ -0,0 +1,4 @@
+module Cache      = Khatus_cache
+module Msg        = Khatus_msg
+module Msg_parser = Khatus_msg_parser
+module Time       = Khatus_time

diff --git a/src/ocaml/lib/khatus_cache.ml b/src/ocaml/lib/khatus_cache.ml
new file mode 100644 (file)
index 0000000..698d20b
--- /dev/null
+++ b/src/ocaml/lib/khatus_cache.ml
@@ -0,0 +1,52 @@
+module Hashtbl = MoreLabels.Hashtbl
+
+module Msg  = Khatus_msg
+module Time = Khatus_time
+
+type t =
+  { values : ((string * string * string list), string) Hashtbl.t
+  ; mtimes : ((string * string * string list), Time.t) Hashtbl.t
+  }
+
+let create () =
+  { values = Hashtbl.create 256
+  ; mtimes = Hashtbl.create 256
+  }
+
+let update {values; mtimes} ~node ~modul ~key ~value:data ~time =
+  let key = (node, modul, key) in
+  Hashtbl.replace values ~key ~data;
+  Hashtbl.replace mtimes ~key ~data:time
+
+let update_if_data t ~msg ~time =
+  match msg with
+  | Msg.({content = Data {key; value}; node; modul}) ->
+      update t ~node ~modul ~key ~value ~time
+  | {Msg.content = Msg.Alert      _; _}
+  | {Msg.content = Msg.Cache      _; _}
+  | {Msg.content = Msg.Error      _; _}
+  | {Msg.content = Msg.Log        _; _}
+  | {Msg.content = Msg.Status_bar _; _}
+  ->
+      ()
+
+let dump {values; mtimes} ~node ~modul ~oc =
+  Hashtbl.iter values ~f:(fun ~key ~data:value ->
+    let mtime =
+      match Hashtbl.find_opt mtimes key with
+      | Some mtime -> mtime
+      | None       -> assert false  (* Implies update was incorrect *)
+    in
+    let (node', modul', key) = key in
+    let msg =
+      Msg.(to_string
+          { node
+          ; modul
+          ; content = Cache {mtime; node = node'; modul = modul'; key; value}
+          }
+        )
+    in
+    output_string
+      oc
+      (msg ^ "\n")
+  )

diff --git a/src/ocaml/lib/khatus_cache.mli b/src/ocaml/lib/khatus_cache.mli
new file mode 100644 (file)
index 0000000..f6c951e
--- /dev/null
+++ b/src/ocaml/lib/khatus_cache.mli
@@ -0,0 +1,16 @@
+type t
+
+val create : unit -> t
+
+val update
+  : t
+  -> node  : string
+  -> modul : string
+  -> key   : (string list)
+  -> value : string
+  -> time  : Khatus_time.t
+  -> unit
+
+val update_if_data : t -> msg:Khatus_msg.t -> time:Khatus_time.t -> unit
+
+val dump : t -> node:string -> modul:string -> oc:out_channel -> unit

diff --git a/src/ocaml/lib/khatus_msg.ml b/src/ocaml/lib/khatus_msg.ml
new file mode 100644 (file)
index 0000000..cd9fd86
--- /dev/null
+++ b/src/ocaml/lib/khatus_msg.ml
@@ -0,0 +1,70 @@
+module Time = Khatus_time
+
+type content =
+  | Alert of {priority : [`low | `med | `hi]; subject : string; body : string}
+  | Data of {key : string list; value : string}
+  | Cache of
+      { mtime : Time.t
+      ; node  : string
+      ; modul : string
+      ; key   : string list
+      ; value : string
+      }
+  | Error of string
+  | Log of {location : string; level : [`info | `error]; msg : string}
+  | Status_bar of string
+
+type t =
+  {node : string; modul : string; content : content}
+
+let sep_1 = "|"
+let sep_2 = ":"
+
+let to_string {node; modul; content} =
+  match content with
+  | Alert {priority; subject; body} ->
+      let priority =
+        match priority with
+        | `hi  -> "hi"
+        | `med -> "med"
+        | `low -> "low"
+      in
+      String.concat sep_1 [node; modul; "alert"; priority; subject; body]
+  | Data {key; value} ->
+      let key = String.concat sep_2 key in
+      String.concat sep_1 [node; modul; "data"; key; value]
+  | Cache {mtime; node=node'; modul=modul'; key; value} ->
+      let key = String.concat sep_2 key in
+      let mtime = Time.to_string mtime in
+      String.concat
+        sep_1
+        [node; modul; "cache"; mtime; node'; modul'; key; value]
+  | Error text ->
+      String.concat sep_1 [node; modul; "error"; text]
+  | Log {location; level; msg} ->
+      let level =
+        match level with
+        | `info  -> "info"
+        | `error -> "error"
+      in
+      String.concat sep_1 [node; modul; "log"; location; level; msg]
+  | Status_bar text ->
+      String.concat sep_1 [node; modul; "status_bar"; text]
+
+let next_time t ~node ~time:time0 =
+  match t with
+  | { modul   = "khatus_sensor_datetime"
+    ; content = Data {key = ["epoch"]; value = time1}
+    ; node    = node'
+    } when node' = node ->
+      (* TODO: Going forawrd, perhaps throwing exceptions is the wrong way. *)
+      (* TODO: Should we check this one at msg parse time? *)
+      Time.of_string time1
+  | {content = Data       _; _}
+  | {content = Alert      _; _}
+  | {content = Cache      _; _}
+  | {content = Error      _; _}
+  | {content = Log        _; _}
+  | {content = Status_bar _; _}
+  ->
+      time0

diff --git a/src/ocaml/lib/khatus_msg.mli b/src/ocaml/lib/khatus_msg.mli
new file mode 100644 (file)
index 0000000..7f89c2b
--- /dev/null
+++ b/src/ocaml/lib/khatus_msg.mli
@@ -0,0 +1,20 @@
+type content =
+  | Alert of {priority : [`low | `med | `hi]; subject : string; body : string}
+  | Data of {key : string list; value : string}
+  | Cache of
+      { mtime : Khatus_time.t
+      ; node  : string
+      ; modul : string
+      ; key   : string list
+      ; value : string
+      }
+  | Error of string
+  | Log of {location : string; level : [`info | `error]; msg : string}
+  | Status_bar of string
+
+type t =
+  {node : string; modul : string; content : content}
+
+val to_string : t -> string
+
+val next_time : t -> node:string -> time:Khatus_time.t -> Khatus_time.t

diff --git a/src/ocaml/lib/khatus_msg_parser.mli b/src/ocaml/lib/khatus_msg_parser.mli
new file mode 100644 (file)
index 0000000..f177b28
--- /dev/null
+++ b/src/ocaml/lib/khatus_msg_parser.mli
@@ -0,0 +1,8 @@
+val parse_msg
+  : Lexing.lexbuf
+  ->
+    ( Khatus_msg.t
+    , [ `Bad_format_of_msg_head
+      | `Bad_format_of_msg_content
+      ]
+    ) result

diff --git a/src/ocaml/lib/khatus_msg_parser.mll b/src/ocaml/lib/khatus_msg_parser.mll
new file mode 100644 (file)
index 0000000..2015f77
--- /dev/null
+++ b/src/ocaml/lib/khatus_msg_parser.mll
@@ -0,0 +1,79 @@
+{
+  module Msg  = Khatus_msg
+  module Time = Khatus_time
+  let sep_2    = ':'
+}
+
+let alphnumdash  = ['a'-'z' 'A'-'Z' '0'-'9' '_' '-']+
+let snake = ['a'-'z' '_']+
+
+let sep_1    = '|'
+let node     = alphnumdash
+let modul    = snake
+let key      = ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' ':']+
+let level    = ("info" | "error")
+let priority = ("low" | "med" | "hi")
+let subject  = alphnumdash
+
+rule parse_msg = parse
+  | (node as node) sep_1 (modul as modul) sep_1 {
+      match parse_content lexbuf with
+      | Ok content     -> Ok Msg.({node; modul; content : content})
+      | (Error _) as e -> e
+  }
+  | _ {
+    parse_msg lexbuf
+  }
+  | eof {
+      Error (`Bad_format_of_msg_head)
+  }
+
+and parse_content = parse
+  | "status_bar" sep_1 {
+      Ok (Msg.Status_bar (tl lexbuf))
+  }
+  | "cache"
+      sep_1 (['0'-'9']+ as mtime)
+      sep_1 (node as node)
+      sep_1 (modul as modul)
+      sep_1 (key as key)
+      sep_1
+  {
+    let key = String.split_on_char sep_2 key in
+    let mtime = Time.of_string mtime in
+    Ok (Msg.Cache {mtime; node; modul; key; value = tl lexbuf})
+  }
+  | "data" sep_1 (key as key) sep_1 {
+      Ok (Msg.Data {key = String.split_on_char sep_2 key; value = tl lexbuf})
+  }
+  | "error" sep_1 {
+      Ok (Msg.Error (tl lexbuf))
+  }
+  | "alert" sep_1 (priority as priority) (subject as subject) sep_1 {
+      let priority =
+        match priority with
+        | "low" -> `low
+        | "med" -> `med
+        | "hi"  -> `hi
+        | _     -> assert false
+      in
+      Ok (Msg.Alert {priority; subject; body = tl lexbuf})
+  }
+  | "log" sep_1 (snake as location) (level as level) sep_1 {
+      let level =
+        match level with
+        | "info"  -> `info
+        | "error" -> `error
+        | _       -> assert false
+      in
+      Ok (Msg.Log {location; level; msg = tl lexbuf})
+  }
+  | _ {
+    parse_content lexbuf
+  }
+  | eof {
+      Error (`Bad_format_of_msg_content)
+  }
+
+and tl = parse
+  | (_* as tail) eof {tail}

diff --git a/src/ocaml/lib/khatus_time.ml b/src/ocaml/lib/khatus_time.ml
new file mode 100644 (file)
index 0000000..cf6538a
--- /dev/null
+++ b/src/ocaml/lib/khatus_time.ml
@@ -0,0 +1,24 @@
+module Span = struct
+  type t = float
+
+  let of_string s =
+    float_of_string s
+
+  let is_gt_or_eq t1 t2 =
+    t1 >= t2
+end
+
+type t = float
+
+let init = 0.0
+
+let diff t0 t1 =
+  t1 -. t0
+
+let to_string t =
+  Printf.sprintf "%f" t
+  |> String.split_on_char '.'
+  |> List.hd
+
+let of_string s =
+  float_of_string s

diff --git a/src/ocaml/lib/khatus_time.mli b/src/ocaml/lib/khatus_time.mli
new file mode 100644 (file)
index 0000000..9f930af
--- /dev/null
+++ b/src/ocaml/lib/khatus_time.mli
@@ -0,0 +1,17 @@
+module Span : sig
+  type t
+
+  val of_string : string -> t
+
+  val is_gt_or_eq : t -> t -> bool
+end
+
+type t
+
+val init : t
+
+val diff : t -> t -> Span.t
+
+val to_string : t -> string
+
+val of_string : string -> t