mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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>
This commit is contained in:
Josselin Poiret
Mathieu Othacehe
parent
7251b15d30
commit
4f2fd33b4f
9 changed files with 49 additions and 47 deletions
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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."))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue