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.
This commit is contained in:
Ludovic Courtès 2019-05-21 14:33:51 +02:00 committed by Ludovic Courtès
parent 6acf6cec7d
commit fd214f1522
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 29 additions and 3 deletions

View File

@ -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 Recording such ``silent'' metadata in the output thus potentially breaks the
source-to-binary bitwise reproducibility property. 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 @item --localstatedir
@itemx --profile-name=@var{name} @itemx --profile-name=@var{name}
Include the ``local state directory'', @file{/var/guix}, in the resulting Include the ``local state directory'', @file{/var/guix}, in the resulting

View File

@ -724,6 +724,10 @@ please email '~a'~%")
(alist-cons 'profile-name arg result)) (alist-cons 'profile-name arg result))
(_ (_
(leave (G_ "~a: unsupported profile name~%") arg))))) (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 (option '(#\v "verbosity") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(let ((level (string->number* arg))) (let ((level (string->number* arg)))
@ -769,6 +773,9 @@ Create a bundle of PACKAGE.\n"))
--profile-name=NAME --profile-name=NAME
populate /var/guix/profiles/.../NAME")) populate /var/guix/profiles/.../NAME"))
(display (G_ " (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")) -v, --verbosity=LEVEL use the given verbosity LEVEL"))
(display (G_ " (display (G_ "
--bootstrap use the bootstrap binaries to build the pack")) --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~%") (leave (G_ "~a: unknown pack format~%")
pack-format)))) pack-format))))
(localstatedir? (assoc-ref opts 'localstatedir?)) (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 (run-with-store store
(mlet* %store-monad ((profile (profile-derivation (mlet* %store-monad ((profile (profile-derivation
manifest manifest
@ -919,6 +927,11 @@ Create a bundle of PACKAGE.\n"))
#:dry-run? dry-run?) #:dry-run? dry-run?)
(munless dry-run? (munless dry-run?
(built-derivations (list drv)) (built-derivations (list drv))
(mwhen gc-root
(register-root* (match (derivation->output-paths drv)
(((names . items) ...)
items))
gc-root))
(return (format #t "~a~%" (return (format #t "~a~%"
(derivation->output-path drv)))))) (derivation->output-path drv))))))
#:system (assoc-ref opts 'system)))))))) #:system (assoc-ref opts 'system))))))))

View File

@ -33,6 +33,9 @@ guix pack --version
GUIX_BUILD_OPTIONS="--no-substitutes" GUIX_BUILD_OPTIONS="--no-substitutes"
export GUIX_BUILD_OPTIONS 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. # Build a tarball with no compression.
guix pack --compression=none --bootstrap guile-bootstrap 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 -n "$out1"
test "$out1" = "$out2" 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. # Build a tarball with a symlink.
the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`" 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 # 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 # exists because /opt/gnu/bin may be an absolute symlink to a store item that
# has been GC'd. # has been GC'd.
test_directory="`mktemp -d`"
trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
cd "$test_directory" cd "$test_directory"
tar -xf "$the_pack" tar -xf "$the_pack"
test -L opt/gnu/bin test -L opt/gnu/bin