[4/5] install: Extract procedure: install-grub-config.

Message ID 20161102054815.11253-5-cmmarusich@gmail.com
State New
Headers

Commit Message

Chris Marusich Nov. 2, 2016, 5:48 a.m. UTC
  From: Chris Marusich <cmmarusich@gmail.com>

* gnu/build/install.scm (install-grub-config): New procedure.
(install-grub): Use it.
---
 gnu/build/install.scm | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)
  

Comments

Ludovic Courtès Nov. 6, 2016, 4:59 p.m. UTC | #1
cmmarusich@gmail.com skribis:

> From: Chris Marusich <cmmarusich@gmail.com>
>
> * gnu/build/install.scm (install-grub-config): New procedure.
> (install-grub): Use it.

Applied!
  
Danny Milosavljevic Nov. 6, 2016, 9 p.m. UTC | #2
Thanks for this!

> -(define* (install-grub grub.cfg device mount-point)
> +(define (install-grub grub.cfg device mount-point)
>    "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
>  MOUNT-POINT.
>  
>  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"

^^^ since you have touched it, maybe you know: How does it know which package's (which directory's) grub-install to invoke here?
  
Chris Marusich Nov. 7, 2016, 1:25 a.m. UTC | #3
Danny Milosavljevic <dannym@scratchpost.org> writes:

> Thanks for this!
>
>> -(define* (install-grub grub.cfg device mount-point)
>> +(define (install-grub grub.cfg device mount-point)
>>    "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
>>  MOUNT-POINT.
>>  
>>  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"
>
> ^^^ since you have touched it, maybe you know: How does it know which package's (which directory's) grub-install to invoke here?

There is logic in the perform-action procedure in (guix scripts system)
which adds GRUB to the PATH environment variable.  That's where the
determination occurs.  So, currently, it looks like the 'grub-install'
command comes from whatever version of grub happens to be defined in
(gnu packages grub) at the time perform-action gets called.  In
practice, I believe this means that whatever grub version is currently
available in guix (e.g., as seen via 'guix package --show=grub') will be
used.

Hope that helps!
  
Danny Milosavljevic Nov. 7, 2016, 10:32 a.m. UTC | #4
Hi Chris,

> Hope that helps!

Yeah, thank you!

(I think it would be a lot less confusing to just pass (derivation->output-path grub) to (install-grub* ...) as well instead of that O_o)
  

Patch

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 7431a09..3d1594e 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,5 +1,6 @@ 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@ 
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (install-grub
+            install-grub-config
             populate-root-file-system
             reset-timestamps
             register-closure
@@ -36,13 +38,24 @@ 
 ;;;
 ;;; Code:
 
-(define* (install-grub grub.cfg device mount-point)
+(define (install-grub grub.cfg device mount-point)
   "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
 MOUNT-POINT.
 
 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"
+                          "--boot-directory"
+                          (string-append mount-point "/boot")
+                          device))
+    (error "failed to install GRUB")))
+
+(define (install-grub-config grub.cfg mount-point)
+  "Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT.  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."
   (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
          (pivot  (string-append target ".new")))
     (mkdir-p (dirname target))
@@ -50,13 +63,7 @@  GC'd."
     ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
     ;; work when /boot is on a separate partition.  Do that atomically.
     (copy-file grub.cfg pivot)
-    (rename-file pivot target)
-
-    (unless (zero? (system* "grub-install" "--no-floppy"
-                            "--boot-directory"
-                            (string-append mount-point "/boot")
-                            device))
-      (error "failed to install GRUB"))))
+    (rename-file pivot target)))
 
 (define (evaluate-populate-directive directive target)
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under