1 files changed, 140 insertions, 0 deletions
diff --git a/pkgs/scripts/monit-prometheus.scm b/pkgs/scripts/monit-prometheus.scm
new file mode 100755
index 0000000..00ac297
--- /dev/null
+++ b/pkgs/scripts/monit-prometheus.scm
@@ -0,0 +1,140 @@
+#!/usr/bin/env gosh
+
+(use sxml.ssax)
+(use sxml.sxpath)
+(use sxml.tools)
+(use gauche.process)
+(use util.match)
+(use srfi-13)
+(use gauche.parseopt)
+
+(define program-prefix "monit")
+
+(define (show-help progname)
+  (display
+#"~|progname|: convert monit's /_status2 endpoint to prometheus-compatible text metrics
+
+Options:
+ -p --prefix: prefix given to all metrics. [default: monit]
+ -i --input: base url of monit to read from (uses curl). If not given, will try to read from `status2.xml'.
+ -o --output: output file path, probably to be served by some webserver. [default: print to stdout]
+")
+  (exit 0))
+
+(define (main args)
+  (let-args
+   (cdr args)
+   ((pprefix "p|prefix=s")
+    (input "i|input=s")
+    (output "o|output=s")
+    (help "h|help" => (cut show-help (car args)))
+    . restargs)
+
+   (if pprefix
+       (set! program-prefix pprefix))
+
+   (let* [(in-raw
+           (if input
+               (process-output->string `(curl --silent ,#"~|input|/_status2?format=xml"))
+               (process-output->string `(cat "status2.xml"))))
+          (in-xml
+           (call-with-input-string
+            in-raw (lambda (port) (ssax:xml->sxml port '()))))
+          (services
+           ((sxpath '(// service)) in-xml))
+          (out-text
+           (services->text services))]
+
+     (if output
+         (begin
+           (with-output-to-file #"~|output|-new" (lambda () (display out-text)))
+           (sys-rename #"~|output|-new" output))
+         (display out-text))
+
+     (exit 0))))
+
+
+(define (service->name service)
+  (let* [(attr ((car-sxpath '(@ name)) service))
+         (content (sxml:content attr))
+         (string (car content))]
+    string))
+
+(define (service->lines service)
+  ((sxpath '(*)) service))
+
+
+;; https://prometheus.io/docs/concepts/data_model/#metric-names-and-labels
+;; > It must match the regex [a-zA-Z_:][a-zA-Z0-9_:]*
+;; > Note: The colons are reserved for user defined recording rules.
+;; > They should not be used by exporters or direct instrumentation
+;; I'll trust myself not to cause name collisions in monit names (for now)
+(define (make-valid-name string)
+  (string-map
+   (lambda (char)
+     (if (char-set-contains? #[a-zA-Z0-9_] char) char #\_))
+   string))
+
+;; apparently I'm not interested in anything that's not a gauge
+(define (line->gauge service line :optional (timestamp #f) (prefix-name #f))
+  (let* [(metric-name
+          (make-valid-name
+           (if prefix-name
+               #"~|program-prefix|_~(service->name service)_~|prefix-name|_~(sxml:node-name line)"
+               #"~|program-prefix|_~(service->name service)_~(sxml:node-name line)")))
+         (value (car (sxml:content line)))]
+   #"# TYPE ~metric-name GAUGE\n~metric-name ~value ~(if timestamp timestamp \"\")\n"))
+
+
+;; https://prometheus.io/docs/instrumenting/exposition_formats/#text-format-details
+(define (metric->text service line :optional (timestamp #f) (prefix #f))
+
+  (define (submetrics->text :optional (prefix-name #f))
+     (string-concatenate
+      (filter-map (lambda (line) (metric->text service line timestamp prefix-name))
+                  (sxml:content line))))
+
+  (match (sxml:node-name line)
+    ['status (line->gauge service line timestamp prefix)]
+    ['monitor (line->gauge service line timestamp prefix)]
+    ['pendingaction (line->gauge service line timestamp prefix)]
+
+    ; in port sub-structure
+    ; TODO: could add extra information as label?
+    ; (port, protocol, url, etc.)
+    ['responsetime (line->gauge service line timestamp prefix)]
+
+    ; in memory, cpu
+    ['percent (line->gauge service line timestamp prefix)]
+    ['percenttotal (line->gauge service line timestamp prefix)]
+    ['kilobyte (line->gauge service line timestamp prefix)]
+    ['kilobytetotal (line->gauge service line timestamp prefix)]
+
+    ; in filedescriptors
+    ['open (line->gauge service line timestamp prefix)]
+    ['opentotal (line->gauge service line timestamp prefix)]
+
+    ; recursion into substructures
+    ; TODO: can't do recursion into two layers deep ..
+    ['memory (submetrics->text "memory")]
+    ['swap (submetrics->text "swap")]
+    ['cpu (submetrics->text "cpu")]
+    ['filedescriptors (submetrics->text "filedescriptors")]
+    [(or 'port 'system) (submetrics->text)]
+    [_ #f]))
+
+(define (service->text service)
+  (define maybe-timestamp
+    (sxml:content ((car-sxpath '(collected_sec)) service)))
+  (define timestamp
+    (if (= 0 (length maybe-timestamp))
+        #f (car maybe-timestamp)))
+  (string-concatenate
+   (filter-map (lambda (line)
+                 (metric->text service line timestamp))
+               (service->lines service))))
+
+(define (services->text services)
+  (string-concatenate
+   (intersperse "\n"
+    (map service->text services))))