From fd214f1522063905021a297dab1ac4d85d94ad83 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludovic.courtes@inria.fr>
Date: Tue, 21 May 2019 14:33:51 +0200
Subject: [PATCH] pack: Add '--root'.

* guix/scripts/pack.scm (%options, show-help): Add "--root".
(guix-pack): Honor it.
* tests/guix-pack.sh: Test it.
* doc/guix.texi (Invoking guix pack): Document it.
---
 doc/guix.texi         |  6 ++++++
 guix/scripts/pack.scm | 15 ++++++++++++++-
 tests/guix-pack.sh    | 11 +++++++++--
 3 files changed, 29 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ae9ad0739e..873eaba490 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4927,6 +4927,12 @@ is an infinity of channel URLs and commit IDs that can lead to the same pack.
 Recording such ``silent'' metadata in the output thus potentially breaks the
 source-to-binary bitwise reproducibility property.
 
+@item --root=@var{file}
+@itemx -r @var{file}
+@cindex garbage collector root, for packs
+Make @var{file} a symlink to the resulting pack, and register it as a garbage
+collector root.
+
 @item --localstatedir
 @itemx --profile-name=@var{name}
 Include the ``local state directory'', @file{/var/guix}, in the resulting
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index b1d1e87c57..58c6ac6148 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -724,6 +724,10 @@ please email '~a'~%")
                       (alist-cons 'profile-name arg result))
                      (_
                       (leave (G_ "~a: unsupported profile name~%") arg)))))
+         (option '(#\r "root") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'gc-root arg result)))
+
          (option '(#\v "verbosity") #t #f
                  (lambda (opt name arg result)
                    (let ((level (string->number* arg)))
@@ -769,6 +773,9 @@ Create a bundle of PACKAGE.\n"))
       --profile-name=NAME
                          populate /var/guix/profiles/.../NAME"))
   (display (G_ "
+  -r, --root=FILE        make FILE a symlink to the result, and register it
+                         as a garbage collector root"))
+  (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (G_ "
       --bootstrap        use the bootstrap binaries to build the pack"))
@@ -882,7 +889,8 @@ Create a bundle of PACKAGE.\n"))
                                  (leave (G_ "~a: unknown pack format~%")
                                         pack-format))))
                  (localstatedir? (assoc-ref opts 'localstatedir?))
-                 (profile-name   (assoc-ref opts 'profile-name)))
+                 (profile-name   (assoc-ref opts 'profile-name))
+                 (gc-root        (assoc-ref opts 'gc-root)))
             (run-with-store store
               (mlet* %store-monad ((profile (profile-derivation
                                              manifest
@@ -919,6 +927,11 @@ Create a bundle of PACKAGE.\n"))
                                        #:dry-run? dry-run?)
                   (munless dry-run?
                     (built-derivations (list drv))
+                    (mwhen gc-root
+                      (register-root* (match (derivation->output-paths drv)
+                                        (((names . items) ...)
+                                         items))
+                                      gc-root))
                     (return (format #t "~a~%"
                                     (derivation->output-path drv))))))
               #:system (assoc-ref opts 'system))))))))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 3cd0404748..0feae6d1e8 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -33,6 +33,9 @@ guix pack --version
 GUIX_BUILD_OPTIONS="--no-substitutes"
 export GUIX_BUILD_OPTIONS
 
+test_directory="`mktemp -d`"
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
 # Build a tarball with no compression.
 guix pack --compression=none --bootstrap guile-bootstrap
 
@@ -42,14 +45,18 @@ out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`
 test -n "$out1"
 test "$out1" = "$out2"
 
+# Test '--root'.
+guix pack -r "$test_directory/my-guile" --bootstrap guile-bootstrap
+test "`readlink "$test_directory/my-guile"`" = "$out1"
+guix gc --list-roots | grep "^$test_directory/my-guile$"
+rm "$test_directory/my-guile"
+
 # Build a tarball with a symlink.
 the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
 
 # Try to extract it.  Note: we cannot test whether /opt/gnu/bin/guile itself
 # exists because /opt/gnu/bin may be an absolute symlink to a store item that
 # has been GC'd.
-test_directory="`mktemp -d`"
-trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
 cd "$test_directory"
 tar -xf "$the_pack"
 test -L opt/gnu/bin