Merge branch 'master' into core-updates

1 files changed, 17 insertions, 9 deletions

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 143ed6de31..9138a627ac 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -145,7 +145,7 @@ Raise an '&http-get-error' condition if downloading fails."
                             (or (not (uri-host uri))
                                 (string=? host (uri-host uri)))
                             port)
-                       (open-connection uri*
+                       (open-connection uri
                                         #:verify-certificate?
                                         verify-certificate?
                                         #:timeout timeout)))))
@@ -296,6 +296,7 @@ returning."
                                   #f #f base64url-alphabet))))
 
 (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
+                            (headers '((user-agent . "GNU Guile")))
                             (write-cache dump-port)
                             (cache-miss (const #t))
                             (log-port (current-error-port))
@@ -307,21 +308,27 @@ Call WRITE-CACHE with the HTTP input port and the cache output port to write
 the data to cache.  Call CACHE-MISS with URI just before fetching data from
 URI.
 
+HEADERS is an alist of extra HTTP headers, to which cache-related headers are
+added automatically as appropriate.
+
 TIMEOUT specifies the timeout in seconds for connection establishment.
 
 Write information about redirects to LOG-PORT."
-  (let ((file (cache-file-for-uri uri)))
+  (let* ((uri (if (string? uri)
+                  (string->uri uri)
+                  uri))
+         (file (cache-file-for-uri uri)))
     (define (update-cache cache-port)
       (define cache-time
         (and cache-port
              (stat:mtime (stat cache-port))))
 
-      (define headers
-        `((user-agent . "GNU Guile")
-          ,@(if cache-time
-                `((if-modified-since
-                   . ,(time-utc->date (make-time time-utc 0 cache-time))))
-                '())))
+      (define extended-headers
+        (if cache-time
+            `((if-modified-since
+               . ,(time-utc->date (make-time time-utc 0 cache-time)))
+              ,@headers)
+            headers))
 
       ;; Update the cache and return an input port.
       (guard (c ((http-get-error? c)
@@ -332,7 +339,8 @@ Write information about redirects to LOG-PORT."
                      (raise c))))
         (let ((port (http-fetch uri #:text? text?
                                 #:log-port log-port
-                                #:headers headers #:timeout timeout)))
+                                #:headers extended-headers
+                                #:timeout timeout)))
           (cache-miss uri)
           (mkdir-p (dirname file))
           (when cache-port