From 760c60d68491bd6803e86e405e765f3337663f17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 22 Dec 2013 01:08:21 +0100 Subject: [PATCH] Add 'guix archive'. * guix/scripts/archive.scm, tests/guix-archive.sh: New files. * Makefile.am (MODULES): Add 'archive.scm'. (SH_TESTS): Add 'guix-archive.sh'. * doc/guix.texi (Invoking guix archive): New section. * guix/scripts/build.scm: Export 'derivation-from-expression'. * guix/scripts/package.scm: Export 'specification->package+output'. --- Makefile.am | 2 + doc/guix.texi | 59 +++++++++- guix/scripts/archive.scm | 232 +++++++++++++++++++++++++++++++++++++++ guix/scripts/build.scm | 3 +- guix/scripts/package.scm | 5 +- tests/guix-archive.sh | 45 ++++++++ 6 files changed, 342 insertions(+), 4 deletions(-) create mode 100644 guix/scripts/archive.scm create mode 100644 tests/guix-archive.sh diff --git a/Makefile.am b/Makefile.am index 4815c55fba..ba54f8c582 100644 --- a/Makefile.am +++ b/Makefile.am @@ -67,6 +67,7 @@ MODULES = \ guix/snix.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ + guix/scripts/archive.scm \ guix/scripts/import.scm \ guix/scripts/package.scm \ guix/scripts/gc.scm \ @@ -130,6 +131,7 @@ SH_TESTS = \ tests/guix-gc.sh \ tests/guix-hash.sh \ tests/guix-package.sh \ + tests/guix-archive.sh \ tests/guix-authenticate.sh if BUILD_DAEMON diff --git a/doc/guix.texi b/doc/guix.texi index fcffa5a22b..c78e0d0d05 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -407,9 +407,10 @@ management tools it provides. @menu * Features:: How Guix will make your life brighter. * Invoking guix package:: Package installation, removal, etc. -* Packages with Multiple Outputs:: Single source package, multiple outputs. +* 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 archive:: Exporting and importing store files. @end menu @node Features @@ -914,6 +915,62 @@ Use the bootstrap Guile to build the latest Guix. This option is only useful to Guix developers. @end table + +@node Invoking guix archive +@section Invoking @command{guix archive} + +The @command{guix archive} command allows users to @dfn{export} files +from the store into a single archive, and to later @dfn{import} them. +In particular, it allows store files to be transferred from one machine +to another machine's store. For example, to transfer the @code{emacs} +package to a machine connected over SSH, one would run: + +@example +guix archive --export emacs | ssh the-machine guix archive --import +@end example + +Archives are stored in the ``Nix archive'' or ``Nar'' format, which is +comparable in spirit to `tar'. When exporting, the daemon digitally +signs the contents of the archive, and that digital signature is +appended. When importing, the daemon verifies the signature and rejects +the import in case of an invalid signature. +@c FIXME: Add xref to daemon doc about signatures. + +The main options are: + +@table @code +@item --export +Export the specified store files or packages (see below.) Write the +resulting archive to the standard output. + +@item --import +Read an archive from the standard input, and import the files listed +therein into the store. Abort if the archive has an invalid digital +signature. +@end table + +To export store files as an archive to the standard output, run: + +@example +guix archive --export @var{options} @var{specifications}... +@end example + +@var{specifications} may be either store file names or package +specifications, as for @command{guix package} (@pxref{Invoking guix +package}). For instance, the following command creates an archive +containing the @code{gui} output of the @code{git} package and the main +output of @code{emacs}: + +@example +guix archive --export git:gui /nix/store/...-emacs-24.3 > great.nar +@end example + +If the specified packages are not built yet, @command{guix archive} +automatically builds them. The build process may be controlled with the +same options that can be passed to the @command{guix build} command +(@pxref{Invoking guix build}). + + @c ********************************************************************* @node Programming Interface @chapter Programming Interface diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm new file mode 100644 index 0000000000..df538ed1b7 --- /dev/null +++ b/guix/scripts/archive.scm @@ -0,0 +1,232 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix scripts archive) + #:use-module (guix config) + #:use-module (guix utils) + #:use-module (guix store) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix ui) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (guix scripts build) + #:use-module (guix scripts package) + #:export (guix-archive)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + `((system . ,(%current-system)) + (substitutes? . #t) + (max-silent-time . 3600) + (verbosity . 0))) + +(define (show-help) + (display (_ "Usage: guix archive [OPTION]... PACKAGE... +Export/import one or more packages from/to the store.\n")) + (display (_ " + --export export the specified files/packages to stdout")) + (display (_ " + --import import from the archive passed on stdin")) + (newline) + (display (_ " + -e, --expression=EXPR build the package or derivation EXPR evaluates to")) + (display (_ " + -S, --source build the packages' source derivations")) + (display (_ " + -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) + (display (_ " + --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) + (display (_ " + -n, --dry-run do not build the derivations")) + (display (_ " + --fallback fall back to building when the substituter fails")) + (display (_ " + --no-substitutes build instead of resorting to pre-built substitutes")) + (display (_ " + --max-silent-time=SECONDS + mark the build as failed after SECONDS of silence")) + (display (_ " + -c, --cores=N allow the use of up to N CPU cores for the build")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix build"))) + + (option '("export") #f #f + (lambda (opt name arg result) + (alist-cons 'export #t result))) + (option '("import") #f #f + (lambda (opt name arg result) + (alist-cons 'import #t result))) + + (option '(#\S "source") #f #f + (lambda (opt name arg result) + (alist-cons 'source? #t result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) + (option '("target") #t #f + (lambda (opt name arg result) + (alist-cons 'target arg + (alist-delete 'target result eq?)))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) + (option '(#\c "cores") #t #f + (lambda (opt name arg result) + (let ((c (false-if-exception (string->number arg)))) + (if c + (alist-cons 'cores c result) + (leave (_ "~a: not a number~%") arg))))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) + (option '("fallback") #f #f + (lambda (opt name arg result) + (alist-cons 'fallback? #t + (alist-delete 'fallback? result)))) + (option '("no-substitutes") #f #f + (lambda (opt name arg result) + (alist-cons 'substitutes? #f + (alist-delete 'substitutes? result)))) + (option '("max-silent-time") #t #f + (lambda (opt name arg result) + (alist-cons 'max-silent-time (string->number* arg) + result))) + (option '(#\r "root") #t #f + (lambda (opt name arg result) + (alist-cons 'gc-root arg result))) + (option '("verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))))) + +(define (options->derivations+files store opts) + "Given OPTS, the result of 'args-fold', return a list of derivations to +build and a list of store files to transfer." + (define package->derivation + (match (assoc-ref opts 'target) + (#f package-derivation) + (triplet + (cut package-cross-derivation <> <> triplet <>)))) + + (define src? (assoc-ref opts 'source?)) + (define sys (assoc-ref opts 'system)) + + (fold2 (lambda (arg derivations files) + (match arg + (('expression . str) + (let ((drv (derivation-from-expression store str + package->derivation + sys src?))) + (values (cons drv derivations) + (cons (derivation->output-path drv) files)))) + (('argument . (? store-path? file)) + (values derivations (cons file files))) + (('argument . (? string? spec)) + (let-values (((p output) + (specification->package+output spec))) + (if src? + (let* ((s (package-source p)) + (drv (package-source-derivation store s))) + (values (cons drv derivations) + (cons (derivation->output-path drv) + files))) + (let ((drv (package->derivation store p sys))) + (values (cons drv derivations) + (cons (derivation->output-path drv output) + files)))))) + (_ + (values derivations files)))) + '() + '() + opts)) + + +;;; +;;; Entry point. +;;; + +(define (export-from-store store opts) + "Export the packages or derivations specified in OPTS from STORE. Write the +resulting archive to the standard output port." + (let-values (((drv files) + (options->derivations+files store opts))) + (show-what-to-build store drv + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:dry-run? (assoc-ref opts 'dry-run?)) + + (set-build-options store + #:build-cores (or (assoc-ref opts 'cores) 0) + #:fallback? (assoc-ref opts 'fallback?) + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:max-silent-time (assoc-ref opts 'max-silent-time)) + + (if (or (assoc-ref opts 'dry-run?) + (build-derivations store drv)) + (export-paths store files (current-output-port)) + (leave (_ "unable to export the given packages"))))) + +(define (guix-archive . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (with-error-handling + ;; Ask for absolute file names so that .drv file names passed from the + ;; user to 'read-derivation' are absolute when it returns. + (with-fluids ((%file-port-name-canonicalization 'absolute)) + (let* ((opts (parse-options)) + (store (open-connection))) + + (cond ((assoc-ref opts 'export) + (export-from-store store opts)) + ((assoc-ref opts 'import) + (import-paths store (current-input-port))) + (else + (leave + (_ "either '--export' or '--import' must be specified")))))))) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index b3d852e950..90187094c1 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -33,7 +33,8 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:autoload (gnu packages) (find-best-packages-by-name) - #:export (guix-build)) + #:export (derivation-from-expression + guix-build)) (define (derivation-from-expression store str package-derivation system source?) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 8c197a741e..7cebf6b4d4 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -41,7 +41,8 @@ #:use-module ((gnu packages base) #:select (guile-final)) #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) #:use-module (guix gnu-maintenance) - #:export (guix-package)) + #:export (specification->package+output + guix-package)) (define %store (make-parameter #f)) @@ -293,7 +294,7 @@ return its return value." #f)))) (define* (specification->package+output spec #:optional (output "out")) - "Find the package and output specified by SPEC, or #f and #f; SPEC may + "Return the package and output specified by SPEC, or #f and #f; SPEC may optionally contain a version number and an output name, as in these examples: guile diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh new file mode 100644 index 0000000000..ef04835469 --- /dev/null +++ b/tests/guix-archive.sh @@ -0,0 +1,45 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2013 Ludovic Courtès +# +# 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 . + +# +# Test the 'guix archive' command-line utility. +# + +guix archive --version + +archive="t-archive-$$" +archive_alt="t-archive-alt-$$" +rm -f "$archive" "$archive_alt" + +trap 'rm -f "$archive" "$archive_alt"' EXIT + +guix archive --export guile-bootstrap > "$archive" +guix archive --export guile-bootstrap:out > "$archive_alt" +cmp "$archive" "$archive_alt" + +guix archive --export \ + -e '(@ (gnu packages bootstrap) %bootstrap-guile)' > "$archive_alt" +cmp "$archive" "$archive_alt" + +guix archive --export `guix build guile-bootstrap` > "$archive_alt" +cmp "$archive" "$archive_alt" + +guix archive --import < "$archive" 2>&1 | grep "import.*guile-bootstrap" + +if guix archive something-that-does-not-exist +then false; else true; fi