From 430fdb321f3401d5a498f002291ae520d47f1dcf Mon Sep 17 00:00:00 2001
From: Chris Marusich
Date: Mon, 3 Apr 2017 23:49:22 -0700
Subject: [PATCH 2/2] system: Support the --root option in 'guix system'.
Fixes .
* guix/scripts/system.scm (perform-action): Add #:gc-root parameter and honor
it.
(show-help): Document the --root option.
(%options): Add 'root'.
(process-action): Pass 'root' option to perform-action as #:gc-root.
---
guix/scripts/system.scm | 25 ++++++++++++++++++++-----
1 file changed, 20 insertions(+), 5 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 144a7fd37..d867465dd 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -593,7 +593,8 @@ PATTERN, a string. When PATTERN is #f, display all the system generations."
#:key grub? dry-run? derivations-only?
use-substitutes? device target
image-size full-boot?
- (mappings '()))
+ (mappings '())
+ (gc-root #f))
"Perform ACTION for OS. GRUB? specifies whether to install GRUB; DEVICE is
the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
is the size of the image to be built, for the 'vm-image' and 'disk-image'
@@ -601,7 +602,10 @@ actions. FULL-BOOT? is used for the 'vm' action; it determines whether to
boot directly to the kernel or to the bootloader.
When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
-building anything."
+building anything.
+
+When GC-ROOT is a path, also make that path an indirect root of the build
+output when building a system derivation, such as a disk image."
(define println
(cut format #t "~a~%" <>))
@@ -665,8 +669,11 @@ building anything."
#:grub.cfg (derivation->output-path grub.cfg)
#:device device))
(else
- ;; All we had to do was to build SYS.
- (return (derivation->output-path sys))))))))
+ ;; All we had to do was to build SYS and maybe register an
+ ;; indirect GC root.
+ (mwhen gc-root
+ (register-root* (list (derivation->output-path sys))
+ gc-root))))))))
(define (export-extension-graph os port)
"Export the service extension graph of OS to PORT."
@@ -741,6 +748,10 @@ Some ACTIONS support additional ARGS.\n"))
(display (_ "
--share=SPEC for 'vm', share host file system according to SPEC"))
(display (_ "
+ -r, --root=FILE for 'vm', 'vm-image', 'disk-image', 'container',
+ and 'build', make FILE a symlink to the result, and
+ register it as a garbage collector root."))
+ (display (_ "
--expose=SPEC for 'vm', expose host file system according to SPEC"))
(display (_ "
--full-boot for 'vm', make a full boot sequence"))
@@ -797,6 +808,9 @@ Some ACTIONS support additional ARGS.\n"))
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
+ (option '(#\r "root") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'gc-root arg result)))
%standard-build-options))
(define %default-options
@@ -863,7 +877,8 @@ resulting from command-line parsing."
(_ #f))
opts)
#:grub? grub?
- #:target target #:device device))))
+ #:target target #:device device
+ #:gc-root (assoc-ref opts 'gc-root)))))
#:system system))))
(define (process-command command args opts)
--
2.12.0