04/24: image: Add Hurd support.

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit 0c6b5ab20fd76675c80a0dfb267b0269517a4259
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sat May 23 19:10:44 2020 +0200

    image: Add Hurd support.
    
    * gnu/system/image.scm (hurd-disk-image): New exported variable,
    (root-offset, root-label): new variables,
    (esp-partition, root-partition): adapt accordingly,
    (find-image): add Hurd support.
---
 gnu/build/image.scm  |  5 +++++
 gnu/system/image.scm | 40 +++++++++++++++++++++++++++++++++++-----
 2 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 14503b0..fb85bd4 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -161,6 +161,8 @@ deduplicates files common to CLOSURE and the rest of 
PREFIX."
                                     references-graphs
                                     (register-closures? #t)
                                     system-directory
+                                    (make-device-nodes
+                                     make-essential-device-nodes)
                                     #:allow-other-keys)
   "Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
 install the bootloader configuration.
@@ -172,6 +174,9 @@ of the directory of the 'system' derivation."
   (populate-root-file-system system-directory root)
   (populate-store references-graphs root)
 
+  ;; Populate /dev.
+  (make-device-nodes root)
+
   (when register-closures?
     (for-each (lambda (closure)
                 (register-closure root
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index f44886c..15dac8a 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -43,6 +43,7 @@
   #:use-module (gnu packages genimage)
   #:use-module (gnu packages guile)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
+  #:use-module (gnu packages hurd)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages mtools)
   #:use-module ((srfi srfi-1) #:prefix srfi-1:)
@@ -54,6 +55,7 @@
   #:export (esp-partition
             root-partition
 
+            hurd-disk-image
             efi-disk-image
             iso9660-image
 
@@ -91,6 +93,26 @@
    (flags '(boot))
    (initializer (gexp initialize-root-partition))))
 
+(define hurd-initialize-root-partition
+  #~(lambda* (#:rest args)
+      (apply initialize-root-partition
+             (append args
+                     (list #:make-device-nodes
+                           make-hurd-device-nodes)))))
+
+(define hurd-disk-image
+  (image
+   (format 'disk-image)
+   (partitions
+    (list (partition
+           (size 'guess)
+           (offset root-offset)
+           (label root-label)
+           (file-system "ext2")
+           (file-system-options '("-o" "hurd" "-O" "ext_attr"))
+           (flags '(boot))
+           (initializer hurd-initialize-root-partition))))))
+
 (define efi-disk-image
   (image
    (format 'disk-image)
@@ -145,12 +167,14 @@
     (with-imported-modules `(,@(source-module-closure
                                 '((gnu build vm)
                                   (gnu build image)
+                                  (gnu build linux-boot)
                                   (guix store database))
                                 #:select? not-config?)
                              ((guix config) => ,(make-config.scm)))
       #~(begin
           (use-modules (gnu build vm)
                        (gnu build image)
+                       (gnu build linux-boot)
                        (guix store database)
                        (guix build utils))
           gexp* ...))))
@@ -525,10 +549,16 @@ image, depending on IMAGE format."
   "Find and return an image that could match the given FILE-SYSTEM-TYPE.  This
 is useful to adapt to interfaces written before the addition of the <image>
 record."
-  (mbegin %store-monad
-    (return
-     (match file-system-type
-       ("iso9660" iso9660-image)
-       (_ efi-disk-image)))))
+  (mlet %store-monad ((target (current-target-system)))
+    (mbegin %store-monad
+      (return
+       (match file-system-type
+         ("iso9660" iso9660-image)
+         (_ (cond
+             ((and target
+                   (hurd-triplet? target))
+              hurd-disk-image)
+             (else
+              efi-disk-image))))))))
 
 ;;; image.scm ends here