#!/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))))