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.
This commit is contained in:
Ludovic Courtès 2019-05-26 01:18:53 +02:00
parent ed90104cc8
commit 493375cdb2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 62 additions and 5 deletions

View file

@ -350,6 +350,9 @@ (define* (narinfo-cache-file directory item
"/" (basename item)
".narinfo"))
(define (hash-part-mapping-cache-file directory hash)
(string-append directory "/hashes/" hash))
(define run-single-baker
(let ((baking (make-weak-value-hash-table))
(mutex (make-mutex)))
@ -403,6 +406,27 @@ (define (nar-expiration-time ttl)
+inf.0
(expiration-time file))))))
(define (hash-part->path* store hash cache)
"Like 'hash-part->path' but cached results under CACHE. This ensures we can
still map HASH to the corresponding store file name, even if said store item
vanished from the store in the meantime."
(let ((cached (hash-part-mapping-cache-file cache hash)))
(catch 'system-error
(lambda ()
(call-with-input-file cached read-string))
(lambda args
(if (= ENOENT (system-error-errno args))
(match (hash-part->path store hash)
("" "")
(result
(mkdir-p (dirname cached))
(call-with-output-file (string-append cached ".tmp")
(lambda (port)
(display result port)))
(rename-file (string-append cached ".tmp") cached)
result))
(apply throw args))))))
(define* (render-narinfo/cached store request hash
#:key ttl (compression %no-compression)
(nar-path "nar")
@ -412,13 +436,17 @@ (define* (render-narinfo/cached store request hash
requested using POOL."
(define (delete-entry narinfo)
;; Delete NARINFO and the corresponding nar from CACHE.
(let ((nar (string-append (string-drop-right narinfo
(string-length ".narinfo"))
".nar")))
(let* ((nar (string-append (string-drop-right narinfo
(string-length ".narinfo"))
".nar"))
(base (basename narinfo ".narinfo"))
(hash (string-take base (string-index base #\-)))
(mapping (hash-part-mapping-cache-file cache hash)))
(delete-file* narinfo)
(delete-file* nar)))
(delete-file* nar)
(delete-file* mapping)))
(let* ((item (hash-part->path store hash))
(let* ((item (hash-part->path* store hash cache))
(compression (actual-compression item compression))
(cached (and (not (string-null? item))
(narinfo-cache-file cache item

View file

@ -469,6 +469,35 @@ (define %gzip-magic-bytes
(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