Add 'guix pack'.

* gnu/system/install.scm (self-contained-tarball): Move to...
* guix/scripts/pack.scm: ... here.  New file.
* doc/guix.texi (Binary Installation): Mention 'guix pack'.
(Invoking guix pack): New node.
* build-aux/make-binary-tarball.scm: Remove.
* Makefile.am (MODULES): Add guix/scripts/pack.scm.
(EXTRA_DIST): Remove build-aux/make-binary-tarball.scm.
(guix-binary.%.tar.xz): Rewrite using 'guix pack'.
* build-aux/hydra/gnu-system.scm (tarball-jobs): Adjust accordingly.

6 files changed, 308 insertions, 113 deletions

diff --git a/Makefile.am b/Makefile.am
index ec1bd2eb8b..2684d66bf1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -139,6 +139,7 @@ MODULES =					\
   guix/scripts/package.scm			\
   guix/scripts/gc.scm				\
   guix/scripts/hash.scm				\
+  guix/scripts/pack.scm				\
   guix/scripts/pull.scm				\
   guix/scripts/substitute.scm			\
   guix/scripts/authenticate.scm			\
@@ -397,7 +398,6 @@ EXTRA_DIST =						\
   build-aux/check-available-binaries.scm		\
   build-aux/check-final-inputs-self-contained.scm	\
   build-aux/download.scm				\
-  build-aux/make-binary-tarball.scm			\
   build-aux/generate-authors.scm			\
   build-aux/test-driver.scm				\
   build-aux/run-system-tests.scm			\
@@ -486,9 +486,10 @@ AM_DISTCHECK_CONFIGURE_FLAGS =			\
 
 # The self-contained tarball.
 guix-binary.%.tar.xz:
