From mboxrd@z Thu Jan 1 00:00:00 1970 From: Mathieu Othacehe Subject: bug#27007: [PATCH 1/2] bootloader: Use menu-entry to define custom bootloader entries. Date: Wed, 31 May 2017 09:23:27 +0200 Message-ID: <20170531072328.16116-2-m.othacehe@gmail.com> References: <87shjvsquh.fsf@gnu.org> <20170531072328.16116-1-m.othacehe@gmail.com> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:34426) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dFxzD-0003i1-0q for bug-guix@gnu.org; Wed, 31 May 2017 03:24:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dFxz8-0000cj-TS for bug-guix@gnu.org; Wed, 31 May 2017 03:24:07 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:43454) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dFxz8-0000cf-Pk for bug-guix@gnu.org; Wed, 31 May 2017 03:24:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dFxz8-0001yz-KX for bug-guix@gnu.org; Wed, 31 May 2017 03:24:02 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <20170531072328.16116-1-m.othacehe@gmail.com> List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 27007@debbugs.gnu.org * gnu/bootloader.scm (): New variable. Export associated getters, This record is extracted from grub module. * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Use menu-entry->boot-parameters to convert menu-entry records to boot-parameters. * gnu/bootloader/grub.scm (): Remove. (boot-parameters->menu-entry): Remove. (grub-configuration-file): Use boot-parameters to create configuration entries. * gnu/system.scm (menu-entry->boot-parameters): New exported procedure. --- gnu/bootloader.scm | 29 ++++++++++++++++++++- gnu/bootloader/extlinux.scm | 3 ++- gnu/bootloader/grub.scm | 62 +++++++++++++++------------------------------ gnu/system.scm | 14 ++++++++++ 4 files changed, 65 insertions(+), 43 deletions(-) diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 4e77974d3..dfce2e2df 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -23,7 +23,16 @@ #:use-module (guix records) #:use-module (guix ui) #:use-module (srfi srfi-1) - #:export (bootloader + #:export (menu-entry + menu-entry? + menu-entry-label + menu-entry-device + menu-entry-device-mount-point + menu-entry-linux + menu-entry-linux-arguments + menu-entry-initrd + + bootloader bootloader? bootloader-name bootloader-package @@ -50,6 +59,24 @@ ;;; +;;; Menu-entry record. +;;; + +(define-record-type* + menu-entry make-menu-entry + menu-entry? + (label menu-entry-label) + (device menu-entry-device ; file system uuid, label, or #f + (default #f)) + (device-mount-point menu-entry-device-mount-point + (default "/")) + (linux menu-entry-linux) + (linux-arguments menu-entry-linux-arguments + (default '())) ; list of string-valued gexps + (initrd menu-entry-initrd)) ; file name of the initrd as a gexp + + +;;; ;;; Bootloader record. ;;; diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm index 67b8815d4..0a1263aed 100644 --- a/gnu/bootloader/extlinux.scm +++ b/gnu/bootloader/extlinux.scm @@ -37,7 +37,8 @@ corresponding to old generations of the system." (define all-entries - (append entries (bootloader-configuration-menu-entries config))) + (append entries (map menu-entry->boot-parameters + (bootloader-configuration-menu-entries config)))) (define (boot-parameters->gexp params) (let ((label (boot-parameters-label params)) diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 49616b716..2ea2bb69a 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -103,19 +103,6 @@ denoting a file name." (color-highlight '((fg . yellow) (bg . black))) (color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 -(define-record-type* - menu-entry make-menu-entry - menu-entry? - (label menu-entry-label) - (device menu-entry-device ; file system uuid, label, or #f - (default #f)) - (device-mount-point menu-entry-device-mount-point - (default "/")) - (linux menu-entry-linux) - (linux-arguments menu-entry-linux-arguments - (default '())) ; list of string-valued gexps - (initrd menu-entry-initrd)) ; file name of the initrd as a gexp - ;;; ;;; Background image & themes. @@ -312,16 +299,6 @@ code." (#f #~(format #f "search --file --set ~a" #$file))))) -(define (boot-parameters->menu-entry conf) - "Convert a instance to a corresponding ." - (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)))) - (define* (grub-configuration-file config entries #:key (system (%current-system)) @@ -331,33 +308,36 @@ code." STORE-FS, a object. OLD-ENTRIES is taken to be a list of menu entries corresponding to old generations of the system." (define all-entries - (map boot-parameters->menu-entry - (append entries - (bootloader-configuration-menu-entries config)))) - - (define entry->gexp - (match-lambda - (($ label device device-mount-point - linux arguments initrd) + (append entries (map menu-entry->boot-parameters + (bootloader-configuration-menu-entries config)))) + + (define (boot-parameters->gexp params) + (let ((device (boot-parameters-store-device params)) + (device-mount-point (boot-parameters-store-mount-point params)) + (label (boot-parameters-label params)) + (kernel (boot-parameters-kernel params)) + (arguments (boot-parameters-kernel-arguments params)) + (initrd (boot-parameters-initrd params))) ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point. - ;; Use the right file names for LINUX and INITRD in case + ;; 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))) + (let ((kernel (strip-mount-point device-mount-point kernel)) + (initrd (strip-mount-point device-mount-point initrd))) #~(format port "menuentry ~s { ~a linux ~a ~a initrd ~a }~%" #$label - #$(grub-root-search device linux) - #$linux (string-join (list #$@arguments)) - #$initrd))))) + #$(grub-root-search device kernel) + #$kernel (string-join (list #$@arguments)) + #$initrd)))) (mlet %store-monad ((sugar (eye-candy config - (menu-entry-device (first all-entries)) - (menu-entry-device-mount-point + (boot-parameters-store-device + (first all-entries)) + (boot-parameters-store-mount-point (first all-entries)) #:system system #:port #~port))) @@ -374,12 +354,12 @@ set default=~a set timeout=~a~%" #$(bootloader-configuration-default-entry config) #$(bootloader-configuration-timeout config)) - #$@(map entry->gexp all-entries) + #$@(map boot-parameters->gexp all-entries) #$@(if (pair? old-entries) #~((format port " submenu \"GNU system, old configurations...\" {~%") - #$@(map entry->gexp (map boot-parameters->menu-entry old-entries)) + #$@(map boot-parameters->gexp old-entries) (format port "}~%")) #~())))) diff --git a/gnu/system.scm b/gnu/system.scm index 0076f2fcb..96ef06a48 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -112,6 +112,7 @@ boot-parameters-initrd read-boot-parameters read-boot-parameters-file + menu-entry->boot-parameters local-host-aliases %setuid-programs @@ -299,6 +300,19 @@ The object has its kernel-arguments extended in order to make it bootable." system root-device))) #f))) + +(define (menu-entry->boot-parameters menu-entry) + "Convert a instance to a corresponding ." + (boot-parameters + (label (menu-entry-label menu-entry)) + (root-device #f) + (boot-name 'custom) + (store-device (menu-entry-device menu-entry)) + (store-mount-point (menu-entry-device-mount-point menu-entry)) + (kernel (menu-entry-linux menu-entry)) + (kernel-arguments (menu-entry-linux-arguments menu-entry)) + (initrd (menu-entry-initrd menu-entry)))) + ;;; ;;; Services. -- 2.13.0