[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: http-client: 'http-client/cached' uses 'If-Modified-Since'.
From: |
Ludovic Courtès |
Subject: |
02/03: http-client: 'http-client/cached' uses 'If-Modified-Since'. |
Date: |
Tue, 19 Sep 2017 06:19:22 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 3ce1b9021a1244063bf800e9d68763f12234edd5
Author: Ludovic Courtès <address@hidden>
Date: Tue Sep 19 11:49:29 2017 +0200
http-client: 'http-client/cached' uses 'If-Modified-Since'.
* guix/http-client.scm (http-fetch/cached)[update-cache]: Add
'cache-port' parameter. Check its mtime and compute 'if-modified-since'
header accordingly. Guard 'http-get-error?' and honor 304.
Adjust callers of 'update-cache'.
* guix/gnu-maintenance.scm (ftp.gnu.org-files): Set #:ttl to 15m.
---
guix/gnu-maintenance.scm | 4 +++-
guix/http-client.scm | 38 +++++++++++++++++++++++++++-----------
2 files changed, 30 insertions(+), 12 deletions(-)
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 62f8173..796c2d6 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -454,7 +454,9 @@ hosted on ftp.gnu.org, or not under that name (this is the
case for
(define (string->lines str)
(string-tokenize str (char-set-complement (char-set #\newline))))
- (let ((port (http-fetch/cached %gnu-file-list-uri #:ttl (* 60 60))))
+ ;; Since https://ftp.gnu.org honors 'If-Modified-Since', the hard-coded
+ ;; TTL can be relatively short.
+ (let ((port (http-fetch/cached %gnu-file-list-uri #:ttl (* 15 60))))
(map trim-leading-components
(call-with-gzip-input-port port
(compose string->lines get-string-all))))))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 5c9342c..853bba4 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -306,14 +306,32 @@ 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"
+ 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.
@@ -325,13 +343,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