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 | ;;; GNU Guix --- Functional package management for GNU | ||||||
| ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | ;;; 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. | ;;; This file is part of GNU Guix. | ||||||
| ;;; | ;;; | ||||||
|  | @ -24,12 +24,16 @@ | ||||||
|   #:use-module (srfi srfi-34) |   #:use-module (srfi srfi-34) | ||||||
|   #:use-module (ice-9 rdelim) |   #:use-module (ice-9 rdelim) | ||||||
|   #:use-module (ice-9 regex) |   #:use-module (ice-9 regex) | ||||||
|  |   #:use-module (ice-9 format) | ||||||
|   #:use-module (ice-9 textual-ports) |   #:use-module (ice-9 textual-ports) | ||||||
|   #:export (read-lines |   #:export (read-lines | ||||||
|             read-all |             read-all | ||||||
|             nearest-exact-integer |             nearest-exact-integer | ||||||
|             read-percentage |             read-percentage | ||||||
|             run-shell-command)) |             run-shell-command | ||||||
|  | 
 | ||||||
|  |             syslog-port | ||||||
|  |             syslog)) | ||||||
| 
 | 
 | ||||||
| (define* (read-lines #:optional (port (current-input-port))) | (define* (read-lines #:optional (port (current-input-port))) | ||||||
|   "Read lines from PORT and return them as a list." |   "Read lines from PORT and return them as a list." | ||||||
|  | @ -91,3 +95,38 @@ COMMAND exited successfully, #f otherwise." | ||||||
|        (newline) |        (newline) | ||||||
|        (pause) |        (pause) | ||||||
|        #t)))) |        #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