installer: Add 'syslog' macro to write to syslog.
* gnu/installer/utils.scm (open-syslog-port, syslog-port): New procedures. (syslog): New macro.
This commit is contained in:
		
							parent
							
								
									b6ec284fe8
								
							
						
					
					
						commit
						2cf65e1d54
					
				
					 1 changed files with 41 additions and 2 deletions
				
			
		|  | @ -1,6 +1,6 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | ||||
| ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | ||||
| ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> | ||||
| ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> | ||||
| ;;; | ||||
| ;;; 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 ...)))))) | ||||
|  |  | |||
		Reference in a new issue