bug#44101: Unable to use /dev/disk/by-id/ symlinks with u-boot and guix system reconfigure

[Mathieu Othacehe]

Hello,

>> ice-9/boot-9.scm:1669:16: In procedure raise-exception:
>> ERROR:
>>   1. &i/o-filename: "/dev/disk/by-id/mmc-SDU64_0xbaf3002e"
>
> Thanks for testing. This is probably a regression in
> "write-file-on-device" that fails to open this kind of files. I'll try
> to reproduce it locally.

This is because the O_EXCL flag was passed, which causes open to fail if
the block device is mounted.

The revised patch attached should fix it.

Thanks,

Mathieu

>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