[bug#53063] [PATCH wip-harden-installer 03/14] installer: Use new installer-log-line everywhere.

[Josselin Poiret via Guix-patches via <guix-patches@gnu.org>]

* 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.
---
 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 @@ (define results
                    #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 @@ (define (install-locale locale)
                      (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 @@ (define (init)
   (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 <F1> 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 @@ (define* (run-install-shell locale
 (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 @@ (define (wait-for-clients)
   ;; 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 @@ (define* (run-form-with-clients form exp)
 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 @@ (define title
   (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 @@ (define title
                        (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 @@ (define title
                 ;; 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 @@ (define (run-page devices)
     ;; 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 @@ (define (small-device? device)
     (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 @@ (define (installation-device? device)
                            (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 @@ (define* (extend-ranges! start-range end-range
                    (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 @@ (define (luks-format-and-open user-partition)
     (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 @@ (define (luks-format-and-open user-partition)
 (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 @@ (define (mount-user-partitions user-partitions)
                        (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 @@ (define (umount-user-partitions user-partitions)
                        (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 @@ (define (free-parted devices)
                       (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 @@ (define* (run result #:key todo-steps done-steps)
                               #: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 @@ (define (pause)
              (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 @@ (define remainder
                 (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))))))
-- 
2.34.0