system: Make /boot/grub/grub.cfg an indirect GC root.

Fixes <http://bugs.gnu.org/19160>.

* guix/scripts/system.scm (install-grub*): Make /boot/grub/grub.cfg an
  indirect GC root.
* gnu/build/install.scm (install-grub): Make TARGET a symlink.
* gnu/build/vm.scm (register-grub.cfg-root): New procedure.
  (initialize-hard-disk): Use it.

2 files changed, 21 insertions, 4 deletions

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index a472259a4a..111b79ee59 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -36,14 +36,15 @@
 
 (define* (install-grub grub.cfg device mount-point)
   "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT."
+MOUNT-POINT.  Note that the caller must make sure that GRUB.CFG is registered
+as a GC root."
   (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
          (pivot  (string-append target ".new")))
     (mkdir-p (dirname target))
 
-    ;; Copy GRUB.CFG instead of just symlinking it since it's not a GC root.
-    ;; Do that atomically.
-    (copy-file grub.cfg pivot)
+    ;; Symlink GRUB.CFG, under the assumption that it has been registered as a
+    ;; GC root somewhere.  Do that atomically.
+    (symlink grub.cfg pivot)
     (rename-file pivot target)
 
     (unless (zero? (system* "grub-install" "--no-floppy"
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 03db1cd5f9..1762582343 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -178,6 +178,18 @@ 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")))
+    (mkdir-p directory)
+    (symlink "/boot/grub/grub.cfg" (string-append directory "/" hash))))
+
 (define* (initialize-hard-disk device
                                #:key
                                system-directory
@@ -222,6 +234,10 @@ 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)
+
   ;; 'guix-register' resets timestamps and everything, so no need to do it
   ;; once more in that case.
   (unless register-closures?