-	$(AM_V_GEN)GUIX_PACKAGE_PATH= \
-	$(top_builddir)/pre-inst-env "$(GUILE)"			\
-	  "$(top_srcdir)/build-aux/make-binary-tarball.scm" "$*" "$@"
+	$(AM_V_GEN)GUIX_PACKAGE_PATH=				\
+	tarball=`$(top_builddir)/pre-inst-env guix pack -C xz	\
+	  -s "$*" guix` ;					\
+	cp "$$tarball" "$@.tmp" ; mv "$@.tmp" "$@"
 
 
 dist-hook: sync-descriptions gen-ChangeLog gen-AUTHORS
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index 04a9d0508a..7a26c72778 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -39,12 +39,15 @@
 (use-modules (guix config)
              (guix store)
              (guix grafts)
+             (guix profiles)
              (guix packages)
              (guix derivations)
              (guix monads)
              ((guix licenses) #:select (gpl3+))
              ((guix utils) #:select (%current-system))
              ((guix scripts system) #:select (read-operating-system))
+             ((guix scripts pack)
+              #:select (lookup-compressor self-contained-tarball))
              (gnu packages)
              (gnu packages gcc)
              (gnu packages base)
@@ -213,7 +216,11 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
                (run-with-store store
                  (mbegin %store-monad
                    (set-guile-for-build (default-guile))
-                   (self-contained-tarball))
+                   (>>= (profile-derivation (packages->manifest (list guix)))
+                        (lambda (profile)
+                          (self-contained-tarball "guix-binary" profile
+                                                  #:compressor
+                                                  (lookup-compressor "xz")))))
                  #:system system))))
 
 (define job-name
diff --git a/build-aux/make-binary-tarball.scm b/build-aux/make-binary-tarball.scm
deleted file mode 100644
index e12bec476c..0000000000
--- a/build-aux/make-binary-tarball.scm
+++ /dev/null
@@ -1,47 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; 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/>.
-
-
-;;;
-;;; Build a self-contained tarball containing binaries for Guix and its
-;;; dependencies.
-;;;
-
-(use-modules (guix)
-             (guix ui)
-             (gnu system install)
-             (ice-9 match))
-
-(define copy-file*
-  (lift2 copy-file %store-monad))
-
-(define rename-file*
-  (lift2 rename-file %store-monad))
-
-(match (command-line)
-  ((_ system file)
-   (with-store store
-     (run-with-store store
-       (mlet %store-monad ((tarball (self-contained-tarball)))
-         (mbegin %store-monad
-           (show-what-to-build* (list tarball))
-           (built-derivations (list tarball))
-           (copy-file* (derivation->output-path tarball)
-                       (string-append file ".part"))
-           (rename-file* (string-append file ".part") file)))
-       #:system system))))
diff --git a/doc/guix.texi b/doc/guix.texi
index ddfd707665..f4cc207e7b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -119,6 +119,7 @@ Package Management
 * Packages with Multiple Outputs::  Single source package, multiple outputs.
 * Invoking guix gc::            Running the garbage collector.
 * Invoking guix pull::          Fetching the latest Guix and distribution.
+* Invoking guix pack::          Creating software bundles.
 * Invoking guix archive::       Exporting and importing store files.
 
 Programming Interface
@@ -530,6 +531,14 @@ by running the following command in the Guix source tree:
 make guix-binary.@var{system}.tar.xz
 @end example
 
+@noindent
+... which, in turn, runs:
+
+@example
+guix pack -s @var{system} guix
+@end example
+
+@xref{Invoking guix pack}, for more info on this handy tool.
 
 @node Requirements
 @section Requirements
@@ -1422,6 +1431,7 @@ guix package -i emacs-guix
 * Packages with Multiple Outputs::  Single source package, multiple outputs.
 * Invoking guix gc::            Running the garbage collector.
 * Invoking guix pull::          Fetching the latest Guix and distribution.
+* Invoking guix pack::          Creating software bundles.
 * Invoking guix archive::       Exporting and importing store files.
 @end menu
 
@@ -2377,6 +2387,60 @@ useful to Guix developers.
 @end table
 
 
+@node Invoking guix pack
+@section Invoking @command{guix pack}
+
+Occasionally you want to pass software to people who are not (yet!)
+lucky enough to be using Guix.  You'd tell them to run @command{guix
+package -i @var{something}}, but that's not possible in this case.  This
+is where @command{guix pack} comes in.
+
+@cindex pack
+@cindex bundle
+@cindex application bundle
+@cindex software bundle
+The @command{guix pack} command creates a shrink-wrapped @dfn{pack} or
+@dfn{software bundle}: it creates a tarball or some other archive
+containing the binaries of the software you're interested in, and all
+its dependencies.  The resulting archive can be used on any machine that
+does not have Guix, and people can run the exact same binaries as those
+you have with Guix.
+
+For example, to create a bundle containing Guile, Emacs, Geiser, and all
+their dependencies, you can run:
+
+@example
+$ guix pack guile emacs geiser
+@dots{}
+/gnu/store/@dots{}-pack.tar.gz
+@end example
+
+The result here is a tarball containing a @file{/gnu/store} directory
+with all the relevant packages.  The resulting tarball contains a
+@dfn{profile} with the three packages of interest; the profile is the
+same as would be created by @command{guix package -i}.  It is this
+mechanism that is used to create Guix's own standalone binary tarball
+(@pxref{Binary Installation}).
+
+Several command-line options allow you to customize your pack:
+
+@table @code
+@item --system=@var{system}
+@itemx -s @var{system}
+Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
+the system type of the build host.
+
+@item --compression=@var{tool}
+@itemx -C @var{tool}
+Compress the resulting tarball using @var{tool}---one of @code{gzip},
+@code{bzip2}, @code{xz}, or @code{lzip}.
+@end table
+
+In addition, @command{guix pack} supports all the common build options
+(@pxref{Common Build Options}) and all the package transformation
+options (@pxref{Package Transformation Options}).
+
+
 @node Invoking guix archive
 @section Invoking @command{guix archive}
 
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 3ec343570a..191ccf1680 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -1,5 +1,5 @@
 ;;; 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 © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;;
@@ -24,7 +24,6 @@
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module ((guix store) #:select (%store-prefix))
-  #:use-module (guix profiles)
   #:use-module (gnu services shepherd)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages bash)
@@ -38,8 +37,7 @@
   #:use-module (gnu packages nvi)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-26)
-  #:export (self-contained-tarball
-            installation-os))
+  #:export (installation-os))
 
 ;;; Commentary:
 ;;;
@@ -49,63 +47,6 @@
 ;;; Code:
 
 
-(define* (self-contained-tarball #:key (guix guix))
-  "Return a self-contained tarball containing a store initialized with the
-closure of GUIX.  The tarball contains /gnu/store, /var/guix, and a profile
-under /root/.guix-profile where GUIX is installed."
-  (mlet %store-monad ((profile (profile-derivation
-                                (manifest
-                                 (list (package->manifest-entry guix))))))
-    (define build
-      (with-imported-modules '((guix build utils)
-                               (guix build store-copy)
-                               (gnu build install))
-        #~(begin
-            (use-modules (guix build utils)
-                         (gnu build install))
-
-            (define %root "root")
-
-            (setenv "PATH"
-                    (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
-
-            ;; Note: there is not much to gain here with deduplication and
-            ;; there is the overhead of the '.links' directory, so turn it
-            ;; off.
-            (populate-single-profile-directory %root
-                                               #:profile #$profile
-                                               #:closure "profile"
-                                               #:deduplicate? #f)
-
-            ;; Create the tarball.  Use GNU format so there's no file name
-            ;; length limitation.
-            (with-directory-excursion %root
-              (zero? (system* "tar" "--xz" "--format=gnu"
-
-                              ;; Avoid non-determinism in the archive.  Use
-                              ;; mtime = 1, not zero, because that is what the
-                              ;; daemon does for files in the store (see the
-                              ;; 'mtimeStore' constant in local-store.cc.)
-                              "--sort=name"
-                              "--mtime=@1"        ;for files in /var/guix
-                              "--owner=root:0"
-                              "--group=root:0"
-
-                              "--check-links"
-                              "-cvf" #$output
-                              ;; Avoid adding / and /var to the tarball, so
-                              ;; that the ownership and permissions of those
-                              ;; directories will not be overwritten when
-                              ;; extracting the archive.  Do not include /root
-                              ;; because the root account might have a
-                              ;; different home directory.
-                              "./var/guix"
-                              (string-append "." (%store-directory))))))))
-
-    (gexp->derivation "guix-tarball.tar.xz" build
-                      #:references-graphs `(("profile" ,profile)))))
-
-
 (define (log-to-info)
   "Return a script that spawns the Info reader on the right section of the
 manual."
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
new file mode 100644
index 0000000000..e8f3d800a8
--- /dev/null
+++ b/guix/scripts/pack.scm
@@ -0,0 +1,229 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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/>.
+
+(define-module (guix scripts pack)
+  #:use-module (guix scripts)
+  #:use-module (guix ui)
+  #:use-module (guix gexp)
+  #:use-module (guix utils)
+  #:use-module (guix store)
+  #:use-module (guix grafts)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (guix derivations)
+  #:use-module (guix scripts build)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages compression)
+  #:autoload   (gnu packages base) (tar)
+  #:autoload   (gnu packages package-management) (guix)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:export (compressor?
+            lookup-compressor
+            self-contained-tarball
+            guix-pack))
+
+;; Type of a compression tool.
+(define-record-type <compressor>
+  (compressor name package extension tar-option)
+  compressor?
+  (name       compressor-name)                    ;string (e.g., "gzip")
+  (package    compressor-package)                 ;package
+  (extension  compressor-extension)               ;string (e.g., "lz")
+  (tar-option compressor-tar-option))             ;string (e.g., "--lzip")
+
+(define %compressors
+  ;; Available compression tools.
+  ;; FIXME: Use '--no-name' for gzip.
+  (list (compressor "gzip"  gzip  "gz"  "--gzip")
+        (compressor "lzip"  lzip  "lz"  "--lzip")
+        (compressor "xz"    xz    "xz"  "--xz")
+        (compressor "bzip2" bzip2 "bz2" "--bzip2")))
+
+(define (lookup-compressor name)
+  "Return the compressor object called NAME.  Error out if it could not be
+found."
+  (or (find (match-lambda
+              (($ <compressor> name*)
+               (string=? name* name)))
+            %compressors)
+      (leave (_ "~a: compressor not found~%") name)))
+
+(define* (self-contained-tarball name profile
+                                 #:key deduplicate?
+                                 (compressor (first %compressors)))
+  "Return a self-contained tarball containing a store initialized with the
+closure of PROFILE, a derivation.  The tarball contains /gnu/store, /var/guix,
+and PROFILE is available as /root/.guix-profile."
+  (define build
+    (with-imported-modules '((guix build utils)
+                             (guix build store-copy)
+                             (gnu build install))
+      #~(begin
+          (use-modules (guix build utils)
+                       (gnu build install))
+
+          (define %root "root")
+
+          ;; We need Guix here for 'guix-register'.
+          (setenv "PATH"
+                  (string-append #$guix "/sbin:" #$tar "/bin:"
+                                 #$(compressor-package compressor) "/bin"))
+
+          ;; Note: there is not much to gain here with deduplication and
+          ;; there is the overhead of the '.links' directory, so turn it
+          ;; off.
+          (populate-single-profile-directory %root
+                                             #:profile #$profile
+                                             #:closure "profile"
+                                             #:deduplicate? #f)
+
+          ;; Create the tarball.  Use GNU format so there's no file name
+          ;; length limitation.
+          (with-directory-excursion %root
+            (zero? (system* "tar" #$(compressor-tar-option compressor)
+                            "--format=gnu"
+
+                            ;; Avoid non-determinism in the archive.  Use
+                            ;; mtime = 1, not zero, because that is what the
+                            ;; daemon does for files in the store (see the
+                            ;; 'mtimeStore' constant in local-store.cc.)
+                            "--sort=name"
+                            "--mtime=@1"          ;for files in /var/guix
+                            "--owner=root:0"
+                            "--group=root:0"
+
+                            "--check-links"
+                            "-cvf" #$output
+                            ;; Avoid adding / and /var to the tarball, so
+                            ;; that the ownership and permissions of those
+                            ;; directories will not be overwritten when
+                            ;; extracting the archive.  Do not include /root
+                            ;; because the root account might have a
+                            ;; different home directory.
+                            "./var/guix"
+                            (string-append "." (%store-directory))))))))
+
+  (gexp->derivation (string-append name ".tar."
+                                   (compressor-extension compressor))
+                    build
+                    #:references-graphs `(("profile" ,profile))))
+
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  `((system . ,(%current-system))
+    (substitutes? . #t)
+    (graft? . #t)
+    (max-silent-time . 3600)
+    (verbosity . 0)
+    (compressor . ,(first %compressors))))
+
+(define %options
+  ;; Specifications of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix pack")))
+
+         (option '(#\n "dry-run") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+         (option '(#\s "system") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'system arg
+                               (alist-delete 'system result eq?))))
+         (option '(#\C "compression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'compressor (lookup-compressor arg)
+                               result)))
+
+         (append %transformation-options
+                 %standard-build-options)))
+
+(define (show-help)
+  (display (_ "Usage: guix pack [OPTION]... PACKAGE...
+Create a bundle of PACKAGE.\n"))
+  (show-build-options-help)
+  (newline)
+  (show-transformation-options-help)
+  (newline)
+  (display (_ "
+  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
+  (display (_ "
+  -C, --compression=TOOL compress using TOOL--e.g., \"lzip\""))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-pack . args)
+  (define opts
+    (parse-command-line args %options (list %default-options)))
+
+  (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))
+             (compressor (assoc-ref opts 'compressor)))
+        (with-store store
+          (run-with-store store
+            (mlet* %store-monad ((profile (profile-derivation
+                                           (packages->manifest packages)))
+                                 (drv (self-contained-tarball "pack" profile
+                                                              #:compressor
+                                                              compressor)))
+              (mbegin %store-monad
+                (show-what-to-build* (list drv)
+                                     #:use-substitutes?
+                                     (assoc-ref opts 'substitutes?)
+                                     #:dry-run? dry-run?)
+                (munless dry-run?
+                  (built-derivations (list drv))
+                  (return (format #t "~a~%"
+                                  (derivation->output-path drv))))))
+            #:system (assoc-ref opts 'system)))))))