From 4f2fd33b4f27f590ec2337daef339cf3e2337dab Mon Sep 17 00:00:00 2001 From: Josselin Poiret Date: Sat, 15 Jan 2022 14:49:56 +0100 Subject: installer: Use new installer-log-line everywhere. * gnu/installer.scm (installer-program) * gnu/installer/final.scm (install-locale) * gnu/installer/newt.scm (init) * gnu/installer/newt/final.scm (run-final-page) * gnu/installer/newt/page.scm (run-form-with-clients) * gnu/installer/newt/partition.scm (run-partitioning-page) * gnu/installer/parted.scm (eligible-devices, mkpart, luks-format-and-open, luks-close, mount-user-partitions, umount-user-partitions, free-parted): * gnu/installer/steps.scm (run-installer-steps): * gnu/installer/utils.scm (run-command, send-to-clients): Use it. Signed-off-by: Mathieu Othacehe --- gnu/installer.scm | 2 +- gnu/installer/final.scm | 6 ++--- gnu/installer/newt.scm | 2 +- gnu/installer/newt/final.scm | 4 ++-- gnu/installer/newt/page.scm | 13 ++++++----- gnu/installer/newt/partition.scm | 4 ++-- gnu/installer/parted.scm | 50 ++++++++++++++++++++-------------------- gnu/installer/steps.scm | 2 +- gnu/installer/utils.scm | 13 ++++++----- 9 files changed, 49 insertions(+), 47 deletions(-) diff --git a/gnu/installer.scm b/gnu/installer.scm index 134fa2faaf..d0d012f04b 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -435,7 +435,7 @@ selected keymap." #f))) (const #f) (lambda (key . args) - (syslog "crashing due to uncaught exception: ~s ~s~%" + (installer-log-line "crashing due to uncaught exception: ~s ~s" key args) (let ((error-file "/tmp/last-installer-error") (dump-archive "/tmp/dump.tgz")) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index 276af908f7..fbfac1f692 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -125,15 +125,15 @@ it can interact with the rest of the system." (setlocale LC_ALL locale)))) (if supported? (begin - (syslog "install supported locale ~a~%." locale) + (installer-log-line "install supported locale ~a." locale) (setenv "LC_ALL" locale)) (begin ;; If the selected locale is not supported, install a default UTF-8 ;; locale. This is required to copy some files with UTF-8 ;; characters, in the nss-certs package notably. Set LANGUAGE ;; anyways, to have translated messages if possible. - (syslog "~a locale is not supported, installating en_US.utf8 \ -locale instead.~%" locale) + (installer-log-line "~a locale is not supported, installing \ +en_US.utf8 locale instead." locale) (setlocale LC_ALL "en_US.utf8") (setenv "LC_ALL" "en_US.utf8") (setenv "LANGUAGE" diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index d48e2c0129..61fb9cf2ca 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -48,7 +48,7 @@ (newt-init) (clear-screen) (set-screen-size!) - (syslog "Display is ~ax~a.~%" (screen-columns) (screen-rows)) + (installer-log-line "Display is ~ax~a." (screen-columns) (screen-rows)) (push-help-line (format #f (G_ "Press for installation parameters.")))) diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm index 7f6dd9f075..efe422f4f4 100644 --- a/gnu/installer/newt/final.scm +++ b/gnu/installer/newt/final.scm @@ -109,7 +109,7 @@ a specific step, or restart the installer.")) (define (run-final-page result prev-steps) (define (wait-for-clients) (unless (null? (current-clients)) - (syslog "waiting with clients before starting final step~%") + (installer-log-line "waiting with clients before starting final step") (send-to-clients '(starting-final-step)) (match (select (current-clients) '() '()) (((port _ ...) _ _) @@ -119,7 +119,7 @@ a specific step, or restart the installer.")) ;; things such as changing the swap partition label. (wait-for-clients) - (syslog "proceeding with final step~%") + (installer-log-line "proceeding with final step") (let* ((configuration (format-configuration prev-steps result)) (user-partitions (result-step result 'partition)) (locale (result-step result 'locale)) diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 4209674c28..d9901c33a1 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -93,9 +93,9 @@ disconnect. Like 'run-form', return two values: the exit reason, and an \"argument\"." (define* (discard-client! port #:optional errno) (if errno - (syslog "removing client ~d due to ~s~%" + (installer-log-line "removing client ~d due to ~s" (fileno port) (strerror errno)) - (syslog "removing client ~d due to EOF~%" + (installer-log-line "removing client ~d due to EOF" (fileno port))) ;; XXX: Watch out! There's no 'form-unwatch-fd' procedure in Newt so we @@ -124,7 +124,7 @@ Like 'run-form', return two values: the exit reason, and an \"argument\"." (send-to-clients exp) (let loop () - (syslog "running form ~s (~s) with ~d clients~%" + (installer-log-line "running form ~s (~s) with ~d clients" form title (length (current-clients))) ;; Call 'watch-clients!' within the loop because there might be new @@ -146,7 +146,7 @@ Like 'run-form', return two values: the exit reason, and an \"argument\"." (discard-client! port) (loop)) (obj - (syslog "form ~s (~s): client ~d replied ~s~%" + (installer-log-line "form ~s (~s): client ~d replied ~s" form title (fileno port) obj) (values 'exit-fd-ready obj)))) (lambda args @@ -156,8 +156,9 @@ Like 'run-form', return two values: the exit reason, and an \"argument\"." ;; Accept a new client and send it EXP. (match (accept port) ((client . _) - (syslog "accepting new client ~d while on form ~s~%" - (fileno client) form) + (installer-log-line + "accepting new client ~d while on form ~s" + (fileno client) form) (catch 'system-error (lambda () (write exp client) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index ccc7686906..6a3aa3daff 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -801,9 +801,9 @@ by pressing the Exit button.~%~%"))) ;; Make sure the disks are not in use before proceeding to formatting. (free-parted eligible-devices) (format-user-partitions user-partitions-with-pass) - (syslog "formatted ~a user partitions~%" + (installer-log-line "formatted ~a user partitions" (length user-partitions-with-pass)) - (syslog "user-partitions: ~a~%" user-partitions) + (installer-log-line "user-partitions: ~a" user-partitions) (destroy-form-and-pop form) user-partitions)) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 66e07574c9..ced7a757d7 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -371,7 +371,8 @@ which are smaller than %MIN-DEVICE-SIZE." (let ((length (device-length device)) (sector-size (device-sector-size device))) (and (< (* length sector-size) %min-device-size) - (syslog "~a is not eligible because it is smaller than ~a.~%" + (installer-log-line "~a is not eligible because it is smaller than \ +~a." (device-path device) (unit-format-custom-byte device %min-device-size @@ -391,7 +392,8 @@ which are smaller than %MIN-DEVICE-SIZE." (string=? the-installer-root-partition-path (partition-get-path partition))) (disk-partitions disk))))) - (syslog "~a is not eligible because it is the installation device.~%" + (installer-log-line "~a is not eligible because it is the \ +installation device." (device-path device)))) (remove @@ -817,24 +819,22 @@ cause them to cross." (disk-add-partition disk partition no-constraint))) (partition-ok? (or partition-constraint-ok? partition-no-contraint-ok?))) - (syslog "Creating partition: -~/type: ~a -~/filesystem-type: ~a -~/start: ~a -~/end: ~a -~/start-range: [~a, ~a] -~/end-range: [~a, ~a] -~/constraint: ~a -~/no-constraint: ~a -" - partition-type - (filesystem-type-name filesystem-type) - start-sector* - end-sector - (geometry-start start-range) (geometry-end start-range) - (geometry-start end-range) (geometry-end end-range) - partition-constraint-ok? - partition-no-contraint-ok?) + (installer-log-line "Creating partition:") + (installer-log-line "~/type: ~a" partition-type) + (installer-log-line "~/filesystem-type: ~a" + (filesystem-type-name filesystem-type)) + (installer-log-line "~/start: ~a" start-sector*) + (installer-log-line "~/end: ~a" end-sector) + (installer-log-line "~/start-range: [~a, ~a]" + (geometry-start start-range) + (geometry-end start-range)) + (installer-log-line "~/end-range: [~a, ~a]" + (geometry-start end-range) + (geometry-end end-range)) + (installer-log-line "~/constraint: ~a" + partition-constraint-ok?) + (installer-log-line "~/no-constraint: ~a" + partition-no-contraint-ok?) ;; Set the partition name if supported. (when (and partition-ok? has-name? name) (partition-set-name partition name)) @@ -1188,7 +1188,7 @@ 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~%" + (installer-log-line "formatting and opening LUKS entry ~s at ~s" label file-name) (system* "cryptsetup" "-q" "luksFormat" file-name key-file) (system* "cryptsetup" "open" "--type" "luks" @@ -1197,7 +1197,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) + (installer-log-line "closing LUKS entry ~s" label) (system* "cryptsetup" "close" label))) (define (format-user-partitions user-partitions) @@ -1279,7 +1279,7 @@ respective mount-points." (file-name (user-partition-upper-file-name user-partition))) (mkdir-p target) - (syslog "mounting ~s on ~s~%" file-name target) + (installer-log-line "mounting ~s on ~s" file-name target) (mount file-name target mount-type))) sorted-partitions))) @@ -1295,7 +1295,7 @@ respective mount-points." (target (string-append (%installer-target-dir) mount-point))) - (syslog "unmounting ~s~%" target) + (installer-log-line "unmounting ~s" target) (umount target) (when crypt-label (luks-close user-partition)))) @@ -1486,6 +1486,6 @@ the devices not to be used before returning." (error (format #f (G_ "Device ~a is still in use.") file-name)) - (syslog "Syncing ~a took ~a seconds.~%" + (installer-log-line "Syncing ~a took ~a seconds." file-name (time-second time))))) device-file-names))) diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index 55433cff31..d9b3d6d07e 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -185,7 +185,7 @@ return the accumalated result so far." #:done-steps '()))))) ((installer-step-break? c) (reverse result))) - (syslog "running step '~a'~%" (installer-step-id step)) + (installer-log-line "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 b1b6f8b23f..74046c9cab 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -100,13 +100,13 @@ 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)) + (installer-log-line "command ~s failed with exit code ~a" + command (invoke-error-exit-status c)) (pause) #f)) - (syslog "running command ~s~%" command) + (installer-log-line "running command ~s" command) (apply invoke command) - (syslog "command ~s succeeded~%" command) + (installer-log-line "command ~s succeeded" command) (newline) (pause) #t)) @@ -259,8 +259,9 @@ accepting socket." (let ((errno (system-error-errno args))) (if (memv errno (list EPIPE ECONNRESET ECONNABORTED)) (begin - (syslog "removing client ~s due to ~s while replying~%" - (fileno client) (strerror errno)) + (installer-log-line + "removing client ~s due to ~s while replying" + (fileno client) (strerror errno)) (false-if-exception (close-port client)) remainder) (cons client remainder)))))) -- cgit v1.2.3