From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:39318) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d71rN-0005AZ-Hr for guix-patches@gnu.org; Sat, 06 May 2017 11:43:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d71rK-0000EG-Cr for guix-patches@gnu.org; Sat, 06 May 2017 11:43:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:60205) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d71rK-0000E8-92 for guix-patches@gnu.org; Sat, 06 May 2017 11:43:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d71rK-0002cX-3B for guix-patches@gnu.org; Sat, 06 May 2017 11:43:02 -0400 Subject: bug#26339: [PATCH v3 1/9] system: Add extlinux support. Resent-Message-ID: From: Mathieu Othacehe Date: Sat, 6 May 2017 17:41:46 +0200 Message-Id: <20170506154154.17836-2-m.othacehe@gmail.com> In-Reply-To: <20170506154154.17836-1-m.othacehe@gmail.com> References: <20170506154154.17836-1-m.othacehe@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 26339@debbugs.gnu.org * gnu/system.scm (operating-system): Add default bootloader. (operating-system-grub.cfg): Use bootloader-configuration-file-generator. * gnu/system/grub.scm (bootloader-configuration->grub-configuration): New variable. (grub-configuration-file): Use bootloader-configuration->grub-configuration. * guix/scripts/system.scm (profile-grub-entries): Rename system->grub-entry to system->boot-parameters and adjust accordingly. (perform-action): Make bootloader optional. Use bootloader-configuration-device. * gnu/system/bootloader.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- gnu/local.mk | 1 + gnu/system.scm | 11 ++-- gnu/system/bootloader.scm | 161 ++++++++++++++++++++++++++++++++++++++++++++++ gnu/system/grub.scm | 22 ++++--- guix/scripts/system.scm | 19 +++--- 5 files changed, 191 insertions(+), 23 deletions(-) create mode 100644 gnu/system/bootloader.scm diff --git a/gnu/local.mk b/gnu/local.mk index c93dca64c..e2730a466 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -443,6 +443,7 @@ GNU_SYSTEM_MODULES = \ \ %D%/system.scm \ %D%/system/file-systems.scm \ + %D%/system/bootloader.scm \ %D%/system/grub.scm \ %D%/system/install.scm \ %D%/system/linux-container.scm \ diff --git a/gnu/system.scm b/gnu/system.scm index 189a13262..b947d982d 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -48,7 +48,7 @@ #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services base) - #:use-module (gnu system grub) + #:use-module (gnu system bootloader) #:use-module (gnu system shadow) #:use-module (gnu system nss) #:use-module (gnu system locale) @@ -139,8 +139,8 @@ booted from ROOT-DEVICE" (default linux-libre)) (kernel-arguments operating-system-user-kernel-arguments (default '())) ; list of gexps/strings - (bootloader operating-system-bootloader) ; - + (bootloader operating-system-bootloader ; + (default (extlinux-configuration))) (initrd operating-system-initrd ; (list fs) -> M derivation (default base-initrd)) (firmware operating-system-firmware ; list of packages @@ -754,9 +754,8 @@ populate the \"old entries\" menu." (uuid->string (file-system-device root-fs)) (file-system-device root-fs))) (entry (operating-system-boot-parameters os system root-device))) - (grub-configuration-file (operating-system-bootloader os) - (list entry) - #:old-entries old-entries))) + ((bootloader-configuration-file-generator (operating-system-bootloader os)) + (operating-system-bootloader os) (list entry) #:old-entries old-entries))) (define (fs->boot-device fs) "Given FS, a object, return a value suitable for use as the diff --git a/gnu/system/bootloader.scm b/gnu/system/bootloader.scm new file mode 100644 index 000000000..ea067bf73 --- /dev/null +++ b/gnu/system/bootloader.scm @@ -0,0 +1,161 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 David Craven +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu system bootloader) + #:use-module (gnu system) + #:use-module (gnu system grub) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (ice-9 match) + #:export (bootloader-configuration + bootloader-configuration? + bootloader-configuration-bootloader + bootloader-configuration-device + bootloader-configuration-menu-entries + bootloader-configuration-default-entry + bootloader-configuration-timeout + bootloader-configuration-file-generator + bootloader-configuration-file-name + bootloader-configuration-installer + bootloader-configuration-additional-configuration + + extlinux-configuration + grub-configuration + grub-efi-configuration + syslinux-configuration)) + +;;; Commentary: +;;; +;;; Generic configuration for bootloaders. +;;; +;;; Code: + +(define-record-type* + bootloader-configuration make-bootloader-configuration + bootloader-configuration? + (bootloader bootloader-configuration-bootloader ; package + (default #f)) + (device bootloader-configuration-device ; string + (default #f)) + (menu-entries bootloader-configuration-menu-entries ; list of + (default '())) + (default-entry bootloader-configuration-default-entry ; integer + (default 0)) + (timeout bootloader-configuration-timeout ; integer + (default 5)) + (configuration-file-name bootloader-configuration-file-name + (default #f)) + (configuration-file-generator bootloader-configuration-file-generator ; procedure + (default #f)) + (installer bootloader-configuration-installer ; procedure + (default #f)) + (additional-configuration bootloader-configuration-additional-configuration ; record + (default #f))) + + + +;;; +;;; Extlinux configuration file. +;;; + +(define* (extlinux-configuration-file config entries + #:key + (system (%current-system)) + (old-entries '())) + "Return the U-Boot configuration file corresponding to CONFIG, a + object, and where the store is available at 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 + (append entries (bootloader-configuration-menu-entries config))) + + (define (boot-parameters->gexp params) + (let ((label (boot-parameters-label params)) + (kernel (boot-parameters-kernel params)) + (kernel-arguments (boot-parameters-kernel-arguments params)) + (initrd (boot-parameters-initrd params))) + #~(format port "LABEL ~a + MENU LABEL ~a + KERNEL ~a + FDTDIR ~a/lib/dtbs + INITRD ~a + APPEND ~a +~%" + #$label #$label + #$kernel #$kernel #$initrd + (string-join (list #$@kernel-arguments))))) + + (define builder + #~(call-with-output-file #$output + (lambda (port) + (let ((timeout #$(bootloader-configuration-timeout config))) + (format port " +UI menu.c32 +PROMPT ~a +TIMEOUT ~a~%" + (if (> timeout 0) 1 0) + ;; timeout is expressed in 1/10s of seconds. + (* 10 timeout)) + #$@(map boot-parameters->gexp all-entries) + + #$@(if (pair? old-entries) + #~((format port "~%") + #$@(map boot-parameters->gexp old-entries) + (format port "~%")) + #~()))))) + + (gexp->derivation "extlinux.conf" builder)) + + + + +;;; +;;; Bootloader configurations. +;;; + +(define* (extlinux-configuration #:optional (config (bootloader-configuration))) + (bootloader-configuration + (inherit config) + (configuration-file-name "/boot/extlinux/extlinux.conf") + (configuration-file-generator extlinux-configuration-file))) + +(define* (grub-configuration #:optional (config (bootloader-configuration))) + (bootloader-configuration + (inherit config) + (bootloader (@ (gnu packages bootloaders) grub)) + (configuration-file-name "/boot/grub/grub.cfg") + (configuration-file-generator grub-configuration-file) + (installer install-grub) + (additional-configuration + (let ((additional-config (bootloader-configuration-additional-configuration config))) + (if additional-config additional-config %default-theme))))) + +(define* (grub-efi-configuration #:optional (config (bootloader-configuration))) + (bootloader-configuration + (inherit (grub-configuration config)) + (bootloader (@ (gnu packages bootloaders) grub-efi)))) + +(define* (syslinux-configuration #:optional (config (bootloader-configuration))) + (bootloader-configuration + (inherit (extlinux-configuration config)) + (bootloader (@ (gnu packages bootloaders) syslinux)) + (installer install-syslinux))) + +;;; bootloader.scm ends here diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index d2fa984ec..b06336cec 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -27,6 +27,7 @@ #:use-module (guix download) #:use-module (gnu artwork) #:use-module (gnu system) + #:use-module (gnu system bootloader) #:use-module (gnu system file-systems) #:autoload (gnu packages bootloaders) (grub) #:autoload (gnu packages compression) (gzip) @@ -49,14 +50,6 @@ %background-image %default-theme - grub-configuration - grub-configuration? - grub-configuration-device - grub-configuration-grub - - menu-entry - menu-entry? - grub-configuration-file)) ;;; Commentary: @@ -277,7 +270,16 @@ code." (linux-arguments (boot-parameters-kernel-arguments conf)) (initrd (boot-parameters-initrd conf)))) -(define* (grub-configuration-file config entries +(define (bootloader-configuration->grub-configuration config) + (grub-configuration + (grub (bootloader-configuration-bootloader config)) + (device (bootloader-configuration-device config)) + (menu-entries (bootloader-configuration-menu-entries config)) + (default-entry (bootloader-configuration-default-entry config)) + (timeout (bootloader-configuration-timeout config)) + (theme (bootloader-configuration-additional-configuration config)))) + +(define* (grub-configuration-file bootloader-config entries #:key (system (%current-system)) (old-entries '())) @@ -285,6 +287,8 @@ code." object, and where the store is available at STORE-FS, a object. OLD-ENTRIES is taken to be a list of menu entries corresponding to old generations of the system." + (define config (bootloader-configuration->grub-configuration bootloader-config)) + (define all-entries (append (map boot-parameters->menu-entry entries) (grub-configuration-menu-entries config))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 2872bcae6..b96836576 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -38,10 +38,10 @@ #:use-module (guix build utils) #:use-module (gnu build install) #:use-module (gnu system) + #:use-module (gnu system bootloader) #:use-module (gnu system file-systems) #:use-module (gnu system linux-container) #:use-module (gnu system vm) - #:use-module (gnu system grub) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services herd) @@ -598,8 +598,11 @@ output when building a system derivation, such as a disk image." #:image-size image-size #:full-boot? full-boot? #:mappings mappings)) - (grub (package->derivation (grub-configuration-grub - (operating-system-bootloader os)))) + (bootloader (let ((bootloader (bootloader-configuration-bootloader + (operating-system-bootloader os)))) + (if bootloader + (package->derivation bootloader) + (return #f)))) (grub.cfg (if (eq? 'container action) (return #f) (operating-system-bootcfg os @@ -611,8 +614,8 @@ output when building a system derivation, such as a disk image." ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC ;; root. See . (drvs -> (if (memq action '(init reconfigure)) - (if bootloader? - (list sys grub.cfg grub) + (if (and bootloader? bootloader) + (list sys grub.cfg bootloader) (list sys grub.cfg)) (list sys))) (% (if derivations-only? @@ -628,8 +631,8 @@ output when building a system derivation, such as a disk image." drvs) ;; Make sure GRUB is accessible. - (when bootloader? - (let ((prefix (derivation->output-path grub))) + (when (and bootloader? bootloader) + (let ((prefix (derivation->output-path bootloader))) (setenv "PATH" (string-append prefix "/bin:" prefix "/sbin:" (getenv "PATH"))))) @@ -832,7 +835,7 @@ resulting from command-line parsing." ((first second) second) (_ #f))) (device (and bootloader? - (grub-configuration-device + (bootloader-configuration-device (operating-system-bootloader os))))) (with-store store -- 2.12.2