From 2cf65e1d543407bc7db43e7c7d39a215907efebc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Feb 2020 18:23:19 +0100 Subject: installer: Add 'syslog' macro to write to syslog. * gnu/installer/utils.scm (open-syslog-port, syslog-port): New procedures. (syslog): New macro. --- gnu/installer/utils.scm | 43 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 41 insertions(+), 2 deletions(-) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index ddb96bc338..a5f390e7a2 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,12 +24,16 @@ #:use-module (srfi srfi-34) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) + #:use-module (ice-9 format) #:use-module (ice-9 textual-ports) #:export (read-lines read-all nearest-exact-integer read-percentage - run-shell-command)) + run-shell-command + + syslog-port + syslog)) (define* (read-lines #:optional (port (current-input-port))) "Read lines from PORT and return them as a list." @@ -91,3 +95,38 @@ COMMAND exited successfully, #f otherwise." (newline) (pause) #t)))) + + +;;; +;;; Logging. +;;; + +(define (open-syslog-port) + "Return an open port (a socket) to /dev/log or #f if that wasn't possible." + (let ((sock (socket AF_UNIX SOCK_DGRAM 0))) + (catch 'system-error + (lambda () + (connect sock AF_UNIX "/dev/log") + (setvbuf sock 'line) + sock) + (lambda args + (close-port sock) + #f)))) + +(define syslog-port + (let ((port #f)) + (lambda () + "Return an output port to syslog." + (unless port + (set! port (open-syslog-port))) + (or port (%make-void-port "w"))))) + +(define-syntax syslog + (lambda (s) + "Like 'format', but write to syslog." + (syntax-case s () + ((_ fmt args ...) + (string? (syntax->datum #'fmt)) + (with-syntax ((fmt (string-append "installer[~d]: " + (syntax->datum #'fmt)))) + #'(format (syslog-port) fmt (getpid) args ...)))))) -- cgit v1.2.3