aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi3
-rw-r--r--guix/scripts/system.scm86
2 files changed, 61 insertions, 28 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 4c32df3c9f..917be1fc4d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3224,6 +3224,9 @@ files, packages, and so on. It also creates other essential files
needed for the system to operate correctly---e.g., the @file{/etc},
@file{/var}, and @file{/run} directories, and the @file{/bin/sh} file.
+This command also installs GRUB on the device specified in
+@file{my-os-config}, unless the @option{--no-grub} option was passed.
+
@item vm
@cindex virtual machine
Build a virtual machine that contain the operating system declared in
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index ee5df6e951..c02ad36c09 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -29,6 +29,8 @@
#:use-module (guix build install)
#:use-module (gnu system)
#:use-module (gnu system vm)
+ #:use-module (gnu system grub)
+ #:use-module (gnu packages grub)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
@@ -69,9 +71,12 @@
file args))))))
(define* (install store os-dir target
- #:key (log-port (current-output-port)))
+ #:key (log-port (current-output-port))
+ grub? grub.cfg device)
"Copy OS-DIR and its dependencies to directory TARGET. TARGET must be an
-absolute directory name since that's what 'guix-register' expects."
+absolute directory name since that's what 'guix-register' expects.
+
+When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
(define to-copy
(let ((lst (delete-duplicates (cons os-dir (references store os-dir))
string=?)))
@@ -97,8 +102,9 @@ absolute directory name since that's what 'guix-register' expects."
(format log-port "populating '~a'...~%" target)
(populate-root-file-system target)
- ;; TODO: Install GRUB.
- )
+ (when grub?
+ (unless (install-grub grub.cfg device target)
+ (leave (_ "failed to install GRUB on device '~a'~%") device))))
;;;
@@ -122,6 +128,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
(show-build-options-help)
(display (_ "
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
+ (display (_ "
+ --no-grub for 'init', do not install GRUB"))
(newline)
(display (_ "
-h, --help display this help and exit"))
@@ -143,6 +151,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
+ (lambda (opt name arg result)
+ (alist-delete 'install-grub? result)))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
@@ -155,7 +166,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
(build-hook? . #t)
(max-silent-time . 3600)
(verbosity . 0)
- (image-size . ,(* 900 (expt 2 20)))))
+ (image-size . ,(* 900 (expt 2 20)))
+ (install-grub? . #t)))
;;;
@@ -205,39 +217,57 @@ Build the operating system declared in FILE according to ACTION.\n"))
args))
(with-error-handling
- (let* ((opts (parse-options))
- (args (option-arguments opts))
- (file (first args))
- (action (assoc-ref opts 'action))
- (os (if file
- (read-operating-system file)
- (leave (_ "no configuration file specified~%"))))
- (mdrv (case action
- ((build init)
- (operating-system-derivation os))
- ((vm-image)
- (let ((size (assoc-ref opts 'image-size)))
- (system-qemu-image os
- #:disk-image-size size)))
- ((vm)
- (system-qemu-image/shared-store-script os))))
- (store (open-connection))
- (dry? (assoc-ref opts 'dry-run?))
- (drv (run-with-store store mdrv)))
+ (let* ((opts (parse-options))
+ (args (option-arguments opts))
+ (file (first args))
+ (action (assoc-ref opts 'action))
+ (os (if file
+ (read-operating-system file)
+ (leave (_ "no configuration file specified~%"))))
+ (mdrv (case action
+ ((build init)
+ (operating-system-derivation os))
+ ((vm-image)
+ (let ((size (assoc-ref opts 'image-size)))
+ (system-qemu-image os
+ #:disk-image-size size)))
+ ((vm)
+ (system-qemu-image/shared-store-script os))))
+ (store (open-connection))
+ (dry? (assoc-ref opts 'dry-run?))
+ (drv (run-with-store store mdrv))
+ (grub? (assoc-ref opts 'install-grub?))
+ (grub.cfg (run-with-store store
+ (operating-system-grub.cfg os)))
+ (grub (package-derivation store grub))
+ (drv-lst (if grub?
+ (list drv grub grub.cfg)
+ (list drv))))
(set-build-options-from-command-line store opts)
- (show-what-to-build store (list drv)
+ (show-what-to-build store drv-lst
#:dry-run? dry?
#:use-substitutes? (assoc-ref opts 'substitutes?))
(unless dry?
- (build-derivations store (list drv))
+ (build-derivations store drv-lst)
(display (derivation->output-path drv))
(newline)
(when (eq? action 'init)
- (let ((target (second args)))
+ (let* ((target (second args))
+ (device (grub-configuration-device
+ (operating-system-bootloader os))))
(format #t (_ "initializing operating system under '~a'...~%")
target)
+ (when grub
+ (let ((prefix (derivation->output-path grub)))
+ (setenv "PATH"
+ (string-append prefix "/bin:" prefix "/sbin:"
+ (getenv "PATH")))))
+
(install store (derivation->output-path drv)
- (canonicalize-path target))))))))
+ (canonicalize-path target)
+ #:grub? grub?
+ #:grub.cfg (derivation->output-path grub.cfg)
+ #:device device)))))))