From c6f8e9dd64feb1ad174201277cf2ad0784f7d001 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 19 Oct 2015 10:09:28 +0200
Subject: [PATCH] guix archive: Add '--extract'.

* guix/scripts/archive.scm (show-help, %options): Add --extract.
  (guix-archive): Honor it.
* tests/guix-archive.sh: Test it.
* doc/guix.texi (Invoking guix archive): Document it.
---
 doc/guix.texi            | 25 +++++++++++++++++++++++++
 guix/scripts/archive.scm | 10 ++++++++++
 tests/guix-archive.sh    | 15 +++++++++++++--
 3 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index fd0adfd203..6d24343025 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1931,6 +1931,31 @@ The list of authorized keys is kept in the human-editable file
 s-expressions''} and is structured as an access-control list in the
 @url{http://theworld.com/~cme/spki.txt, Simple Public-Key Infrastructure
 (SPKI)}.
+
+@item --extract=@var{directory}
+@itemx -x @var{directory}
+Read a single-item archive as served by substitute servers
+(@pxref{Substitutes}) and extract it to @var{directory}.  This is a
+low-level operation needed in only very narrow use cases; see below.
+
+For example, the following command extracts the substitute for Emacs
+served by @code{hydra.gnu.org} to @file{/tmp/emacs}:
+
+@example
+$ wget -O - \
+  http://hydra.gnu.org/nar/@dots{}-emacs-24.5 \
+  | bunzip2 | guix archive -x /tmp/emacs
+@end example
+
+Single-item archives are different from multiple-item archives produced
+by @command{guix archive --export}; they contain a single store item,
+and they do @emph{not} embed a signature.  Thus this operation does
+@emph{no} signature verification and its output should be considered
+unsafe.
+
+The primary purpose of this operation is to facilitate inspection of
+archive contents coming from possibly untrusted substitute servers.
+
 @end table
 
 To export store files as an archive to the standard output, run:
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index b120c555e3..1a941d1a73 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -20,6 +20,7 @@
   #:use-module (guix config)
   #:use-module (guix utils)
   #:use-module ((guix build utils) #:select (mkdir-p))
+  #:use-module ((guix serialization) #:select (restore-file))
   #:use-module (guix store)
   #:use-module (guix packages)
   #:use-module (guix derivations)
@@ -63,6 +64,8 @@ Export/import one or more packages from/to the store.\n"))
       --import           import from the archive passed on stdin"))
   (display (_ "
       --missing          print the files from stdin that are missing"))
+  (display (_ "
+  -x, --extract=DIR      extract the archive on stdin to DIR"))
   (newline)
   (display (_ "
       --generate-key[=PARAMETERS]
@@ -119,6 +122,9 @@ Export/import one or more packages from/to the store.\n"))
          (option '("missing") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'missing #t result)))
+         (option '("extract" #\x) #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'extract arg result)))
          (option '("generate-key") #f #t
                  (lambda (opt name arg result)
                    (catch 'gcry-error
@@ -328,6 +334,10 @@ the input port."
                                (missing (remove (cut valid-path? store <>)
                                                 files)))
                           (format #t "~{~a~%~}" missing)))
+                       ((assoc-ref opts 'extract)
+                        =>
+                        (lambda (target)
+                          (restore-file (current-input-port) target)))
                        (else
                         (leave
                          (_ "either '--export' or '--import' \
diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh
index 8eacf89338..fdaeb98ad2 100644
--- a/tests/guix-archive.sh
+++ b/tests/guix-archive.sh
@@ -24,9 +24,11 @@ guix archive --version
 
 archive="t-archive-$$"
 archive_alt="t-archive-alt-$$"
+tmpdir="t-archive-dir-$$"
 rm -f "$archive" "$archive_alt"
+rm -rf "$tmpdir"
 
-trap 'rm -f "$archive" "$archive_alt"' EXIT
+trap 'rm -f "$archive" "$archive_alt"; rm -rf "$tmpdir"' EXIT
 
 guix archive --export guile-bootstrap > "$archive"
 guix archive --export guile-bootstrap:out > "$archive_alt"
@@ -39,7 +41,7 @@ cmp "$archive" "$archive_alt"
 guix archive --export `guix build guile-bootstrap` > "$archive_alt"
 cmp "$archive" "$archive_alt"
 
-# Check the exit value and stderr upon import.
+# Check the exit value upon import.
 guix archive --import < "$archive"
 
 if guix archive something-that-does-not-exist
@@ -63,5 +65,14 @@ echo something invalid > "$archive"
 if guix archive --missing < "$archive"
 then false; else true; fi
 
+# Check '--extract'.
+guile -c "(use-modules (guix serialization))
+  (call-with-output-file \"$archive\"
+    (lambda (port)
+      (write-file \"$(guix build guile-bootstrap)\" port)))"
+guix archive -x "$tmpdir" < "$archive"
+test -x "$tmpdir/bin/guile"
+test -d "$tmpdir/lib/guile"
+
 if echo foo | guix archive --authorize
 then false; else true; fi