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 prom_prefix = PC.prom_prefix val summary_prefix = PC.summary_prefix val info_prefix = PC.info_prefix val stats_prefix = PC.stats_prefix val timestamp = ref (LargeInt.toString (Time.toMilliseconds (Time.now ()))) val newline = String.str #"\n" val summary_header = [ "# HELP " ^ summary_prefix ^ " sum of nodes and of some attributes" ^ newline ^ "# TYPE " ^ summary_prefix ^ " gauge" ^ newline ] val info_header = [ "# HELP " ^ info_prefix ^ " static attributes of a node" ^ newline ^ "# TYPE " ^ info_prefix ^ " counter" ^ newline, "# HELP " ^ info_prefix ^ "_fw_version firmware version as an integer value" ^ newline ^ "# TYPE " ^ info_prefix ^ "_fw_version gauge" ^ newline, "# HELP " ^ info_prefix ^ "_lastseen metric for the lastseen attribute of a node" ^ newline ^ "# TYPE " ^ info_prefix ^ "_lastseen gauge" ^ newline, "# HELP " ^ info_prefix ^ "_firstseen metric for the firtseen attribute of a node" ^ newline ^ "# TYPE " ^ info_prefix ^ "_firstseen gauge" ^ newline ] fun stats_header key = "# HELP " ^ stats_prefix ^ key ^ " metric for the " ^ key ^ " attribute of a node" ^ newline ^ "# TYPE " ^ stats_prefix ^ key ^ " 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 firmware2int firmware = foldl (fn (s, i) => 100 * i + valOf (Int.fromString s)) 0 (String.tokens (fn c => c = #".") firmware) fun timestring2time ts = (* "timestamp" : "2017-10-01T18:49:11+02:00" *) let val tsfields = String.tokens (fn c => c = #"-" orelse c = #"T" orelse c = #":" orelse c = #"+") ts val tsints = map (valOf o Int.fromString) tsfields fun int2month i = let open Date val months = [ Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec ] in List.nth (months, i - 1) end val tsdate = Date.date { year = List.nth (tsints, 0), month = int2month (List.nth (tsints, 1)), day = List.nth (tsints, 2), hour = List.nth (tsints, 3), minute = List.nth (tsints, 4), second = List.nth (tsints, 5), (* Basis/date.html: ... offset reports time zone information as the amount of time west [sic!] of UTC. *) offset = SOME (Time.fromSeconds (~1 * 60 * Int.toLarge ((60 * List.nth (tsints, 6) + List.nth (tsints, 7))))) } in Date.toTime tsdate end fun get_timestamp obj = let val tsstring = JU.asString (JU.lookupField obj "timestamp") val tstime = timestring2time tsstring in timestamp := LargeInt.toString (Time.toMilliseconds tstime) end handle exn => json_handler ("get_timestamp") exn 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 obj "nodes") fun extract node = let val nodeinfo = JU.lookupField node "nodeinfo" val hostname = JU.asString (JU.lookupField nodeinfo "hostname") val node_id = JU.asString (JU.lookupField nodeinfo "node_id") local val interfaces' = get_fields (JU.lookupField (JU.lookupField (JU.lookupField (JU.lookupField nodeinfo "network") "mesh") "bat0") "interfaces") val interfaces'' = map (fn i => (#1 i) ^ ":" ^ (Int.toString (length (get_list (#2 i))))) interfaces' val interfaces''' = ListMergeSort.sort String.> interfaces'' in val interfaces = ListFormat.fmt { init = "", sep = ",", final = "", fmt = (fn s => s) } interfaces''' end val location = JU.findField nodeinfo "location" val (longitude, latitude) = case location of SOME l => (SOME (JU.asNumber (JU.lookupField l "longitude")), SOME (JU.asNumber (JU.lookupField l "latitude"))) | NONE => (NONE, NONE) val software = JU.lookupField nodeinfo "software" val autoupdater = JU.asBool (JU.lookupField (JU.lookupField software "autoupdater") "enabled") val fastd = JU.asBool (JU.lookupField (JU.lookupField software "fastd") "enabled") val firmware = JU.asString (JU.lookupField (JU.lookupField software "firmware") "release") val base = JU.asString (JU.lookupField (JU.lookupField software "firmware") "base") val model = JU.asString (JU.lookupField (JU.lookupField nodeinfo "hardware") "model") val statistics = JU.lookupField node "statistics" val clients = JU.asInt (JU.lookupField statistics "clients") val gateway = JU.asString (JU.lookupField statistics "gateway") val loadavg = JU.asNumber (JU.lookupField statistics "loadavg") val memory_usage = JU.asNumber (JU.lookupField statistics "memory_usage") val rootfs_usage = JU.asNumber (JU.lookupField statistics "rootfs_usage") val uptime = JU.asNumber (JU.lookupField statistics "uptime") val traffic = JU.lookupField statistics "traffic" val tx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "tx") "bytes")) handle exn => NONE val rx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "rx") "bytes")) handle exn => NONE val forward = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "forward") "bytes")) handle exn => NONE val mgmt_tx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "mgmt_tx") "bytes")) handle exn => NONE val mgmt_rx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "mgmt_rx") "bytes")) handle exn => NONE val flags = JU.lookupField node "flags" val online = JU.asBool (JU.lookupField flags "online") val uplink = JU.asBool (JU.lookupField flags "uplink") val lastseen = timestring2time (JU.asString (JU.lookupField node "lastseen")) val firstseen = timestring2time (JU.asString (JU.lookupField node "firstseen")) in SOME ({ clients = clients, online = online, uplink = uplink }, { hostname = hostname, online = online, node_id = node_id, interfaces = interfaces, longitude = longitude, latitude = latitude, autoupdater = autoupdater, gateway = gateway, fastd = fastd, firmware = firmware, base = base, model = model, lastseen = lastseen, firstseen = firstseen }, { hostname = hostname, node_id = node_id, clients = clients, online = online, uplink = uplink, loadavg = loadavg, memory_usage = memory_usage, rootfs_usage = rootfs_usage, uptime = uptime, tx = tx, rx = rx, forward = forward, mgmt_tx = mgmt_tx, mgmt_rx = mgmt_rx } ) end handle exn => (json_handler "extract" exn ; NONE) fun nodes_summary node_summaries = let fun summate (node_summary, (hcount, ccount, ocount, ucount)) = let val { clients, online, uplink } = node_summary in (hcount + 1, ccount + clients, if online then ocount + 1 else ocount, if uplink then ucount + 1 else ucount) end val (hc, cc, oc, uc) = foldl summate (0, 0, 0, 0) node_summaries val scalars = map Int.toString [hc, cc, oc, uc] val labelvalues = ["nodes", "clients", "online", "uplink"] val items = ListPair.zip (labelvalues, scalars) in foldr (fn ((count, scalar), result) => (prom2string (summary_prefix, [("count", count)], scalar)) ^ result) "" items end fun node_info { hostname, online, node_id, interfaces, longitude, latitude, autoupdater, fastd, gateway, firmware, base, model, lastseen, firstseen } = let val minitems = [ ("hostname", hostname), ("node_id", node_id)] val allitems = minitems @ [ ("interfaces", interfaces), ("longitude", case longitude of NONE => "NaN" | SOME l => Real.toString l), ("latitude", case latitude of NONE => "NaN" | SOME l => Real.toString l), ("autoupdater", Bool.toString autoupdater), ("fastd", Bool.toString fastd), ("gateway", gateway), ("firmware", firmware), ("base", base), ("model", model)] in [("!info", prom2string (info_prefix, allitems, "1")), ("fw_version", prom2string (info_prefix ^ "_fw_version", minitems, Int.toString (firmware2int firmware))), ("lastseen", prom2string (info_prefix ^ "_lastseen", minitems, LargeInt.toString (Time.toSeconds lastseen))), ("firstseen", prom2string (info_prefix ^ "_firstseen", minitems, LargeInt.toString (Time.toSeconds firstseen)))] end fun node_stats { hostname, node_id, clients, online, uplink, loadavg, memory_usage, uptime, rootfs_usage, tx, rx, forward, mgmt_tx, mgmt_rx } = let val items = [SOME ("clients", Int.toString clients), SOME ("online", if online then "1" else "0"), SOME ("uplink", if uplink then "1" else "0"), SOME ("loadavg", Real.toString loadavg), SOME ("memory_usage", Real.toString memory_usage), SOME ("rootfs_usage", Real.toString rootfs_usage), SOME ("uptime", Real.toString(uptime)), case tx of SOME tx' => SOME ("tx", Real.toString(tx')) | NONE => NONE, case rx of SOME rx' => SOME ("rx", Real.toString(rx')) | NONE => NONE, case forward of SOME forward' => SOME ("forward", Real.toString(forward')) | NONE => NONE, case mgmt_tx of SOME mgmt_tx' => SOME ("mgmt_tx", Real.toString(mgmt_tx')) | NONE => NONE, case mgmt_rx of SOME mgmt_rx' => SOME ("mgmt_rx", Real.toString(mgmt_rx')) | NONE => NONE] fun item2prom (key, value) = (key, stats_prefix ^ key ^ "{hostname=\"" ^ hostname ^ "\",node_id=\"" ^ node_id ^ "\"} " ^ value ^ " " ^ !timestamp ^ "\n") in List.mapPartial (fn (SOME i) => SOME (item2prom i) | NONE => NONE) items 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_timestamp json val nodes_json = get_nodes json handle exn => (json_handler "get_nodes" exn ; raise Fail "get_nodes") val nodes_extract = List.mapPartial extract nodes_json val summaries = map #1 nodes_extract val infos = map #2 nodes_extract val (infokeys', infos) = ListPair.unzip (ListMergeSort.sort (fn ((k1,_), (k2,_)) => String.> (k1, k2)) (List.concat (List.map node_info infos))) val infokeys = ListMergeSort.uniqueSort String.compare infokeys' val stats' = List.filter (fn stts => #online stts) (map #3 nodes_extract) val (statskeys', stats) = ListPair.unzip (ListMergeSort.sort (fn ((k1,_), (k2,_)) => String.> (k1, k2)) (List.concat (List.map node_stats stats'))) val statskeys = ListMergeSort.uniqueSort String.compare statskeys' in (app print (List.concat [summary_header, info_header, map stats_header statskeys]) ; print (nodes_summary summaries) ; app print infos ; app print stats ; OS.Process.success) end handle e => complain (p, exnMessage e)) | main (p, _) = complain (p, "usage: " ^ p ^ " nodes.json") end