summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJosselin Poiret <dev@jpoiret.xyz>2022-01-15 14:49:56 +0100
committerMathieu Othacehe <othacehe@gnu.org>2022-02-02 16:46:43 +0100
commit4f2fd33b4f27f590ec2337daef339cf3e2337dab (patch)
treed4f21ad7f267b276a12c367c4111ec41d5038dcb
parent7251b15d302cdc53f26555396b226ad60684ad9c (diff)
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 <othacehe@gnu.org>
-rw-r--r--gnu/installer.scm2
-rw-r--r--gnu/installer/final.scm6
-rw-r--r--gnu/installer/newt.scm2
-rw-r--r--gnu/installer/newt/final.scm4
-rw-r--r--gnu/installer/newt/page.scm13
-rw-r--r--gnu/installer/newt/partition.scm4
-rw-r--r--gnu/installer/parted.scm50
-rw-r--r--gnu/installer/steps.scm2
-rw-r--r--gnu/installer/utils.scm13
9 files changed, 49 insertions, 47 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 134fa2faaff..d0d012f04b2 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -435,7 +435,7 @@ selected keymap."
435 #f))) 435 #f)))
436 (const #f) 436 (const #f)
437 (lambda (key . args) 437 (lambda (key . args)
438 (syslog "crashing due to uncaught exception: ~s ~s~%" 438 (installer-log-line "crashing due to uncaught exception: ~s ~s"
439 key args) 439 key args)
440 (let ((error-file "/tmp/last-installer-error") 440 (let ((error-file "/tmp/last-installer-error")
441 (dump-archive "/tmp/dump.tgz")) 441 (dump-archive "/tmp/dump.tgz"))
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 276af908f71..fbfac1f6926 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -125,15 +125,15 @@ it can interact with the rest of the system."
125 (setlocale LC_ALL locale)))) 125 (setlocale LC_ALL locale))))
126 (if supported? 126 (if supported?
127 (begin 127 (begin
128 (syslog "install supported locale ~a~%." locale) 128 (installer-log-line "install supported locale ~a." locale)
129 (setenv "LC_ALL" locale)) 129 (setenv "LC_ALL" locale))
130 (begin 130 (begin
131 ;; If the selected locale is not supported, install a default UTF-8 131 ;; If the selected locale is not supported, install a default UTF-8
132 ;; locale. This is required to copy some files with UTF-8 132 ;; locale. This is required to copy some files with UTF-8
133 ;; characters, in the nss-certs package notably. Set LANGUAGE 133 ;; characters, in the nss-certs package notably. Set LANGUAGE
134 ;; anyways, to have translated messages if possible. 134 ;; anyways, to have translated messages if possible.
135 (syslog "~a locale is not supported, installating en_US.utf8 \ 135 (installer-log-line "~a locale is not supported, installing \
136locale instead.~%" locale) 136en_US.utf8 locale instead." locale)
137 (setlocale LC_ALL "en_US.utf8") 137 (setlocale LC_ALL "en_US.utf8")
138 (setenv "LC_ALL" "en_US.utf8") 138 (setenv "LC_ALL" "en_US.utf8")
139 (setenv "LANGUAGE" 139 (setenv "LANGUAGE"
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index d48e2c01298..61fb9cf2ca8 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -48,7 +48,7 @@
48 (newt-init) 48 (newt-init)
49 (clear-screen) 49 (clear-screen)
50 (set-screen-size!) 50 (set-screen-size!)
51 (syslog "Display is ~ax~a.~%" (screen-columns) (screen-rows)) 51 (installer-log-line "Display is ~ax~a." (screen-columns) (screen-rows))
52 (push-help-line 52 (push-help-line
53 (format #f (G_ "Press <F1> for installation parameters.")))) 53 (format #f (G_ "Press <F1> for installation parameters."))))
54 54
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 7f6dd9f075c..efe422f4f41 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -109,7 +109,7 @@ a specific step, or restart the installer."))
109(define (run-final-page result prev-steps) 109(define (run-final-page result prev-steps)
110 (define (wait-for-clients) 110 (define (wait-for-clients)
111 (unless (null? (current-clients)) 111 (unless (null? (current-clients))
112 (syslog "waiting with clients before starting final step~%") 112 (installer-log-line "waiting with clients before starting final step")
113 (send-to-clients '(starting-final-step)) 113 (send-to-clients '(starting-final-step))
114 (match (select (current-clients) '() '()) 114 (match (select (current-clients) '() '())
115 (((port _ ...) _ _) 115 (((port _ ...) _ _)
@@ -119,7 +119,7 @@ a specific step, or restart the installer."))
119 ;; things such as changing the swap partition label. 119 ;; things such as changing the swap partition label.
120 (wait-for-clients) 120 (wait-for-clients)
121 121
122 (syslog "proceeding with final step~%") 122 (installer-log-line "proceeding with final step")
123 (let* ((configuration (format-configuration prev-steps result)) 123 (let* ((configuration (format-configuration prev-steps result))
124 (user-partitions (result-step result 'partition)) 124 (user-partitions (result-step result 'partition))
125 (locale (result-step result 'locale)) 125 (locale (result-step result 'locale))
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 4209674c28c..d9901c33a14 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -93,9 +93,9 @@ disconnect.
93Like 'run-form', return two values: the exit reason, and an \"argument\"." 93Like 'run-form', return two values: the exit reason, and an \"argument\"."
94 (define* (discard-client! port #:optional errno) 94 (define* (discard-client! port #:optional errno)
95 (if errno 95 (if errno
96 (syslog "removing client ~d due to ~s~%" 96 (installer-log-line "removing client ~d due to ~s"
97 (fileno port) (strerror errno)) 97 (fileno port) (strerror errno))
98 (syslog "removing client ~d due to EOF~%" 98 (installer-log-line "removing client ~d due to EOF"
99 (fileno port))) 99 (fileno port)))
100 100
101 ;; XXX: Watch out! There's no 'form-unwatch-fd' procedure in Newt so we 101 ;; 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\"."
124 (send-to-clients exp) 124 (send-to-clients exp)
125 125
126 (let loop () 126 (let loop ()
127 (syslog "running form ~s (~s) with ~d clients~%" 127 (installer-log-line "running form ~s (~s) with ~d clients"
128 form title (length (current-clients))) 128 form title (length (current-clients)))
129 129
130 ;; Call 'watch-clients!' within the loop because there might be new 130 ;; 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\"."
146 (discard-client! port) 146 (discard-client! port)
147 (loop)) 147 (loop))
148 (obj 148 (obj
149 (syslog "form ~s (~s): client ~d replied ~s~%" 149 (installer-log-line "form ~s (~s): client ~d replied ~s"
150 form title (fileno port) obj) 150 form title (fileno port) obj)
151 (values 'exit-fd-ready obj)))) 151 (values 'exit-fd-ready obj))))
152 (lambda args 152 (lambda args
@@ -156,8 +156,9 @@ Like 'run-form', return two values: the exit reason, and an \"argument\"."
156 ;; Accept a new client and send it EXP. 156 ;; Accept a new client and send it EXP.
157 (match (accept port) 157 (match (accept port)
158 ((client . _) 158 ((client . _)
159 (syslog "accepting new client ~d while on form ~s~%" 159 (installer-log-line
160 (fileno client) form) 160 "accepting new client ~d while on form ~s"
161 (fileno client) form)
161 (catch 'system-error 162 (catch 'system-error
162 (lambda () 163 (lambda ()
163 (write exp client) 164 (write exp client)
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index ccc7686906d..6a3aa3daff4 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -801,9 +801,9 @@ by pressing the Exit button.~%~%")))
801 ;; Make sure the disks are not in use before proceeding to formatting. 801 ;; Make sure the disks are not in use before proceeding to formatting.
802 (free-parted eligible-devices) 802 (free-parted eligible-devices)
803 (format-user-partitions user-partitions-with-pass) 803 (format-user-partitions user-partitions-with-pass)
804 (syslog "formatted ~a user partitions~%" 804 (installer-log-line "formatted ~a user partitions"
805 (length user-partitions-with-pass)) 805 (length user-partitions-with-pass))
806 (syslog "user-partitions: ~a~%" user-partitions) 806 (installer-log-line "user-partitions: ~a" user-partitions)
807 807
808 (destroy-form-and-pop form) 808 (destroy-form-and-pop form)
809 user-partitions)) 809 user-partitions))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 66e07574c90..ced7a757d7e 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -371,7 +371,8 @@ which are smaller than %MIN-DEVICE-SIZE."
371 (let ((length (device-length device)) 371 (let ((length (device-length device))
372 (sector-size (device-sector-size device))) 372 (sector-size (device-sector-size device)))
373 (and (< (* length sector-size) %min-device-size) 373 (and (< (* length sector-size) %min-device-size)
374 (syslog "~a is not eligible because it is smaller than ~a.~%" 374 (installer-log-line "~a is not eligible because it is smaller than \
375~a."
375 (device-path device) 376 (device-path device)
376 (unit-format-custom-byte device 377 (unit-format-custom-byte device
377 %min-device-size 378 %min-device-size
@@ -391,7 +392,8 @@ which are smaller than %MIN-DEVICE-SIZE."
391 (string=? the-installer-root-partition-path 392 (string=? the-installer-root-partition-path
392 (partition-get-path partition))) 393 (partition-get-path partition)))
393 (disk-partitions disk))))) 394 (disk-partitions disk)))))
394 (syslog "~a is not eligible because it is the installation device.~%" 395 (installer-log-line "~a is not eligible because it is the \
396installation device."
395 (device-path device)))) 397 (device-path device))))
396 398
397 (remove 399 (remove
@@ -817,24 +819,22 @@ cause them to cross."
817 (disk-add-partition disk partition no-constraint))) 819 (disk-add-partition disk partition no-constraint)))
818 (partition-ok? 820 (partition-ok?
819 (or partition-constraint-ok? partition-no-contraint-ok?))) 821 (or partition-constraint-ok? partition-no-contraint-ok?)))
820 (syslog "Creating partition: 822 (installer-log-line "Creating partition:")
821~/type: ~a 823 (installer-log-line "~/type: ~a" partition-type)
822~/filesystem-type: ~a 824 (installer-log-line "~/filesystem-type: ~a"
823~/start: ~a 825 (filesystem-type-name filesystem-type))
824~/end: ~a 826 (installer-log-line "~/start: ~a" start-sector*)
825~/start-range: [~a, ~a] 827 (installer-log-line "~/end: ~a" end-sector)
826~/end-range: [~a, ~a] 828 (installer-log-line "~/start-range: [~a, ~a]"
827~/constraint: ~a 829 (geometry-start start-range)
828~/no-constraint: ~a 830 (geometry-end start-range))
829" 831 (installer-log-line "~/end-range: [~a, ~a]"
830 partition-type 832 (geometry-start end-range)
831 (filesystem-type-name filesystem-type) 833 (geometry-end end-range))
832 start-sector* 834 (installer-log-line "~/constraint: ~a"
833 end-sector 835 partition-constraint-ok?)
834 (geometry-start start-range) (geometry-end start-range) 836 (installer-log-line "~/no-constraint: ~a"
835 (geometry-start end-range) (geometry-end end-range) 837 partition-no-contraint-ok?)
836 partition-constraint-ok?
837 partition-no-contraint-ok?)
838 ;; Set the partition name if supported. 838 ;; Set the partition name if supported.
839 (when (and partition-ok? has-name? name) 839 (when (and partition-ok? has-name? name)
840 (partition-set-name partition name)) 840 (partition-set-name partition name))
@@ -1188,7 +1188,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
1188 (call-with-luks-key-file 1188 (call-with-luks-key-file
1189 password 1189 password
1190 (lambda (key-file) 1190 (lambda (key-file)
1191 (syslog "formatting and opening LUKS entry ~s at ~s~%" 1191 (installer-log-line "formatting and opening LUKS entry ~s at ~s"
1192 label file-name) 1192 label file-name)
1193 (system* "cryptsetup" "-q" "luksFormat" file-name key-file) 1193 (system* "cryptsetup" "-q" "luksFormat" file-name key-file)
1194 (system* "cryptsetup" "open" "--type" "luks" 1194 (system* "cryptsetup" "open" "--type" "luks"
@@ -1197,7 +1197,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
1197(define (luks-close user-partition) 1197(define (luks-close user-partition)
1198 "Close the encrypted partition pointed by USER-PARTITION." 1198 "Close the encrypted partition pointed by USER-PARTITION."
1199 (let ((label (user-partition-crypt-label user-partition))) 1199 (let ((label (user-partition-crypt-label user-partition)))
1200 (syslog "closing LUKS entry ~s~%" label) 1200 (installer-log-line "closing LUKS entry ~s" label)
1201 (system* "cryptsetup" "close" label))) 1201 (system* "cryptsetup" "close" label)))
1202 1202
1203(define (format-user-partitions user-partitions) 1203(define (format-user-partitions user-partitions)
@@ -1279,7 +1279,7 @@ respective mount-points."
1279 (file-name 1279 (file-name
1280 (user-partition-upper-file-name user-partition))) 1280 (user-partition-upper-file-name user-partition)))
1281 (mkdir-p target) 1281 (mkdir-p target)
1282 (syslog "mounting ~s on ~s~%" file-name target) 1282 (installer-log-line "mounting ~s on ~s" file-name target)
1283 (mount file-name target mount-type))) 1283 (mount file-name target mount-type)))
1284 sorted-partitions))) 1284 sorted-partitions)))
1285 1285
@@ -1295,7 +1295,7 @@ respective mount-points."
1295 (target 1295 (target
1296 (string-append (%installer-target-dir) 1296 (string-append (%installer-target-dir)
1297 mount-point))) 1297 mount-point)))
1298 (syslog "unmounting ~s~%" target) 1298 (installer-log-line "unmounting ~s" target)
1299 (umount target) 1299 (umount target)
1300 (when crypt-label 1300 (when crypt-label
1301 (luks-close user-partition)))) 1301 (luks-close user-partition))))
@@ -1486,6 +1486,6 @@ the devices not to be used before returning."
1486 (error 1486 (error
1487 (format #f (G_ "Device ~a is still in use.") 1487 (format #f (G_ "Device ~a is still in use.")
1488 file-name)) 1488 file-name))
1489 (syslog "Syncing ~a took ~a seconds.~%" 1489 (installer-log-line "Syncing ~a took ~a seconds."
1490 file-name (time-second time))))) 1490 file-name (time-second time)))))
1491 device-file-names))) 1491 device-file-names)))
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 55433cff31a..d9b3d6d07ec 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -185,7 +185,7 @@ return the accumalated result so far."
185 #:done-steps '()))))) 185 #:done-steps '())))))
186 ((installer-step-break? c) 186 ((installer-step-break? c)
187 (reverse result))) 187 (reverse result)))
188 (syslog "running step '~a'~%" (installer-step-id step)) 188 (installer-log-line "running step '~a'" (installer-step-id step))
189 (let* ((id (installer-step-id step)) 189 (let* ((id (installer-step-id step))
190 (compute (installer-step-compute step)) 190 (compute (installer-step-compute step))
191 (res (compute result done-steps))) 191 (res (compute result done-steps)))
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index b1b6f8b23ff..74046c9cabd 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -100,13 +100,13 @@ successfully, #f otherwise."
100 (format (current-error-port) 100 (format (current-error-port)
101 (G_ "Command failed with exit code ~a.~%") 101 (G_ "Command failed with exit code ~a.~%")
102 (invoke-error-exit-status c)) 102 (invoke-error-exit-status c))
103 (syslog "command ~s failed with exit code ~a" 103 (installer-log-line "command ~s failed with exit code ~a"
104 command (invoke-error-exit-status c)) 104 command (invoke-error-exit-status c))
105 (pause) 105 (pause)
106 #f)) 106 #f))
107 (syslog "running command ~s~%" command) 107 (installer-log-line "running command ~s" command)
108 (apply invoke command) 108 (apply invoke command)
109 (syslog "command ~s succeeded~%" command) 109 (installer-log-line "command ~s succeeded" command)
110 (newline) 110 (newline)
111 (pause) 111 (pause)
112 #t)) 112 #t))
@@ -259,8 +259,9 @@ accepting socket."
259 (let ((errno (system-error-errno args))) 259 (let ((errno (system-error-errno args)))
260 (if (memv errno (list EPIPE ECONNRESET ECONNABORTED)) 260 (if (memv errno (list EPIPE ECONNRESET ECONNABORTED))
261 (begin 261 (begin
262 (syslog "removing client ~s due to ~s while replying~%" 262 (installer-log-line
263 (fileno client) (strerror errno)) 263 "removing client ~s due to ~s while replying"
264 (fileno client) (strerror errno))
264 (false-if-exception (close-port client)) 265 (false-if-exception (close-port client))
265 remainder) 266 remainder)
266 (cons client remainder)))))) 267 (cons client remainder))))))