mirror/guix
mirror/guix
1
Fork 0
mirror of https://https.git.savannah.gnu.org/git/guix.git/ synced 2025-07-14 19:10:49 +02:00
Code Releases Activity

system: reconfigure: Use the disk-installer if provided.

Browse source 
Fixes: <https://issues.guix.gnu.org/44101>.

* gnu/build/bootloader.scm (write-file-on-device): Pass 'no-fail flag instead
of 'no-create. Use a latin-1 transcoder.
* guix/scripts/system/reconfigure.scm (install-bootloader-program): Add a
"disk-installer" argument and use it as a fallback.
(install-bootloader): Adapt accordingly.
* gnu/tests/reconfigure.scm (run-install-bootloader-test): Ditto.
This commit is contained in:
Mathieu Othacehe 2020-10-21 10:42:50 +02:00
parent 25e811583f
commit a38d861e57
No known key found for this signature in database
GPG key ID: 8354763531769CA6
3 changed files with 22 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

7
gnu/build/bootloader.scm
View file

@ -38,10 +38,13 @@
(lambda (input) (lambda (input)
(let ((bv (get-bytevector-n input size))) (let ((bv (get-bytevector-n input size)))
(call-with-port (call-with-port
;; Do not use "call-with-output-file" that would truncate the file.
(open-file-output-port device (open-file-output-port device
(file-options no-truncate no-create) (file-options no-truncate no-fail)
(buffer-mode block) (buffer-mode block)
(native-transcoder)) ;; Use the binary-friendly ISO-8859-1
;; encoding.
(make-transcoder (latin-1-codec)))
(lambda (output) (lambda (output)
(seek output offset SEEK_SET) (seek output offset SEEK_SET)
(put-bytevector output bv))))))) (put-bytevector output bv)))))))

4
gnu/tests/reconfigure.scm
View file

@ -260,7 +260,9 @@ bootloader's configuration file."
;; test suite, the bootloader installer script is omitted. 'grub-install' ;; test suite, the bootloader installer script is omitted. 'grub-install'
;; would attempt to write directly to the virtual disk if the ;; would attempt to write directly to the virtual disk if the
;; installation script were run. ;; installation script were run.
(test (install-bootloader-program #f #f bootcfg bootcfg-file #f "/"))))) (test
(install-bootloader-program #f #f #f bootcfg bootcfg-file #f "/")))))
(define %test-switch-to-system (define %test-switch-to-system
(system-test (system-test

17
guix/scripts/system/reconfigure.scm
View file

@ -204,7 +204,8 @@ services as defined by OS."
;;; Bootloader configuration. ;;; Bootloader configuration.
;;; ;;;
(define (install-bootloader-program installer bootloader-package bootcfg (define (install-bootloader-program installer disk-installer
bootloader-package bootcfg
bootcfg-file device target) bootcfg-file device target)
"Return an executable store item that, upon being evaluated, will install "Return an executable store item that, upon being evaluated, will install
BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system device, BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system device,
@ -246,10 +247,17 @@ BOOTLOADER-PACKAGE."
;; a broken installation. ;; a broken installation.
(switch-symlinks new-gc-root #$bootcfg) (switch-symlinks new-gc-root #$bootcfg)
(install-boot-config #$bootcfg #$bootcfg-file #$target) (install-boot-config #$bootcfg #$bootcfg-file #$target)
(when #$installer (when (or #$installer #$disk-installer)
(catch #t (catch #t
(lambda () (lambda ()
(#$installer #$bootloader-package #$device #$target)) ;; The bootloader might not support installation on a
;; mounted directory using the BOOTLOADER-INSTALLER
;; procedure. In that case, fallback to installing the
;; bootloader directly on DEVICE using the
;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
(if #$installer
(#$installer #$bootloader-package #$device #$target)
(#$disk-installer #$bootloader-package 0 #$device)))
(lambda args (lambda args
(delete-file new-gc-root) (delete-file new-gc-root)
(match args (match args
@ -272,11 +280,14 @@ additional configurations specified by MENU-ENTRIES can be selected."
(let* ((bootloader (bootloader-configuration-bootloader configuration)) (let* ((bootloader (bootloader-configuration-bootloader configuration))
(installer (and run-installer? (installer (and run-installer?
(bootloader-installer bootloader))) (bootloader-installer bootloader)))
(disk-installer (and run-installer?
(bootloader-disk-image-installer bootloader)))
(package (bootloader-package bootloader)) (package (bootloader-package bootloader))
(device (bootloader-configuration-target configuration)) (device (bootloader-configuration-target configuration))
(bootcfg-file (bootloader-configuration-file bootloader))) (bootcfg-file (bootloader-configuration-file bootloader)))
(eval #~(parameterize ((current-warning-port (%make-void-port "w"))) (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
(primitive-load #$(install-bootloader-program installer (primitive-load #$(install-bootloader-program installer
disk-installer
package package
bootcfg bootcfg
bootcfg-file bootcfg-file