Toggle quote (88 lines)
>> From 780327ebb0db74ca4cc43d26ba7cf945d64c7d30 Mon Sep 17 00:00:00 2001
>> From: Mathieu Othacehe <othacehe@gnu.org>
>> 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