me/guix
Archived
1
0
Fork 0
Code Activity

installer: Use new installer-log-line everywhere.

Browse source 
* 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>
This commit is contained in:
Josselin Poiret 2022-01-15 14:49:56 +01:00 • committed by Mathieu Othacehe
parent 7251b15d30
commit 4f2fd33b4f
No known key found for this signature in database
GPG key ID: 8354763531769CA6
9 changed files with 49 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
gnu/installer.scm
View file

@ -435,7 +435,7 @@ selected keymap."
#f))) #f)))
(const #f) (const #f)
(lambda (key . args) (lambda (key . args)
(syslog "crashing due to uncaught exception: ~s ~s~%" (installer-log-line "crashing due to uncaught exception: ~s ~s"
key args) key args)
(let ((error-file "/tmp/last-installer-error") (let ((error-file "/tmp/last-installer-error")
(dump-archive "/tmp/dump.tgz")) (dump-archive "/tmp/dump.tgz"))

6
gnu/installer/final.scm
View file

@ -125,15 +125,15 @@ it can interact with the rest of the system."
(setlocale LC_ALL locale)))) (setlocale LC_ALL locale))))
(if supported? (if supported?
(begin (begin
(syslog "install supported locale ~a~%." locale) (installer-log-line "install supported locale ~a." locale)
(setenv "LC_ALL" locale)) (setenv "LC_ALL" locale))
(begin (begin
;; If the selected locale is not supported, install a default UTF-8 ;; If the selected locale is not supported, install a default UTF-8
;; locale. This is required to copy some files with UTF-8 ;; locale. This is required to copy some files with UTF-8
;; characters, in the nss-certs package notably. Set LANGUAGE ;; characters, in the nss-certs package notably. Set LANGUAGE
;; anyways, to have translated messages if possible. ;; anyways, to have translated messages if possible.
(syslog "~a locale is not supported, installating en_US.utf8 \ (installer-log-line "~a locale is not supported, installing \
locale instead.~%" locale) en_US.utf8 locale instead." locale)
(setlocale LC_ALL "en_US.utf8") (setlocale LC_ALL "en_US.utf8")
(setenv "LC_ALL" "en_US.utf8") (setenv "LC_ALL" "en_US.utf8")
(setenv "LANGUAGE" (setenv "LANGUAGE"

2
gnu/installer/newt.scm
View file

@ -48,7 +48,7 @@
(newt-init) (newt-init)
(clear-screen) (clear-screen)
(set-screen-size!) (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 (push-help-line
(format #f (G_ "Press <F1> for installation parameters.")))) (format #f (G_ "Press <F1> for installation parameters."))))

4
gnu/installer/newt/final.scm
View file

@ -109,7 +109,7 @@ a specific step, or restart the installer."))
(define (run-final-page result prev-steps) (define (run-final-page result prev-steps)
(define (wait-for-clients) (define (wait-for-clients)
(unless (null? (current-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)) (send-to-clients '(starting-final-step))
(match (select (current-clients) '() '()) (match (select (current-clients) '() '())
(((port _ ...) _ _) (((port _ ...) _ _)
@ -119,7 +119,7 @@ a specific step, or restart the installer."))
;; things such as changing the swap partition label. ;; things such as changing the swap partition label.
(wait-for-clients) (wait-for-clients)
(syslog "proceeding with final step~%") (installer-log-line "proceeding with final step")
(let* ((configuration (format-configuration prev-steps result)) (let* ((configuration (format-configuration prev-steps result))
(user-partitions (result-step result 'partition)) (user-partitions (result-step result 'partition))
(locale (result-step result 'locale)) (locale (result-step result 'locale))

11
gnu/installer/newt/page.scm
View file

@ -93,9 +93,9 @@ disconnect.
Like 'run-form', return two values: the exit reason, and an \"argument\"." Like 'run-form', return two values: the exit reason, and an \"argument\"."
(define* (discard-client! port #:optional errno) (define* (discard-client! port #:optional errno)
(if errno (if errno
(syslog "removing client ~d due to ~s~%" (installer-log-line "removing client ~d due to ~s"
(fileno port) (strerror errno)) (fileno port) (strerror errno))
(syslog "removing client ~d due to EOF~%" (installer-log-line "removing client ~d due to EOF"
(fileno port))) (fileno port)))
;; XXX: Watch out! There's no 'form-unwatch-fd' procedure in Newt so we ;; 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) (send-to-clients exp)
(let loop () (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))) form title (length (current-clients)))
;; Call 'watch-clients!' within the loop because there might be new ;; 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) (discard-client! port)
(loop)) (loop))
(obj (obj
(syslog "form ~s (~s): client ~d replied ~s~%" (installer-log-line "form ~s (~s): client ~d replied ~s"
form title (fileno port) obj) form title (fileno port) obj)
(values 'exit-fd-ready obj)))) (values 'exit-fd-ready obj))))
(lambda args (lambda args
@ -156,7 +156,8 @@ Like 'run-form', return two values: the exit reason, and an \"argument\"."
;; Accept a new client and send it EXP. ;; Accept a new client and send it EXP.
(match (accept port) (match (accept port)
((client . _) ((client . _)
(syslog "accepting new client ~d while on form ~s~%" (installer-log-line
"accepting new client ~d while on form ~s"
(fileno client) form) (fileno client) form)
(catch 'system-error (catch 'system-error
(lambda () (lambda ()

4
gnu/installer/newt/partition.scm
View file

@ -801,9 +801,9 @@ by pressing the Exit button.~%~%")))
;; Make sure the disks are not in use before proceeding to formatting. ;; Make sure the disks are not in use before proceeding to formatting.
(free-parted eligible-devices) (free-parted eligible-devices)
(format-user-partitions user-partitions-with-pass) (format-user-partitions user-partitions-with-pass)
(syslog "formatted ~a user partitions~%" (installer-log-line "formatted ~a user partitions"
(length user-partitions-with-pass)) (length user-partitions-with-pass))
(syslog "user-partitions: ~a~%" user-partitions) (installer-log-line "user-partitions: ~a" user-partitions)
(destroy-form-and-pop form) (destroy-form-and-pop form)
user-partitions)) user-partitions))

48
gnu/installer/parted.scm
View file

@ -371,7 +371,8 @@ which are smaller than %MIN-DEVICE-SIZE."
(let ((length (device-length device)) (let ((length (device-length device))
(sector-size (device-sector-size device))) (sector-size (device-sector-size device)))
(and (< (* length sector-size) %min-device-size) (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) (device-path device)
(unit-format-custom-byte device (unit-format-custom-byte device
%min-device-size %min-device-size
@ -391,7 +392,8 @@ which are smaller than %MIN-DEVICE-SIZE."
(string=? the-installer-root-partition-path (string=? the-installer-root-partition-path
(partition-get-path partition))) (partition-get-path partition)))
(disk-partitions disk))))) (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)))) (device-path device))))
(remove (remove
@ -817,23 +819,21 @@ cause them to cross."
(disk-add-partition disk partition no-constraint))) (disk-add-partition disk partition no-constraint)))
(partition-ok? (partition-ok?
(or partition-constraint-ok? partition-no-contraint-ok?))) (or partition-constraint-ok? partition-no-contraint-ok?)))
(syslog "Creating partition: (installer-log-line "Creating partition:")
~/type: ~a (installer-log-line "~/type: ~a" partition-type)
~/filesystem-type: ~a (installer-log-line "~/filesystem-type: ~a"
~/start: ~a (filesystem-type-name filesystem-type))
~/end: ~a (installer-log-line "~/start: ~a" start-sector*)
~/start-range: [~a, ~a] (installer-log-line "~/end: ~a" end-sector)
~/end-range: [~a, ~a] (installer-log-line "~/start-range: [~a, ~a]"
~/constraint: ~a (geometry-start start-range)
~/no-constraint: ~a (geometry-end start-range))
" (installer-log-line "~/end-range: [~a, ~a]"
partition-type (geometry-start end-range)
(filesystem-type-name filesystem-type) (geometry-end end-range))
start-sector* (installer-log-line "~/constraint: ~a"
end-sector partition-constraint-ok?)
(geometry-start start-range) (geometry-end start-range) (installer-log-line "~/no-constraint: ~a"
(geometry-start end-range) (geometry-end end-range)
partition-constraint-ok?
partition-no-contraint-ok?) partition-no-contraint-ok?)
;; Set the partition name if supported. ;; Set the partition name if supported.
(when (and partition-ok? has-name? name) (when (and partition-ok? has-name? name)
@ -1188,7 +1188,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
(call-with-luks-key-file (call-with-luks-key-file
password password
(lambda (key-file) (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) label file-name)
(system* "cryptsetup" "-q" "luksFormat" file-name key-file) (system* "cryptsetup" "-q" "luksFormat" file-name key-file)
(system* "cryptsetup" "open" "--type" "luks" (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) (define (luks-close user-partition)
"Close the encrypted partition pointed by USER-PARTITION." "Close the encrypted partition pointed by USER-PARTITION."
(let ((label (user-partition-crypt-label 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))) (system* "cryptsetup" "close" label)))
(define (format-user-partitions user-partitions) (define (format-user-partitions user-partitions)
@ -1279,7 +1279,7 @@ respective mount-points."
(file-name (file-name
(user-partition-upper-file-name user-partition))) (user-partition-upper-file-name user-partition)))
(mkdir-p target) (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))) (mount file-name target mount-type)))
sorted-partitions))) sorted-partitions)))
@ -1295,7 +1295,7 @@ respective mount-points."
(target (target
(string-append (%installer-target-dir) (string-append (%installer-target-dir)
mount-point))) mount-point)))
(syslog "unmounting ~s~%" target) (installer-log-line "unmounting ~s" target)
(umount target) (umount target)
(when crypt-label (when crypt-label
(luks-close user-partition)))) (luks-close user-partition))))
@ -1486,6 +1486,6 @@ the devices not to be used before returning."
(error (error
(format #f (G_ "Device ~a is still in use.") (format #f (G_ "Device ~a is still in use.")
file-name)) file-name))
(syslog "Syncing ~a took ~a seconds.~%" (installer-log-line "Syncing ~a took ~a seconds."
file-name (time-second time))))) file-name (time-second time)))))
device-file-names))) device-file-names)))

