ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-12 22:26:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

installer: Generalize logging facility.

Browse source 
* 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>
This commit is contained in:
Josselin Poiret 2022-01-15 14:49:55 +01:00 committed by Mathieu Othacehe
parent 4a68a00c8b
commit 7251b15d30
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 45 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
gnu/installer/utils.scm
View file

@ -37,7 +37,12 @@ (define-module (gnu installer utils)
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 @@ (define syslog-port
(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 @@ (define-syntax syslog
(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.