* [RFC 3/4] install: Create a GC root during install-grub.
@ 2016-02-21 6:46 Jookia
2016-03-08 7:59 ` [RFCv2] " Jookia
` (2 more replies)
0 siblings, 3 replies; 8+ messages in thread
From: Jookia @ 2016-02-21 6:46 UTC (permalink / raw)
To: guix-devel
While previously creating a GC root for GRUB's resources was the caller's
responsibility, it's much less repetitive to put it in install-grub now that
it's wrapped by error handling. This also means we can replace the install-grub*
function with a small definition inside perform-action named 'install-boot'.
* gnu/build/install.scm (install-grub): Make a GC root for grub.cfg on success.
(register-grub.cfg-root): Remove function, install-grub does this now.
* gnu/system/vm.scm (qemu-image): Don't explicitly make a GC root.
* guix/scripts/system.scm (install-grub*): Move useful parts to perform-action.
(perform-action): Use inline definition install-boot to install GRUB.
---
gnu/build/install.scm | 22 +++++++++-------------
gnu/system/vm.scm | 15 +++++++--------
guix/scripts/system.scm | 47 +++++++++++++----------------------------------
3 files changed, 29 insertions(+), 55 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index e4f087f..b28dea8 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -22,7 +22,6 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (install-grub
- register-grub.cfg-root
populate-root-file-system
reset-timestamps
register-closure
@@ -39,13 +38,10 @@
(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."
+MOUNT-POINT."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
- (pivot (string-append target ".new")))
+ (pivot (string-append target ".new"))
+ (gcroot "/var/guix/gcroots"))
(mkdir-p (dirname target))
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
@@ -57,13 +53,13 @@ GC'd."
"--boot-directory"
(string-append mount-point "/boot")
device))
- (error "failed to install GRUB"))))
+ (error "failed to install GRUB"))
-(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 grub.cfg (string-append directory "/grub.cfg"))))
+ ;; Register GRUB.CFG as a GC root so the fonts, background images, etc.
+ ;; referred to by GRUB.CFG are not GC'd.
+ (evaluate-populate-directive `(directory ,gcroot) mount-point)
+ (evaluate-populate-directive
+ `(,(string-append gcroot "/grub.cfg") -> ,grub.cfg) mount-point)))
(define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 35c573d..e8a577c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -228,14 +228,13 @@ the image."
(guix build utils))
(define* (do-install-grub #:key device target)
- (and #$(prepare-install-grub
- #:mount-point 'target
- #:grub.cfg grub.cfg
- #:config
- (grub-configuration
- (inherit (operating-system-bootloader os-configuration))
- (device drive)))
- (register-grub.cfg-root target #$grub.cfg)))
+ #$(prepare-install-grub
+ #:mount-point 'target
+ #:grub.cfg grub.cfg
+ #:config
+ (grub-configuration
+ (inherit (operating-system-bootloader os-configuration))
+ (device drive))))
(let ((inputs
'#$(append (list qemu parted grub e2fsprogs)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 4374a10..d4d66e0 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -125,32 +125,6 @@ TARGET, and register them."
(map (cut copy-item <> target #:log-port log-port)
to-copy))))
-(define* (install-grub* #:key grub.cfg config target)
- "This is a variant of 'install-grub' with error handling, lifted in
-%STORE-MONAD"
- (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 (eval (prepare-install-grub
- #:grub.cfg grub.cfg
- #:config config
- #:mount-point target)
- (current-module))
- (delete-file temp-gc-root)
- (leave (_ "failed to install GRUB on device '~a'~%")
- (grub-configuration-device config)))
-
- ;; Register GRUB.CFG as a GC root so that its dependencies (background
- ;; image, font, etc.) are not reclaimed.
- (rename temp-gc-root gc-root))))
-
(define* (install os-drv target grub.cfg
#:key (log-port (current-output-port)))
"Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to
@@ -487,6 +461,7 @@ building anything."
(if (eq? 'init action)
'()
(previous-grub-entries)))))
+ (grub-config -> (operating-system-bootloader os))
;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
@@ -502,6 +477,16 @@ building anything."
(maybe-build drvs #:dry-run? dry-run?
#:use-substitutes? use-substitutes?))))
+ (define (install-boot)
+ (mbegin %store-monad
+ (munless (eval (prepare-install-grub
+ #:grub.cfg (derivation->output-path grub.cfg)
+ #:config grub-config
+ #:mount-point target)
+ (current-module))
+ (leave (_ "failed to install GRUB on device '~a'~%")
+ (grub-configuration-device grub-config)))))
+
(if (or dry-run? derivations-only?)
(return #f)
(begin
@@ -520,10 +505,7 @@ building anything."
(mbegin %store-monad
(switch-to-system os)
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target "/"))))
+ (install-boot))))
((init)
(newline)
(format #t (_ "initializing operating system under '~a'...~%")
@@ -532,10 +514,7 @@ building anything."
(install sys (canonicalize-path target)
(derivation->output-path grub.cfg))
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target target))))
+ (install-boot))))
(else
;; All we had to do was to build SYS.
(return (derivation->output-path sys))))))))
--
2.7.0
^ permalink raw reply related [flat|nested] 8+ messages in thread
* [RFCv2] install: Create a GC root during install-grub.
2016-02-21 6:46 [RFC 3/4] install: Create a GC root during install-grub Jookia
@ 2016-03-08 7:59 ` Jookia
2016-03-08 7:59 ` [RFCv3] " Jookia
2016-03-11 6:35 ` [RFCv4] " Jookia
2 siblings, 0 replies; 8+ messages in thread
From: Jookia @ 2016-03-08 7:59 UTC (permalink / raw)
To: guix-devel
While previously creating a GC root for GRUB's resources was the caller's
responsibility, it's much less repetitive to put it in install-grub now that
it's wrapped by error handling. This also means we can replace the install-grub*
function with a small definition inside perform-action named 'install-boot'.
* gnu/build/install.scm (install-grub): Make a GC root for grub.cfg on success.
(register-grub.cfg-root): Remove function, install-grub does this now.
* gnu/system/vm.scm (qemu-image): Don't explicitly make a GC root.
* guix/scripts/system.scm (install-grub*): Move useful parts to perform-action.
(perform-action): Use inline definition install-boot to install GRUB.
---
gnu/build/install.scm | 22 +++++++++-------------
gnu/system/vm.scm | 15 +++++++--------
guix/scripts/system.scm | 47 +++++++++++++----------------------------------
3 files changed, 29 insertions(+), 55 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index e4f087f..b28dea8 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -22,7 +22,6 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (install-grub
- register-grub.cfg-root
populate-root-file-system
reset-timestamps
register-closure
@@ -39,13 +38,10 @@
(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."
+MOUNT-POINT."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
- (pivot (string-append target ".new")))
+ (pivot (string-append target ".new"))
+ (gcroot "/var/guix/gcroots"))
(mkdir-p (dirname target))
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
@@ -57,13 +53,13 @@ GC'd."
"--boot-directory"
(string-append mount-point "/boot")
device))
- (error "failed to install GRUB"))))
+ (error "failed to install GRUB"))
-(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 grub.cfg (string-append directory "/grub.cfg"))))
+ ;; Register GRUB.CFG as a GC root so the fonts, background images, etc.
+ ;; referred to by GRUB.CFG are not GC'd.
+ (evaluate-populate-directive `(directory ,gcroot) mount-point)
+ (evaluate-populate-directive
+ `(,(string-append gcroot "/grub.cfg") -> ,grub.cfg) mount-point)))
(define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 35c573d..e8a577c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -228,14 +228,13 @@ the image."
(guix build utils))
(define* (do-install-grub #:key device target)
- (and #$(prepare-install-grub
- #:mount-point 'target
- #:grub.cfg grub.cfg
- #:config
- (grub-configuration
- (inherit (operating-system-bootloader os-configuration))
- (device drive)))
- (register-grub.cfg-root target #$grub.cfg)))
+ #$(prepare-install-grub
+ #:mount-point 'target
+ #:grub.cfg grub.cfg
+ #:config
+ (grub-configuration
+ (inherit (operating-system-bootloader os-configuration))
+ (device drive))))
(let ((inputs
'#$(append (list qemu parted grub e2fsprogs)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 4374a10..f3a10a5 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -125,32 +125,6 @@ TARGET, and register them."
(map (cut copy-item <> target #:log-port log-port)
to-copy))))
-(define* (install-grub* #:key grub.cfg config target)
- "This is a variant of 'install-grub' with error handling, lifted in
-%STORE-MONAD"
- (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 (eval (prepare-install-grub
- #:grub.cfg grub.cfg
- #:config config
- #:mount-point target)
- (current-module))
- (delete-file temp-gc-root)
- (leave (_ "failed to install GRUB on device '~a'~%")
- (grub-configuration-device config)))
-
- ;; Register GRUB.CFG as a GC root so that its dependencies (background
- ;; image, font, etc.) are not reclaimed.
- (rename temp-gc-root gc-root))))
-
(define* (install os-drv target grub.cfg
#:key (log-port (current-output-port)))
"Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to
@@ -487,6 +461,7 @@ building anything."
(if (eq? 'init action)
'()
(previous-grub-entries)))))
+ (grub-config -> (operating-system-bootloader os))
;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
@@ -502,6 +477,16 @@ building anything."
(maybe-build drvs #:dry-run? dry-run?
#:use-substitutes? use-substitutes?))))
+ (define (install-boot mount-point)
+ (mbegin %store-monad
+ (munless (eval (prepare-install-grub
+ #:grub.cfg (derivation->output-path grub.cfg)
+ #:config grub-config
+ #:mount-point mount-point)
+ (current-module))
+ (leave (_ "failed to install GRUB on device '~a'~%")
+ (grub-configuration-device grub-config)))))
+
(if (or dry-run? derivations-only?)
(return #f)
(begin
@@ -520,10 +505,7 @@ building anything."
(mbegin %store-monad
(switch-to-system os)
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target "/"))))
+ (install-boot "/"))))
((init)
(newline)
(format #t (_ "initializing operating system under '~a'...~%")
@@ -532,10 +514,7 @@ building anything."
(install sys (canonicalize-path target)
(derivation->output-path grub.cfg))
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target target))))
+ (install-boot mount-point))))
(else
;; All we had to do was to build SYS.
(return (derivation->output-path sys))))))))
--
2.7.0
^ permalink raw reply related [flat|nested] 8+ messages in thread
* [RFCv3] install: Create a GC root during install-grub.
2016-02-21 6:46 [RFC 3/4] install: Create a GC root during install-grub Jookia
2016-03-08 7:59 ` [RFCv2] " Jookia
@ 2016-03-08 7:59 ` Jookia
2016-03-11 6:35 ` [RFCv4] " Jookia
2 siblings, 0 replies; 8+ messages in thread
From: Jookia @ 2016-03-08 7:59 UTC (permalink / raw)
To: guix-devel
While previously creating a GC root for GRUB's resources was the caller's
responsibility, it's much less repetitive to put it in install-grub now that
it's wrapped by error handling. This also means we can replace the install-grub*
function with a small definition inside perform-action named 'install-boot'.
* gnu/build/install.scm (install-grub): Make a GC root for grub.cfg on success.
(register-grub.cfg-root): Remove function, install-grub does this now.
* gnu/system/vm.scm (qemu-image): Don't explicitly make a GC root.
* guix/scripts/system.scm (install-grub*): Move useful parts to perform-action.
(perform-action): Use inline definition install-boot to install GRUB.
---
gnu/build/install.scm | 22 +++++++++-------------
gnu/system/vm.scm | 15 +++++++--------
guix/scripts/system.scm | 48 +++++++++++++-----------------------------------
3 files changed, 29 insertions(+), 56 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index e4f087f..b28dea8 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -22,7 +22,6 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (install-grub
- register-grub.cfg-root
populate-root-file-system
reset-timestamps
register-closure
@@ -39,13 +38,10 @@
(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."
+MOUNT-POINT."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
- (pivot (string-append target ".new")))
+ (pivot (string-append target ".new"))
+ (gcroot "/var/guix/gcroots"))
(mkdir-p (dirname target))
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
@@ -57,13 +53,13 @@ GC'd."
"--boot-directory"
(string-append mount-point "/boot")
device))
- (error "failed to install GRUB"))))
+ (error "failed to install GRUB"))
-(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 grub.cfg (string-append directory "/grub.cfg"))))
+ ;; Register GRUB.CFG as a GC root so the fonts, background images, etc.
+ ;; referred to by GRUB.CFG are not GC'd.
+ (evaluate-populate-directive `(directory ,gcroot) mount-point)
+ (evaluate-populate-directive
+ `(,(string-append gcroot "/grub.cfg") -> ,grub.cfg) mount-point)))
(define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 35c573d..e8a577c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -228,14 +228,13 @@ the image."
(guix build utils))
(define* (do-install-grub #:key device target)
- (and #$(prepare-install-grub
- #:mount-point 'target
- #:grub.cfg grub.cfg
- #:config
- (grub-configuration
- (inherit (operating-system-bootloader os-configuration))
- (device drive)))
- (register-grub.cfg-root target #$grub.cfg)))
+ #$(prepare-install-grub
+ #:mount-point 'target
+ #:grub.cfg grub.cfg
+ #:config
+ (grub-configuration
+ (inherit (operating-system-bootloader os-configuration))
+ (device drive))))
(let ((inputs
'#$(append (list qemu parted grub e2fsprogs)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index dae47a5..57e5a18 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -126,33 +126,6 @@ TARGET, and register them."
(map (cut copy-item <> target #:log-port log-port)
to-copy))))
-(define* (install-grub* #:key grub.cfg config target)
- "This is a variant of 'install-grub' with error handling, lifted in
-%STORE-MONAD"
- (let* ((gc-root (string-append target %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 (eval (prepare-install-grub
- #:grub.cfg grub.cfg
- #:config config
- #:mount-point target)
- (current-module))
- (delete-file temp-gc-root)
- (leave (_ "failed to install GRUB on device '~a'~%")
- (grub-configuration-device config)))
-
- ;; Register GRUB.CFG as a GC root so that its dependencies (background
- ;; image, font, etc.) are not reclaimed.
- (rename temp-gc-root gc-root))))
-
(define* (install os-drv target grub.cfg
#:key (log-port (current-output-port)))
"Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to
@@ -510,6 +483,7 @@ building anything."
(if (eq? 'init action)
'()
(previous-grub-entries)))))
+ (grub-config -> (operating-system-bootloader os))
;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
@@ -525,6 +499,16 @@ building anything."
(maybe-build drvs #:dry-run? dry-run?
#:use-substitutes? use-substitutes?))))
+ (define (install-boot mount-point)
+ (mbegin %store-monad
+ (munless (eval (prepare-install-grub
+ #:grub.cfg (derivation->output-path grub.cfg)
+ #:config grub-config
+ #:mount-point mount-point)
+ (current-module))
+ (leave (_ "failed to install GRUB on device '~a'~%")
+ (grub-configuration-device grub-config)))))
+
(if (or dry-run? derivations-only?)
(return #f)
(begin
@@ -543,10 +527,7 @@ building anything."
(mbegin %store-monad
(switch-to-system os)
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target "/"))))
+ (install-boot "/"))))
((init)
(newline)
(format #t (_ "initializing operating system under '~a'...~%")
@@ -555,10 +536,7 @@ building anything."
(install sys (canonicalize-path target)
(derivation->output-path grub.cfg))
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target target))))
+ (install-boot mount-point))))
(else
;; All we had to do was to build SYS.
(return (derivation->output-path sys))))))))
--
2.7.0
^ permalink raw reply related [flat|nested] 8+ messages in thread
* [RFCv4] install: Create a GC root during install-grub.
2016-02-21 6:46 [RFC 3/4] install: Create a GC root during install-grub Jookia
2016-03-08 7:59 ` [RFCv2] " Jookia
2016-03-08 7:59 ` [RFCv3] " Jookia
@ 2016-03-11 6:35 ` Jookia
2016-03-11 14:48 ` Ludovic Courtès
2 siblings, 1 reply; 8+ messages in thread
From: Jookia @ 2016-03-11 6:35 UTC (permalink / raw)
To: guix-devel
While previously creating a GC root for GRUB's resources was the caller's
responsibility, it's much less repetitive to put it in install-grub now that
it's wrapped by error handling. This also means we can replace the install-grub*
function with a small definition inside perform-action named 'install-boot'.
* gnu/build/install.scm (install-grub): Make a GC root for grub.cfg on success.
(register-grub.cfg-root): Remove function, install-grub does this now.
* gnu/system/vm.scm (qemu-image): Don't explicitly make a GC root.
* guix/scripts/system.scm (install-grub*): Move useful parts to perform-action.
(perform-action): Use inline definition install-boot to install GRUB.
---
gnu/build/install.scm | 22 +++++++++-------------
gnu/system/vm.scm | 15 +++++++--------
guix/scripts/system.scm | 48 +++++++++++++-----------------------------------
3 files changed, 29 insertions(+), 56 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index e4f087f..b28dea8 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -22,7 +22,6 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (install-grub
- register-grub.cfg-root
populate-root-file-system
reset-timestamps
register-closure
@@ -39,13 +38,10 @@
(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."
+MOUNT-POINT."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
- (pivot (string-append target ".new")))
+ (pivot (string-append target ".new"))
+ (gcroot "/var/guix/gcroots"))
(mkdir-p (dirname target))
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
@@ -57,13 +53,13 @@ GC'd."
"--boot-directory"
(string-append mount-point "/boot")
device))
- (error "failed to install GRUB"))))
+ (error "failed to install GRUB"))
-(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 grub.cfg (string-append directory "/grub.cfg"))))
+ ;; Register GRUB.CFG as a GC root so the fonts, background images, etc.
+ ;; referred to by GRUB.CFG are not GC'd.
+ (evaluate-populate-directive `(directory ,gcroot) mount-point)
+ (evaluate-populate-directive
+ `(,(string-append gcroot "/grub.cfg") -> ,grub.cfg) mount-point)))
(define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 35c573d..e8a577c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -228,14 +228,13 @@ the image."
(guix build utils))
(define* (do-install-grub #:key device target)
- (and #$(prepare-install-grub
- #:mount-point 'target
- #:grub.cfg grub.cfg
- #:config
- (grub-configuration
- (inherit (operating-system-bootloader os-configuration))
- (device drive)))
- (register-grub.cfg-root target #$grub.cfg)))
+ #$(prepare-install-grub
+ #:mount-point 'target
+ #:grub.cfg grub.cfg
+ #:config
+ (grub-configuration
+ (inherit (operating-system-bootloader os-configuration))
+ (device drive))))
(let ((inputs
'#$(append (list qemu parted grub e2fsprogs)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index dae47a5..bd92ae8 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -126,33 +126,6 @@ TARGET, and register them."
(map (cut copy-item <> target #:log-port log-port)
to-copy))))
-(define* (install-grub* #:key grub.cfg config target)
- "This is a variant of 'install-grub' with error handling, lifted in
-%STORE-MONAD"
- (let* ((gc-root (string-append target %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 (eval (prepare-install-grub
- #:grub.cfg grub.cfg
- #:config config
- #:mount-point target)
- (current-module))
- (delete-file temp-gc-root)
- (leave (_ "failed to install GRUB on device '~a'~%")
- (grub-configuration-device config)))
-
- ;; Register GRUB.CFG as a GC root so that its dependencies (background
- ;; image, font, etc.) are not reclaimed.
- (rename temp-gc-root gc-root))))
-
(define* (install os-drv target grub.cfg
#:key (log-port (current-output-port)))
"Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to
@@ -510,6 +483,7 @@ building anything."
(if (eq? 'init action)
'()
(previous-grub-entries)))))
+ (grub-config -> (operating-system-bootloader os))
;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
@@ -525,6 +499,16 @@ building anything."
(maybe-build drvs #:dry-run? dry-run?
#:use-substitutes? use-substitutes?))))
+ (define (install-boot mount-point)
+ (mbegin %store-monad
+ (munless (eval (prepare-install-grub
+ #:grub.cfg (derivation->output-path grub.cfg)
+ #:config grub-config
+ #:mount-point mount-point)
+ (current-module))
+ (leave (_ "failed to install GRUB on device '~a'~%")
+ (grub-configuration-device grub-config)))))
+
(if (or dry-run? derivations-only?)
(return #f)
(begin
@@ -543,10 +527,7 @@ building anything."
(mbegin %store-monad
(switch-to-system os)
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target "/"))))
+ (install-boot "/"))))
((init)
(newline)
(format #t (_ "initializing operating system under '~a'...~%")
@@ -555,10 +536,7 @@ building anything."
(install sys (canonicalize-path target)
(derivation->output-path grub.cfg))
(mwhen grub?
- (install-grub*
- #:grub.cfg (derivation->output-path grub.cfg)
- #:config (operating-system-bootloader os)
- #:target target))))
+ (install-boot target))))
(else
;; All we had to do was to build SYS.
(return (derivation->output-path sys))))))))
--
2.7.0
^ permalink raw reply related [flat|nested] 8+ messages in thread
* Re: [RFCv4] install: Create a GC root during install-grub.
2016-03-11 6:35 ` [RFCv4] " Jookia
@ 2016-03-11 14:48 ` Ludovic Courtès
2016-03-11 16:23 ` Jookia
0 siblings, 1 reply; 8+ messages in thread
From: Ludovic Courtès @ 2016-03-11 14:48 UTC (permalink / raw)
To: Jookia; +Cc: guix-devel
Jookia <166291@gmail.com> skribis:
> While previously creating a GC root for GRUB's resources was the caller's
> responsibility, it's much less repetitive to put it in install-grub now that
> it's wrapped by error handling. This also means we can replace the install-grub*
> function with a small definition inside perform-action named 'install-boot'.
>
> * gnu/build/install.scm (install-grub): Make a GC root for grub.cfg on success.
> (register-grub.cfg-root): Remove function, install-grub does this now.
> * gnu/system/vm.scm (qemu-image): Don't explicitly make a GC root.
> * guix/scripts/system.scm (install-grub*): Move useful parts to perform-action.
> (perform-action): Use inline definition install-boot to install GRUB.
Is it different from v1 to v3?
I’m asking because I feel it might be difficult for me to find out what
the right version is when I start reviewing these. :-)
Ludo’.
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [RFCv4] install: Create a GC root during install-grub.
2016-03-11 14:48 ` Ludovic Courtès
@ 2016-03-11 16:23 ` Jookia
2016-03-13 21:44 ` Ludovic Courtès
0 siblings, 1 reply; 8+ messages in thread
From: Jookia @ 2016-03-11 16:23 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
On Fri, Mar 11, 2016 at 03:48:38PM +0100, Ludovic Courtès wrote:
> Jookia <166291@gmail.com> skribis:
>
> > While previously creating a GC root for GRUB's resources was the caller's
> > responsibility, it's much less repetitive to put it in install-grub now that
> > it's wrapped by error handling. This also means we can replace the install-grub*
> > function with a small definition inside perform-action named 'install-boot'.
> >
> > * gnu/build/install.scm (install-grub): Make a GC root for grub.cfg on success.
> > (register-grub.cfg-root): Remove function, install-grub does this now.
> > * gnu/system/vm.scm (qemu-image): Don't explicitly make a GC root.
> > * guix/scripts/system.scm (install-grub*): Move useful parts to perform-action.
> > (perform-action): Use inline definition install-boot to install GRUB.
>
> Is it different from v1 to v3?
>
> I’m asking because I feel it might be difficult for me to find out what
> the right version is when I start reviewing these. :-)
>
> Ludo’.
Yes, apologies since I'm not exactly sure how to add text that would be taken
out in final patches. v2 fixes an issue with reconfigure breaking since it
assumed there was always a target (not true), I can't remember what v3 fixed, v4
fixed v2's fix since I used the wrong variable name. Perhaps I should write
diffs to patches assuming all the patches are in a single directory?
Jookia.
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [RFCv4] install: Create a GC root during install-grub.
2016-03-11 16:23 ` Jookia
@ 2016-03-13 21:44 ` Ludovic Courtès
2016-03-14 2:58 ` Jookia
0 siblings, 1 reply; 8+ messages in thread
From: Ludovic Courtès @ 2016-03-13 21:44 UTC (permalink / raw)
To: Jookia; +Cc: guix-devel
Jookia <166291@gmail.com> skribis:
> On Fri, Mar 11, 2016 at 03:48:38PM +0100, Ludovic Courtès wrote:
>> Jookia <166291@gmail.com> skribis:
>>
>> > While previously creating a GC root for GRUB's resources was the caller's
>> > responsibility, it's much less repetitive to put it in install-grub now that
>> > it's wrapped by error handling. This also means we can replace the install-grub*
>> > function with a small definition inside perform-action named 'install-boot'.
>> >
>> > * gnu/build/install.scm (install-grub): Make a GC root for grub.cfg on success.
>> > (register-grub.cfg-root): Remove function, install-grub does this now.
>> > * gnu/system/vm.scm (qemu-image): Don't explicitly make a GC root.
>> > * guix/scripts/system.scm (install-grub*): Move useful parts to perform-action.
>> > (perform-action): Use inline definition install-boot to install GRUB.
>>
>> Is it different from v1 to v3?
>>
>> I’m asking because I feel it might be difficult for me to find out what
>> the right version is when I start reviewing these. :-)
>>
>> Ludo’.
>
> Yes, apologies since I'm not exactly sure how to add text that would be taken
> out in final patches. v2 fixes an issue with reconfigure breaking since it
> assumed there was always a target (not true), I can't remember what v3 fixed, v4
> fixed v2's fix since I used the wrong variable name.
OK.
> Perhaps I should write diffs to patches assuming all the patches are
> in a single directory?
Diffs to patches would be hard to read, but if you could simply add a
cover letter with a short summary of the changes compared to previous
versions, that’d be perfect. :-)
Ludo’.
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [RFCv4] install: Create a GC root during install-grub.
2016-03-13 21:44 ` Ludovic Courtès
@ 2016-03-14 2:58 ` Jookia
0 siblings, 0 replies; 8+ messages in thread
From: Jookia @ 2016-03-14 2:58 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
On Sun, Mar 13, 2016 at 10:44:38PM +0100, Ludovic Courtès wrote:
> Diffs to patches would be hard to read, but if you could simply add a
> cover letter with a short summary of the changes compared to previous
> versions, that’d be perfect. :-)
I think for an RFC at least it'd be best for me to stop squashing commits and
freely add on. The downside is that each patch isn't usable on its own, but I
suppose that's a bit of premature optimization on my end. It also cost me way
too much time testing with that workflow.
For patches I've found I can just add a notice under the Git commit, so that
works too.
> Ludo’.
Jookia.
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2016-03-14 3:01 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-02-21 6:46 [RFC 3/4] install: Create a GC root during install-grub Jookia
2016-03-08 7:59 ` [RFCv2] " Jookia
2016-03-08 7:59 ` [RFCv3] " Jookia
2016-03-11 6:35 ` [RFCv4] " Jookia
2016-03-11 14:48 ` Ludovic Courtès
2016-03-11 16:23 ` Jookia
2016-03-13 21:44 ` Ludovic Courtès
2016-03-14 2:58 ` Jookia
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).