diff options
author | Josselin Poiret <dev@jpoiret.xyz> | 2022-01-15 14:49:55 +0100 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2022-02-02 16:46:43 +0100 |
commit | 7251b15d302cdc53f26555396b226ad60684ad9c (patch) | |
tree | 16e4d50eaab7d497d77414f1cbda054536b2ce58 /gnu/installer/utils.scm | |
parent | 4a68a00c8b86b999510b0cd3aaeb76c064fbcd34 (diff) |
installer: Generalize logging facility.
* gnu/installer/utils.scm (%syslog-line-hook, open-new-log-port,
installer-log-port, %installer-log-line-hook, %display-line-hook,
%default-installer-line-hooks, installer-log-line): Add new
variables.
Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
Diffstat (limited to 'gnu/installer/utils.scm')
-rw-r--r-- | gnu/installer/utils.scm | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 9bd41e2ca0..b1b6f8b23f 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -37,7 +37,12 @@ run-command syslog-port + %syslog-line-hook syslog + installer-log-port + %installer-log-line-hook + %default-installer-line-hooks + installer-log-line call-with-time let/time @@ -142,6 +147,9 @@ values." (set! port (open-syslog-port))) (or port (%make-void-port "w"))))) +(define (%syslog-line-hook line) + (format (syslog-port) "installer[~d]: ~a~%" (getpid) line)) + (define-syntax syslog (lambda (s) "Like 'format', but write to syslog." @@ -152,6 +160,43 @@ values." (syntax->datum #'fmt)))) #'(format (syslog-port) fmt (getpid) args ...)))))) +(define (open-new-log-port) + (define now (localtime (time-second (current-time)))) + (define filename + (format #f "/tmp/installer.~a.log" + (strftime "%F.%T" now))) + (open filename (logior O_RDWR + O_CREAT))) + +(define installer-log-port + (let ((port #f)) + (lambda () + "Return an input and output port to the installer log." + (unless port + (set! port (open-new-log-port))) + port))) + +(define (%installer-log-line-hook line) + (format (installer-log-port) "~a~%" line)) + +(define (%display-line-hook line) + (display line) + (newline)) + +(define %default-installer-line-hooks + (list %syslog-line-hook + %installer-log-line-hook)) + +(define-syntax installer-log-line + (lambda (s) + "Like 'format', but uses the default line hooks, and only formats one line." + (syntax-case s () + ((_ fmt args ...) + (string? (syntax->datum #'fmt)) + #'(let ((formatted (format #f fmt args ...))) + (for-each (lambda (f) (f formatted)) + %default-installer-line-hooks)))))) + ;;; ;;; Client protocol. |