From 493375cdb23fc1416348da584f17bec7171faadd Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 26 May 2019 01:18:53 +0200
Subject: 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.
---
 guix/scripts/publish.scm | 38 +++++++++++++++++++++++++++++++++-----
 1 file changed, 33 insertions(+), 5 deletions(-)

(limited to 'guix')

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 @@ (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
-- 
cgit v1.2.3