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.

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