summaryrefslogtreecommitdiff
path: root/guix/scripts/publish.scm
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 /guix/scripts/publish.scm
parented90104cc82fdd6b762a159b06c0ea37b417a9a5 (diff)
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 'guix/scripts/publish.scm')
-rw-r--r--guix/scripts/publish.scm38
1 files changed, 33 insertions, 5 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index a236f3e45c..db64d6483e 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -350,6 +350,9 @@ appropriate duration. NAR-PATH specifies the prefix for nar URLs."
"/" (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 @@ items. Failing that, we could eventually have to recompute them and return
+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 @@ CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
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