From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id OBktJ37+2F7BUwAA0tVLHw (envelope-from ) for ; Thu, 04 Jun 2020 14:00:30 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id EBECI37+2F4ILQAAB5/wlQ (envelope-from ) for ; Thu, 04 Jun 2020 14:00:30 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 4B300940ED3 for ; Thu, 4 Jun 2020 14:00:17 +0000 (UTC) Received: from localhost ([::1]:41542 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jgqPm-0001QN-Q6 for larch@yhetil.org; Thu, 04 Jun 2020 10:00:14 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:35254) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jgqPb-0001Ng-Qo for bug-guix@gnu.org; Thu, 04 Jun 2020 10:00:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35602) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jgqPb-00025K-GE for bug-guix@gnu.org; Thu, 04 Jun 2020 10:00:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jgqPb-0004Yc-Es for bug-guix@gnu.org; Thu, 04 Jun 2020 10:00:03 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#41541: [PATCH 3/8] system: Add 'multiboot-modules' field to . Resent-From: "Jan (janneke) Nieuwenhuizen" Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Thu, 04 Jun 2020 14:00:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41541 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: 41541@debbugs.gnu.org Received: via spool by 41541-submit@debbugs.gnu.org id=B41541.159127917317381 (code B ref 41541); Thu, 04 Jun 2020 14:00:03 +0000 Received: (at 41541) by debbugs.gnu.org; 4 Jun 2020 13:59:33 +0000 Received: from localhost ([127.0.0.1]:47134 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jgqP7-0004WA-3B for submit@debbugs.gnu.org; Thu, 04 Jun 2020 09:59:33 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50562) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jgqP2-0004V4-Io for 41541@debbugs.gnu.org; Thu, 04 Jun 2020 09:59:29 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:33094) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jgqOx-0001v7-9D; Thu, 04 Jun 2020 09:59:23 -0400 Received: from [2001:980:1b4f:1:42d2:832d:bb59:862] (port=43728 helo=dundal.fritz.box) by fencepost.gnu.org with esmtpa (Exim 4.82) (envelope-from ) id 1jgqOw-0000GG-1I; Thu, 04 Jun 2020 09:59:22 -0400 From: "Jan (janneke) Nieuwenhuizen" Date: Thu, 4 Jun 2020 15:59:09 +0200 Message-Id: <20200604135914.4499-4-janneke@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200604135914.4499-1-janneke@gnu.org> References: <20200604135914.4499-1-janneke@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -3.3 (---) X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Spam-Score: 3.99 X-TUID: a/v6tZP9z8W1 * gnu/system.scm ()[multiboot-modules]: New field. (read-boot-parameters): Initialize it. (operating-system-multiboot-modules, hurd-multiboot-modules): New procedure. (operating-system-boot-parameters): Cater for multiboot the Hurd and initialize it; avoid initrd in that case. (operating-system-kernel-file): Cater for for Gnumach (the Hurd) besides Linux. (boot-parameters->menu-entry): Use it to support a multiboot . --- gnu/system.scm | 92 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 73 insertions(+), 19 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index 43dd2ec598..a96a6e6f2c 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -39,9 +39,11 @@ #:use-module (guix utils) #:use-module (gnu packages base) #:use-module (gnu packages bash) + #:use-module (gnu packages cross-base) #:use-module (gnu packages guile) #:use-module (gnu packages guile-xyz) #:use-module (gnu packages admin) + #:use-module (gnu packages hurd) #:use-module (gnu packages linux) #:use-module (gnu packages pciutils) #:use-module (gnu packages package-management) @@ -142,6 +144,7 @@ boot-parameters-kernel boot-parameters-kernel-arguments boot-parameters-initrd + boot-parameters-multiboot-modules read-boot-parameters read-boot-parameters-file boot-parameters->menu-entry @@ -283,7 +286,8 @@ directly by the user." (store-mount-point boot-parameters-store-mount-point) (kernel boot-parameters-kernel) (kernel-arguments boot-parameters-kernel-arguments) - (initrd boot-parameters-initrd)) + (initrd boot-parameters-initrd) + (multiboot-modules boot-parameters-multiboot-modules)) (define (ensure-not-/dev device) "If DEVICE starts with a slash, return #f. This is meant to filter out @@ -314,7 +318,7 @@ file system labels." (match (read port) (('boot-parameters ('version 0) ('label label) ('root-device root) - ('kernel linux) + ('kernel kernel) rest ...) (boot-parameters (label label) @@ -330,12 +334,12 @@ file system labels." ((_ entries) (map sexp->menu-entry entries)) (#f '()))) - ;; In the past, we would store the directory name of the kernel instead - ;; of the absolute file name of its image. Detect that and correct it. - (kernel (if (string=? linux (direct-store-path linux)) - (string-append linux "/" + ;; In the past, we would store the directory name of linux instead of + ;; the absolute file name of its image. Detect that and correct it. + (kernel (if (string=? kernel (direct-store-path kernel)) + (string-append kernel "/" (system-linux-image-file-name)) - linux)) + kernel)) (kernel-arguments (match (assq 'kernel-arguments rest) @@ -349,6 +353,8 @@ file system labels." (('initrd (? string? file)) file))) + (multiboot-modules (or (assq 'multiboot-modules rest) '())) + (store-device ;; Linux device names like "/dev/sda1" are not suitable GRUB device ;; identifiers, so we just filter them out. @@ -386,14 +392,25 @@ The object has its kernel-arguments extended in order to make it bootable." (boot-parameters-kernel-arguments params)))))) (define (boot-parameters->menu-entry conf) - (menu-entry - (label (boot-parameters-label conf)) - (device (boot-parameters-store-device conf)) - (device-mount-point (boot-parameters-store-mount-point conf)) - (linux (boot-parameters-kernel conf)) - (linux-arguments (boot-parameters-kernel-arguments conf)) - (initrd (boot-parameters-initrd conf)))) - + (let* ((kernel (boot-parameters-kernel conf)) + (multiboot-modules (boot-parameters-multiboot-modules conf)) + (multiboot? (pair? multiboot-modules))) + (menu-entry + (label (boot-parameters-label conf)) + (device (boot-parameters-store-device conf)) + (device-mount-point (boot-parameters-store-mount-point conf)) + (linux (and (not multiboot?) kernel)) + (linux-arguments (if (not multiboot?) ' + (boot-parameters-kernel-arguments conf) + '())) + (initrd (boot-parameters-initrd conf)) + (multiboot-kernel (and multiboot? kernel)) + (multiboot-arguments (if multiboot? + (boot-parameters-kernel-arguments conf) + '())) + (multiboot-modules (if multiboot? + (boot-parameters-multiboot-modules conf) + '()))))) ;;; @@ -485,8 +502,17 @@ from the initrd." (define (operating-system-kernel-file os) "Return an object representing the absolute file name of the kernel image of OS." - (file-append (operating-system-kernel os) - "/" (system-linux-image-file-name))) + (if (operating-system-hurd os) + (let* ((mach (operating-system-kernel os)) + (mach (if (%current-target-system) + ;; A cross-built GNUmach does not work + (with-parameters ((%current-system "i686-linux") + (%current-target-system #f)) + mach) + mach))) + (file-append mach "/boot/gnumach")) + (file-append (operating-system-kernel os) + "/" (system-linux-image-file-name)))) (define (package-for-kernel target-kernel module-package) "Return a package like MODULE-PACKAGE, adapted for TARGET-KERNEL, if @@ -1131,17 +1157,44 @@ a list of , to populate the \"old entries\" menu." #:store-directory-prefix (btrfs-store-subvolume-file-name file-systems)))) +(define (operating-system-multiboot-modules os) + (if (operating-system-hurd os) (hurd-multiboot-modules os) '())) + +(define (hurd-multiboot-modules os) + (let* ((hurd (operating-system-hurd os)) + (root-file-system-command + (list (file-append hurd "/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" + "--x-xattr-translator-records" + "'${root}'" "'$(task-create)'" "'$(task-resume)'")) + (target (%current-target-system)) + (libc (if target + (with-parameters ((%current-target-system #f)) + (cross-libc target)) + glibc)) + (exec-server-command + (list (file-append libc "/lib/ld.so.1") "exec" + (file-append hurd "/hurd/exec") "'$(exec-task=task-create)'"))) + (list root-file-system-command exec-server-command))) + (define* (operating-system-boot-parameters os root-device #:key system-kernel-arguments?) "Return a monadic record that describes the boot parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments such as '--root' and '--load' to ." - (let* ((initrd (operating-system-initrd-file os)) + (let* ((initrd (and (not (hurd-target?)) + (operating-system-initrd-file os))) (store (operating-system-store-file-system os)) (bootloader (bootloader-configuration-bootloader (operating-system-bootloader os))) (bootloader-name (bootloader-name bootloader)) - (label (operating-system-label os))) + (label (operating-system-label os)) + (multiboot-modules (operating-system-multiboot-modules os))) (boot-parameters (label label) (root-device root-device) @@ -1151,6 +1204,7 @@ such as '--root' and '--load' to ." (operating-system-kernel-arguments os root-device) (operating-system-user-kernel-arguments os))) (initrd initrd) + (multiboot-modules multiboot-modules) (bootloader-name bootloader-name) (bootloader-menu-entries (bootloader-configuration-menu-entries (operating-system-bootloader os))) -- 2.26.2