~ruther/guix-local

3ce1b9021a1244063bf800e9d68763f12234edd5 — Ludovic Courtès 8 years ago 82781d8
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.
2 files changed, 30 insertions(+), 12 deletions(-)

M guix/gnu-maintenance.scm
M guix/http-client.scm
M guix/gnu-maintenance.scm => guix/gnu-maintenance.scm +3 -1
@@ 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))))))

M guix/http-client.scm => guix/http-client.scm +27 -11
@@ 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