me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2015-01-17 15:59:00 +01:00
parent 867d847305
commit 5b3d863f00
2 changed files with 41 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/store.scm
View File

@ -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)))) (or done? (loop (process-stderr server port))))
(= 1 (read-int s)))) (= 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, "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 (define ordered
;; Sort PATHS, but don't include their references. (let ((sorted (topologically-sorted server paths)))
(filter (cut member <> paths) ;; When RECURSIVE? is #f, filter out the references of PATHS.
(topologically-sorted server paths))) (if recursive?
sorted
(filter (cut member <> paths) sorted))))
(let ((s (nix-server-socket server))) (let ((s (nix-server-socket server)))
(let loop ((paths ordered)) (let loop ((paths ordered))

33
tests/store.scm
View File

@ -552,6 +552,39 @@ Deriver: ~a~%"
(equal? (list file0) (references %store file1)) (equal? (list file0) (references %store file1))
(equal? (list file1) (references %store file2))))))) (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" (test-assert "import corrupt path"
(let* ((text (random-text)) (let* ((text (random-text))
(file (add-text-to-store %store "text" text)) (file (add-text-to-store %store "text" text))