02/05: store: Add #:recursive? parameter to 'export-paths'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 5b3d863f0099257890f9714f81e24789f8e8e362
Author: Ludovic Courtès <address@hidden>
Date:   Sat Jan 17 15:59:00 2015 +0100

    store: Add #:recursive? parameter to 'export-paths'.
    
    * guix/store.scm (export-paths): Add #:recursive? parameter and honor
      it.
    * tests/store.scm ("export/import incomplete", "export/import
      recursive"): New tests.
---
 guix/store.scm  |   13 ++++++++-----
 tests/store.scm |   33 +++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 82ed94b..9e30744 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -795,13 +795,16 @@ is raised if the set of paths read from PORT is not 
signed (as per
       (or done? (loop (process-stderr server port))))
     (= 1 (read-int s))))
 
-(define* (export-paths server paths port #:key (sign? #t))
+(define* (export-paths server paths port #:key (sign? #t) recursive?)
   "Export the store paths listed in PATHS to PORT, in topological order,
-signing them if SIGN? is true."
+signing them if SIGN? is true.  When RECURSIVE? is true, export the closure of
+PATHS---i.e., PATHS and all their dependencies."
   (define ordered
-    ;; Sort PATHS, but don't include their references.
-    (filter (cut member <> paths)
-            (topologically-sorted server paths)))
+    (let ((sorted (topologically-sorted server paths)))
+      ;; When RECURSIVE? is #f, filter out the references of PATHS.
+      (if recursive?
+          sorted
+          (filter (cut member <> paths) sorted))))
 
   (let ((s (nix-server-socket server)))
     (let loop ((paths ordered))
diff --git a/tests/store.scm b/tests/store.scm
index f43fcb1..6d3854c 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -552,6 +552,39 @@ Deriver: ~a~%"
                 (equal? (list file0) (references %store file1))
                 (equal? (list file1) (references %store file2)))))))
 
+(test-assert "export/import incomplete"
+  (let* ((file0 (add-text-to-store %store "baz" (random-text)))
+         (file1 (add-text-to-store %store "foo" (random-text)
+                                   (list file0)))
+         (file2 (add-text-to-store %store "bar" (random-text)
+                                   (list file1)))
+         (dump  (call-with-bytevector-output-port
+                 (cute export-paths %store (list file2) <>))))
+    (delete-paths %store (list file0 file1 file2))
+    (guard (c ((nix-protocol-error? c)
+               (and (not (zero? (nix-protocol-error-status c)))
+                    (string-contains (nix-protocol-error-message c)
+                                     "not valid"))))
+      ;; Here we get an exception because DUMP does not include FILE0 and
+      ;; FILE1, which are dependencies of FILE2.
+      (import-paths %store (open-bytevector-input-port dump)))))
+
+(test-assert "export/import recursive"
+  (let* ((file0 (add-text-to-store %store "baz" (random-text)))
+         (file1 (add-text-to-store %store "foo" (random-text)
+                                   (list file0)))
+         (file2 (add-text-to-store %store "bar" (random-text)
+                                   (list file1)))
+         (dump  (call-with-bytevector-output-port
+                 (cute export-paths %store (list file2) <>
+                       #:recursive? #t))))
+    (delete-paths %store (list file0 file1 file2))
+    (let ((imported (import-paths %store (open-bytevector-input-port dump))))
+      (and (equal? imported (list file0 file1 file2))
+           (every file-exists? (list file0 file1 file2))
+           (equal? (list file0) (references %store file1))
+           (equal? (list file1) (references %store file2))))))
+
 (test-assert "import corrupt path"
   (let* ((text (random-text))
          (file (add-text-to-store %store "text" text))