10/16: bootloader: grub: Add support for '<hurd-menu-entry>'.

[guix-commits]

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

commit cddfcb70855667390731adc8cd026a74d5433613
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Sun May 10 13:24:48 2020 +0200

    bootloader: grub: Add support for '<hurd-menu-entry>'.
    
    * gnu/bootloader/grub.scm (grub-configuration-file): Add support for
    <hurd-menu-entry> and switch between entries of type <menu-entry> and
    <hurd-menu-entry>.
---
 gnu/bootloader/grub.scm | 81 ++++++++++++++++++++++++++++++++++---------------
 1 file changed, 57 insertions(+), 24 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 3f61b4a..169e89f 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -30,6 +30,7 @@
   #:use-module (gnu system uuid)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system keyboard)
+  #:use-module (gnu packages base)
   #:use-module (gnu packages bootloaders)
   #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
   #:autoload   (gnu packages xorg) (xkeyboard-config)
@@ -331,33 +332,65 @@ entries corresponding to old generations of the system."
   (define all-entries
     (append entries (bootloader-configuration-menu-entries config)))
   (define (menu-entry->gexp entry)
-    (let ((device (menu-entry-device entry))
-          (device-mount-point (menu-entry-device-mount-point entry))
-          (label (menu-entry-label entry))
-          (kernel (menu-entry-linux entry))
-          (arguments (menu-entry-linux-arguments entry))
-          (initrd (menu-entry-initrd entry)))
-      ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
-      ;; Use the right file names for KERNEL and INITRD in case
-      ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
-      ;; separate partition.
-      (let ((kernel  (strip-mount-point device-mount-point kernel))
-            (initrd  (strip-mount-point device-mount-point initrd)))
-        #~(format port "menuentry ~s {
+    (match entry
+      ((? menu-entry?)
+       (let ((device (menu-entry-device entry))
+             (device-mount-point (menu-entry-device-mount-point entry))
+             (label (menu-entry-label entry))
+             (linux (menu-entry-linux entry))
+             (arguments (menu-entry-linux-arguments entry))
+             (initrd (menu-entry-initrd entry)))
+         ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
+         ;; Use the right file names for KERNEL and INITRD in case
+         ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
+         ;; separate partition.
+         (let ((linux  (strip-mount-point device-mount-point linux))
+               (initrd  (strip-mount-point device-mount-point initrd)))
+           #~(format port "menuentry ~s {
   ~a
   linux ~a ~a
   initrd ~a
 }~%"
-                  #$label
-                  #$(grub-root-search device kernel)
-                  #$kernel (string-join (list #$@arguments))
-                  #$initrd))))
-  (define sugar
-    (eye-candy config
-               (menu-entry-device (first all-entries))
-               (menu-entry-device-mount-point (first all-entries))
-               #:system system
-               #:port #~port))
+                     #$label
+                     #$(grub-root-search device linux)
+                     #$linux (string-join (list #$@arguments))
+                     #$initrd))))
+      ((? hurd-menu-entry?)
+       (let ((device (hurd-menu-entry-device entry))
+             (device-mount-point (hurd-menu-entry-device-mount-point entry))
+             (label (hurd-menu-entry-label entry))
+             (mach (hurd-menu-entry-mach entry))
+             (hurd (hurd-menu-entry-hurd entry))
+             (libc glibc))
+         #~(format port "
+menuentry ~s {
+  multiboot ~a root=device:hd0s1
+  module ~a/hurd/ext2fs.static ext2fs \\
+    --multiboot-command-line='${kernel-command-line}' \\
+    --host-priv-port='${host-port}' \\
+    --device-master-port='${device-port}' \\
+    --exec-server-task='${exec-task}' -T typed '${root}' \\
+    '$(task-create)' '$(task-resume)'
+  module ~a/lib/ld.so.1 exec ~a/hurd/exec '$(exec-task=task-create)'
+}~%"
+                   #$label
+                   #$mach #$hurd
+                   #$libc #$hurd)))))
+
+  (define (sugar)
+    (let* ((entry (first all-entries))
+           (hurd? (hurd-menu-entry? entry))
+           (device ((if hurd? hurd-menu-entry-device menu-entry-device)
+                    entry))
+           (mount-point ((if hurd?
+                             hurd-menu-entry-device-mount-point
+                             menu-entry-device-mount-point)
+                         entry)))
+      (eye-candy config
+                 device
+                 mount-point
+                 #:system system
+                 #:port #~port)))
 
   (define keyboard-layout-config
     (let ((layout (bootloader-configuration-keyboard-layout config))
@@ -377,7 +410,7 @@ keymap ~a~%" keymap)))))
                   "# This file was generated from your Guix configuration.  
Any changes
 # will be lost upon reconfiguration.
 ")
-          #$sugar
+          #$(sugar)
           #$keyboard-layout-config
           (format port "
 set default=~a