branch wip-disk-image updated: system: image: Fix bootloader field.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch wip-disk-image
in repository guix.

The following commit(s) were added to refs/heads/wip-disk-image by this push:
     new 19fe743  system: image: Fix bootloader field.
19fe743 is described below

commit 19fe7436f00cc7d2864006ce13b8a8aae8e532a0
Author: Mathieu Othacehe <address@hidden>
AuthorDate: Fri Apr 24 19:28:27 2020 +0200

    system: image: Fix bootloader field.
---
 gnu/system/image.scm | 86 +++++++++++++++++++++++++++-------------------------
 1 file changed, 44 insertions(+), 42 deletions(-)

diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 64b5ce2..467506b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -177,6 +177,46 @@
          ((member 'esp flags) "0xEF")
          (else "0x83"))))
 
+    (define (partition-image partition)
+      (let* ((os (image-operating-system image))
+             (schema (local-file (search-path %load-path
+                                              "guix/store/schema.sql")))
+             (graph (match inputs
+                      (((names . _) ...)
+                       names)))
+             (root-builder
+              (with-imported-modules*
+               (let* ((initializer #$(partition-initializer partition)))
+                 (sql-schema #$schema)
+
+                 ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be
+                 ;; decoded.
+                 (setenv "GUIX_LOCPATH"
+                         #+(file-append glibc-utf8-locales "/lib/locale"))
+                 (setlocale LC_ALL "en_US.utf8")
+
+                 (initializer #$output
+                              #:references-graphs '#$graph
+                              #:deduplicate? #f
+                              #:system-directory #$os
+                              #:bootloader-package
+                              #$(bootloader-package bootloader)
+                              #:bootcfg #$bootcfg
+                              #:bootcfg-location
+                              #$(bootloader-configuration-file bootloader)))))
+             (image-root
+              (computed-file "partition-image-root" root-builder
+                             #:options `(#:references-graphs ,inputs)))
+             (type (partition-file-system partition))
+             (image-builder
+              (with-imported-modules*
+               (let ((inputs '#$(list e2fsprogs dosfstools mtools)))
+                 (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+                 (make-partition-image #$(partition->gexp partition)
+                                       #$output
+                                       #$image-root)))))
+        (computed-file "partition.img" image-builder)))
+
     (define (partition->config partition)
       (let ((label (partition-label partition))
             (dos-type (partition->dos-type partition))
@@ -203,44 +243,6 @@ image ~a {
 }~%" #$genimage-name #$image-type (list #$@partitions-config))))))))
       (computed-file "genimage.cfg" builder)))
 
-  (define (partition-image partition)
-    (let* ((os (image-operating-system image))
-           (schema (local-file (search-path %load-path
-                                            "guix/store/schema.sql")))
-           (graph (match inputs
-                    (((names . _) ...)
-                     names)))
-           (root-builder
-            (with-imported-modules*
-             (let* ((initializer #$(partition-initializer partition)))
-               (sql-schema #$schema)
-
-               ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded.
-               (setenv "GUIX_LOCPATH"
-                       #+(file-append glibc-utf8-locales "/lib/locale"))
-               (setlocale LC_ALL "en_US.utf8")
-
-               (initializer #$output
-                            #:references-graphs '#$graph
-                            #:deduplicate? #f
-                            #:system-directory #$os
-                            #:bootloader-package #$bootloader
-                            #:bootcfg #$bootcfg
-                            #:bootcfg-location
-                            #$(bootloader-configuration-file bootloader)))))
-           (image-root
-            (computed-file "partition-image-root" root-builder
-                           #:options `(#:references-graphs ,inputs)))
-           (type (partition-file-system partition))
-           (image-builder
-            (with-imported-modules*
-             (let ((inputs '#$(list e2fsprogs dosfstools mtools)))
-               (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-               (make-partition-image #$(partition->gexp partition)
-                                     #$output
-                                     #$image-root)))))
-      (computed-file "partition.img" image-builder)))
-
   (let* ((builder
           (with-imported-modules*
            (let ((inputs '#$(list genimage coreutils findutils)))
@@ -275,6 +277,7 @@ image ~a {
                                (grub-mkrescue-environment '())
                                (substitutable? #t))
   (let* ((os (image-operating-system image))
+         (bootloader (bootloader-package bootloader))
          (schema (local-file (search-path %load-path
                                           "guix/store/schema.sql")))
          (graph (match inputs
@@ -326,7 +329,7 @@ image ~a {
   (define (find-root-partition)
     (let ((partitions (image-partitions image)))
       (find (lambda (partition)
-              (member (partition-flags partition) 'boot))
+              (member 'boot (partition-flags partition)))
             partitions)))
 
   (let ((format (image-format image)))
@@ -379,9 +382,8 @@ image ~a {
          (image* (image-with-os image os))
          (register-closures? (has-guix-service-type? os))
          (bootcfg (operating-system-bootcfg os))
-         (bootloader (bootloader-package
-                      (bootloader-configuration-bootloader
-                       (operating-system-bootloader os)))))
+         (bootloader (bootloader-configuration-bootloader
+                      (operating-system-bootloader os))))
     (case (image-format image)
       ((disk-image)
        (system-disk-image image*