@@ -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)
@@ -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,28 +36,49 @@
;;;
;;; Code:
-(define* (install-grub grub.cfg device mount-point)
+(define* (install-bootloader-config source target)
+ (let* ((pivot (string-append target ".new")))
+ (mkdir-p (dirname target))
+
+ ;; 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 source pivot)
+ (rename-file pivot target)))
+
+(define* (install-grub grub-name grub.cfg device mount-point)
"Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT.
+MOUNT-POINT. FIXME is that correct?
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")))
- (mkdir-p (dirname target))
-
- ;; Copy GRUB.CFG 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)
-
+ (let ((target (string-append mount-point "/boot/grub/grub.cfg")))
+ (install-bootloader-config grub.cfg target)
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
(error "failed to install GRUB"))))
+(define* (install-u-boot u-boot-name 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* (string-append u-boot-name "/bin/u-boot-install")
+ (string-append "--boot-directory=" mount-point)
+ device))
+ (error "failed to install U-Boot")))
+
+(define* (install-bootloader package-output-name config-filename device mount-point)
+ "Install bootloader with CONFIG-FILENAME on DEVICE, which is assumed to be
+mounted on MOUNT-POINT."
+ (let* ((grub? (string-contains package-output-name "grub"))
+ (bootloader-installer (if grub? install-grub
+ install-u-boot)))
+ (bootloader-installer package-output-name config-filename device mount-point)))
+
(define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
directory TARGET."
@@ -295,6 +295,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(define* (initialize-hard-disk device
#:key
+ grub
grub.cfg
(partitions '()))
"Initialize DEVICE as a disk containing all the <partition> objects listed
@@ -313,7 +314,7 @@ 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 grub grub.cfg device target)
;; Register GRUB.CFG as a GC root.
(register-grub.cfg-root target grub.cfg)
@@ -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,6 +90,7 @@
operating-system-derivation
operating-system-profile
+ operating-system-grub
operating-system-grub.cfg
operating-system-etc-directory
operating-system-locale-directory
@@ -703,6 +705,13 @@ 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 os)
+ (match (operating-system-bootloader os)
+ ((? grub-configuration? config)
+ (grub-configuration-package config))
+ ((? u-boot-configuration? config)
+ (u-boot-configuration-package config))))
+
(define* (operating-system-grub.cfg os #:optional (old-entries '()))
"Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the
\"old entries\" menu."
@@ -49,6 +49,7 @@
grub-configuration
grub-configuration?
+ grub-configuration-package
grub-configuration-device
menu-entry
@@ -141,6 +142,9 @@
(system* (string-append #$imagemagick "/bin/convert")
"-resize" #$size #$image #$output)))))
+(define (grub-configuration-package config)
+ grub)
+
(define* (grub-background-image config #:key (width 1024) (height 768))
"Return the GRUB background image defined in CONFIG with a ratio of
WIDTH/HEIGHT, or #f if none was found."
@@ -35,7 +35,7 @@
#:export (u-boot-configuration
u-boot-configuration?
u-boot-configuration-board
- u-boot-configuration-u-boot
+ u-boot-configuration-package
u-boot-configuration-device
u-boot-configuration-file))
@@ -61,6 +61,10 @@
+(define (u-boot-configuration-package config)
+ (or (u-boot-configuration-u-boot config)
+ (make-u-boot-package (u-boot-configuration-board config))))
+
;;;
;;; Configuration file.
;;;
@@ -175,6 +175,7 @@ made available under the /xchg CIFS share."
(file-system-type "ext4")
file-system-label
os-derivation
+ grub
grub-configuration
(register-closures? #t)
(inputs '())
@@ -231,6 +232,7 @@ the image."
(initializer initialize)))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
+ #:grub #$grub
#:grub.cfg #$grub-configuration)
(reboot)))))
#:system system
@@ -283,9 +285,11 @@ to USB sticks meant to be read-only."
file-systems-to-keep)))))
(mlet* %store-monad ((os-drv (operating-system-derivation os))
+ (grub (operating-system-grub os))
(grub.cfg (operating-system-grub.cfg os)))
(qemu-image #:name name
#:os-derivation os-drv
+ #:grub grub
#:grub-configuration grub.cfg
#:disk-image-size disk-image-size
#:disk-image-format "raw"
@@ -330,6 +334,7 @@ of the GNU system as described by OS."
((os-drv (operating-system-derivation os))
(grub.cfg (operating-system-grub.cfg os)))
(qemu-image #:os-derivation os-drv
+ #:grub grub
#:grub-configuration grub.cfg
#:disk-image-size disk-image-size
#:file-system-type file-system-type
@@ -416,12 +421,14 @@ 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 (operating-system-grub os))
(grub.cfg (operating-system-grub.cfg 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
;; font, and the background image), but it's hard to filter that.
(qemu-image #:os-derivation os-drv
+ #:grub grub
#:grub-configuration grub.cfg
#:disk-image-size disk-image-size
#:inputs (if full-boot?
@@ -126,7 +126,7 @@ TARGET, and register them."
(map (cut copy-item <> target #:log-port log-port)
to-copy))))
-(define (install-grub* grub.cfg device target)
+(define (install-bootloader* grub grub.cfg device target)
"This is a variant of 'install-grub' with error handling, lifted in
%STORE-MONAD"
(let* ((gc-root (string-append target %gc-roots-directory
@@ -140,7 +140,7 @@ TARGET, and register them."
;; 'install-grub' completes (being a bit paranoid.)
(make-symlink temp-gc-root grub.cfg)
- (munless (false-if-exception (install-grub grub.cfg device target))
+ (munless (false-if-exception (install-bootloader grub grub.cfg device target))
(delete-file temp-gc-root)
(leave (_ "failed to install GRUB on device '~a'~%") device))
@@ -150,7 +150,7 @@ TARGET, and register them."
(define* (install os-drv target
#:key (log-port (current-output-port))
- grub? grub.cfg device)
+ grub 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.
@@ -193,7 +193,7 @@ the ownership of '~a' may be incorrect!~%")
(populate os-dir target)
(mwhen grub?
- (install-grub* grub.cfg device target)))))
+ (install-bootloader* grub grub.cfg device target)))))
;;;
@@ -598,13 +598,15 @@ building anything."
(mbegin %store-monad
(switch-to-system os)
(mwhen grub?
- (install-grub* (derivation->output-path grub.cfg)
- device "/"))))
+ (install-bootloader* (derivation->output-path grub)
+ (derivation->output-path grub.cfg)
+ device "/"))))
((init)
(newline)
(format #t (_ "initializing operating system under '~a'...~%")
target)
(install sys (canonicalize-path target)
+ #:grub grub
#:grub? grub?
#:grub.cfg (derivation->output-path grub.cfg)
#:device device))