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(-) (limited to 'gnu/installer/utils.scm') 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 1.4.1 From 5c04b00cf463a543b8ffc9eb55991f6b4cc145dd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Feb 2020 12:08:40 +0100 Subject: installer: Log important bits to syslog. * gnu/installer.scm (installer-program): Log crashes with 'syslog'. * gnu/installer/parted.scm (luks-format-and-open, luks-close) (mount-user-partitions, umount-user-partitions): Add 'syslog' calls. * gnu/installer/steps.scm (run-installer-steps): Log the running step with 'syslog'. * gnu/installer/utils.scm (run-shell-command): Add calls to 'syslog'. --- gnu/installer.scm | 5 ++++- gnu/installer/parted.scm | 7 ++++++- gnu/installer/steps.scm | 1 + gnu/installer/utils.scm | 4 ++++ 4 files changed, 15 insertions(+), 2 deletions(-) (limited to 'gnu/installer/utils.scm') diff --git a/gnu/installer.scm b/gnu/installer.scm index 3f4ae4bf53..edef3fde62 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2020 Mathieu Othacehe -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. @@ -26,6 +26,7 @@ #:use-module (guix utils) #:use-module (guix ui) #:use-module ((guix self) #:select (make-config.scm)) + #:use-module (gnu installer utils) #:use-module (gnu packages admin) #:use-module (gnu packages base) #:use-module (gnu packages bash) @@ -395,6 +396,8 @@ selected keymap." #f))) (const #f) (lambda (key . args) + (syslog "crashing due to uncaught exception: ~s ~s~%" + key args) (let ((error-file "/tmp/last-installer-error")) (call-with-output-file error-file (lambda (port) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index c2b02c9281..6c805cc053 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2019 Mathieu Othacehe -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; Copyright © 2020 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. @@ -1070,6 +1070,8 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise." (call-with-luks-key-file password (lambda (key-file) + (syslog "formatting and opening LUKS entry ~s at ~s~%" + label file-name) (system* "cryptsetup" "-q" "luksFormat" file-name key-file) (system* "cryptsetup" "open" "--type" "luks" "--key-file" key-file file-name label))))) @@ -1077,6 +1079,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise." (define (luks-close user-partition) "Close the encrypted partition pointed by USER-PARTITION." (let ((label (user-partition-crypt-label user-partition))) + (syslog "closing LUKS entry ~s~%" label) (system* "cryptsetup" "close" label))) (define (format-user-partitions user-partitions) @@ -1150,6 +1153,7 @@ respective mount-points." (file-name (user-partition-upper-file-name user-partition))) (mkdir-p target) + (syslog "mounting ~s on ~s~%" file-name target) (mount file-name target mount-type))) sorted-partitions))) @@ -1165,6 +1169,7 @@ respective mount-points." (target (string-append (%installer-target-dir) mount-point))) + (syslog "unmounting ~s~%" target) (umount target) (when crypt-label (luks-close user-partition)))) diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index 4e90f32f95..b2fc819d89 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -177,6 +177,7 @@ return the accumalated result so far." #:done-steps '()))))) ((installer-step-break? c) (reverse result))) + (syslog "running step '~a'~%" (installer-step-id step)) (let* ((id (installer-step-id step)) (compute (installer-step-compute step)) (res (compute result done-steps))) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index a5f390e7a2..842bd02ced 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -89,9 +89,13 @@ COMMAND exited successfully, #f otherwise." (format (current-error-port) (G_ "Command failed with exit code ~a.~%") (invoke-error-exit-status c)) + (syslog "command ~s failed with exit code ~a" + command (invoke-error-exit-status c)) (pause) #f)) + (syslog "running command ~s~%" command) (invoke "bash" "--init-file" file) + (syslog "command ~s succeeded~%" command) (newline) (pause) #t)))) -- cgit 1.4.1