Package: guix-patches;
Reported by: Mathieu Othacehe <m.othacehe <at> gmail.com>
Date: Sun, 2 Apr 2017 13:51:01 UTC
Severity: important
Tags: patch
Done: Mathieu Othacehe <m.othacehe <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Mathieu Othacehe <m.othacehe <at> gmail.com> To: 26339 <at> debbugs.gnu.org Cc: Mathieu Othacehe <m.othacehe <at> gmail.com> Subject: bug#26339: [PATCH v3 7/9] scripts: system: Adapt "init" to new bootloader API. Date: Sat, 6 May 2017 17:41:52 +0200
* guix/scripts/system.scm (install): Pass installer a new
argument. Rename other arguments.
Call install-bootloader instead of install-grub*.
(perform-action): Adapt.
---
guix/scripts/system.scm | 46 ++++++++++++++++++++++++++++------------------
1 file changed, 28 insertions(+), 18 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0a066853a..b3e2d7b72 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -178,12 +178,14 @@ TARGET, and register them."
(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
+ installer install-bootloader?
+ bootcfg bootcfg-location
+ 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
'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)
(with-monad %store-monad
(if (string=? target "/")
@@ -212,16 +214,21 @@ 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 BOOTCFG, which includes OS-DIR,
+ ;; eventual background image and so on.
+ (maybe-copy
+ (derivation->output-path bootcfg))
;; 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 install-bootloader?
+ (install-bootloader installer
+ #:bootcfg bootcfg
+ #:bootcfg-location bootcfg-location
+ #:device device
+ #:target target)))))
;;;
@@ -589,12 +596,13 @@ PATTERN, a string. When PATTERN is #f, display all the system generations."
#$target))))))
(define* (perform-action action os
- #:key bootloader? dry-run? derivations-only?
+ #:key install-bootloader?
+ dry-run? derivations-only?
use-substitutes? device target
image-size full-boot?
(mappings '())
(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
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;
@@ -630,7 +638,7 @@ output when building a system derivation, such as a disk image."
(profile-boot-parameters)))))
(bootcfg-location -> (bootloader-configuration-file-name
(operating-system-bootloader os)))
- (install-proc
+ (installer
(let ((procedure (bootloader-configuration-installer
(operating-system-bootloader os)))
(target (or target "/")))
@@ -640,8 +648,8 @@ output when building a system derivation, such as a disk image."
;; --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 (and bootloader? bootloader)
- (list sys bootcfg bootloader install-proc)
+ (if (and install-bootloader? bootloader)
+ (list sys bootcfg bootloader installer)
(list sys bootcfg))
(list sys)))
(% (if derivations-only?
@@ -660,8 +668,8 @@ output when building a system derivation, such as a disk image."
((reconfigure)
(mbegin %store-monad
(switch-to-system os)
- (mwhen bootloader?
- (install-bootloader install-proc
+ (mwhen install-bootloader?
+ (install-bootloader installer
#:bootcfg bootcfg
#:bootcfg-location bootcfg-location
#:device device
@@ -671,8 +679,10 @@ output when building a system derivation, such as a disk image."
(format #t (G_ "initializing operating system under '~a'...~%")
target)
(install sys (canonicalize-path target)
- #:grub? bootloader?
- #:grub.cfg (derivation->output-path grub.cfg)
+ #:install-bootloader? install-bootloader?
+ #:bootcfg bootcfg
+ #:bootcfg-location bootcfg-location
+ #:installer installer
#:device device))
(else
;; All we had to do was to build SYS and maybe register an
@@ -884,7 +894,7 @@ resulting from command-line parsing."
m)
(_ #f))
opts)
- #:bootloader? bootloader?
+ #:install-bootloader? bootloader?
#:target target #:device device
#:gc-root (assoc-ref opts 'gc-root)))))
#:system system))))
--
2.12.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.