nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

scripts: system: Adapt "init" to new bootloader API. 

* guix/scripts/system.scm (install): Pass installer a new
argument. Rename other arguments.
Call install-bootloader instead of install-grub*.
(perform-action): Adapt.
This commit is contained in:
Mathieu Othacehe 2017-04-02 09:53:51 +02:00
parent 3042c5d8bb
commit 1229d328fb
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 27 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
guix/scripts/system.scm
View File

@ -178,12 +178,14 @@ TARGET, and register them."
(define* (install os-drv target (define* (install os-drv target
#:key (log-port (current-output-port)) #:key (log-port (current-output-port))
grub? grub.cfg device) bootloader-installer install-bootloader?
"Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to bootcfg bootcfg-file
device)
"Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
directory TARGET. TARGET must be an absolute directory name since that's what directory TARGET. TARGET must be an absolute directory name since that's what
'guix-register' expects. 'guix-register' expects.
When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG." When INSTALL-BOOTLOADER? is true, install bootloader on DEVICE, using BOOTCFG."
(define (maybe-copy to-copy) (define (maybe-copy to-copy)
(with-monad %store-monad (with-monad %store-monad
(if (string=? target "/") (if (string=? target "/")
@ -212,16 +214,21 @@ the ownership of '~a' may be incorrect!~%")
(populate (lift2 populate-root-file-system %store-monad))) (populate (lift2 populate-root-file-system %store-monad)))
(mbegin %store-monad (mbegin %store-monad
;; Copy the closure of GRUB.CFG, which includes OS-DIR, GRUB's ;; Copy the closure of BOOTCFG, which includes OS-DIR,
;; background image and so on. ;; eventual background image and so on.
(maybe-copy grub.cfg) (maybe-copy
(derivation->output-path bootcfg))
;; Create a bunch of additional files. ;; Create a bunch of additional files.
(format log-port "populating '~a'...~%" target) (format log-port "populating '~a'...~%" target)
(populate os-dir target) (populate os-dir target)
(mwhen grub? (mwhen install-bootloader?
(install-grub* grub.cfg device target))))) (install-bootloader bootloader-installer
#:bootcfg bootcfg
#:bootcfg-file bootcfg-file
#:device device
#:target target)))))
;;; ;;;
@ -589,12 +596,13 @@ and TARGET arguments."
(#$installer #$bootloader #$device #$target)))))) (#$installer #$bootloader #$device #$target))))))
(define* (perform-action action os (define* (perform-action action os
#:key bootloader? dry-run? derivations-only? #:key install-bootloader?
dry-run? derivations-only?
use-substitutes? device target use-substitutes? device target
image-size full-boot? image-size full-boot?
(mappings '()) (mappings '())
(gc-root #f)) (gc-root #f))
"Perform ACTION for OS. BOOTLOADER? specifies whether to install "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install
bootloader; DEVICE is the target devices for bootloader; TARGET is the target bootloader; DEVICE is the target devices for bootloader; TARGET is the target
root directory; IMAGE-SIZE is the size of the image to be built, for the 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; 'vm-image' and 'disk-image' actions. FULL-BOOT? is used for the 'vm' action;
@ -642,7 +650,7 @@ output when building a system derivation, such as a disk image."
;; --no-bootloader is passed, because we then use it as a GC root. ;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>. ;; See <http://bugs.gnu.org/21068>.
(drvs -> (if (memq action '(init reconfigure)) (drvs -> (if (memq action '(init reconfigure))
(if (and bootloader? bootloader-package) (if (and install-bootloader? bootloader-package)
(list sys bootcfg (list sys bootcfg
bootloader-package bootloader-package
bootloader-installer) bootloader-installer)
@ -664,7 +672,7 @@ output when building a system derivation, such as a disk image."
((reconfigure) ((reconfigure)
(mbegin %store-monad (mbegin %store-monad
(switch-to-system os) (switch-to-system os)
(mwhen bootloader? (mwhen install-bootloader?
(install-bootloader bootloader-installer (install-bootloader bootloader-installer
#:bootcfg bootcfg #:bootcfg bootcfg
#:bootcfg-file bootcfg-file #:bootcfg-file bootcfg-file
@ -675,8 +683,10 @@ output when building a system derivation, such as a disk image."
(format #t (G_ "initializing operating system under '~a'...~%") (format #t (G_ "initializing operating system under '~a'...~%")
target) target)
(install sys (canonicalize-path target) (install sys (canonicalize-path target)
#:grub? bootloader? #:install-bootloader? install-bootloader?
#:grub.cfg (derivation->output-path grub.cfg) #:bootcfg bootcfg
#:bootcfg-file bootcfg-file
#:bootloader-installer bootloader-installer
#:device device)) #:device device))
(else (else
;; All we had to do was to build SYS and maybe register an ;; All we had to do was to build SYS and maybe register an
@ -890,7 +900,7 @@ resulting from command-line parsing."
m) m)
(_ #f)) (_ #f))
opts) opts)
#:bootloader? bootloader? #:install-bootloader? bootloader?
#:target target #:device device #:target target #:device device
#:gc-root (assoc-ref opts 'gc-root))))) #:gc-root (assoc-ref opts 'gc-root)))))
#:system system)))) #:system system))))