aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-05-26 01:18:53 +0200
committerLudovic Courtès <ludo@gnu.org>2019-05-26 01:34:17 +0200
commit493375cdb23fc1416348da584f17bec7171faadd (patch)
treed418a5f8526b61df0eb61eec57de9f7859325486 /tests
parented90104cc82fdd6b762a159b06c0ea37b417a9a5 (diff)
downloadguix-493375cdb23fc1416348da584f17bec7171faadd.tar
guix-493375cdb23fc1416348da584f17bec7171faadd.tar.gz
publish: Maintain a hash-part-to-store-item mapping in cache.
Fixes <https://bugs.gnu.org/33897>. * guix/scripts/publish.scm (hash-part-mapping-cache-file) (hash-part->path*): New procedures. * guix/scripts/publish.scm (render-narinfo/cached)[delete-entry]: Delete the 'hash-part-mapping-cache-file'. Use 'hash-part->path*' instead of 'hash-part->path'. * tests/publish.scm ("with cache, vanishing item"): New test.
Diffstat (limited to 'tests')
-rw-r--r--tests/publish.scm29
1 files changed, 29 insertions, 0 deletions
diff --git a/tests/publish.scm b/tests/publish.scm
index 097ac036e0..7f44bc700f 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -469,6 +469,35 @@ FileSize: ~a~%"
(assoc-ref narinfo "FileSize"))
(response-code compressed))))))))))
+(test-equal "with cache, vanishing item" ;<https://bugs.gnu.org/33897>
+ 200
+ (call-with-temporary-directory
+ (lambda (cache)
+ (let ((thread (with-separate-output-ports
+ (call-with-new-thread
+ (lambda ()
+ (guix-publish "--port=6795"
+ (string-append "--cache=" cache)))))))
+ (wait-until-ready 6795)
+
+ ;; Make sure that, even if ITEM disappears, we're still able to fetch
+ ;; it.
+ (let* ((base "http://localhost:6795/")
+ (item (add-text-to-store %store "random" (random-text)))
+ (part (store-path-hash-part item))
+ (url (string-append base part ".narinfo"))
+ (cached (string-append cache
+ (if (zlib-available?)
+ "/gzip/" "/none/")
+ (basename item)
+ ".narinfo"))
+ (response (http-get url)))
+ (and (= 404 (response-code response))
+ (wait-for-file cached)
+ (begin
+ (delete-paths %store (list item))
+ (response-code (pk 'response (http-get url))))))))))
+
(test-equal "/log/NAME"
`(200 #t application/x-bzip2)
(let ((drv (run-with-store %store