diff options
| -rw-r--r-- | prometheus.scm | 135 |
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 '("." ".."))))) + '())))))) |