diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/utils.scm | 25 | ||||
| -rw-r--r-- | guix-data-service/web/controller.scm | 6 |
2 files changed, 30 insertions, 1 deletions
diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm index 361d7c8..9dd94df 100644 --- a/guix-data-service/utils.scm +++ b/guix-data-service/utils.scm @@ -18,6 +18,7 @@ (define-module (guix-data-service utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (ice-9 threads) @@ -48,6 +49,7 @@ delete-duplicates/sort! get-gc-metrics-updater + get-port-metrics-updater call-with-sigint run-server/patched)) @@ -451,6 +453,29 @@ available. Return the resource once PROC has returned." (metric-set metric value)))) metrics)))) +(define (get-port-metrics-updater registry) + (let ((ports-metric + (make-gauge-metric registry "guile_ports_total")) + (fds-metric + (make-gauge-metric registry "file_descriptors_total"))) + (lambda () + (let ((count 0)) + (port-for-each + (lambda _ + (set! count (+ 1 count)))) + + (metric-set ports-metric count)) + + (metric-set + 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 '("." ".."))))) + '())))))) + ;; This variant of run-server from the fibers library supports running ;; multiple servers within one process. (define run-server/patched diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index a0b847c..a7ed02c 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -193,7 +193,10 @@ #:labels '(pool_name))))) (gc-metrics-updater - (get-gc-metrics-updater registry))) + (get-gc-metrics-updater registry)) + + (port-metrics-updater + (get-port-metrics-updater registry))) (define guile-time-metrics-updater (let ((internal-real-time @@ -399,6 +402,7 @@ (or load-new-guix-revision-job-metrics '())) (gc-metrics-updater) + (port-metrics-updater) (guile-time-metrics-updater) (list (build-response |