From 780327ebb0db74ca4cc43d26ba7cf945d64c7d30 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 21 Oct 2020 10:42:50 +0200 Subject: [PATCH] system: reconfigure: Use the disk-installer if provided. --- gnu/build/bootloader.scm | 4 ++-- gnu/tests/reconfigure.scm | 4 +++- guix/scripts/system/reconfigure.scm | 12 +++++++++--- 3 files changed, 14 insertions(+), 6 deletions(-) diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm index 5ec839f902..06a2c3ab76 100644 --- a/gnu/build/bootloader.scm +++ b/gnu/build/bootloader.scm @@ -39,9 +39,9 @@ (let ((bv (get-bytevector-n input size))) (call-with-port (open-file-output-port device - (file-options no-truncate no-create) + (file-options no-truncate no-fail) (buffer-mode block) - (native-transcoder)) + (make-transcoder (latin-1-codec))) (lambda (output) (seek output offset SEEK_SET) (put-bytevector output bv))))))) diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm index 928a210a94..52beeef447 100644 --- a/gnu/tests/reconfigure.scm +++ b/gnu/tests/reconfigure.scm @@ -260,7 +260,9 @@ bootloader's configuration file." ;; test suite, the bootloader installer script is omitted. 'grub-install' ;; would attempt to write directly to the virtual disk if the ;; 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 (system-test diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index d89caf80fc..b1982b20d2 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -204,7 +204,8 @@ services as defined by OS." ;;; Bootloader configuration. ;;; -(define (install-bootloader-program installer bootloader-package bootcfg +(define (install-bootloader-program installer disk-installer + bootloader-package bootcfg bootcfg-file device target) "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, @@ -246,10 +247,12 @@ BOOTLOADER-PACKAGE." ;; a broken installation. (switch-symlinks new-gc-root #$bootcfg) (install-boot-config #$bootcfg #$bootcfg-file #$target) - (when #$installer + (when (or #$installer #$disk-installer) (catch #t (lambda () - (#$installer #$bootloader-package #$device #$target)) + (if #$installer + (#$installer #$bootloader-package #$device #$target) + (#$disk-installer #$bootloader-package 0 #$device))) (lambda args (delete-file new-gc-root) (match args @@ -272,11 +275,14 @@ additional configurations specified by MENU-ENTRIES can be selected." (let* ((bootloader (bootloader-configuration-bootloader configuration)) (installer (and run-installer? (bootloader-installer bootloader))) + (disk-installer (and run-installer? + (bootloader-disk-image-installer bootloader))) (package (bootloader-package bootloader)) (device (bootloader-configuration-target configuration)) (bootcfg-file (bootloader-configuration-file bootloader))) (eval #~(parameterize ((current-warning-port (%make-void-port "w"))) (primitive-load #$(install-bootloader-program installer + disk-installer package bootcfg bootcfg-file -- 2.28.0