2
gnu/installer/steps.scm
View file

@ -185,7 +185,7 @@ return the accumalated result so far."
#:done-steps '()))))) #:done-steps '())))))
((installer-step-break? c) ((installer-step-break? c)
(reverse result))) (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)) (let* ((id (installer-step-id step))
(compute (installer-step-compute step)) (compute (installer-step-compute step))
(res (compute result done-steps))) (res (compute result done-steps)))

9
gnu/installer/utils.scm
View file

@ -100,13 +100,13 @@ successfully, #f otherwise."
(format (current-error-port) (format (current-error-port)
(G_ "Command failed with exit code ~a.~%") (G_ "Command failed with exit code ~a.~%")
(invoke-error-exit-status c)) (invoke-error-exit-status c))
(syslog "command ~s failed with exit code ~a" (installer-log-line "command ~s failed with exit code ~a"
command (invoke-error-exit-status c)) command (invoke-error-exit-status c))
(pause) (pause)
#f)) #f))
(syslog "running command ~s~%" command) (installer-log-line "running command ~s" command)
(apply invoke command) (apply invoke command)
(syslog "command ~s succeeded~%" command) (installer-log-line "command ~s succeeded" command)
(newline) (newline)
(pause) (pause)
#t)) #t))
@ -259,7 +259,8 @@ accepting socket."
(let ((errno (system-error-errno args))) (let ((errno (system-error-errno args)))
(if (memv errno (list EPIPE ECONNRESET ECONNABORTED)) (if (memv errno (list EPIPE ECONNRESET ECONNABORTED))
(begin (begin
(syslog "removing client ~s due to ~s while replying~%" (installer-log-line
"removing client ~s due to ~s while replying"
(fileno client) (strerror errno)) (fileno client) (strerror errno))
(false-if-exception (close-port client)) (false-if-exception (close-port client))
remainder) remainder)