[bug#33111] [PATCH 2/3] pack: Add '--profile-name'.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/scripts/pack.scm (self-contained-tarball): Add #:profile-name and
honor it.
(squashfs-image, docker-image): Add #:profile-name.
(%default-options): Add 'profile-name'.
(%options, show-help): Add "--profile-name".
(guix-pack): Honor it.
* tests/guix-pack.sh: Add test for '--localstatedir
--profile-name=current-guix'.
* doc/guix.texi (Invoking guix pack): Document "--profile-name".
---
 doc/guix.texi         |  7 +++++--
 guix/scripts/pack.scm | 20 +++++++++++++++++++-
 tests/guix-pack.sh    | 17 +++++++++++++++--
 3 files changed, 39 insertions(+), 5 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 12346c4b8..7265eed91 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3459,8 +3459,11 @@ For instance, @code{-S /opt/gnu/bin=bin} creates a @file{/opt/gnu/bin}
 symlink pointing to the @file{bin} sub-directory of the profile.
 
 @item --localstatedir
-Include the ``local state directory'', @file{/var/guix}, in the
-resulting pack.
+@itemx --profile-name=@var{name}
+Include the ``local state directory'', @file{/var/guix}, in the resulting
+pack, and notably the @file{/var/guix/profiles/per-user/root/@var{name}}
+profile---by default @var{name} is @code{guix-profile}, which corresponds to
+@file{~root/.guix-profile}.
 
 @file{/var/guix} contains the store database (@pxref{The Store}) as well
 as garbage-collector roots (@pxref{Invoking guix gc}).  Providing it in
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index b7b4e22bb..a87a96115 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -105,6 +105,7 @@ found."
 
 (define* (self-contained-tarball name profile
                                  #:key target
+                                 (profile-name "guix-profile")
                                  deduplicate?
                                  (compressor (first %compressors))
                                  localstatedir?
@@ -184,6 +185,7 @@ added to the pack."
             ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>.
             (populate-single-profile-directory %root
                                                #:profile #$profile
+                                               #:profile-name #$profile-name
                                                #:closure "profile"
                                                #:deduplicate? #f
                                                #:register? #$localstatedir?
@@ -244,6 +246,7 @@ added to the pack."
 
 (define* (squashfs-image name profile
                          #:key target
+                         (profile-name "guix-profile")
                          deduplicate?
                          (compressor (first %compressors))
                          localstatedir?
@@ -333,6 +336,7 @@ added to the pack."
 
 (define* (docker-image name profile
                        #:key target
+                       (profile-name "guix-profile")
                        deduplicate?
                        (compressor (first %compressors))
                        localstatedir?
@@ -538,6 +542,7 @@ please email '~a'~%")
 (define %default-options
   ;; Alist of default option values.
   `((format . tarball)
+    (profile-name . "guix-profile")
     (system . ,(%current-system))
     (substitutes? . #t)
     (build-hook? . #t)
@@ -609,6 +614,13 @@ please email '~a'~%")
          (option '("localstatedir") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'localstatedir? #t result)))
+         (option '("profile-name") #t #f
+                 (lambda (opt name arg result)
+                   (match arg
+                     ((or "guix-profile" "current-guix")
+                      (alist-cons 'profile-name arg result))
+                     (_
+                      (leave (G_ "~a: unsupported profile name~%") arg)))))
          (option '("bootstrap") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'bootstrap? #t result)))
@@ -641,6 +653,9 @@ Create a bundle of PACKAGE.\n"))
   -m, --manifest=FILE    create a pack with the manifest from FILE"))
   (display (G_ "
       --localstatedir    include /var/guix in the resulting pack"))
+  (display (G_ "
+      --profile-name=NAME
+                         populate /var/guix/profiles/.../NAME"))
   (display (G_ "
       --bootstrap        use the bootstrap binaries to build the pack"))
   (newline)
@@ -730,7 +745,8 @@ Create a bundle of PACKAGE.\n"))
                                 (#f
                                  (leave (G_ "~a: unknown pack format~%")
                                         pack-format))))
-                 (localstatedir? (assoc-ref opts 'localstatedir?)))
+                 (localstatedir? (assoc-ref opts 'localstatedir?))
+                 (profile-name   (assoc-ref opts 'profile-name)))
             (run-with-store store
               (mlet* %store-monad ((profile (profile-derivation
                                              manifest
@@ -749,6 +765,8 @@ Create a bundle of PACKAGE.\n"))
                                                      symlinks
                                                      #:localstatedir?
                                                      localstatedir?
+                                                     #:profile-name
+                                                     profile-name
                                                      #:archiver
                                                      archiver)))
                 (mbegin %store-monad
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index cd721a60e..c55fe6c9a 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -61,7 +61,7 @@ the_pack="`guix pack -S /opt/gnu/bin=bin guile-bootstrap`"
 # exists because /opt/gnu/bin may be an absolute symlink to a store item that
 # has been GC'd.
 test_directory="`mktemp -d`"
-trap 'rm -rf "$test_directory"' EXIT
+trap 'find "$test_directory" -type d -exec chmod +w {} \; ;rm -rf "$test_directory"' EXIT
 cd "$test_directory"
 tar -xf "$the_pack"
 test -L opt/gnu/bin
@@ -74,10 +74,23 @@ is_available () {
 if is_available chroot && is_available unshare; then
     # Verify we can use what we built.
     unshare -r chroot . /opt/gnu/bin/guile --version
-    cd -
 else
     echo "warning: skipped some verification because chroot or unshare is unavailable" >&2
 fi
+cd -
+rm -rf "$test_directory"
+
+# Build a tarball with '--localstatedir'
+the_pack="`guix pack -C none --localstatedir --profile-name=current-guix \
+            guile-bootstrap`"
+test_directory="`mktemp -d`"
+cd "$test_directory"
+tar -xf "$the_pack"
+
+profile="`find -name current-guix`"
+test "`readlink $profile`" = "current-guix-1-link"
+test -s "`dirname $profile`/../../../db/db.sqlite"
+test -x ".`guix build guile-bootstrap`/bin/guile"
 
 # For the tests that build Docker images below, we currently have to use
 # --dry-run because if we don't, there are only two possible cases:
-- 
2.19.1