Initial commit.

2 files changed, 77 insertions, 0 deletions

diff --git a/channels.scm b/channels.scm
new file mode 100644
index 0000000..fe47342
--- /dev/null
+++ b/channels.scm
@@ -0,0 +1,6 @@
+(list (channel
+        (name 'guix)
+        (url "https://git.savannah.gnu.org/git/guix.git")
+        (branch "master")
+        (commit
+          "1f734a6f0a7db5b0e12091a0c869c5c4810ac80e")))
diff --git a/prometheus-shepherd-exporter.scm b/prometheus-shepherd-exporter.scm
new file mode 100644
index 0000000..aa29076
--- /dev/null
+++ b/prometheus-shepherd-exporter.scm
@@ -0,0 +1,71 @@
+;; This Guile module provides a Prometheus exporter for the GNU Shepherd.
+;;
+;; Build command:
+;; guix build -L . -e '(@ (prometheus-shepherd-exporter) prometheus-shepherd-exporter)'
+
+(define-module (prometheus-shepherd-exporter)
+  #:use-module (gnu packages guile-xyz)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:export (prometheus-shepherd-exporter))
+
+(define prometheus-shepherd-exporter
+  (program-file
+   "prometheus-shepherd-exporter"
+   (with-extensions (list guile-prometheus)
+     (with-imported-modules (source-module-closure '((gnu services herd)
+                                                     (prometheus)))
+       #~(begin
+           (use-modules (gnu services herd)
+                        (prometheus)
+                        (srfi srfi-1)
+                        (web request)
+                        (web response)
+                        (web server)
+                        (web uri))
+
+           (define my-registry
+             (make-metrics-registry #:namespace "shepherd"))
+
+           (define request-counter
+             (make-counter-metric my-registry "requests_count"))
+
+           (define service-status-gauge
+             (make-gauge-metric my-registry "service_status"))
+
+           (define %exclude-services
+             (append '(host-name
+                       kernel-module-loader
+                       kres-cache-gc
+                       sysctl
+                       term-console
+                       user-homes)
+                     '(lvm-thin)))
+
+           (define (request-handler request body)
+             (metric-increment request-counter)
+             (for-each (lambda (service)
+                         (metric-set service-status-gauge
+                                     (cond
+                                      ((member
+                                        (live-service-canonical-name service)
+                                        %exclude-services)
+                                       2)
+                                      ((live-service-running service)
+                                       1)
+                                      (else
+                                       0))
+                                     #:label-values
+                                     `((service . ,(live-service-canonical-name service)))))
+                       (current-services))
+             (if (equal? (split-and-decode-uri-path (uri-path (request-uri request)))
+                         '("metrics"))
+                 (values '((content-type . (text/plain)))
+                         (lambda (port)
+                           (write-metrics my-registry port)))
+                 (values '((content-type . (text/plain)))
+                         (lambda (port)
+                           (display "Incrementing metric\n" port)))))
+
+           (run-server request-handler 'http
+                       '(#:port 9180)))))))