From e63335e64a1f63967b94ba6dd97889f9f565ca48 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 22 Mar 2024 13:05:45 +0000
Subject: Add a process metrics updater

---
 prometheus.scm | 135 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 134 insertions(+), 1 deletion(-)

diff --git a/prometheus.scm b/prometheus.scm
index 5bb42af..7332d57 100644
--- a/prometheus.scm
+++ b/prometheus.scm
@@ -21,10 +21,12 @@
 (define-module (prometheus)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 textual-ports)
   #:export (make-metrics-registry
             metrics-registry-fetch-metric
             write-metrics
@@ -46,7 +48,8 @@
 
             call-with-duration-metric
 
-            get-gc-metrics-updater))
+            get-gc-metrics-updater
+            get-process-metrics-updater))
 
 (define-record-type <metrics-registry>
   (make-metrics-registry-record metrics-hash namespace)
@@ -574,3 +577,133 @@ This procedure takes care of atomically replacing the file."
           (let ((value (assq-ref stats name)))
             (metric-set metric value))))
        metrics))))
+
+(define* (get-process-metrics-updater registry
+                                      #:key (pid (getpid))
+                                      (proc "/proc"))
+  (define cpu-seconds-metric
+    (make-gauge-metric registry
+                       "process_cpu_seconds_total"
+                       #:docstring
+                       "Total user and system CPU time spent in seconds."))
+
+  (define open-fds-metric
+    (make-gauge-metric registry
+                       "process_open_fds"
+                       #:docstring "Number of open file descriptors."))
+
+  (define max-fds-metric
+    (make-gauge-metric registry
+                       "process_max_fds"
+                       #:docstring "Maximum number of open file descriptors."))
+
+  (define virtual-memory-bytes-metric
+    (make-gauge-metric registry
+                       "process_virtual_memory_bytes"
+                       #:docstring "Virtual memory size in bytes."))
+
+  ;; (define virtual-memory-max-bytes-metric
+  ;;   (make-gauge-metric registry
+  ;;                      "process_virtual_memory_max_bytes"
+  ;;                      #:docstring "Maximum amount of virtual memory available in bytes."))
+
+  (define resident-memory-bytes-metric
+    (make-gauge-metric registry
+                       "process_resident_memory_bytes"
+                       #:docstring "Resident memory size in bytes."))
+
+  ;; (define heap-bytes-metric
+  ;;   (make-gauge-metric registry
+  ;;                      "process_heap_bytes"
+  ;;                      #:docstring "Process heap size in bytes."))
+
+  (define start-time-seconds-metric
+    (make-gauge-metric registry
+                       "process_start_time_seconds"
+                       #:docstring "Start time of the process since unix epoch in seconds."))
+
+  (define threads-metric
+    (make-gauge-metric registry
+                       "process_threads"
+                       #:docstring "Number of OS threads in the process."))
+
+  (define boot-time
+    (let ((contents
+           (call-with-input-file (string-append proc "/stat")
+             get-string-all)))
+      (match (string-split
+              (find
+               (lambda (line)
+                 (string-prefix? "btime " line))
+               (string-split contents #\newline))
+              #\space)
+        ((_ btime)
+         (string->number btime)))))
+
+  (define page-size
+    ;; TODO Assume the page size
+    4096)
+
+  (define ticks
+    ;; TODO
+    100)
+
+  (lambda ()
+    (let ((stat-parts
+           (drop
+            (string-split
+             (last
+              (string-split
+               (call-with-input-file
+                   (string-append proc "/" (number->string pid) "/stat")
+                 get-string-all)
+               #\)))
+             #\space)
+            1)))
+
+      (metric-set virtual-memory-bytes-metric
+                  (string->number (list-ref stat-parts 20)))
+
+      (metric-set resident-memory-bytes-metric
+                  (* (string->number (list-ref stat-parts 21)) page-size))
+
+      (metric-set start-time-seconds-metric
+                  (+ (/ (string->number (list-ref stat-parts 19)) ticks) boot-time))
+
+      (let ((utime (/ (string->number (list-ref stat-parts 11)) ticks))
+            (stime (/ (string->number (list-ref stat-parts 12)) ticks)))
+        (metric-set cpu-seconds-metric
+                    (+ utime stime)))
+
+      (metric-set threads-metric
+                  (string->number (list-ref stat-parts 17))))
+
+    (let ((limits-lines
+           (string-split
+            (call-with-input-file
+                (string-append proc "/" (number->string pid) "/limits")
+              get-string-all)
+            #\newline)))
+
+      (let ((max-open-files-data
+             (take-right
+              (remove
+               string-null?
+               (string-split
+                (find
+                 (lambda (line)
+                   (string-prefix? "Max open files" line))
+                 limits-lines)
+                #\space))
+              3)))
+        (metric-set max-fds-metric
+                    (string->number (first max-open-files-data))))
+
+      (metric-set open-fds-metric
+                  (length
+                   ;; In theory 'scandir' cannot return #f, but in practice,
+                   ;; we've seen it before.
+                   (or (scandir "/proc/self/fd"
+                                (lambda (file)
+                                  (not (member file '("." "..")))))
+                       '()))))))
-- 
cgit v1.2.3