|
|
@@ -0,0 +1,120 @@
|
|
|
+structure Main :
|
|
|
+sig
|
|
|
+ val main: string * string list -> OS.Process.status
|
|
|
+end =
|
|
|
+struct
|
|
|
+ structure J = JSON
|
|
|
+ structure JP = JSONParser
|
|
|
+ structure JU = JSONUtil
|
|
|
+
|
|
|
+ structure PC = PromConfig
|
|
|
+ val link_prefix = PC.link_prefix
|
|
|
+ val mesh_prefix = PC.mesh_prefix
|
|
|
+
|
|
|
+ (* val timestamp = LargeInt.toString (Time.toMilliseconds (Time.now ())) *)
|
|
|
+
|
|
|
+ val newline = String.str #"\n"
|
|
|
+ val link_header =
|
|
|
+ "# HELP " ^ link_prefix ^ " link quality between two nodes" ^ newline ^
|
|
|
+ "# TYPE " ^ link_prefix ^ " gauge" ^ newline
|
|
|
+ val mesh_header =
|
|
|
+ "# HELP " ^ mesh_prefix ^ " path length between two nodes in a mesh" ^ newline ^
|
|
|
+ "# TYPE " ^ mesh_prefix ^ " gauge" ^ newline
|
|
|
+
|
|
|
+ fun prom2string (metric, labels, scalar) =
|
|
|
+ let fun esc #"\"" = "\\\""
|
|
|
+ | esc #"\\" = "\\\\"
|
|
|
+ | esc #"\n" = "\\n"
|
|
|
+ | esc c = str c
|
|
|
+ in metric ^
|
|
|
+ (ListFormat.fmt {init = "{", sep= ",", final = "}",
|
|
|
+ fmt = fn (label, value) => label ^ "=\"" ^ (String.translate esc value) ^ "\""}
|
|
|
+ labels) ^ " " ^
|
|
|
+ scalar ^ (* " " ^
|
|
|
+ timestamp ^ *) newline
|
|
|
+ end
|
|
|
+
|
|
|
+ (* exnMessage from JSONUtil - slightly extended *)
|
|
|
+
|
|
|
+ fun v2bs' (J.ARRAY []) = "[]"
|
|
|
+ | v2bs' (J.ARRAY _) = "[...]"
|
|
|
+ | v2bs' (J.BOOL v) = Bool.toString v
|
|
|
+ | v2bs' (J.FLOAT v) = Real.toString v
|
|
|
+ | v2bs' (J.INT v) = IntInf.toString v
|
|
|
+ | v2bs' J.NULL = "null"
|
|
|
+ | v2bs' (J.OBJECT []) = "{}"
|
|
|
+ | v2bs' (J.OBJECT _) = "{...}"
|
|
|
+ | v2bs' (J.STRING v) = v
|
|
|
+
|
|
|
+ fun v2bs (J.ARRAY []) = "[]"
|
|
|
+ | v2bs (J.ARRAY vl) =
|
|
|
+ ListFormat.fmt { init = "[", sep = ",", final = "]", fmt = v2bs' } vl
|
|
|
+ | v2bs (J.OBJECT []) = "{}"
|
|
|
+ | v2bs (J.OBJECT fl) =
|
|
|
+ ListFormat.fmt { init = "{", sep = ",", final = "}",
|
|
|
+ fmt = fn (n, v) => n ^ ":" ^ (v2bs' v) } fl
|
|
|
+ | v2bs v = v2bs' v
|
|
|
+
|
|
|
+ fun json_handler logstring exn =
|
|
|
+ (TextIO.output (TextIO.stdErr,
|
|
|
+ "json_handler(" ^ logstring ^ "): " ^ (JU.exnMessage exn) ^ ": " ^
|
|
|
+ (v2bs (case exn
|
|
|
+ of JU.NotBool v => v
|
|
|
+ | JU.NotInt v => v
|
|
|
+ | JU.NotNumber v => v
|
|
|
+ | JU.NotString v => v
|
|
|
+ | JU.NotObject v => v
|
|
|
+ | JU.FieldNotFound(v, fld) => v
|
|
|
+ | JU.NotArray v => v
|
|
|
+ | _ => raise exn)) ^
|
|
|
+ "\n") ; ())
|
|
|
+
|
|
|
+ fun get_version obj = JU.asInt (JU.lookupField obj "version")
|
|
|
+
|
|
|
+ fun get_fields (J.OBJECT flds) = flds
|
|
|
+ | get_fields v = raise Fail ("value is not an object (" ^ (v2bs v) ^ ")")
|
|
|
+
|
|
|
+ fun get_list (J.OBJECT flds) = map #2 flds
|
|
|
+ | get_list (J.ARRAY nds) = nds
|
|
|
+ | get_list v = raise Fail ("value does not contain a list (" ^ (v2bs v) ^ ")")
|
|
|
+
|
|
|
+ fun get_nodes obj = get_list (JU.lookupField (JU.lookupField obj "batadv") "nodes")
|
|
|
+ fun get_links obj = get_list (JU.lookupField (JU.lookupField obj "batadv") "links")
|
|
|
+
|
|
|
+ fun extract_node obj = { id = JU.asString (JU.lookupField obj "id"),
|
|
|
+ node_id = JU.asString (JU.lookupField obj "node_id") }
|
|
|
+
|
|
|
+ fun extract_link obj = { source = JU.asInt (JU.lookupField obj "source"),
|
|
|
+ target = JU.asInt (JU.lookupField obj "target"),
|
|
|
+ tq = JU.asNumber (JU.lookupField obj "tq"),
|
|
|
+ vpn = JU.asBool (JU.lookupField obj "vpn") }
|
|
|
+
|
|
|
+ fun link2prom nodes_id_vector { source, target, tq, vpn } =
|
|
|
+ let val source_id = Vector.sub (nodes_id_vector, source)
|
|
|
+ val target_id = Vector.sub (nodes_id_vector, target)
|
|
|
+ in prom2string (link_prefix,
|
|
|
+ [("source", source_id), ("target", target_id), ("vpn", Bool.toString vpn)],
|
|
|
+ Real.toString tq)
|
|
|
+ end
|
|
|
+
|
|
|
+ fun complain (p, s) =
|
|
|
+ (TextIO.output (TextIO.stdErr, concat [p, ": ", s, "\n"]);
|
|
|
+ OS.Process.failure)
|
|
|
+
|
|
|
+ fun main (p, [inf]) =
|
|
|
+ (let val json = JP.parseFile inf
|
|
|
+ val _ = get_version json = 1 orelse raise Fail "version must be 1"
|
|
|
+ val nodes_json = get_nodes json
|
|
|
+ handle exn => (json_handler "get_nodes" exn ; raise Fail "get_nodes")
|
|
|
+ val nodes_vector = Vector.fromList (map extract_node nodes_json)
|
|
|
+ val nodes_id_vector = Vector.map #node_id nodes_vector
|
|
|
+ val links_json = get_links json
|
|
|
+ handle exn => (json_handler "get_links" exn ; raise Fail "get_links")
|
|
|
+ val links_extract = map extract_link links_json
|
|
|
+ val links_prom = map (link2prom nodes_id_vector) links_extract
|
|
|
+ in (print link_header ;
|
|
|
+ app print links_prom ;
|
|
|
+ OS.Process.success)
|
|
|
+ end handle e => complain (p, exnMessage e))
|
|
|
+ | main (p, _) = complain (p, "usage: " ^ p ^ " nodes.json")
|
|
|
+end
|
