[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
09/24: bootloader: grub: Add support for '<hurd-menu-entry>'.
From: |
guix-commits |
Subject: |
09/24: bootloader: grub: Add support for '<hurd-menu-entry>'. |
Date: |
Sun, 17 May 2020 06:00:51 -0400 (EDT) |
janneke pushed a commit to branch wip-hurd-vm
in repository guix.
commit 50343b8c545bd0fd1905c90895797ff1f211801a
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 | 92 ++++++++++++++++++++++++++++++++++++-------------
1 file changed, 68 insertions(+), 24 deletions(-)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 842592c..894e0dc 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -25,12 +25,15 @@
#:use-module (guix records)
#:use-module ((guix utils) #:select (%current-system))
#:use-module (guix gexp)
+ #:use-module (guix utils)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
#: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)
+ #:use-module (gnu packages cross-base)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages xorg) (xkeyboard-config)
#:use-module (ice-9 match)
@@ -331,33 +334,74 @@ 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))
+ (target (%current-target-system))
+ (hurd (hurd-menu-entry-hurd entry))
+ (mach (if target
+ (with-parameters ((%current-system "i686-linux"))
+ mach)
+ mach))
+ (libc (if target
+ (with-parameters ((%current-target-system #f))
+ (cross-libc target))
+ 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}' \\
+ --store-type=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 +421,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
- branch wip-hurd-vm created (now e4e1876), guix-commits, 2020/05/17
- 01/24: utils: Move 'reset-timestamps' out of database., guix-commits, 2020/05/17
- 02/24: system: vm: Do not register-closures when cross-building., guix-commits, 2020/05/17
- 03/24: system: vm: Build vm-image using native qemu., guix-commits, 2020/05/17
- 05/24: system: hurd: Add hurd-default-essential-services., guix-commits, 2020/05/17
- 11/24: system: Use 'hurd' package in label., guix-commits, 2020/05/17
- 08/24: system: Add 'hurd' field to <boot-parameters>., guix-commits, 2020/05/17
- 16/24: gnu: hurd: Create minimal "runsystem" script to invoke "rc"., guix-commits, 2020/05/17
- 07/24: bootloader: Add `<hurd-menu-entry>'., guix-commits, 2020/05/17
- 09/24: bootloader: grub: Add support for '<hurd-menu-entry>'.,
guix-commits <=
- 13/24: services: hurd: Add `hurd-etc-service'., guix-commits, 2020/05/17
- 12/24: system: examples: Add bare-hurd.tmpl., guix-commits, 2020/05/17
- 14/24: system: Add `hurd-activation'., guix-commits, 2020/05/17
- 17/24: services: Add `hurd-console-service-type'., guix-commits, 2020/05/17
- 18/24: services: Add `hurd-getty-service-type'., guix-commits, 2020/05/17
- 19/24: system: hurd: Populate services., guix-commits, 2020/05/17
- 20/24: DRAFT: system: vm: Activate the Hurd., guix-commits, 2020/05/17
- 21/24: system: bare-hurd.tmpl: Add openssh client and service., guix-commits, 2020/05/17
- 22/24: gnu: linux-libre: Add support for gnu.* namespace., guix-commits, 2020/05/17
- 23/24: gnu: hurd: Update to upstream Hurd-reserved xattr index., guix-commits, 2020/05/17