-data/
-bin/khatus_bar
+_build/
bin/khatus_actuate_alert_to_notify_send
bin/khatus_actuate_device_add_to_automount
bin/khatus_actuate_status_bar_to_xsetroot_name
+bin/khatus_bar
+bin/khatus_dashboard
bin/khatus_monitor_devices
bin/khatus_monitor_energy
bin/khatus_monitor_errors
bin/khatus_parse_sys_block_stat
bin/khatus_parse_udevadm_monitor_block
bin/khatus_parse_upower
+data/
bin/khatus_parse_sys_block_stat \
bin/khatus_parse_udevadm_monitor_block \
bin/khatus_parse_upower
+OCAML_EXECUTABLES := \
+ bin/khatus_dashboard
define BUILD_AWK_EXE
echo '#! $(PATH_TO_AWK) -f' > $@ && \
install \
clean
-build: $(AWK_EXECUTABLES)
+build: $(AWK_EXECUTABLES) $(OCAML_EXECUTABLES)
install:
$(foreach filename,$(wildcard bin/*),cp -p "$(filename)" "$(PREFIX)/$(filename)"; )
clean:
rm -f $(AWK_EXECUTABLES)
+ rm -f $(OCAML_EXECUTABLES)
+#-----------------------------------------------------------------------------
+# AWK
+#-----------------------------------------------------------------------------
bin/khatus_bar: \
src/awk/exe/bar.awk \
src/awk/lib/cache.awk \
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
-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) \
--- /dev/null
+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 ())
--- /dev/null
+module Cache = Khatus_cache
+module Msg = Khatus_msg
+module Msg_parser = Khatus_msg_parser
+module Time = Khatus_time
--- /dev/null
+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")
+ )
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+val parse_msg
+ : Lexing.lexbuf
+ ->
+ ( Khatus_msg.t
+ , [ `Bad_format_of_msg_head
+ | `Bad_format_of_msg_content
+ ]
+ ) result
--- /dev/null
+{
+ 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}
--- /dev/null
+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
--- /dev/null
+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
home / code / khatus.git / commitdiff
