From 39d1f82b520df44c80fa4acf6614709bb05a0f4c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 4 Dec 2014 23:52:28 +0100 Subject: system: Make /boot/grub/grub.cfg an indirect GC root. Fixes . * 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. --- guix/scripts/system.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 35f858cf29..f2a25dd65a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -134,10 +134,14 @@ 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" - (with-monad %store-monad - (unless (false-if-exception (install-grub grub.cfg device target)) - (leave (_ "failed to install GRUB on device '~a'~%") device)) - (return #t))) + (let ((add-root (store-lift add-indirect-root))) + (mbegin %store-monad + (munless (false-if-exception (install-grub grub.cfg device target)) + (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")))) (define* (install os-drv target #:key (log-port (current-output-port)) -- cgit v1.2.3