diff options
| author | Josselin Poiret <dev@jpoiret.xyz> | 2022-01-15 14:49:56 +0100 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2022-02-02 16:46:43 +0100 |
| commit | 4f2fd33b4f27f590ec2337daef339cf3e2337dab (patch) | |
| tree | d4f21ad7f267b276a12c367c4111ec41d5038dcb | |
| parent | 7251b15d302cdc53f26555396b226ad60684ad9c (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.scm | 2 | ||||
| -rw-r--r-- | gnu/installer/final.scm | 6 | ||||
| -rw-r--r-- | gnu/installer/newt.scm | 2 | ||||
| -rw-r--r-- | gnu/installer/newt/final.scm | 4 | ||||
| -rw-r--r-- | gnu/installer/newt/page.scm | 13 | ||||
| -rw-r--r-- | gnu/installer/newt/partition.scm | 4 | ||||
| -rw-r--r-- | gnu/installer/parted.scm | 50 | ||||
| -rw-r--r-- | gnu/installer/steps.scm | 2 | ||||
| -rw-r--r-- | gnu/installer/utils.scm | 13 |
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 \ |
| 136 | locale instead.~%" locale) | 136 | en_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. | |||
| 93 | Like 'run-form', return two values: the exit reason, and an \"argument\"." | 93 | Like '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 \ |
| 396 | installation 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)))))) |
