[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guix bootloader selection - wip patch
|
From: |
Danny Milosavljevic |
|
Subject: |
guix bootloader selection - wip patch |
|
Date: |
Wed, 27 Jul 2016 22:29:24 +0200 |
Hi,
so far I came up with the patch to Guix below for the actual bootloader
selection.
Some places are still broken. Search for "FIXME" below.
For example I need a way to find out what the bootloader config file is
supposed to be called in the new routine 'install-bootloader . It will get
(derivation->output-path bootloader-configuration-file) as argument. Given it,
can I still find out whether the filename is "grub.cfg" or "extlinux.conf"? Is
that safe enough?
diff --git a/gnu.scm b/gnu.scm
index 932e4cd..9207e38 100644
--- a/gnu.scm
+++ b/gnu.scm
@@ -35,6 +35,7 @@
(gnu system mapped-devices)
(gnu system file-systems)
(gnu system grub) ; 'grub-configuration'
+ (gnu system u-boot) ; 'u-boot-configuration'
(gnu system pam)
(gnu system shadow) ; 'user-account'
(gnu system linux-initrd)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index aebf38c..b799e00 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -21,7 +21,7 @@
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-grub
+ #:export (install-bootloader
populate-root-file-system
reset-timestamps
register-closure
@@ -36,27 +36,48 @@
;;;
;;; Code:
-(define* (install-grub grub.cfg device mount-point)
- "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT.
-
-Note that the caller must make sure that GRUB.CFG is registered as a GC root
-so that the fonts, background images, etc. referred to by GRUB.CFG are not
-GC'd."
- (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
- (pivot (string-append target ".new")))
+(define* (install-bootloader-config source target)
+ (let* ((pivot (string-append target ".new")))
(mkdir-p (dirname target))
- ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
+ ;; Copy bootloader config file instead of just symlinking it, because
symlinks won't
;; work when /boot is on a separate partition. Do that atomically.
- (copy-file grub.cfg pivot)
- (rename-file pivot target)
+ (copy-file source pivot)
+ (rename-file pivot target)))
- (unless (zero? (system* "grub-install" "--no-floppy"
+;; TODO split install-bootloader-config off completely?
+(define* (install-grub grub.cfg device mount-point)
+ "Install bootloader with GRUB.CFG on DEVICE, which is assumed to be
+mounted on MOUNT-POINT.
+
+Note that the caller must make sure that GRUB.CFG is registered as a GC root
so that
+the fonts, background images, etc. referred to by GRUB.CFG are not GC'd."
+ (install-bootloader-config grub.cfg
+ (string-append mount-point
+ "/boot/grub/grub.cfg"))
+ (unless (zero? (system* "grub-install"
+ "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
- (error "failed to install GRUB"))))
+ (error "failed to install GRUB")))
+
+(define* (install-u-boot extlinux.conf device mount-point)
+ "Install U-Boot with EXTLINUX.CONF on DEVICE, which is assumed to be mounted
on
+MOUNT-POINT. FIXME is that correct?"
+ (install-bootloader-config extlinux.conf
+ (string-append mount-point
+ "/extlinux.conf"))
+ (unless (zero? (system* "u-boot-install"
+ (string-append "--boot-directory=" mount-point)
+ device))
+ (error "failed to install U-Boot")))
+
+(define* (install-bootloader config-filename device mount-point)
+ "Install bootloader with CONFIG-FILENAME on DEVICE, which is assumed to be
+mounted on MOUNT-POINT."
+ ; FIXME install-u-boot match
+ (install-grub config-filename device mount-point))
(define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index cc5cf45..c81e437 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -287,18 +287,20 @@ SYSTEM-DIRECTORY is the name of the directory of the
'system' derivation."
(unless register-closures?
(reset-timestamps target))))
-(define (register-grub.cfg-root target grub.cfg)
- "On file system TARGET, register GRUB.CFG as a GC root."
+(define (register-bootloader-configuration-file-root target
bootloader-configuration-filename)
+ "On file system TARGET, register BOOTLOADER-CONFIGURATION-FILENAME as a GC
root."
(let ((directory (string-append target "/var/guix/gcroots")))
(mkdir-p directory)
- (symlink grub.cfg (string-append directory "/grub.cfg"))))
+ ; FIXME fix grub.cfg
+ (symlink bootloader-configuration-filename (string-append directory
"/grub.cfg"))))
(define* (initialize-hard-disk device
#:key
- grub.cfg
+ bootloader-configuration-filename
(partitions '()))
"Initialize DEVICE as a disk containing all the <partition> objects listed
-in PARTITIONS, and using GRUB.CFG as its bootloader configuration file.
+in PARTITIONS, and using BOOTLOADER-CONFIGURATION-FILENAME
+as its bootloader configuration file.
Each partition is initialized by calling its 'initializer' procedure,
passing it a directory name where it is mounted."
@@ -313,10 +315,10 @@ passing it a directory name where it is mounted."
(display "mounting root partition...\n")
(mkdir-p target)
(mount (partition-device root) target (partition-file-system root))
- (install-grub grub.cfg device target)
+ (install-bootloader bootloader-configuration-filename device target)
- ;; Register GRUB.CFG as a GC root.
- (register-grub.cfg-root target grub.cfg)
+ ;; Register BOOTLOADER-CONFIGURATION-FILENAME as a GC root.
+ (register-bootloader-configuration-file-root target
bootloader-configuration-filename)
(umount target)))
diff --git a/gnu/system.scm b/gnu/system.scm
index 476720b..3cee2f7 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -47,6 +47,7 @@
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu system grub)
+ #:use-module (gnu system u-boot)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@@ -89,11 +90,13 @@
operating-system-derivation
operating-system-profile
- operating-system-grub.cfg
+ operating-system-bootloader-configuration-file
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
+ bootloader-configuration-device
+
boot-parameters
boot-parameters?
boot-parameters-label
@@ -122,7 +125,7 @@
(default linux-libre))
(kernel-arguments operating-system-kernel-arguments
(default '())) ; list of gexps/strings
- (bootloader operating-system-bootloader) ; <grub-configuration>
+ (bootloader operating-system-bootloader) ; <grub-configuration> or
<u-boot-configuration>
(initrd operating-system-initrd ; (list fs) -> M derivation
(default base-initrd))
@@ -695,8 +698,15 @@ listed in OS. The C library expects to find it under
"Return the file system that contains the store of OS."
(store-file-system (operating-system-file-systems os)))
-(define* (operating-system-grub.cfg os #:optional (old-entries '()))
- "Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the
+(define (bootloader-configuration-device bootloader-configuration)
+ (match bootloader-configuration
+ (($ <grub-configuration> config)
+ (grub-configuration-device config))
+ (($ <u-boot-configuration> config)
+ (u-boot-configuration-device config))))
+
+(define* (operating-system-bootloader-configuration-file os #:optional
(old-entries '()))
+ "Return the bootloader configuration file for OS. Use OLD-ENTRIES to
populate the
\"old entries\" menu."
(mlet* %store-monad
((system (operating-system-derivation os))
@@ -716,13 +726,19 @@ listed in OS. The C library expects to find it under
"/boot")
(operating-system-kernel-arguments os)))
(initrd #~(string-append #$system "/initrd"))))))
- (grub-configuration-file (operating-system-bootloader os)
- store-fs entries
- #:old-entries old-entries)))
+ (match (operating-system-bootloader os)
+ (($ <grub-configuration> config)
+ (grub-configuration-file config
+ store-fs entries
+ #:old-entries old-entries))
+ (($ <u-boot-configuration> config)
+ (u-boot-configuration-file config
+ store-fs entries
+ #:old-entries old-entries)))))
(define (operating-system-parameters-file os)
"Return a file that describes the boot parameters of OS. The primary use of
-this file is the reconstruction of GRUB menu entries for old configurations."
+this file is the reconstruction of bootloader menu entries for old
configurations."
(mlet %store-monad ((initrd (operating-system-initrd-file os))
(root -> (operating-system-root-file-system os))
(label -> (kernel->grub-label
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 45b46ca..a38bcca 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -47,6 +47,7 @@
%background-image
%default-theme
+ <grub-configuration>
grub-configuration
grub-configuration?
grub-configuration-device
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c31e3a8..a615855 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -188,7 +188,7 @@ made available under the /xchg CIFS share."
(file-system-type "ext4")
file-system-label
os-derivation
- grub-configuration
+ bootloader-configuration-filename
(register-closures? #t)
(inputs '())
copy-inputs?)
@@ -196,8 +196,9 @@ made available under the /xchg CIFS share."
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.
Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root
partition. The returned image is a full disk image that runs OS-DERIVATION,
-with a GRUB installation that uses GRUB-CONFIGURATION as its configuration
-file (GRUB-CONFIGURATION must be the name of a file in the VM.)
+with a bootloader installation that uses BOOTLOADER-CONFIGURATION-FILENAME as
its
+configuration file (BOOTLOADER-CONFIGURATION-FILENAME must be the name of a
+file in the VM.)
INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy
all of INPUTS into the image being built. When REGISTER-CLOSURES? is true,
@@ -243,7 +244,8 @@ the image."
(initializer initialize)))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
- #:grub.cfg #$grub-configuration)
+ #:bootloader-configuration-filename
+ #$bootloader-configuration-filename)
(reboot)))))
#:system system
#:make-disk-image? #t
@@ -295,10 +297,10 @@ to USB sticks meant to be read-only."
file-systems-to-keep)))))
(mlet* %store-monad ((os-drv (operating-system-derivation os))
- (grub.cfg (operating-system-grub.cfg os)))
+ (bootloader-configuration-filename
(operating-system-bootloader-configuration-file os)))
(qemu-image #:name name
#:os-derivation os-drv
- #:grub-configuration grub.cfg
+ #:bootloader-configuration-filename
bootloader-configuration-filename
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
@@ -306,7 +308,7 @@ to USB sticks meant to be read-only."
#:copy-inputs? #t
#:register-closures? #t
#:inputs `(("system" ,os-drv)
- ("grub.cfg" ,grub.cfg))))))
+ ("grub.cfg"
,bootloader-configuration-filename))))))
(define* (system-qemu-image os
#:key
@@ -340,13 +342,13 @@ of the GNU system as described by OS."
file-systems-to-keep)))))
(mlet* %store-monad
((os-drv (operating-system-derivation os))
- (grub.cfg (operating-system-grub.cfg os)))
+ (bootloader-configuration-filename
(operating-system-bootloader-configuration-file os)))
(qemu-image #:os-derivation os-drv
- #:grub-configuration grub.cfg
+ #:bootloader-configuration-filename
bootloader-configuration-filename
#:disk-image-size disk-image-size
#:file-system-type file-system-type
#:inputs `(("system" ,os-drv)
- ("grub.cfg" ,grub.cfg))
+ ("grub.cfg" ,bootloader-configuration-filename))
#:copy-inputs? #t))))
@@ -428,16 +430,16 @@ When FULL-BOOT? is true, return an image that does a
complete boot sequence,
bootloaded included; thus, make a disk image that contains everything the
bootloader refers to: OS kernel, initrd, bootloader data, etc."
(mlet* %store-monad ((os-drv (operating-system-derivation os))
- (grub.cfg (operating-system-grub.cfg os)))
+ (bootloader-configuration-file
(operating-system-bootloader-configuration-file os)))
;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
- ;; GRUB.CFG and all its dependencies, including the output of OS-DRV.
- ;; This is more than needed (we only need the kernel, initrd, GRUB for its
+ ;; BOOTLOADER-CONFIGURATION-FILENAME and all its dependencies, including
the output of OS-DRV.
+ ;; This is more than needed (we only need the kernel, initrd, the
bootloader for its
;; font, and the background image), but it's hard to filter that.
(qemu-image #:os-derivation os-drv
- #:grub-configuration grub.cfg
+ #:bootloader-configuration-filename
bootloader-configuration-file
#:disk-image-size disk-image-size
#:inputs (if full-boot?
- `(("grub.cfg" ,grub.cfg))
+ `(("grub.cfg" ,bootloader-configuration-file))
'())
;; XXX: Passing #t here is too slow, so let it off by default.
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index e2c6b2e..7214a36 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -125,9 +125,10 @@ TARGET, and register them."
(map (cut copy-item <> target #:log-port log-port)
to-copy))))
-(define (install-grub* grub.cfg device target)
- "This is a variant of 'install-grub' with error handling, lifted in
+(define (install-bootloader* cfg device target)
+ "This is a variant of 'install-bootloader' with error handling, lifted in
%STORE-MONAD"
+; FIXME name
(let* ((gc-root (string-append target %gc-roots-directory
"/grub.cfg"))
(temp-gc-root (string-append gc-root ".new"))
@@ -135,26 +136,27 @@ TARGET, and register them."
(make-symlink (lift2 switch-symlinks %store-monad))
(rename (lift2 rename-file %store-monad)))
(mbegin %store-monad
- ;; Prepare the symlink to GRUB.CFG to make sure that it's a GC root when
- ;; 'install-grub' completes (being a bit paranoid.)
- (make-symlink temp-gc-root grub.cfg)
+ ;; Prepare the symlink to CFG to make sure that it's a GC root when
+ ;; 'install-bootloader' completes (being a bit paranoid.)
+ (make-symlink temp-gc-root cfg)
- (munless (false-if-exception (install-grub grub.cfg device target))
+ (munless (false-if-exception (install-bootloader cfg device target))
(delete-file temp-gc-root)
- (leave (_ "failed to install GRUB on device '~a'~%") device))
+ (leave (_ "failed to install bootloader on device '~a'~%") device))
- ;; Register GRUB.CFG as a GC root so that its dependencies (background
+ ;; Register CFG as a GC root so that its dependencies (background
;; image, font, etc.) are not reclaimed.
(rename temp-gc-root gc-root))))
(define* (install os-drv target
#:key (log-port (current-output-port))
- grub? grub.cfg device)
- "Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to
-directory TARGET. TARGET must be an absolute directory name since that's what
-'guix-register' expects.
+ bootloader? bootloader-configuration-filename device)
+ "Copy the closure of BOOTLOADER-CONFIGURATION-FILENAME, which includes the
+output of OS-DRV, to directory TARGET. TARGET must be an absolute directory
+name since that's what 'guix-register' expects.
-When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
+When BOOTLOADER? is true, install bootloader on DEVICE, using
+BOOTLOADER-CONFIGURATION-FILENAME."
(define (maybe-copy to-copy)
(with-monad %store-monad
(if (string=? target "/")
@@ -183,16 +185,16 @@ the ownership of '~a' may be incorrect!~%")
(populate (lift2 populate-root-file-system %store-monad)))
(mbegin %store-monad
- ;; Copy the closure of GRUB.CFG, which includes OS-DIR, GRUB's
- ;; background image and so on.
- (maybe-copy grub.cfg)
+ ;; Copy the closure of BOOTLOADER-CONFIGURATION-FILENAME,
+ ;; which includes OS-DIR, the background image and so on.
+ (maybe-copy bootloader-configuration-filename)
;; Create a bunch of additional files.
(format log-port "populating '~a'...~%" target)
(populate os-dir target)
- (mwhen grub?
- (install-grub* grub.cfg device target)))))
+ (mwhen bootloader?
+ (install-bootloader* bootloader-configuration-filename device
target)))))
;;;
@@ -384,7 +386,7 @@ it atomically, and then run OS's activation script."
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
-(define* (previous-grub-entries #:optional (profile %system-profile))
+(define* (previous-bootloader-entries #:optional (profile %system-profile))
"Return a list of 'menu-entry' for the generations of PROFILE."
(define (system->grub-entry system number time)
(unless-file-not-found
@@ -543,13 +545,13 @@ PATTERN, a string. When PATTERN is #f, display all the
system generations."
(warning (_ "Failing to do that may downgrade your system!~%"))))
(define* (perform-action action os
- #:key grub? dry-run? derivations-only?
+ #:key bootloader? dry-run? derivations-only?
use-substitutes? device target
image-size full-boot?
(mappings '()))
- "Perform ACTION for OS. GRUB? specifies whether to install GRUB; DEVICE is
-the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
-is the size of the image to be built, for the 'vm-image' and 'disk-image'
+ "Perform ACTION for OS. BOOTLOADER? specifies whether to install the
bootloade;
+DEVICE is the target device for the bootloader; TARGET is the target root
directory;
+IMAGE-SIZE is the size of the image to be built, for the 'vm-image' and
'disk-image'
actions. FULL-BOOT? is used for the 'vm' action; it determines whether to
boot directly to the kernel or to the bootloader.
@@ -566,21 +568,21 @@ building anything."
#:image-size image-size
#:full-boot? full-boot?
#:mappings mappings))
- (grub (package->derivation grub))
- (grub.cfg (if (eq? 'container action)
+ (grub (package->derivation grub)) ; FIXME U-Boot
+ (bootloader-configuration-file (if (eq? 'container action)
(return #f)
- (operating-system-grub.cfg os
+ (operating-system-bootloader-configuration-file os
(if (eq? 'init action)
'()
-
(previous-grub-entries)))))
+
(previous-bootloader-entries)))))
- ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
- ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
- ;; root. See <http://bugs.gnu.org/21068>.
+ ;; For 'init' and 'reconfigure', always build
BOOTLOADER-CONFIGURATION-FILE,
+ ;; even if --no-bootloader is passed, 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)
- (list sys grub.cfg))
+ (if bootloader?
+ (list sys bootloader-configuration-file grub) ;
FIXME U-Boot
+ (list sys bootloader-configuration-file))
(list sys)))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
@@ -595,8 +597,8 @@ building anything."
drvs)
;; Make sure GRUB is accessible.
- (when grub?
- (let ((prefix (derivation->output-path grub)))
+ (when bootloader?
+ (let ((prefix (derivation->output-path grub))) ; FIXME bootloader
(setenv "PATH"
(string-append prefix "/bin:" prefix "/sbin:"
(getenv "PATH")))))
@@ -605,16 +607,16 @@ building anything."
((reconfigure)
(mbegin %store-monad
(switch-to-system os)
- (mwhen grub?
- (install-grub* (derivation->output-path grub.cfg)
+ (mwhen bootloader?
+ (install-bootloader* (derivation->output-path
bootloader-configuration-file)
device "/"))))
((init)
(newline)
(format #t (_ "initializing operating system under '~a'...~%")
target)
(install sys (canonicalize-path target)
- #:grub? grub?
- #:grub.cfg (derivation->output-path grub.cfg)
+ #:bootloader? bootloader?
+ #:bootloader-configuration-filename
(derivation->output-path bootloader-configuration-file)
#:device device))
(else
;; All we had to do was to build SYS.
@@ -684,7 +686,7 @@ Build the operating system declared in FILE according to
ACTION.\n"))
(display (_ "
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
(display (_ "
- --no-grub for 'init', do not install GRUB"))
+ --no-bootloader for 'init', do not install bootloader"))
(display (_ "
--share=SPEC for 'vm', share host file system according to SPEC"))
(display (_ "
@@ -719,9 +721,9 @@ Build the operating system declared in FILE according to
ACTION.\n"))
(lambda (opt name arg result)
(alist-cons 'image-size (size->number arg)
result)))
- (option '("no-grub") #f #f
+ (option '("no-bootloader") #f #f
(lambda (opt name arg result)
- (alist-cons 'install-grub? #f result)))
+ (alist-cons 'install-bootloader? #f result)))
(option '("full-boot") #f #f
(lambda (opt name arg result)
(alist-cons 'full-boot? #t result)))
@@ -755,7 +757,7 @@ Build the operating system declared in FILE according to
ACTION.\n"))
(max-silent-time . 3600)
(verbosity . 0)
(image-size . ,(* 900 (expt 2 20)))
- (install-grub? . #t)))
+ (install-bootloader? . #t)))
;;;
@@ -777,12 +779,12 @@ resulting from command-line parsing."
(leave (_ "no configuration file specified~%"))))
(dry? (assoc-ref opts 'dry-run?))
- (grub? (assoc-ref opts 'install-grub?))
+ (bootloader? (assoc-ref opts 'install-bootloader?))
(target (match args
((first second) second)
(_ #f)))
- (device (and grub?
- (grub-configuration-device
+ (device (and bootloader?
+ (bootloader-configuration-device
(operating-system-bootloader os)))))
(with-store store
@@ -809,7 +811,7 @@ resulting from command-line parsing."
m)
(_ #f))
opts)
- #:grub? grub?
+ #:bootloader? bootloader?
#:target target #:device device))))
#:system system))))