726 lines
26 KiB
Scheme
726 lines
26 KiB
Scheme
;;; Guile Prometheus
|
|
;;;
|
|
;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
|
|
;;;
|
|
;;; This file is part of the Guile Prometheus client.
|
|
;;;
|
|
;;; The Guile Prometheus client is free software; you can redistribute
|
|
;;; it and/or modify it under the terms of the GNU General Public
|
|
;;; License as published by the Free Software Foundation; either
|
|
;;; version 3 of the License, or (at your option) any later version.
|
|
;;;
|
|
;;; The Guile Prometheus client is distributed in the hope that it
|
|
;;; will be useful, but WITHOUT ANY WARRANTY; without even the implied
|
|
;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
;;; See the GNU General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with the guix-data-service. If not, see
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
(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
|
|
write-textfile
|
|
|
|
make-counter-metric
|
|
make-gauge-metric
|
|
|
|
%default-histogram-buckets
|
|
linear-histogram-buckets
|
|
exponential-histogram-buckets
|
|
|
|
make-histogram-metric
|
|
|
|
metric-increment
|
|
metric-decrement
|
|
metric-set
|
|
metric-observe
|
|
|
|
call-with-duration-metric
|
|
|
|
get-gc-metrics-updater
|
|
get-process-metrics-updater))
|
|
|
|
(define-record-type <metrics-registry>
|
|
(make-metrics-registry-record metrics-hash namespace)
|
|
metrics-registry?
|
|
(metrics-hash metrics-registry-metrics-hash)
|
|
(namespace metrics-registry-namespace))
|
|
|
|
(define* (make-metrics-registry #:key namespace)
|
|
"Create a metrics registry. This record stores named metrics, and
|
|
can have an optional @var{namespace}.
|
|
|
|
The @var{namespace} is used when writing out the metrics, each metric
|
|
name will be prefixed by the @var{namespace}, separated with an
|
|
underscore. Convention for naming metrics is that the @var{namespace}
|
|
should be a single word that identifies the application or area the
|
|
metrics relate to."
|
|
(make-metrics-registry-record (make-hash-table)
|
|
namespace))
|
|
|
|
(define-record-type <metric>
|
|
(make-metric type name values docstring labels label-preset-values
|
|
mutex)
|
|
metric?
|
|
(type metric-type)
|
|
(name metric-name)
|
|
(values metric-values)
|
|
(docstring metric-docstring)
|
|
(labels metric-labels)
|
|
(label-preset-values metric-label-preset-values)
|
|
(mutex metric-mutex))
|
|
|
|
(define (metrics-registry-add-metric registry name metric)
|
|
(let ((metrics-hash
|
|
(metrics-registry-metrics-hash registry)))
|
|
(when (hash-ref metrics-hash name)
|
|
(raise-exception
|
|
(make-exception-with-message
|
|
(simple-format #f "metric ~A already exists"
|
|
name))))
|
|
|
|
(hash-set! metrics-hash name metric)
|
|
|
|
metric))
|
|
|
|
(define (metrics-registry-fetch-metric registry name)
|
|
"Fetch a metric by @var{name} from the @var{registry}"
|
|
(hash-ref (metrics-registry-metrics-hash registry)
|
|
name))
|
|
|
|
(define* (make-counter-metric registry name
|
|
#:key
|
|
docstring
|
|
(labels '())
|
|
(label-preset-values '()))
|
|
"Make a counter metric, to track a value that only increases aside
|
|
from when it resets to 0 normally when the collector restarts. The
|
|
metric is associated with the specified @var{registry} under the given
|
|
@var{name}.
|
|
|
|
A metric record is returned, the value of the metric can be changed
|
|
with the @code{metric-increment} procedure.
|
|
|
|
The following keyword arguments can be used with all metrics:
|
|
@var{#:docstring} a short description of the metric, @var{#:labels} a
|
|
list of label names to be permitted for this metric and
|
|
@var{#:label-preset-values} default values for labels."
|
|
(metrics-registry-add-metric
|
|
registry
|
|
name
|
|
(make-metric 'counter
|
|
name
|
|
(make-hash-table)
|
|
docstring
|
|
labels
|
|
label-preset-values
|
|
(make-mutex))))
|
|
|
|
(define* (make-gauge-metric registry name
|
|
#:key
|
|
docstring
|
|
(labels '())
|
|
(label-preset-values '()))
|
|
"Make a gauge metric, to track a value that can go up or down. The
|
|
metric is associated with the specified @var{registry} under the given
|
|
@var{name}.
|
|
|
|
A metric record is returned, the value of the metric can be changed
|
|
with the @code{metric-increment}, @code{metric-decrement} or
|
|
@code{metric-set} procedures.
|
|
|
|
The following keyword arguments can be used with all metrics:
|
|
@var{#:docstring} a short description of the metric, @var{#:labels} a
|
|
list of label names to be permitted for this metric and
|
|
@var{#:label-preset-values} default values for labels."
|
|
(metrics-registry-add-metric
|
|
registry
|
|
name
|
|
(make-metric 'gauge
|
|
name
|
|
(make-hash-table)
|
|
docstring
|
|
(map canonicalise-label labels)
|
|
(canonicalise-label-values label-preset-values)
|
|
(make-mutex))))
|
|
|
|
(define-record-type <histogram-metric-type>
|
|
(make-histogram-metric-type buckets)
|
|
histogram-metric-type?
|
|
(buckets histogram-metric-type-buckets))
|
|
|
|
(define-record-type <histogram-values>
|
|
(make-histogram-values buckets sum count)
|
|
histogram-values?
|
|
(buckets histogram-values-buckets)
|
|
(sum histogram-values-sum set-histogram-values-sum!)
|
|
(count histogram-values-count set-histogram-values-count!))
|
|
|
|
(define %default-histogram-buckets
|
|
;; The default buckets used in other client libraries
|
|
(list 0.005 0.01 0.025 0.05 0.1 0.25 0.5 1 2.5 5 10 (inf)))
|
|
|
|
(define* (linear-histogram-buckets #:key start step end count)
|
|
(when (and end count)
|
|
(raise-exception
|
|
(make-exception-with-message
|
|
"you can only specify either end or count to linear-histogram-buckets")))
|
|
|
|
(append (if count
|
|
(map (lambda (index)
|
|
(+ start
|
|
(* step index)))
|
|
(iota count))
|
|
(let loop ((reverse-result (list start))
|
|
(current-value start))
|
|
(let ((next-value (+ current-value step)))
|
|
(if (>= next-value end)
|
|
(reverse (cons end reverse-result))
|
|
(loop (cons next-value reverse-result)
|
|
next-value)))))
|
|
(list (inf))))
|
|
|
|
(define* (exponential-histogram-buckets #:key start (factor 2) end count)
|
|
(when (and end count)
|
|
(raise-exception
|
|
(make-exception-with-message
|
|
"you can only specify either end or count to exponential-histogram-buckets")))
|
|
|
|
(append (if count
|
|
(map (lambda (index)
|
|
(* start
|
|
(expt factor index)))
|
|
(iota count))
|
|
(let loop ((reverse-result (list start)))
|
|
(let ((next-value
|
|
(* start
|
|
(expt factor
|
|
(+ 1 (length reverse-result))))))
|
|
(if (>= next-value end)
|
|
(reverse (cons end reverse-result))
|
|
(loop (cons next-value reverse-result))))))
|
|
(list (inf))))
|
|
|
|
(define* (make-histogram-metric registry name
|
|
#:key
|
|
(buckets %default-histogram-buckets)
|
|
docstring
|
|
(labels '())
|
|
(label-preset-values '()))
|
|
"Make a histogram metric, to track observations of values in a set
|
|
of buckets. Quantiles can be calculated from the histogram, which
|
|
makes this metric type good for observing things like durations.
|
|
|
|
Internally, this metric represents multiple metrics. One for each
|
|
bucket, plus one to record the total of all observed values and
|
|
another to count the number of observations.
|
|
|
|
A metric record is returned, this can be used with the
|
|
@code{metric-observe} procedure.
|
|
|
|
The following keyword arguments can be used with all metrics:
|
|
@var{#:docstring} a short description of the metric, @var{#:labels} a
|
|
list of label names to be permitted for this metric and
|
|
@var{#:label-preset-values} default values for labels."
|
|
;; TODO validate buckets
|
|
|
|
(metrics-registry-add-metric
|
|
registry
|
|
name
|
|
(make-metric (make-histogram-metric-type buckets)
|
|
name
|
|
(make-hash-table)
|
|
docstring
|
|
labels
|
|
label-preset-values
|
|
(make-mutex))))
|
|
|
|
(define (canonicalise-label label)
|
|
(call-with-output-string
|
|
(lambda (port)
|
|
(display label port))))
|
|
|
|
(define (canonicalise-label-value value)
|
|
(call-with-output-string
|
|
(lambda (port)
|
|
(display value port))))
|
|
|
|
(define (canonicalise-label-values label-values)
|
|
(let ((canonical-label-values
|
|
(map (match-lambda
|
|
((k . v)
|
|
(cons (canonicalise-label k)
|
|
(canonicalise-label-value v))))
|
|
label-values)))
|
|
(let loop ((lst (map car canonical-label-values)))
|
|
(unless (null? lst)
|
|
(let ((element (car lst))
|
|
(rest (cdr lst)))
|
|
(when (member element rest string=?)
|
|
(raise-exception
|
|
(make-exception-with-message
|
|
(simple-format
|
|
#f "label value specified multiple times: ~A"
|
|
element))))
|
|
|
|
(loop rest))))
|
|
|
|
canonical-label-values))
|
|
|
|
(define* (metric-increment metric
|
|
#:key
|
|
(by 1)
|
|
(label-values '()))
|
|
"Increment the value of the given @var{metric} by 1 (or the @var{#:by} value).
|
|
|
|
This procedure can be used with counter or gauge metrics.
|
|
|
|
To specify values for the labels, pass an alist as
|
|
@var{#:label-values} where the keys are the label names, and the
|
|
values are the values."
|
|
(unless (memq (metric-type metric)
|
|
'(counter gauge))
|
|
(raise-exception
|
|
(make-exception-with-message
|
|
"can only increment counter and gauge metrics")))
|
|
|
|
(unless (positive? by)
|
|
(raise-exception
|
|
(make-exception-with-message "can only increment positive values")))
|
|
|
|
(let ((canonical-labels
|
|
(canonicalise-label-values label-values))
|
|
(hash
|
|
(metric-values metric)))
|
|
(call-with-blocked-asyncs
|
|
(lambda ()
|
|
(with-mutex (metric-mutex metric)
|
|
(hash-set! hash
|
|
canonical-labels
|
|
(+ by
|
|
(or (hash-ref hash canonical-labels)
|
|
0))))))))
|
|
|
|
(define* (metric-decrement metric
|
|
#:key
|
|
(by 1)
|
|
(label-values '()))
|
|
"Decrement the value of the given @var{metric} by 1 (or the @var{#:by} value).
|
|
|
|
This procedure can be used with gauge metrics.
|
|
|
|
To specify values for the labels, pass an alist as
|
|
@var{#:label-values} where the keys are the label names, and the
|
|
values are the values."
|
|
(unless (memq (metric-type metric)
|
|
'(gauge))
|
|
(raise-exception
|
|
(make-exception-with-message "can only increment gauge metrics")))
|
|
|
|
(let ((canonical-labels
|
|
(canonicalise-label-values label-values))
|
|
(hash
|
|
(metric-values metric)))
|
|
(call-with-blocked-asyncs
|
|
(lambda ()
|
|
(with-mutex (metric-mutex metric)
|
|
(hash-set! hash
|
|
canonical-labels
|
|
(+ (* -1 by)
|
|
(or (hash-ref hash canonical-labels)
|
|
0))))))))
|
|
|
|
(define* (metric-set metric value
|
|
#:key (label-values '()))
|
|
"Set the value of the given @var{metric} to @var{value}.
|
|
|
|
This procedure can be used with gauge metrics.
|
|
|
|
To specify values for the labels, pass an alist as
|
|
@var{#:label-values} where the keys are the label names, and the
|
|
values are the values."
|
|
(unless (memq (metric-type metric)
|
|
'(gauge))
|
|
(raise-exception
|
|
(make-exception-with-message "can only set gauge metrics")))
|
|
|
|
(unless (number? value)
|
|
(raise-exception
|
|
(make-exception-with-message
|
|
(simple-format #f "metric-set value must be a number: ~A"
|
|
value))))
|
|
|
|
(call-with-blocked-asyncs
|
|
(lambda ()
|
|
(with-mutex (metric-mutex metric)
|
|
(hash-set! (metric-values metric)
|
|
(canonicalise-label-values label-values)
|
|
value)))))
|
|
|
|
(define* (metric-observe metric value
|
|
#:key (label-values '()))
|
|
"With the given @var{metric}, observe the given @var{value}.
|
|
|
|
This procedure can be used with histogram metrics.
|
|
|
|
To specify values for the labels, pass an alist as
|
|
@var{#:label-values} where the keys are the label names, and the
|
|
values are the values."
|
|
|
|
(unless (histogram-metric-type? (metric-type metric))
|
|
(raise-exception
|
|
(make-exception-with-message
|
|
"can only observe histogram metrics")))
|
|
|
|
(let ((canonical-labels
|
|
(canonicalise-label-values label-values))
|
|
(hash
|
|
(metric-values metric)))
|
|
|
|
(call-with-blocked-asyncs
|
|
(lambda ()
|
|
(with-mutex (metric-mutex metric)
|
|
(let* ((buckets
|
|
(histogram-metric-type-buckets (metric-type metric)))
|
|
(histogram-values-record
|
|
(or (hash-ref hash canonical-labels)
|
|
(let ((new-record (make-histogram-values (make-vector
|
|
(length buckets)
|
|
0)
|
|
0
|
|
0)))
|
|
(hash-set! hash canonical-labels new-record)
|
|
new-record))))
|
|
|
|
(set-histogram-values-sum! histogram-values-record
|
|
(+ value
|
|
(histogram-values-sum
|
|
histogram-values-record)))
|
|
(set-histogram-values-count! histogram-values-record
|
|
(+ 1
|
|
(histogram-values-count
|
|
histogram-values-record)))
|
|
(let ((bucket-values-vector (histogram-values-buckets
|
|
histogram-values-record)))
|
|
(for-each
|
|
(lambda (index bucket-upper-limit)
|
|
(when (<= value bucket-upper-limit)
|
|
(vector-set! bucket-values-vector
|
|
index
|
|
(+ 1
|
|
(vector-ref bucket-values-vector
|
|
index)))))
|
|
(iota (length buckets))
|
|
buckets))))))))
|
|
|
|
(define* (call-with-duration-metric registry metric-name thunk
|
|
#:key
|
|
(buckets %default-histogram-buckets)
|
|
docstring
|
|
(labels '())
|
|
(label-values '())
|
|
(label-preset-values '()))
|
|
"Call @var{thunk} while recording the duration in seconds between
|
|
calling @var{thunk} and the procedure ending using a metric by the
|
|
name of @var{metric-name}.
|
|
|
|
The metric with the name @var{metric-name} is fetched from the
|
|
@var{registry}, or created if it doesn't already exist.
|
|
"
|
|
(let* ((metric
|
|
(or (metrics-registry-fetch-metric registry metric-name)
|
|
(make-histogram-metric
|
|
registry
|
|
metric-name
|
|
#:buckets buckets
|
|
#:docstring docstring
|
|
#:labels labels
|
|
#:label-preset-values label-preset-values)))
|
|
(start-time (get-internal-real-time)))
|
|
(call-with-values
|
|
thunk
|
|
(lambda results
|
|
(metric-observe metric
|
|
(/ (- (get-internal-real-time) start-time)
|
|
internal-time-units-per-second)
|
|
#:label-values label-values)
|
|
|
|
(apply values results)))))
|
|
|
|
(define (write-metrics registry port)
|
|
"Write all metrics from the given @var{registry} to @var{port} in
|
|
the standard text based exposition format.
|
|
|
|
Usually, this would be in response to a HTTP request from Prometheus
|
|
so that it can receive and store the metric values."
|
|
|
|
(define (write-line name label-values value)
|
|
(format
|
|
port
|
|
"~a~a ~f\n"
|
|
name
|
|
(if (null? label-values)
|
|
""
|
|
(string-append
|
|
"{"
|
|
(string-join (map
|
|
(match-lambda
|
|
((label . (? number? value))
|
|
(format
|
|
#f
|
|
"~a=\"~f\""
|
|
label value))
|
|
((label . value)
|
|
(format
|
|
#f
|
|
"~a=\"~a\""
|
|
label value)))
|
|
label-values)
|
|
",")
|
|
"}"))
|
|
value))
|
|
|
|
(hash-for-each
|
|
(lambda (name metric)
|
|
(let ((full-name
|
|
(string-append
|
|
(or (and=> (metrics-registry-namespace registry)
|
|
(lambda (namespace)
|
|
(string-append namespace "_")))
|
|
"")
|
|
name))
|
|
(type (metric-type metric)))
|
|
|
|
(and=> (metric-docstring metric)
|
|
(lambda (docstring)
|
|
(simple-format
|
|
port
|
|
"# HELP ~A ~A\n"
|
|
full-name
|
|
docstring)))
|
|
|
|
(simple-format port "# TYPE ~A ~A\n"
|
|
full-name
|
|
(match type
|
|
((? histogram-metric-type? type) 'histogram)
|
|
(type type)))
|
|
|
|
(cond
|
|
((histogram-metric-type? type)
|
|
(let ((buckets (histogram-metric-type-buckets type)))
|
|
(hash-for-each
|
|
(lambda (label-values value)
|
|
(for-each (lambda (index bucket)
|
|
(write-line (string-append full-name "_bucket")
|
|
`(,@label-values
|
|
(le . ,(if (inf? bucket)
|
|
"+Inf"
|
|
(format #f "~f" bucket))))
|
|
(vector-ref (histogram-values-buckets value)
|
|
index)))
|
|
(iota (length buckets))
|
|
buckets)
|
|
(write-line (string-append full-name "_sum")
|
|
label-values
|
|
(histogram-values-sum value))
|
|
(write-line (string-append full-name "_count")
|
|
label-values
|
|
(histogram-values-count value)))
|
|
(metric-values metric))))
|
|
(else
|
|
(hash-for-each
|
|
(lambda (label-values value)
|
|
(write-line full-name label-values value))
|
|
(metric-values metric))))))
|
|
(metrics-registry-metrics-hash registry)))
|
|
|
|
(define (write-textfile registry filename)
|
|
"Write all metrics from the given @var{registry} to @var{filename}
|
|
in the standard text based exposition format.
|
|
|
|
For the node exporter to read the file, the @var{filename} must end
|
|
with .prom.
|
|
|
|
This procedure takes care of atomically replacing the file."
|
|
(let* ((template (string-append filename ".XXXXXX"))
|
|
(out (mkstemp! template)))
|
|
(with-throw-handler #t
|
|
(lambda ()
|
|
(chmod out(logand #o666 (lognot (umask))))
|
|
(write-metrics registry out)
|
|
(close out)
|
|
(rename-file template filename)
|
|
#t)
|
|
(lambda (key . args)
|
|
(false-if-exception (delete-file template))))))
|
|
|
|
(define (get-gc-metrics-updater registry)
|
|
(define metrics
|
|
`((gc-time-taken
|
|
. ,(make-gauge-metric registry "guile_gc_time_taken_seconds"))
|
|
(heap-size
|
|
. ,(make-gauge-metric registry "guile_heap_bytes"))
|
|
(heap-free-size
|
|
. ,(make-gauge-metric registry "guile_heap_free_bytes"))
|
|
(heap-total-allocated
|
|
. ,(make-gauge-metric registry "guile_heap_total_allocated_bytes"))
|
|
(heap-allocated-since-gc
|
|
. ,(make-gauge-metric registry "guile_allocated_since_gc_bytes"))
|
|
(protected-objects
|
|
. ,(make-gauge-metric registry "guile_gc_protected_objects_total"))
|
|
(gc-times
|
|
. ,(make-gauge-metric registry "guile_gc_times_total"))))
|
|
|
|
(lambda ()
|
|
(let ((stats (gc-stats)))
|
|
(for-each
|
|
(match-lambda
|
|
(('gc-time-taken . metric)
|
|
(metric-set metric
|
|
(/ (assq-ref stats 'gc-time-taken)
|
|
internal-time-units-per-second)))
|
|
((name . metric)
|
|
(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 '("." "..")))))
|
|
'()))))))
|