aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--prometheus.scm135
1 files changed, 134 insertions, 1 deletions
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 '("." "..")))))
+ '()))))))