diff options
| -rw-r--r-- | gnu.scm | 4 | ||||
| -rw-r--r-- | gnu/bootloader.scm | 127 | ||||
| -rw-r--r-- | gnu/bootloader/extlinux.scm | 123 | ||||
| -rw-r--r-- | gnu/bootloader/grub.scm (renamed from gnu/system/grub.scm) | 137 | ||||
| -rw-r--r-- | gnu/local.mk | 4 | ||||
| -rw-r--r-- | gnu/system.scm | 14 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 2 | ||||
| -rw-r--r-- | gnu/tests.scm | 3 | ||||
| -rw-r--r-- | gnu/tests/nfs.scm | 3 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 20 |
10 files changed, 369 insertions, 68 deletions
| @@ -1,6 +1,7 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> | 3 | ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> |
| 4 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | ||
| 4 | ;;; | 5 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 6 | ;;; This file is part of GNU Guix. |
| 6 | ;;; | 7 | ;;; |
| @@ -34,7 +35,8 @@ | |||
| 34 | '((gnu system) | 35 | '((gnu system) |
| 35 | (gnu system mapped-devices) | 36 | (gnu system mapped-devices) |
| 36 | (gnu system file-systems) | 37 | (gnu system file-systems) |
| 37 | (gnu system grub) ; 'grub-configuration' | 38 | (gnu bootloader) |
| 39 | (gnu bootloader grub) | ||
| 38 | (gnu system pam) | 40 | (gnu system pam) |
| 39 | (gnu system shadow) ; 'user-account' | 41 | (gnu system shadow) ; 'user-account' |
| 40 | (gnu system linux-initrd) | 42 | (gnu system linux-initrd) |
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm new file mode 100644 index 00000000000..4e77974d315 --- /dev/null +++ b/gnu/bootloader.scm | |||
| @@ -0,0 +1,127 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | ||
| 2 | ;;; Copyright © 2017 David Craven <david@craven.ch> | ||
| 3 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | ||
| 4 | ;;; Copyright © 2017 Leo Famulari <leo@famulari.name> | ||
| 5 | ;;; | ||
| 6 | ;;; This file is part of GNU Guix. | ||
| 7 | ;;; | ||
| 8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | ||
| 9 | ;;; under the terms of the GNU General Public License as published by | ||
| 10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | ||
| 11 | ;;; your option) any later version. | ||
| 12 | ;;; | ||
| 13 | ;;; GNU Guix is distributed in the hope that it will be useful, but | ||
| 14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;;; GNU General Public License for more details. | ||
| 17 | ;;; | ||
| 18 | ;;; You should have received a copy of the GNU General Public License | ||
| 19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | (define-module (gnu bootloader) | ||
| 22 | #:use-module (guix discovery) | ||
| 23 | #:use-module (guix records) | ||
| 24 | #:use-module (guix ui) | ||
| 25 | #:use-module (srfi srfi-1) | ||
| 26 | #:export (bootloader | ||
| 27 | bootloader? | ||
| 28 | bootloader-name | ||
| 29 | bootloader-package | ||
| 30 | bootloader-installer | ||
| 31 | bootloader-configuration-file | ||
| 32 | bootloader-configuration-file-generator | ||
| 33 | |||
| 34 | bootloader-configuration | ||
| 35 | bootloader-configuration? | ||
| 36 | bootloader-configuration-bootloader | ||
| 37 | bootloader-configuration-device | ||
| 38 | bootloader-configuration-menu-entries | ||
| 39 | bootloader-configuration-default-entry | ||
| 40 | bootloader-configuration-timeout | ||
| 41 | bootloader-configuration-theme | ||
| 42 | bootloader-configuration-terminal-outputs | ||
| 43 | bootloader-configuration-terminal-inputs | ||
| 44 | bootloader-configuration-serial-unit | ||
| 45 | bootloader-configuration-serial-speed | ||
| 46 | bootloader-configuration-additional-configuration | ||
| 47 | |||
| 48 | %bootloaders | ||
| 49 | lookup-bootloader-by-name)) | ||
| 50 | |||
| 51 | |||
| 52 | ;;; | ||
| 53 | ;;; Bootloader record. | ||
| 54 | ;;; | ||
| 55 | |||
| 56 | ;; The <bootloader> record contains fields expressing how the bootloader | ||
| 57 | ;; should be installed. Every bootloader in gnu/bootloader/ directory | ||
| 58 | ;; has to be described by this record. | ||
| 59 | |||
| 60 | (define-record-type* <bootloader> | ||
| 61 | bootloader make-bootloader | ||
| 62 | bootloader? | ||
| 63 | (name bootloader-name) | ||
| 64 | (package bootloader-package) | ||
| 65 | (installer bootloader-installer) | ||
| 66 | (configuration-file bootloader-configuration-file) | ||
| 67 | (configuration-file-generator bootloader-configuration-file-generator)) | ||
| 68 | |||
| 69 | |||
| 70 | ;;; | ||
| 71 | ;;; Bootloader configuration record. | ||
| 72 | ;;; | ||
| 73 | |||
| 74 | ;; The <bootloader-configuration> record contains bootloader independant | ||
| 75 | ;; configuration used to fill bootloader configuration file. | ||
| 76 | |||
| 77 | (define-record-type* <bootloader-configuration> | ||
| 78 | bootloader-configuration make-bootloader-configuration | ||
| 79 | bootloader-configuration? | ||
| 80 | (bootloader bootloader-configuration-bootloader) ; <bootloader> | ||
| 81 | (device bootloader-configuration-device ; string | ||
| 82 | (default #f)) | ||
| 83 | (menu-entries bootloader-configuration-menu-entries ; list of <boot-parameters> | ||
| 84 | (default '())) | ||
| 85 | (default-entry bootloader-configuration-default-entry ; integer | ||
| 86 | (default 0)) | ||
| 87 | (timeout bootloader-configuration-timeout ; seconds as integer | ||
| 88 | (default 5)) | ||
| 89 | (theme bootloader-configuration-theme ; bootloader-specific theme | ||
| 90 | (default #f)) | ||
| 91 | (terminal-outputs bootloader-configuration-terminal-outputs ; list of symbols | ||
| 92 | (default '(gfxterm))) | ||
| 93 | (terminal-inputs bootloader-configuration-terminal-inputs ; list of symbols | ||
| 94 | (default '())) | ||
| 95 | (serial-unit bootloader-configuration-serial-unit ; integer | #f | ||
| 96 | (default #f)) | ||
| 97 | (serial-speed bootloader-configuration-serial-speed ; integer | #f | ||
| 98 | (default #f)) | ||
| 99 | (additional-configuration bootloader-configuration-additional-configuration ; record | ||
| 100 | (default #f))) | ||
| 101 | |||
| 102 | |||
| 103 | ;;; | ||
| 104 | ;;; Bootloaders. | ||
| 105 | ;;; | ||
| 106 | |||
| 107 | (define (bootloader-modules) | ||
| 108 | "Return the list of bootloader modules." | ||
| 109 | (all-modules (map (lambda (entry) | ||
| 110 | `(,entry . "gnu/bootloader")) | ||
| 111 | %load-path))) | ||
| 112 | |||
| 113 | (define %bootloaders | ||
| 114 | ;; The list of publically-known bootloaders. | ||
| 115 | (delay (fold-module-public-variables (lambda (obj result) | ||
| 116 | (if (bootloader? obj) | ||
| 117 | (cons obj result) | ||
| 118 | result)) | ||
| 119 | '() | ||
| 120 | (bootloader-modules)))) | ||
| 121 | |||
| 122 | (define (lookup-bootloader-by-name name) | ||
| 123 | "Return the bootloader called NAME." | ||
| 124 | (or (find (lambda (bootloader) | ||
| 125 | (eq? name (bootloader-name bootloader))) | ||
| 126 | (force %bootloaders)) | ||
| 127 | (leave (G_ "~a: no such bootloader~%") name))) | ||
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm new file mode 100644 index 00000000000..a0020010718 --- /dev/null +++ b/gnu/bootloader/extlinux.scm | |||
| @@ -0,0 +1,123 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | ||
| 2 | ;;; Copyright © 2017 David Craven <david@craven.ch> | ||
| 3 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | ||
| 4 | ;;; | ||
| 5 | ;;; This file is part of GNU Guix. | ||
| 6 | ;;; | ||
| 7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | ||
| 8 | ;;; under the terms of the GNU General Public License as published by | ||
| 9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | ||
| 10 | ;;; your option) any later version. | ||
| 11 | ;;; | ||
| 12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | ||
| 13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;;; GNU General Public License for more details. | ||
| 16 | ;;; | ||
| 17 | ;;; You should have received a copy of the GNU General Public License | ||
| 18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | (define-module (gnu bootloader extlinux) | ||
| 21 | #:use-module (gnu bootloader) | ||
| 22 | #:use-module (gnu system) | ||
| 23 | #:use-module (gnu packages bootloaders) | ||
| 24 | #:use-module (guix gexp) | ||
| 25 | #:use-module (guix monads) | ||
| 26 | #:use-module (guix records) | ||
| 27 | #:use-module (guix utils) | ||
| 28 | #:export (extlinux-bootloader | ||
| 29 | syslinux-bootloader | ||
| 30 | |||
| 31 | extlinux-configuration | ||
| 32 | syslinux-configuration)) | ||
| 33 | |||
| 34 | (define* (extlinux-configuration-file config entries | ||
| 35 | #:key | ||
| 36 | (system (%current-system)) | ||
| 37 | (old-entries '())) | ||
| 38 | "Return the U-Boot configuration file corresponding to CONFIG, a | ||
| 39 | <u-boot-configuration> object, and where the store is available at STORE-FS, a | ||
| 40 | <file-system> object. OLD-ENTRIES is taken to be a list of menu entries | ||
| 41 | corresponding to old generations of the system." | ||
| 42 | |||
| 43 | (define all-entries | ||
| 44 | (append entries (bootloader-configuration-menu-entries config))) | ||
| 45 | |||
| 46 | (define (boot-parameters->gexp params) | ||
| 47 | (let ((label (boot-parameters-label params)) | ||
| 48 | (kernel (boot-parameters-kernel params)) | ||
| 49 | (kernel-arguments (boot-parameters-kernel-arguments params)) | ||
| 50 | (initrd (boot-parameters-initrd params))) | ||
| 51 | #~(format port "LABEL ~a | ||
| 52 | MENU LABEL ~a | ||
| 53 | KERNEL ~a | ||
| 54 | FDTDIR ~a/lib/dtbs | ||
| 55 | INITRD ~a | ||
| 56 | APPEND ~a | ||
| 57 | ~%" | ||
| 58 | #$label #$label | ||
| 59 | #$kernel #$kernel #$initrd | ||
| 60 | (string-join (list #$@kernel-arguments))))) | ||
| 61 | |||
| 62 | (define builder | ||
| 63 | #~(call-with-output-file #$output | ||
| 64 | (lambda (port) | ||
| 65 | (let ((timeout #$(bootloader-configuration-timeout config))) | ||
| 66 | (format port " | ||
| 67 | UI menu.c32 | ||
| 68 | PROMPT ~a | ||
| 69 | TIMEOUT ~a~%" | ||
| 70 | (if (> timeout 0) 1 0) | ||
| 71 | ;; timeout is expressed in 1/10s of seconds. | ||
| 72 | (* 10 timeout)) | ||
| 73 | #$@(map boot-parameters->gexp all-entries) | ||
| 74 | |||
| 75 | #$@(if (pair? old-entries) | ||
| 76 | #~((format port "~%") | ||
| 77 | #$@(map boot-parameters->gexp old-entries) | ||
| 78 | (format port "~%")) | ||
| 79 | #~()))))) | ||
| 80 | |||
| 81 | (gexp->derivation "extlinux.conf" builder)) | ||
| 82 | |||
| 83 | |||
| 84 | |||
| 85 | |||
| 86 | ;;; | ||
| 87 | ;;; Install procedures. | ||
| 88 | ;;; | ||
| 89 | |||
| 90 | (define dd | ||
| 91 | #~(lambda (bs count if of) | ||
| 92 | (zero? (system* "dd" | ||
| 93 | (string-append "bs=" (number->string bs)) | ||
| 94 | (string-append "count=" (number->string count)) | ||
| 95 | (string-append "if=" if) | ||
| 96 | (string-append "of=" of))))) | ||
| 97 | |||
| 98 | (define install-extlinux | ||
| 99 | #~(lambda (bootloader device mount-point) | ||
| 100 | (let ((extlinux (string-append bootloader "/sbin/extlinux")) | ||
| 101 | (install-dir (string-append mount-point "/boot/extlinux")) | ||
| 102 | (syslinux-dir (string-append bootloader "/share/syslinux"))) | ||
| 103 | (for-each (lambda (file) | ||
| 104 | (install-file file install-dir)) | ||
| 105 | (find-files syslinux-dir "\\.c32$")) | ||
| 106 | |||
| 107 | (unless (and (zero? (system* extlinux "--install" install-dir)) | ||
| 108 | (#$dd 440 1 (string-append syslinux-dir "/mbr.bin") device)) | ||
| 109 | (error "failed to install SYSLINUX"))))) | ||
| 110 | |||
| 111 | |||
| 112 | |||
| 113 | ;;; | ||
| 114 | ;;; Bootloader definitions. | ||
| 115 | ;;; | ||
| 116 | |||
| 117 | (define extlinux-bootloader | ||
| 118 | (bootloader | ||
| 119 | (name 'extlinux) | ||
| 120 | (package syslinux) | ||
| 121 | (installer install-extlinux) | ||
| 122 | (configuration-file "/boot/extlinux/extlinux.conf") | ||
| 123 | (configuration-file-generator extlinux-configuration-file))) | ||
diff --git a/gnu/system/grub.scm b/gnu/bootloader/grub.scm index 85878de85c7..49616b71642 100644 --- a/gnu/system/grub.scm +++ b/gnu/bootloader/grub.scm | |||
| @@ -2,6 +2,7 @@ | |||
| 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> | 3 | ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> |
| 4 | ;;; Copyright © 2017 Leo Famulari <leo@famulari.name> | 4 | ;;; Copyright © 2017 Leo Famulari <leo@famulari.name> |
| 5 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | ||
| 5 | ;;; | 6 | ;;; |
| 6 | ;;; This file is part of GNU Guix. | 7 | ;;; This file is part of GNU Guix. |
| 7 | ;;; | 8 | ;;; |
| @@ -18,7 +19,7 @@ | |||
| 18 | ;;; You should have received a copy of the GNU General Public License | 19 | ;;; You should have received a copy of the GNU General Public License |
| 19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | 20 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 20 | 21 | ||
| 21 | (define-module (gnu system grub) | 22 | (define-module (gnu bootloader grub) |
| 22 | #:use-module (guix store) | 23 | #:use-module (guix store) |
| 23 | #:use-module (guix packages) | 24 | #:use-module (guix packages) |
| 24 | #:use-module (guix derivations) | 25 | #:use-module (guix derivations) |
| @@ -28,6 +29,7 @@ | |||
| 28 | #:use-module (guix download) | 29 | #:use-module (guix download) |
| 29 | #:use-module (gnu artwork) | 30 | #:use-module (gnu artwork) |
| 30 | #:use-module (gnu system) | 31 | #:use-module (gnu system) |
| 32 | #:use-module (gnu bootloader) | ||
| 31 | #:use-module (gnu system file-systems) | 33 | #:use-module (gnu system file-systems) |
| 32 | #:autoload (gnu packages bootloaders) (grub) | 34 | #:autoload (gnu packages bootloaders) (grub) |
| 33 | #:autoload (gnu packages compression) (gzip) | 35 | #:autoload (gnu packages compression) (gzip) |
| @@ -50,15 +52,10 @@ | |||
| 50 | %background-image | 52 | %background-image |
| 51 | %default-theme | 53 | %default-theme |
| 52 | 54 | ||
| 53 | grub-configuration | 55 | grub-bootloader |
| 54 | grub-configuration? | 56 | grub-efi-bootloader |
| 55 | grub-configuration-device | ||
| 56 | grub-configuration-grub | ||
| 57 | 57 | ||
| 58 | menu-entry | 58 | grub-configuration)) |
| 59 | menu-entry? | ||
| 60 | |||
| 61 | grub-configuration-file)) | ||
| 62 | 59 | ||
| 63 | ;;; Commentary: | 60 | ;;; Commentary: |
| 64 | ;;; | 61 | ;;; |
| @@ -106,29 +103,6 @@ denoting a file name." | |||
| 106 | (color-highlight '((fg . yellow) (bg . black))) | 103 | (color-highlight '((fg . yellow) (bg . black))) |
| 107 | (color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 | 104 | (color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 |
| 108 | 105 | ||
| 109 | (define-record-type* <grub-configuration> | ||
| 110 | grub-configuration make-grub-configuration | ||
| 111 | grub-configuration? | ||
| 112 | (grub grub-configuration-grub ; package | ||
| 113 | (default (@ (gnu packages bootloaders) grub))) | ||
| 114 | (device grub-configuration-device) ; string | ||
| 115 | (menu-entries grub-configuration-menu-entries ; list | ||
| 116 | (default '())) | ||
| 117 | (default-entry grub-configuration-default-entry ; integer | ||
| 118 | (default 0)) | ||
| 119 | (timeout grub-configuration-timeout ; integer | ||
| 120 | (default 5)) | ||
| 121 | (theme grub-configuration-theme ; <grub-theme> | ||
| 122 | (default %default-theme)) | ||
| 123 | (terminal-outputs grub-configuration-terminal-outputs ; list of symbols | ||
| 124 | (default '(gfxterm))) | ||
| 125 | (terminal-inputs grub-configuration-terminal-inputs ; list of symbols | ||
| 126 | (default '())) | ||
| 127 | (serial-unit grub-configuration-serial-unit ; integer | #f | ||
| 128 | (default #f)) | ||
| 129 | (serial-speed grub-configuration-serial-speed ; integer | #f | ||
| 130 | (default #f))) | ||
| 131 | |||
| 132 | (define-record-type* <menu-entry> | 106 | (define-record-type* <menu-entry> |
| 133 | menu-entry make-menu-entry | 107 | menu-entry make-menu-entry |
| 134 | menu-entry? | 108 | menu-entry? |
| @@ -147,6 +121,11 @@ denoting a file name." | |||
| 147 | ;;; Background image & themes. | 121 | ;;; Background image & themes. |
| 148 | ;;; | 122 | ;;; |
| 149 | 123 | ||
| 124 | (define (bootloader-theme config) | ||
| 125 | "Return user defined theme in CONFIG if defined or %default-theme | ||
| 126 | otherwise." | ||
| 127 | (or (bootloader-configuration-theme config) %default-theme)) | ||
| 128 | |||
| 150 | (define* (svg->png svg #:key width height) | 129 | (define* (svg->png svg #:key width height) |
| 151 | "Build a PNG of HEIGHT x WIDTH from SVG." | 130 | "Build a PNG of HEIGHT x WIDTH from SVG." |
| 152 | (gexp->derivation "grub-image.png" | 131 | (gexp->derivation "grub-image.png" |
| @@ -171,7 +150,8 @@ WIDTH/HEIGHT, or #f if none was found." | |||
| 171 | (let* ((ratio (/ width height)) | 150 | (let* ((ratio (/ width height)) |
| 172 | (image (find (lambda (image) | 151 | (image (find (lambda (image) |
| 173 | (= (grub-image-aspect-ratio image) ratio)) | 152 | (= (grub-image-aspect-ratio image) ratio)) |
| 174 | (grub-theme-images (grub-configuration-theme config))))) | 153 | (grub-theme-images |
| 154 | (bootloader-theme config))))) | ||
| 175 | (if image | 155 | (if image |
| 176 | (svg->png (grub-image-file image) | 156 | (svg->png (grub-image-file image) |
| 177 | #:width width #:height height) | 157 | #:width width #:height height) |
| @@ -212,14 +192,14 @@ system string---e.g., \"x86_64-linux\"." | |||
| 212 | "")) | 192 | "")) |
| 213 | 193 | ||
| 214 | (define (setup-gfxterm config font-file) | 194 | (define (setup-gfxterm config font-file) |
| 215 | (if (memq 'gfxterm (grub-configuration-terminal-outputs config)) | 195 | (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config)) |
| 216 | #~(format #f "if loadfont ~a; then | 196 | #~(format #f "if loadfont ~a; then |
| 217 | setup_gfxterm | 197 | setup_gfxterm |
| 218 | fi~%" #$font-file) | 198 | fi~%" #$font-file) |
| 219 | "")) | 199 | "")) |
| 220 | 200 | ||
| 221 | (define (theme-colors type) | 201 | (define (theme-colors type) |
| 222 | (let* ((theme (grub-configuration-theme config)) | 202 | (let* ((theme (bootloader-theme config)) |
| 223 | (colors (type theme))) | 203 | (colors (type theme))) |
| 224 | (string-append (symbol->string (assoc-ref colors 'fg)) "/" | 204 | (string-append (symbol->string (assoc-ref colors 'fg)) "/" |
| 225 | (symbol->string (assoc-ref colors 'bg))))) | 205 | (symbol->string (assoc-ref colors 'bg))))) |
| @@ -266,10 +246,10 @@ fi~%" | |||
| 266 | is a string that can be inserted in grub.cfg." | 246 | is a string that can be inserted in grub.cfg." |
| 267 | (let* ((symbols->string (lambda (list) | 247 | (let* ((symbols->string (lambda (list) |
| 268 | (string-join (map symbol->string list) " "))) | 248 | (string-join (map symbol->string list) " "))) |
| 269 | (outputs (grub-configuration-terminal-outputs config)) | 249 | (outputs (bootloader-configuration-terminal-outputs config)) |
| 270 | (inputs (grub-configuration-terminal-inputs config)) | 250 | (inputs (bootloader-configuration-terminal-inputs config)) |
| 271 | (unit (grub-configuration-serial-unit config)) | 251 | (unit (bootloader-configuration-serial-unit config)) |
| 272 | (speed (grub-configuration-serial-speed config)) | 252 | (speed (bootloader-configuration-serial-speed config)) |
| 273 | 253 | ||
| 274 | ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT, | 254 | ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT, |
| 275 | ;; as documented in GRUB manual section "Simple Configuration | 255 | ;; as documented in GRUB manual section "Simple Configuration |
| @@ -347,12 +327,13 @@ code." | |||
| 347 | (system (%current-system)) | 327 | (system (%current-system)) |
| 348 | (old-entries '())) | 328 | (old-entries '())) |
| 349 | "Return the GRUB configuration file corresponding to CONFIG, a | 329 | "Return the GRUB configuration file corresponding to CONFIG, a |
| 350 | <grub-configuration> object, and where the store is available at STORE-FS, a | 330 | <bootloader-configuration> object, and where the store is available at |
| 351 | <file-system> object. OLD-ENTRIES is taken to be a list of menu entries | 331 | STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu |
| 352 | corresponding to old generations of the system." | 332 | entries corresponding to old generations of the system." |
| 353 | (define all-entries | 333 | (define all-entries |
| 354 | (append (map boot-parameters->menu-entry entries) | 334 | (map boot-parameters->menu-entry |
| 355 | (grub-configuration-menu-entries config))) | 335 | (append entries |
| 336 | (bootloader-configuration-menu-entries config)))) | ||
| 356 | 337 | ||
| 357 | (define entry->gexp | 338 | (define entry->gexp |
| 358 | (match-lambda | 339 | (match-lambda |
| @@ -391,8 +372,8 @@ corresponding to old generations of the system." | |||
| 391 | (format port " | 372 | (format port " |
| 392 | set default=~a | 373 | set default=~a |
| 393 | set timeout=~a~%" | 374 | set timeout=~a~%" |
| 394 | #$(grub-configuration-default-entry config) | 375 | #$(bootloader-configuration-default-entry config) |
| 395 | #$(grub-configuration-timeout config)) | 376 | #$(bootloader-configuration-timeout config)) |
| 396 | #$@(map entry->gexp all-entries) | 377 | #$@(map entry->gexp all-entries) |
| 397 | 378 | ||
| 398 | #$@(if (pair? old-entries) | 379 | #$@(if (pair? old-entries) |
| @@ -404,4 +385,64 @@ submenu \"GNU system, old configurations...\" {~%") | |||
| 404 | 385 | ||
| 405 | (gexp->derivation "grub.cfg" builder))) | 386 | (gexp->derivation "grub.cfg" builder))) |
| 406 | 387 | ||
| 388 | |||
| 389 | |||
| 390 | ;;; | ||
| 391 | ;;; Install procedures. | ||
| 392 | ;;; | ||
| 393 | |||
| 394 | (define install-grub | ||
| 395 | #~(lambda (bootloader device mount-point) | ||
| 396 | ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. | ||
| 397 | (let ((grub (string-append bootloader "/sbin/grub-install")) | ||
| 398 | (install-dir (string-append mount-point "/boot"))) | ||
| 399 | ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or | ||
| 400 | ;; root partition. | ||
| 401 | (setenv "GRUB_ENABLE_CRYPTODISK" "y") | ||
| 402 | |||
| 403 | (unless (zero? (system* grub "--no-floppy" | ||
| 404 | "--boot-directory" install-dir | ||
| 405 | device)) | ||
| 406 | (error "failed to install GRUB"))))) | ||
| 407 | |||
| 408 | |||
| 409 | |||
| 410 | ;;; | ||
| 411 | ;;; Bootloader definitions. | ||
| 412 | ;;; | ||
| 413 | |||
| 414 | (define grub-bootloader | ||
| 415 | (bootloader | ||
| 416 | (name 'grub) | ||
| 417 | (package grub) | ||
| 418 | (installer install-grub) | ||
| 419 | (configuration-file "/boot/grub/grub.cfg") | ||
| 420 | (configuration-file-generator grub-configuration-file))) | ||
| 421 | |||
| 422 | (define* grub-efi-bootloader | ||
| 423 | (bootloader | ||
| 424 | (inherit grub-bootloader) | ||
| 425 | (name 'grub-efi) | ||
| 426 | (package grub-efi))) | ||
| 427 | |||
| 428 | |||
| 429 | ;;; | ||
| 430 | ;;; Compatibility macros. | ||
| 431 | ;;; | ||
| 432 | |||
| 433 | (define-syntax grub-configuration | ||
| 434 | (syntax-rules (grub) | ||
| 435 | ((_ (grub package) fields ...) | ||
| 436 | (if (eq? package grub) | ||
| 437 | (bootloader-configuration | ||
| 438 | (bootloader grub-bootloader) | ||
| 439 | fields ...) | ||
| 440 | (bootloader-configuration | ||
| 441 | (bootloader grub-efi-bootloader) | ||
| 442 | fields ...))) | ||
| 443 | ((_ fields ...) | ||
| 444 | (bootloader-configuration | ||
| 445 | (bootloader grub-bootloader) | ||
| 446 | fields ...)))) | ||
| 447 | |||
| 407 | ;;; grub.scm ends here | 448 | ;;; grub.scm ends here |
diff --git a/gnu/local.mk b/gnu/local.mk index c560c717254..d0c5b9daf8e 100644 --- a/gnu/local.mk +++ b/gnu/local.mk | |||
| @@ -36,6 +36,9 @@ | |||
| 36 | GNU_SYSTEM_MODULES = \ | 36 | GNU_SYSTEM_MODULES = \ |
| 37 | gnu.scm \ | 37 | gnu.scm \ |
| 38 | %D%/artwork.scm \ | 38 | %D%/artwork.scm \ |
| 39 | %D%/bootloader.scm \ | ||
| 40 | %D%/bootloader/grub.scm \ | ||
| 41 | %D%/bootloader/extlinux.scm \ | ||
| 39 | %D%/packages.scm \ | 42 | %D%/packages.scm \ |
| 40 | %D%/packages/abduco.scm \ | 43 | %D%/packages/abduco.scm \ |
| 41 | %D%/packages/abiword.scm \ | 44 | %D%/packages/abiword.scm \ |
| @@ -443,7 +446,6 @@ GNU_SYSTEM_MODULES = \ | |||
| 443 | \ | 446 | \ |
| 444 | %D%/system.scm \ | 447 | %D%/system.scm \ |
| 445 | %D%/system/file-systems.scm \ | 448 | %D%/system/file-systems.scm \ |
| 446 | %D%/system/grub.scm \ | ||
| 447 | %D%/system/install.scm \ | 449 | %D%/system/install.scm \ |
| 448 | %D%/system/linux-container.scm \ | 450 | %D%/system/linux-container.scm \ |
| 449 | %D%/system/linux-initrd.scm \ | 451 | %D%/system/linux-initrd.scm \ |
diff --git a/gnu/system.scm b/gnu/system.scm index f9a0da9a75e..a705bf69002 100644 --- a/gnu/system.scm +++ b/gnu/system.scm | |||
| @@ -48,6 +48,7 @@ | |||
| 48 | #:use-module (gnu services) | 48 | #:use-module (gnu services) |
| 49 | #:use-module (gnu services shepherd) | 49 | #:use-module (gnu services shepherd) |
| 50 | #:use-module (gnu services base) | 50 | #:use-module (gnu services base) |
| 51 | #:use-module (gnu bootloader) | ||
| 51 | #:use-module (gnu system shadow) | 52 | #:use-module (gnu system shadow) |
| 52 | #:use-module (gnu system nss) | 53 | #:use-module (gnu system nss) |
| 53 | #:use-module (gnu system locale) | 54 | #:use-module (gnu system locale) |
| @@ -139,7 +140,7 @@ booted from ROOT-DEVICE" | |||
| 139 | (default linux-libre)) | 140 | (default linux-libre)) |
| 140 | (kernel-arguments operating-system-user-kernel-arguments | 141 | (kernel-arguments operating-system-user-kernel-arguments |
| 141 | (default '())) ; list of gexps/strings | 142 | (default '())) ; list of gexps/strings |
| 142 | (bootloader operating-system-bootloader) ; <grub-configuration> | 143 | (bootloader operating-system-bootloader) ; <bootloader-configuration> |
| 143 | 144 | ||
| 144 | (initrd operating-system-initrd ; (list fs) -> M derivation | 145 | (initrd operating-system-initrd ; (list fs) -> M derivation |
| 145 | (default base-initrd)) | 146 | (default base-initrd)) |
| @@ -847,12 +848,11 @@ populate the \"old entries\" menu." | |||
| 847 | (root-device -> (if (eq? 'uuid (file-system-title root-fs)) | 848 | (root-device -> (if (eq? 'uuid (file-system-title root-fs)) |
| 848 | (uuid->string (file-system-device root-fs)) | 849 | (uuid->string (file-system-device root-fs)) |
| 849 | (file-system-device root-fs))) | 850 | (file-system-device root-fs))) |
| 850 | (entry (operating-system-boot-parameters os system root-device))) | 851 | (entry (operating-system-boot-parameters os system root-device)) |
| 851 | ((module-ref (resolve-interface '(gnu system grub)) | 852 | (bootloader-conf -> (operating-system-bootloader os))) |
| 852 | 'grub-configuration-file) | 853 | ((bootloader-configuration-file-generator |
| 853 | (operating-system-bootloader os) | 854 | (bootloader-configuration-bootloader bootloader-conf)) |
| 854 | (list entry) | 855 | bootloader-conf (list entry) #:old-entries old-entries))) |
| 855 | #:old-entries old-entries))) | ||
| 856 | 856 | ||
| 857 | (define (fs->boot-device fs) | 857 | (define (fs->boot-device fs) |
| 858 | "Given FS, a <file-system> object, return a value suitable for use as the | 858 | "Given FS, a <file-system> object, return a value suitable for use as the |
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 2c8b954c805..080014cde4f 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm | |||
| @@ -49,7 +49,7 @@ | |||
| 49 | #:use-module (gnu system shadow) | 49 | #:use-module (gnu system shadow) |
| 50 | #:use-module (gnu system pam) | 50 | #:use-module (gnu system pam) |
| 51 | #:use-module (gnu system linux-initrd) | 51 | #:use-module (gnu system linux-initrd) |
| 52 | #:use-module (gnu system grub) | 52 | #:use-module (gnu bootloader) |
| 53 | #:use-module (gnu system file-systems) | 53 | #:use-module (gnu system file-systems) |
| 54 | #:use-module (gnu system) | 54 | #:use-module (gnu system) |
| 55 | #:use-module (gnu services) | 55 | #:use-module (gnu services) |
diff --git a/gnu/tests.scm b/gnu/tests.scm index 810711ab911..2886a982f46 100644 --- a/gnu/tests.scm +++ b/gnu/tests.scm | |||
| @@ -1,5 +1,6 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | ||
| 3 | ;;; | 4 | ;;; |
| 4 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| 5 | ;;; | 6 | ;;; |
| @@ -20,8 +21,8 @@ | |||
| 20 | #:use-module (guix gexp) | 21 | #:use-module (guix gexp) |
| 21 | #:use-module (guix utils) | 22 | #:use-module (guix utils) |
| 22 | #:use-module (guix records) | 23 | #:use-module (guix records) |
| 24 | #:use-module (gnu bootloader grub) | ||
| 23 | #:use-module (gnu system) | 25 | #:use-module (gnu system) |
| 24 | #:use-module (gnu system grub) | ||
| 25 | #:use-module (gnu system file-systems) | 26 | #:use-module (gnu system file-systems) |
| 26 | #:use-module (gnu system shadow) | 27 | #:use-module (gnu system shadow) |
| 27 | #:use-module (gnu services) | 28 | #:use-module (gnu services) |
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index 1f28f5a5b87..9e1ac1d55ae 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm | |||
| @@ -1,6 +1,7 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2016 John Darrington <jmd@gnu.org> | 3 | ;;; Copyright © 2016 John Darrington <jmd@gnu.org> |
| 4 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | ||
| 4 | ;;; | 5 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 6 | ;;; This file is part of GNU Guix. |
| 6 | ;;; | 7 | ;;; |
| @@ -19,8 +20,8 @@ | |||
| 19 | 20 | ||
| 20 | (define-module (gnu tests nfs) | 21 | (define-module (gnu tests nfs) |
| 21 | #:use-module (gnu tests) | 22 | #:use-module (gnu tests) |
| 23 | #:use-module (gnu bootloader grub) | ||
| 22 | #:use-module (gnu system) | 24 | #:use-module (gnu system) |
| 23 | #:use-module (gnu system grub) | ||
| 24 | #:use-module (gnu system file-systems) | 25 | #:use-module (gnu system file-systems) |
| 25 | #:use-module (gnu system shadow) | 26 | #:use-module (gnu system shadow) |
| 26 | #:use-module (gnu system vm) | 27 | #:use-module (gnu system vm) |
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 9c09767508c..5fd0d7600c0 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm | |||
| @@ -38,10 +38,10 @@ | |||
| 38 | #:use-module (guix build utils) | 38 | #:use-module (guix build utils) |
| 39 | #:use-module (gnu build install) | 39 | #:use-module (gnu build install) |
| 40 | #:use-module (gnu system) | 40 | #:use-module (gnu system) |
| 41 | #:use-module (gnu bootloader) | ||
| 41 | #:use-module (gnu system file-systems) | 42 | #:use-module (gnu system file-systems) |
| 42 | #:use-module (gnu system linux-container) | 43 | #:use-module (gnu system linux-container) |
| 43 | #:use-module (gnu system vm) | 44 | #:use-module (gnu system vm) |
| 44 | #:use-module (gnu system grub) | ||
| 45 | #:use-module (gnu services) | 45 | #:use-module (gnu services) |
| 46 | #:use-module (gnu services shepherd) | 46 | #:use-module (gnu services shepherd) |
| 47 | #:use-module (gnu services herd) | 47 | #:use-module (gnu services herd) |
| @@ -598,8 +598,12 @@ output when building a system derivation, such as a disk image." | |||
| 598 | #:image-size image-size | 598 | #:image-size image-size |
| 599 | #:full-boot? full-boot? | 599 | #:full-boot? full-boot? |
| 600 | #:mappings mappings)) | 600 | #:mappings mappings)) |
| 601 | (grub (package->derivation (grub-configuration-grub | 601 | (bootloader (let ((bootloader (bootloader-package |
| 602 | (operating-system-bootloader os)))) | 602 | (bootloader-configuration-bootloader |
| 603 | (operating-system-bootloader os))))) | ||
| 604 | (if bootloader | ||
| 605 | (package->derivation bootloader) | ||
| 606 | (return #f)))) | ||
| 603 | (grub.cfg (if (eq? 'container action) | 607 | (grub.cfg (if (eq? 'container action) |
| 604 | (return #f) | 608 | (return #f) |
| 605 | (operating-system-bootcfg os | 609 | (operating-system-bootcfg os |
| @@ -611,8 +615,8 @@ output when building a system derivation, such as a disk image." | |||
| 611 | ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC | 615 | ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC |
| 612 | ;; root. See <http://bugs.gnu.org/21068>. | 616 | ;; root. See <http://bugs.gnu.org/21068>. |
| 613 | (drvs -> (if (memq action '(init reconfigure)) | 617 | (drvs -> (if (memq action '(init reconfigure)) |
| 614 | (if bootloader? | 618 | (if (and bootloader? bootloader) |
| 615 | (list sys grub.cfg grub) | 619 | (list sys grub.cfg bootloader) |
| 616 | (list sys grub.cfg)) | 620 | (list sys grub.cfg)) |
| 617 | (list sys))) | 621 | (list sys))) |
| 618 | (% (if derivations-only? | 622 | (% (if derivations-only? |
| @@ -628,8 +632,8 @@ output when building a system derivation, such as a disk image." | |||
| 628 | drvs) | 632 | drvs) |
| 629 | 633 | ||
| 630 | ;; Make sure GRUB is accessible. | 634 | ;; Make sure GRUB is accessible. |
| 631 | (when bootloader? | 635 | (when (and bootloader? bootloader) |
| 632 | (let ((prefix (derivation->output-path grub))) | 636 | (let ((prefix (derivation->output-path bootloader))) |
| 633 | (setenv "PATH" | 637 | (setenv "PATH" |
| 634 | (string-append prefix "/bin:" prefix "/sbin:" | 638 | (string-append prefix "/bin:" prefix "/sbin:" |
| 635 | (getenv "PATH"))))) | 639 | (getenv "PATH"))))) |
| @@ -832,7 +836,7 @@ resulting from command-line parsing." | |||
| 832 | ((first second) second) | 836 | ((first second) second) |
| 833 | (_ #f))) | 837 | (_ #f))) |
| 834 | (device (and bootloader? | 838 | (device (and bootloader? |
| 835 | (grub-configuration-device | 839 | (bootloader-configuration-device |
| 836 | (operating-system-bootloader os))))) | 840 | (operating-system-bootloader os))))) |
| 837 | 841 | ||
| 838 | (with-store store | 842 | (with-store store |
