cuirass: Log resource usage statistics regularly.

* src/cuirass/logging.scm (log-monitoring-stats): New procedure.
* bin/cuirass.in (main): Add a fiber that calls it regularly.
This commit is contained in:
Ludovic Courtès 2018-01-29 12:17:20 +01:00
parent fcd1bc13bc
commit 23fecf8f3d
2 changed files with 22 additions and 1 deletions

View File

@ -142,6 +142,14 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(run-cuirass-server db #:host host #:port port))))
#:parallel? #t)
(spawn-fiber
(essential-task
'monitor exit-channel
(lambda ()
(while #t
(log-monitoring-stats)
(sleep 600)))))
(primitive-exit (get-message exit-channel))))))
;; Most of our code is I/O so preemption doesn't matter much (it

View File

@ -19,10 +19,13 @@
(define-module (cuirass logging)
#:use-module (srfi srfi-19)
#:use-module (ice-9 format)
#:use-module (ice-9 threads)
#:use-module (ice-9 ftw)
#:export (current-logging-port
current-logging-procedure
log-message
with-time-logging))
with-time-logging
log-monitoring-stats))
(define current-logging-port
(make-parameter (current-error-port)))
@ -61,3 +64,13 @@
(define-syntax-rule (with-time-logging name exp ...)
"Log under NAME the time taken to evaluate EXP."
(call-with-time-logging name (lambda () exp ...)))
(define (log-monitoring-stats)
"Log info about useful metrics: heap size, number of threads, etc."
(log-message "heap: ~,2f MiB; threads: ~a; file descriptors: ~a"
(/ (assoc-ref (gc-stats) 'heap-size) (expt 2. 20))
(length (all-threads))
(length
(scandir "/proc/self/fd"
(lambda (file)
(not (member file '("." ".."))))))))