summaryrefslogtreecommitdiff
path: root/pkgs/scripts/monit-prometheus.scm
blob: 00ac297738c3ec2954ede0e9c4047dfc14e39e7c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
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))))