diff options
Diffstat (limited to 'guix/http-client.scm')
| -rw-r--r-- | guix/http-client.scm | 46 |
1 files changed, 34 insertions, 12 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm index 3c5441c38c..59788c1f38 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2012, 2015 Free Software Foundation, Inc. +;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -259,7 +260,10 @@ Raise an '&http-get-error' condition if downloading fails." ((200) (values data (response-content-length resp))) ((301 ; moved permanently - 302) ; found (redirection) + 302 ; found (redirection) + 303 ; see other + 307 ; temporary redirection + 308) ; permanent redirection (let ((uri (resolve-uri-reference (response-location resp) uri))) (close-port port) (format #t (G_ "following redirection to `~a'...~%") @@ -302,14 +306,34 @@ Raise an '&http-get-error' condition if downloading fails." "Like 'http-fetch', return an input port, but cache its contents in ~/.cache/guix. The cache remains valid for TTL seconds." (let ((file (cache-file-for-uri uri))) - (define (update-cache) + (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)))) + '()))) + ;; Update the cache and return an input port. - (let ((port (http-fetch uri #:text? text?))) - (mkdir-p (dirname file)) - (with-atomic-file-output file - (cut dump-port port <>)) - (close-port port) - (open-input-file file))) + (guard (c ((http-get-error? c) + (if (= 304 (http-get-error-code c)) ;"Not Modified" + (begin + (utime file) ;update FILE's mtime + cache-port) + (raise c)))) + (let ((port (http-fetch uri #:text? text? + #:headers headers))) + (mkdir-p (dirname file)) + (when cache-port + (close-port cache-port)) + (with-atomic-file-output file + (cut dump-port port <>)) + (close-port port) + (open-input-file file)))) (define (old? port) ;; Return true if PORT has passed TTL. @@ -321,13 +345,11 @@ Raise an '&http-get-error' condition if downloading fails." (lambda () (let ((port (open-input-file file))) (if (old? port) - (begin - (close-port port) - (update-cache)) + (update-cache port) port))) (lambda args (if (= ENOENT (system-error-errno args)) - (update-cache) + (update-cache #f) (apply throw args)))))) ;;; http-client.scm ends here |