tests: Add tests for "guix pack".

* guix/scripts/pack.scm (bootstrap-xz): New variable.
  (%options) <--bootstrap>: New option.
  (show-help): Document the new --bootstrap option.
  (guix-pack): When --bootstrap is specified, use the bootstrap Guile,
  tar, and xz to build the pack, and do not use any profile hooks or
  locales.
* doc/guix.texi (Invoking guix pull): Document the new --bootstrap
  option.
* tests/guix-pack.sh: New file.
* Makefile.am (SH_TESTS): Add guix-pack.sh.
* gnu/packages/package-management.scm (guix) <inputs>: Add util-linux.
This commit is contained in:
Chris Marusich 2018-03-11 01:13:01 +01:00
parent 24fa6bcac6
commit 272c070962
No known key found for this signature in database
GPG Key ID: DD409A15D822469D
5 changed files with 138 additions and 18 deletions

View File

@ -374,6 +374,7 @@ SH_TESTS = \
tests/guix-download.sh \ tests/guix-download.sh \
tests/guix-gc.sh \ tests/guix-gc.sh \
tests/guix-hash.sh \ tests/guix-hash.sh \
tests/guix-pack.sh \
tests/guix-package.sh \ tests/guix-package.sh \
tests/guix-package-net.sh \ tests/guix-package-net.sh \
tests/guix-system.sh \ tests/guix-system.sh \

View File

@ -23,7 +23,7 @@ Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@* Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@*
Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@* Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@*
Copyright @copyright{} 2016 Ben Woodcroft@* Copyright @copyright{} 2016 Ben Woodcroft@*
Copyright @copyright{} 2016, 2017 Chris Marusich@* Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@*
Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@* Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@*
Copyright @copyright{} 2016 John Darrington@* Copyright @copyright{} 2016 John Darrington@*
Copyright @copyright{} 2016, 2017 Nils Gillmann@* Copyright @copyright{} 2016, 2017 Nils Gillmann@*
@ -2899,6 +2899,10 @@ added to it or removed from it after extraction of the pack.
One use case for this is the Guix self-contained binary tarball One use case for this is the Guix self-contained binary tarball
(@pxref{Binary Installation}). (@pxref{Binary Installation}).
@item --bootstrap
Use the bootstrap binaries to build the pack. This option is only
useful to Guix developers.
@end table @end table
In addition, @command{guix pack} supports all the common build options In addition, @command{guix pack} supports all the common build options

View File

