Hi Danny,

Thanks for this patch! I have verified that it works both for `guix
system vm-image` and on my grub-efi system.

Do you think this eliminates the need for the "setenv PATH" trick in
guix/scripts/system.scm:648? For the record, I tested the patch with
that section removed as well, making sure there was no grub-install in
my PATH.

Other than that this LGTM. Would like a second opinion from more
seasoned Guix hackers before committing, though :)

Danny Milosavljevic <dannym@scratchpost.org> writes:

> * 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