[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Explicitly pass grub to install, install-grub*, install-grub, in
From: |
Danny Milosavljevic |
Subject: |
[PATCH] Explicitly pass grub to install, install-grub*, install-grub, initialize-hard-disk and qemu-image. |
Date: |
Thu, 10 Nov 2016 10:09:27 +0100 |
* gnu/build/install.scm (install-grub): Add grub-store-path parameter. Use it.
* gnu/build/vm.scm (initialize-hard-disk): Add grub parameter. Use it. Call
modified install-grub.
* guix/scripts/system.scm (install-grub*): Add grub parameter. Pass it along to
install-grub.
* guix/scripts/system.scm (install): Add grub parameter. Call modified
install-grub*.
* guix/scripts/system.scm (perform-action): Call modified install.
* gnu/system/vm.scm (qemu-image): Call modified initialize-hard-disk.
---
gnu/build/install.scm | 5 +++--
gnu/build/vm.scm | 3 ++-
gnu/system/vm.scm | 1 +
guix/scripts/system.scm | 12 +++++++-----
4 files changed, 13 insertions(+), 8 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 3d1594e..6e11538 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -38,7 +38,7 @@
;;;
;;; Code:
-(define (install-grub grub.cfg device mount-point)
+(define (install-grub grub-store-path grub.cfg device mount-point)
"Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
MOUNT-POINT.
@@ -46,7 +46,8 @@ 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."
(install-grub-config grub.cfg mount-point)
- (unless (zero? (system* "grub-install" "--no-floppy"
+ (unless (zero? (system* (string-append grub-store-path "/sbin/grub-install")
+ "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index cc5cf45..f9468aa 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -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-grub grub grub.cfg device target)
;; Register GRUB.CFG as a GC root.
(register-grub.cfg-root target grub.cfg)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 03f7d6c..e914635 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -231,6 +231,7 @@ the image."
(initializer initialize)))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
+ #:grub #$grub
#:grub.cfg #$grub-configuration)
(reboot)))))
#:system system
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 71ddccf..3043d2e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -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-grub* 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-grub 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-grub* grub grub.cfg device target)))))
;;;
@@ -657,7 +657,8 @@ building anything."
(mbegin %store-monad
(switch-to-system os)
(mwhen grub?
- (install-grub* (derivation->output-path grub.cfg)
+ (install-grub* (derivation->output-path grub)
+ (derivation->output-path grub.cfg)
device "/"))))
((init)
(newline)
@@ -665,6 +666,7 @@ building anything."
target)
(install sys (canonicalize-path target)
#:grub? grub?
+ #:grub (derivation->output-path grub)
#:grub.cfg (derivation->output-path grub.cfg)
#:device device))
(else
- [PATCH] Explicitly pass grub to install, install-grub*, install-grub, initialize-hard-disk and qemu-image.,
Danny Milosavljevic <=