summaryrefslogtreecommitdiff
path: root/pkgs/scripts
diff options
context:
space:
mode:
Diffstat (limited to 'pkgs/scripts')
-rwxr-xr-xpkgs/scripts/monit-prometheus.scm140
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))))