guix system: 'guix system init' installs GRUB by default.
* guix/scripts/system.scm (install): Add #:grub?, #:grub.cfg, and #:device parameters; honor them. (show-help): Document '--no-grub'. (%options): Add '--no-grub'. (%default-options): Add 'install-grub?'. (guix-system): Honor 'install-grub?' option from OPTS. Adjust 'install' call accordingly. * doc/guix.texi (Invoking guix system): Document '--no-grub'.
This commit is contained in:
parent
e38e18ff01
commit
c79d54fe41
|
@ -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},
|
needed for the system to operate correctly---e.g., the @file{/etc},
|
||||||
@file{/var}, and @file{/run} directories, and the @file{/bin/sh} file.
|
@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
|
@item vm
|
||||||
@cindex virtual machine
|
@cindex virtual machine
|
||||||
Build a virtual machine that contain the operating system declared in
|
Build a virtual machine that contain the operating system declared in
|
||||||
|
|
|
@ -29,6 +29,8 @@
|
||||||
#:use-module (guix build install)
|
#:use-module (guix build install)
|
||||||
#:use-module (gnu system)
|
#:use-module (gnu system)
|
||||||
#:use-module (gnu system vm)
|
#:use-module (gnu system vm)
|
||||||
|
#:use-module (gnu system grub)
|
||||||
|
#:use-module (gnu packages grub)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
|
@ -69,9 +71,12 @@
|
||||||
file args))))))
|
file args))))))
|
||||||
|
|
||||||
(define* (install store os-dir target
|
(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
|
"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
|
(define to-copy
|
||||||
(let ((lst (delete-duplicates (cons os-dir (references store os-dir))
|
(let ((lst (delete-duplicates (cons os-dir (references store os-dir))
|
||||||
string=?)))
|
string=?)))
|
||||||
|
@ -97,8 +102,9 @@ absolute directory name since that's what 'guix-register' expects."
|
||||||
(format log-port "populating '~a'...~%" target)
|
(format log-port "populating '~a'...~%" target)
|
||||||
(populate-root-file-system 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)
|
(show-build-options-help)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
|
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
|
||||||
|
(display (_ "
|
||||||
|
--no-grub for 'init', do not install GRUB"))
|
||||||
(newline)
|
(newline)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-h, --help display this help and exit"))
|
-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)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'image-size (size->number arg)
|
(alist-cons 'image-size (size->number arg)
|
||||||
result)))
|
result)))
|
||||||
|
(option '("no-grub") #f #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-delete 'install-grub? result)))
|
||||||
(option '(#\n "dry-run") #f #f
|
(option '(#\n "dry-run") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'dry-run? #t 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)
|
(build-hook? . #t)
|
||||||
(max-silent-time . 3600)
|
(max-silent-time . 3600)
|
||||||
(verbosity . 0)
|
(verbosity . 0)
|
||||||
(image-size . ,(* 900 (expt 2 20)))))
|
(image-size . ,(* 900 (expt 2 20)))
|
||||||
|
(install-grub? . #t)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -223,21 +235,39 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
||||||
(system-qemu-image/shared-store-script os))))
|
(system-qemu-image/shared-store-script os))))
|
||||||
(store (open-connection))
|
(store (open-connection))
|
||||||
(dry? (assoc-ref opts 'dry-run?))
|
(dry? (assoc-ref opts 'dry-run?))
|
||||||
(drv (run-with-store store mdrv)))
|
(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)
|
(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?
|
#:dry-run? dry?
|
||||||
#:use-substitutes? (assoc-ref opts 'substitutes?))
|
#:use-substitutes? (assoc-ref opts 'substitutes?))
|
||||||
|
|
||||||
(unless dry?
|
(unless dry?
|
||||||
(build-derivations store (list drv))
|
(build-derivations store drv-lst)
|
||||||
(display (derivation->output-path drv))
|
(display (derivation->output-path drv))
|
||||||
(newline)
|
(newline)
|
||||||
|
|
||||||
(when (eq? action 'init)
|
(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'...~%")
|
(format #t (_ "initializing operating system under '~a'...~%")
|
||||||
target)
|
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)
|
(install store (derivation->output-path drv)
|
||||||
(canonicalize-path target))))))))
|
(canonicalize-path target)
|
||||||
|
#:grub? grub?
|
||||||
|
#:grub.cfg (derivation->output-path grub.cfg)
|
||||||
|
#:device device)))))))
|
||||||
|
|
Loading…
Reference in New Issue