guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#26339: [PATCH 02/18] system: Add extlinux support.


From: Mathieu Othacehe
Subject: bug#26339: [PATCH 02/18] system: Add extlinux support.
Date: Sun, 2 Apr 2017 15:52:26 +0200

From: David Craven <address@hidden>

* 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)        ; <grub-configuration>
-
+  (bootloader operating-system-bootloader         ; <bootloader-configuration>
+              (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 <file-system> 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 <address@hidden>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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>
+  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 <boot-parameters>
+                                   (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
+<u-boot-configuration> object, and where the store is available at STORE-FS, a
+<file-system> 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
+      (($ <boot-parameters> 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 address@hidden))))))
+
+  (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."
 <grub-configuration> object, and where the store is available at STORE-FS, a
 <file-system> 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 <http://bugs.gnu.org/21068>.
        (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






reply via email to

[Prev in Thread] Current Thread [Next in Thread]