diff options
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http/server.scm | 7 | ||||
| -rw-r--r-- | guix-build-coordinator/utils.scm | 36 |
2 files changed, 42 insertions, 1 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm index 2928513..ceda10c 100644 --- a/guix-build-coordinator/agent-messaging/http/server.scm +++ b/guix-build-coordinator/agent-messaging/http/server.scm @@ -80,12 +80,17 @@ if there was no request body." (get-gc-metrics-updater (build-coordinator-metrics-registry build-coordinator))) + (define guix-memory-metrics-updater + (get-guix-memory-metrics-updater + (build-coordinator-metrics-registry build-coordinator))) + (define datastore-metrics-updater (base-datastore-metrics-updater build-coordinator)) (define (update-managed-metrics!) (call-with-delay-logging datastore-metrics-updater) - (call-with-delay-logging gc-metrics-updater)) + (call-with-delay-logging gc-metrics-updater) + (call-with-delay-logging guix-memory-metrics-updater)) (call-with-error-handling (lambda () diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index e633c05..5370d10 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -93,6 +93,7 @@ running-on-the-hurd? get-gc-metrics-updater + get-guix-memory-metrics-updater check-locale!)) @@ -1224,6 +1225,41 @@ again." (metric-set metric value)))) metrics)))) +(define (get-guix-memory-metrics-updater registry) + (define %memoization-tables + (@@ (guix memoization) %memoization-tables)) + + (define memoization-table-entry-count-metric + (make-gauge-metric + registry "guix_memoization_table_entry_count" + #:labels '(procedure))) + + (define %derivation-cache + (@@ (guix derivations) %derivation-cache)) + + (define derivation-cache-entry-count-metric + (make-gauge-metric + registry "guix_derivation_cache_entry_count")) + + (lambda () + (metric-set + derivation-cache-entry-count-metric + ;; hash-count doesn't work for weak tables? + (hash-fold (lambda (k v result) + (+ 1 result)) + 0 + %derivation-cache)) + + (hash-for-each + (lambda (proc table) + (metric-set + memoization-table-entry-count-metric + (hash-count (const #t) table) + #:label-values `((procedure . ,(simple-format + #f "~A" + proc))))) + %memoization-tables))) + (define (check-locale!) (with-exception-handler (lambda (exn) |