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.
This commit is contained in:
		
							parent
							
								
									998ac26a1e
								
							
						
					
					
						commit
						239c22663a
					
				
					 6 changed files with 308 additions and 113 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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))))
 | 
			
		||||
| 
						 | 
				
			
			@ -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}
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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:
 | 
			
		||||
;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -48,63 +46,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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										229
									
								
								guix/scripts/pack.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										229
									
								
								guix/scripts/pack.scm
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -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)))))))
 | 
			
		||||
		Reference in a new issue