@ -257,6 +257,8 @@
;; Many tests rely on the 'guile-bootstrap' package, which is why we ;; Many tests rely on the 'guile-bootstrap' package, which is why we
;; have it here. ;; have it here.
("boot-guile" ,(bootstrap-guile-origin (%current-system))) ("boot-guile" ,(bootstrap-guile-origin (%current-system)))
;; Some of the tests use "unshare" when it is available.
("util-linux" ,util-linux)
,@(if (and (not (%current-target-system)) ,@(if (and (not (%current-target-system))
(string=? (%current-system) "x86_64-linux")) (string=? (%current-system) "x86_64-linux"))
`(("boot-guile/i686" ,(bootstrap-guile-origin "i686-linux"))) `(("boot-guile/i686" ,(bootstrap-guile-origin "i686-linux")))

View File

@ -3,6 +3,7 @@
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net> ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -33,7 +34,9 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages guile)
#:autoload (gnu packages base) (tar) #:autoload (gnu packages base) (tar)
#:autoload (gnu packages package-management) (guix) #:autoload (gnu packages package-management) (guix)
#:autoload (gnu packages gnupg) (libgcrypt) #:autoload (gnu packages gnupg) (libgcrypt)
@ -67,6 +70,11 @@
#~(#+(file-append bzip2 "/bin/bzip2") "-9")) #~(#+(file-append bzip2 "/bin/bzip2") "-9"))
(compressor "none" "" #f))) (compressor "none" "" #f)))
;; This one is only for use in this module, so don't put it in %compressors.
(define bootstrap-xz
(compressor "bootstrap-xz" ".xz"
#~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e -T0")))
(define (lookup-compressor name) (define (lookup-compressor name)
"Return the compressor object called NAME. Error out if it could not be "Return the compressor object called NAME. Error out if it could not be
found." found."
@ -325,6 +333,9 @@ the image."
(option '("localstatedir") #f #f (option '("localstatedir") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'localstatedir? #t result))) (alist-cons 'localstatedir? #t result)))
(option '("bootstrap") #f #f
(lambda (opt name arg result)
(alist-cons 'bootstrap? #t result)))
(append %transformation-options (append %transformation-options
%standard-build-options))) %standard-build-options)))
@ -352,6 +363,8 @@ Create a bundle of PACKAGE.\n"))
-m, --manifest=FILE create a pack with the manifest from FILE")) -m, --manifest=FILE create a pack with the manifest from FILE"))
(display (G_ " (display (G_ "
--localstatedir include /var/guix in the resulting pack")) --localstatedir include /var/guix in the resulting pack"))
(display (G_ "
--bootstrap use the bootstrap binaries to build the pack"))
(newline) (newline)
(display (G_ " (display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
@ -393,14 +406,19 @@ Create a bundle of PACKAGE.\n"))
(else (packages->manifest packages))))) (else (packages->manifest packages)))))
(with-error-handling (with-error-handling
(parameterize ((%graft? (assoc-ref opts 'graft?)))
(let* ((dry-run? (assoc-ref opts 'dry-run?)) (let* ((dry-run? (assoc-ref opts 'dry-run?))
(manifest (manifest-from-args opts)) (manifest (manifest-from-args opts))
(pack-format (assoc-ref opts 'format)) (pack-format (assoc-ref opts 'format))
(name (string-append (symbol->string pack-format) (name (string-append (symbol->string pack-format)
"-pack")) "-pack"))
(target (assoc-ref opts 'target)) (target (assoc-ref opts 'target))
(compressor (assoc-ref opts 'compressor)) (bootstrap? (assoc-ref opts 'bootstrap?))
(compressor (if bootstrap?
bootstrap-xz
(assoc-ref opts 'compressor)))
(tar (if bootstrap?
%bootstrap-coreutils&co
tar))
(symlinks (assoc-ref opts 'symlinks)) (symlinks (assoc-ref opts 'symlinks))
(build-image (match (assq-ref %formats pack-format) (build-image (match (assq-ref %formats pack-format)
((? procedure? proc) proc) ((? procedure? proc) proc)
@ -409,12 +427,22 @@ Create a bundle of PACKAGE.\n"))
format)))) format))))
(localstatedir? (assoc-ref opts 'localstatedir?))) (localstatedir? (assoc-ref opts 'localstatedir?)))
(with-store store (with-store store
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build (package-derivation
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(canonical-package guile-2.2)))))
;; Set the build options before we do anything else. ;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
(run-with-store store (run-with-store store
(mlet* %store-monad ((profile (profile-derivation (mlet* %store-monad ((profile (profile-derivation
manifest manifest
#:hooks (if bootstrap?
'()
%default-profile-hooks)
#:locales? (not bootstrap?)
#:target target)) #:target target))
(drv (build-image name profile (drv (build-image name profile
#:target #:target
@ -424,7 +452,9 @@ Create a bundle of PACKAGE.\n"))
#:symlinks #:symlinks
symlinks symlinks
#:localstatedir? #:localstatedir?
localstatedir?))) localstatedir?
#:tar
tar)))
(mbegin %store-monad (mbegin %store-monad
(show-what-to-build* (list drv) (show-what-to-build* (list drv)
#:use-substitutes? #:use-substitutes?

83
tests/guix-pack.sh Normal file
View File

@ -0,0 +1,83 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
#
# This file is part of GNU Guix.
#
# GNU Guix is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or (at
# your option) any later version.
#
# GNU Guix is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
#
# Test the `guix pack' command-line utility.
#
# A network connection is required to build %bootstrap-coreutils&co,
# which is required to run these tests with the --bootstrap option.
if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null; then
exit 77
fi
guix pack --version
# Use --no-substitutes because we need to verify we can do this ourselves.
GUIX_BUILD_OPTIONS="--no-substitutes"
export GUIX_BUILD_OPTIONS
# Build a tarball with no compression.
guix pack --compression=none --bootstrap guile-bootstrap
# Build a tarball (with compression).
guix pack --bootstrap guile-bootstrap
# Build a tarball with a symlink.
the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
# Try to extract it.
test_directory="`mktemp -d`"
trap 'rm -rf "$test_directory"' EXIT
cd "$test_directory"
tar -xf "$the_pack"
test -x opt/gnu/bin/guile
is_available () {
# Use the "type" shell builtin to see if the program is on PATH.
type "$1" > /dev/null
}
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
# 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:
#
# Case 1: We do not use --bootstrap, and the build takes hours to finish
# because it needs to build tar etc.
#
# Case 2: We use --bootstrap, and the build fails because the bootstrap
# Guile cannot dlopen shared libraries. Not to mention the fact
# that we would still have to build many non-bootstrap inputs
# (e.g., guile-json) in order to create the Docker image.
# Build a Docker image.
guix pack --dry-run --bootstrap -f docker guile-bootstrap
# Build a Docker image with a symlink.
guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
# Build a tarball pack of cross-compiled software. Use coreutils because
# guile-bootstrap is not intended to be cross-compiled.
guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils