aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChris Marusich <cmmarusich@gmail.com>2017-04-03 23:49:22 -0700
committerLudovic Courtès <ludo@gnu.org>2017-04-06 10:24:32 +0200
commit5ea69d9a563fa1e2890c94fe9574c7e16f778f3b (patch)
tree85f1513506778ad6faa978967fb63e4130ead4ca
parenta09b45da6fe951112eb30da5feb0f86266f8ba8a (diff)
downloadguix-5ea69d9a563fa1e2890c94fe9574c7e16f778f3b.tar
guix-5ea69d9a563fa1e2890c94fe9574c7e16f778f3b.tar.gz
system: Support the --root option in 'guix system'.
Fixes <https://bugs.gnu.org/26271>. * 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. * doc/guix.texi (Invoking guix system): Document '--root'. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
-rw-r--r--doc/guix.texi5
-rw-r--r--guix/scripts/system.scm31
2 files changed, 29 insertions, 7 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index c29af46ff1..d413ea4a50 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -15238,6 +15238,11 @@ of the given @var{size}. @var{size} may be a number of bytes, or it may
include a unit as a suffix (@pxref{Block size, size specifications,,
coreutils, GNU Coreutils}).
+@item --root=@var{file}
+@itemx -r @var{file}
+Make @var{file} a symlink to the result, and register it as a garbage
+collector root.
+
@item --on-error=@var{strategy}
Apply @var{strategy} when an error occurs when reading @var{file}.
@var{strategy} may be one of the following:
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 144a7fd377..b0a794bf8e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -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,13 @@ 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.
+ (let ((output (derivation->output-path sys)))
+ (mbegin %store-monad
+ (mwhen gc-root
+ (register-root* (list output) gc-root))
+ (return output)))))))))
(define (export-extension-graph os port)
"Export the service extension graph of OS to PORT."
@@ -741,6 +750,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 +810,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 +879,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)