From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:44109) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cufxG-0002Ty-NQ for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cufxD-0000OS-Dv for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:58367) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cufxD-0000OI-9X for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cufxD-0000bM-2O for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:03 -0400 Subject: bug#26339: [PATCH 02/18] system: Add extlinux support. Resent-Message-ID: From: Mathieu Othacehe Date: Sun, 2 Apr 2017 15:52:26 +0200 Message-Id: <20170402135242.2958-2-m.othacehe@gmail.com> In-Reply-To: <20170402135242.2958-1-m.othacehe@gmail.com> References: <20170402135242.2958-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 Cc: David Craven From: David Craven * gnu/system.scm (operating-system): Add default bootloader. (operating-system-grub.cfg): Use bootloader-configuration-file-procedure. * 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. * tests/system.scm: Adjust operating-system to new API. * tests/guix-system.sh: Adjust operating-system to new API. --- gnu/local.mk | 1 + gnu/system.scm | 10 +-- gnu/system/bootloader.scm | 158 ++++++++++++++++++++++++++++++++++++++++++++++ gnu/system/grub.scm | 22 ++++--- guix/scripts/system.scm | 44 ++++++------- tests/guix-system.sh | 2 - tests/system.scm | 2 - 7 files changed, 197 insertions(+), 42 deletions(-) create mode 100644 gnu/system/bootloader.scm diff --git a/gnu/local.mk b/gnu/local.mk index 68f561e95..d3033f54f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -437,6 +437,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 d528c4a6a..e0257bd4a 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -47,7 +47,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) @@ -131,8 +131,8 @@ (default linux-libre)) (kernel-arguments operating-system-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 @@ -759,8 +759,8 @@ listed in OS. The C library expects to find it under "/boot") (operating-system-kernel-arguments os))) (initrd initrd))))) - (grub-configuration-file (operating-system-bootloader os) entries - #:old-entries old-entries))) + ((bootloader-configuration-file-procedure (operating-system-bootloader os)) + (operating-system-bootloader os) entries #:old-entries old-entries))) (define (grub-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..6da19f6d3 --- /dev/null +++ b/gnu/system/bootloader.scm @@ -0,0 +1,158 @@ +;;; 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-location + bootloader-configuration-file-procedure + bootloader-configuration-install-procedure + 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-location bootloader-configuration-file-location + (default #f)) + (configuration-file-procedure bootloader-configuration-file-procedure ; procedure + (default #f)) + (install-procedure bootloader-configuration-install-procedure ; 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 + (match-lambda + (($ label _ _ _ kernel kernel-arguments initrd) + #~(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) + (* 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-location "/boot/extlinux/extlinux.conf") + (configuration-file-procedure extlinux-configuration-file))) + +(define* (grub-configuration #:optional (config (bootloader-configuration))) + (bootloader-configuration + (inherit config) + (bootloader (@ (gnu packages bootloaders) grub)) + (configuration-file-location "/boot/grub/grub.cfg") + (configuration-file-procedure grub-configuration-file) + (install-procedure 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)) + (install-procedure install-syslinux))) + +;;; bootloader.scm ends here diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index f2838d633..0b52e3e7e 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: @@ -276,7 +269,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 '())) @@ -284,6 +286,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 144a7fd37..fb32d08a5 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -37,10 +37,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) @@ -366,32 +366,25 @@ it atomically, and then run OS's activation script." (numbers (generation-numbers profile))) "Return a list of 'menu-entry' for the generations of PROFILE specified by NUMBERS, which is a list of generation numbers." - (define (system->grub-entry system number time) + (define (system->boot-parameters system number time) (unless-file-not-found (let* ((file (string-append system "/parameters")) (params (call-with-input-file file read-boot-parameters)) - (label (boot-parameters-label params)) (root (boot-parameters-root-device params)) (root-device (if (bytevector? root) (uuid->string root) - root)) - (kernel (boot-parameters-kernel params)) - (kernel-arguments (boot-parameters-kernel-arguments params)) - (initrd (boot-parameters-initrd params))) - (menu-entry - (label (string-append label " (#" + root))) + (boot-parameters + (inherit params) + (label (string-append (boot-parameters-label params) " (#" (number->string number) ", " (seconds->string time) ")")) - (device (boot-parameters-store-device params)) - (device-mount-point (boot-parameters-store-mount-point params)) - (linux kernel) - (linux-arguments - (cons* (string-append "--root=" root-device) + (kernel-arguments + (cons* (string-append "--root=" (boot-parameters-root-device params)) (string-append "--system=" system) (string-append "--load=" system "/boot") - kernel-arguments)) - (initrd initrd))))) + (boot-parameters-kernel-arguments params))))))) (let* ((systems (map (cut generation-file-name profile <>) numbers)) @@ -399,7 +392,7 @@ NUMBERS, which is a list of generation numbers." (unless-file-not-found (stat:mtime (lstat system)))) systems))) - (filter-map system->grub-entry systems numbers times))) + (filter-map system->boot-parameters systems numbers times))) ;;; @@ -613,8 +606,11 @@ building anything." #: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-grub.cfg os @@ -626,8 +622,8 @@ building anything." ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC ;; root. See . (drvs -> (if (memq action '(init reconfigure)) - (if grub? - (list sys grub.cfg grub) + (if (and grub? bootloader) + (list sys grub.cfg bootloader) (list sys grub.cfg)) (list sys))) (% (if derivations-only? @@ -643,8 +639,8 @@ building anything." drvs) ;; Make sure GRUB is accessible. - (when grub? - (let ((prefix (derivation->output-path grub))) + (when (and grub? bootloader) + (let ((prefix (derivation->output-path bootloader))) (setenv "PATH" (string-append prefix "/bin:" prefix "/sbin:" (getenv "PATH"))))) @@ -835,7 +831,7 @@ resulting from command-line parsing." ((first second) second) (_ #f))) (device (and grub? - (grub-configuration-device + (bootloader-configuration-device (operating-system-bootloader os))))) (with-store store diff --git a/tests/guix-system.sh b/tests/guix-system.sh index de6db0928..525480a11 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -91,7 +91,6 @@ OS_BASE=' (timezone "Europe/Paris") (locale "en_US.UTF-8") - (bootloader (grub-configuration (device "/dev/sdX"))) (file-systems (cons (file-system (device "root") (title (string->symbol "label")) @@ -162,7 +161,6 @@ make_user_config () (timezone "Europe/Paris") (locale "en_US.UTF-8") - (bootloader (grub-configuration (device "/dev/sdX"))) (file-systems (cons (file-system (device "root") (title 'label) diff --git a/tests/system.scm b/tests/system.scm index ca34409be..bdda08e18 100644 --- a/tests/system.scm +++ b/tests/system.scm @@ -36,7 +36,6 @@ (host-name "komputilo") (timezone "Europe/Berlin") (locale "en_US.utf8") - (bootloader (grub-configuration (device "/dev/sdX"))) (file-systems (cons %root-fs %base-file-systems)) (users %base-user-accounts))) @@ -51,7 +50,6 @@ (host-name "komputilo") (timezone "Europe/Berlin") (locale "en_US.utf8") - (bootloader (grub-configuration (device "/dev/sdX"))) (mapped-devices (list %luks-device)) (file-systems (cons (file-system (inherit %root-fs) -- 2.12.2