From a4e7083da32395dd434970725df0bc15601d202a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 25 Feb 2016 17:23:29 +0100 Subject: 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 file changed, 11 insertions(+), 5 deletions(-) (limited to 'guix/http-client.scm') diff --git a/guix/http-client.scm b/guix/http-client.scm index b26795c64d..2161856c63 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 fails." string->number*) 36)))) +(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) -- cgit v1.2.3