02/03: http-client: 'http-client/cached' uses 'If-Modified-Since'.

[Ludovic Courtès]

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