[PATCH] Explicitly pass grub to install, install-grub*, install-grub, initialize-hard-disk and qemu-image.

[Danny Milosavljevic <dannym@scratchpost.org>]

* 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)))))
 
 \f
 ;;;
@@ -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