5 files changed, 57 insertions, 24 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 68402fda18..6bb1f72eb9 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -51,7 +51,9 @@
             options->transformation
             show-transformation-options-help
 
-            guix-build))
+            guix-build
+            register-root
+            register-root*))
 
 (define %default-log-urls
   ;; Default base URLs for build logs.
@@ -122,6 +124,9 @@ found.  Return #f if no build log was found."
         (leave (_ "failed to create GC root `~a': ~a~%")
                root (strerror (system-error-errno args)))))))
 
+(define register-root*
+  (store-lift register-root))
+
 (define (package-with-source store p uri)
   "Return a package based on P but with its source taken from URI.  Extract
 the new package's version number from URI."
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 44f490043c..5a6abd00fb 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -79,7 +79,9 @@ existing enviroment variables with additional search paths."
                (let ((current (getenv variable)))
                  (setenv variable
                          (if (and current (not pure?))
-                             (string-append value separator current)
+                             (if separator
+                                 (string-append value separator current)
+                                 value)
                              value)))))
             (evaluate-profile-search-paths profile paths))
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 9e91bc22ac..165e4ccf2a 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -280,6 +280,9 @@ the image."
          (option '(#\f "format") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'format (string->symbol arg) result)))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
@@ -323,6 +326,8 @@ Create a bundle of PACKAGE.\n"))
   (display (_ "
   -f, --format=FORMAT    build a pack in the given FORMAT"))
   (display (_ "
+  -e, --expression=EXPR  consider the package EXPR evaluates to"))
+  (display (_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
   (display (_ "
       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
@@ -349,20 +354,22 @@ Create a bundle of PACKAGE.\n"))
   (define opts
     (parse-command-line args %options (list %default-options)))
 
+  (define maybe-package-argument
+    ;; Given an option pair, return a package, a package/output tuple, or #f.
+    (match-lambda
+      (('argument . spec)
+       (call-with-values
+           (lambda ()
+             (specification->package+output spec))
+         list))
+      (('expression . exp)
+       (read/eval-package-expression exp))
+      (x #f)))
+
   (with-error-handling
     (parameterize ((%graft? (assoc-ref opts 'graft?)))
-      (let* ((dry-run? (assoc-ref opts 'dry-run?))
-             (specs    (filter-map (match-lambda
-                                     (('argument . name)
-                                      name)
-                                     (x #f))
-                                   opts))
-             (packages (map (lambda (spec)
-                              (call-with-values
-                                  (lambda ()
-                                    (specification->package+output spec))
-                                list))
-                            specs))
+      (let* ((dry-run?    (assoc-ref opts 'dry-run?))
+             (packages    (filter-map maybe-package-argument opts))
              (pack-format (assoc-ref opts 'format))
              (name        (string-append (symbol->string pack-format)
                                          "-pack"))
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index ea259f3758..f612dae700 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -91,7 +91,8 @@ if ITEM is not in the store."
                          (* 100. (/ self whole 1.)))))
               (sort profile
                     (match-lambda*
-                      ((($ <profile> _ _ total1) ($ <profile> _ _ total2))
+                      ((($ <profile> name1 self1 total1)
+                        ($ <profile> name2 self2 total2))
                        (> total1 total2)))))
     (format port (_ "total: ~,1f MiB~%") (/ whole MiB 1.))))
 
@@ -200,7 +201,8 @@ the name of a PNG file."
            0
            (sort profiles
                  (match-lambda*
-                   ((($ <profile> _ _ total1) ($ <profile> _ _ total2))
+                   ((($ <profile> name1 self1 total1)
+                     ($ <profile> name2 self2 total2))
                     (> total1 total2))))))
 
   ;; TRANSLATORS: This is the title of a graph, meaning that the graph
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)