[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

02/03: http-client: 'http-client/cached' uses unique cache file names.

From: Ludovic Courtès
Subject: 02/03: http-client: 'http-client/cached' uses unique cache file names.
Date: Thu, 25 Feb 2016 18:33:34 +0000

civodul pushed a commit to branch master
in repository guix.

commit a4e7083da32395dd434970725df0bc15601d202a
Author: Ludovic Courtès <address@hidden>
Date:   Thu Feb 25 17:23:29 2016 +0100

    http-client: 'http-client/cached' uses unique cache file names.
    * guix/http-client.scm (cache-file-for-uri): New procedure.
    (http-fetch/cached): Use it.  Remove 'directory' variable.
    [update-cache]: Make the 'dirname' of FILE.
 guix/http-client.scm |   16 +++++++++++-----
 1 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index b26795c..2161856 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -33,6 +33,7 @@
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix base64)
+  #:autoload   (guix hash) (sha256)
   #:use-module ((guix build utils)
                 #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
@@ -280,17 +281,22 @@ Raise an '&http-get-error' condition if downloading 
+(define (cache-file-for-uri uri)
+  "Return the name of the file in the cache corresponding to URI."
+  (let ((digest (sha256 (string->utf8 (uri->string uri)))))
+    ;; Use the "URL" alphabet because it does not contain "/".
+    (string-append (cache-directory) "/http/"
+                   (base64-encode digest 0 (bytevector-length digest)
+                                  #f #f base64url-alphabet))))
 (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?)
   "Like 'http-fetch', return an input port, but cache its contents in
 ~/.cache/guix.  The cache remains valid for TTL seconds."
-  (let* ((directory (string-append (cache-directory) "/http/"
-                                   (uri-host uri)))
-         (file      (string-append directory "/"
-                                   (basename (uri-path uri)))))
+  (let ((file (cache-file-for-uri uri)))
     (define (update-cache)
       ;; Update the cache and return an input port.
       (let ((port (http-fetch uri #:text? text?)))
-        (mkdir-p directory)
+        (mkdir-p (dirname file))
         (with-atomic-file-output file
           (cut dump-port port <>))
         (close-port port)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]