3 files changed, 25 insertions(+), 20 deletions(-)

M gnu/build/install.scm
M gnu/build/vm.scm
M guix/scripts/system.scm

@@ 36,15 36,18 @@
 
 (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."
+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))
 
-    ;; Symlink GRUB.CFG, under the assumption that it has been registered as a
-    ;; GC root somewhere.  Do that atomically.
-    (symlink grub.cfg pivot)
+    ;; 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"

@@ 178,17 178,11 @@ volume name."
   (display "populating...\n")
   (populate-root-file-system system-directory target-directory))
 
-(define (register-grub.cfg-root target)
-  "On file system TARGET, make '/boot/grub/grub.cfg' an indirect GC root."
-  (define hash
-    ;; XXX: Believe it or not, this is that nix-base32-encoded SHA1 of the
-    ;; string "/boot/grub/grub.cfg".  We need it here, but gcrypt isn't
-    ;; available (a random hash would do as well, though.)
-    "kv0yq1d48kavqfhjfzvc4lcyazx2mqhv")
-
-  (let ((directory (string-append target "/var/guix/gcroots/auto")))
+(define (register-grub.cfg-root target grub.cfg)
+  "On file system TARGET, register GRUB.CFG as a GC root."
+  (let ((directory (string-append target "/var/guix/gcroots")))
     (mkdir-p directory)
-    (symlink "/boot/grub/grub.cfg" (string-append directory "/" hash))))
+    (symlink grub.cfg (string-append directory "/grub.cfg"))))
 
 (define* (initialize-hard-disk device
                                #:key


@@ 234,9 228,8 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
 
   (install-grub grub.cfg device target-directory)
 
-  ;; Register $target/boot/grub/grub.cfg as an indirect root, so that GRUB.CFG
-  ;; is not reclaimed.
-  (register-grub.cfg-root target-directory)
+  ;; Register GRUB.CFG as a GC root.
+  (register-grub.cfg-root target-directory grub.cfg)
 
   ;; 'guix-register' resets timestamps and everything, so no need to do it
   ;; once more in that case.

@@ 134,14 134,23 @@ TARGET, and register them."
 (define (install-grub* grub.cfg device target)
   "This is a variant of 'install-grub' with error handling, lifted in
 %STORE-MONAD"
-  (let ((add-root (store-lift add-indirect-root)))
+  (let* ((gc-root      (string-append %gc-roots-directory "/grub.cfg"))
+         (temp-gc-root (string-append gc-root ".new"))
+         (delete-file  (lift1 delete-file %store-monad))
+         (make-symlink (lift2 switch-symlinks %store-monad))
+         (rename       (lift2 rename-file %store-monad)))
     (mbegin %store-monad
+      ;; Prepare the symlink to GRUB.CFG to make sure that it's a GC root when
+      ;; 'install-grub' completes (being a bit paranoid.)
+      (make-symlink temp-gc-root grub.cfg)
+
       (munless (false-if-exception (install-grub grub.cfg device target))
+        (delete-file temp-gc-root)
         (leave (_ "failed to install GRUB on device '~a'~%") device))
 
       ;; Register GRUB.CFG as a GC root so that its dependencies (background
       ;; image, font, etc.) are not reclaimed.
-      (add-root "/boot/grub/grub.cfg"))))
+      (rename temp-gc-root gc-root))))
 
 (define* (install os-drv target
                   #:key (log-port (current-output-port))