import: elpa: Use 'http-fetch/cached' to retrieve the archive.

* guix/import/elpa.scm (elpa-fetch-archive): Set %HTTP-CACHE-TTL to 6
  hours.
  (call-with-downloaded-file): Use 'http-fetch/cached' instead of
  'url-fetch'.
This commit is contained in:
Ludovic Courtès 2015-10-21 12:12:59 +02:00
parent 0a7c5a09fe
commit 218622a737
1 changed files with 6 additions and 8 deletions

View File

@ -19,6 +19,7 @@
(define-module (guix import elpa) (define-module (guix import elpa)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (web uri)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
@ -26,6 +27,7 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module ((guix download) #:select (download-to-store)) #:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix http-client)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix hash) #:use-module (guix hash)
@ -74,20 +76,16 @@ NAMES (strings)."
(let ((url (and=> (elpa-url repo) (let ((url (and=> (elpa-url repo)
(cut string-append <> "/archive-contents")))) (cut string-append <> "/archive-contents"))))
(if url (if url
(call-with-downloaded-file url read) ;; Use a relatively small TTL for the archive itself.
(parameterize ((%http-cache-ttl (* 6 3600)))
(call-with-downloaded-file url read))
(leave (_ "~A: currently not supported~%") repo)))) (leave (_ "~A: currently not supported~%") repo))))
(define* (call-with-downloaded-file url proc #:optional (error-thunk #f)) (define* (call-with-downloaded-file url proc #:optional (error-thunk #f))
"Fetch URL, store the content in a temporary file and call PROC with that "Fetch URL, store the content in a temporary file and call PROC with that
file. Returns the value returned by PROC. On error call ERROR-THUNK and file. Returns the value returned by PROC. On error call ERROR-THUNK and
return its value or leave if it's false." return its value or leave if it's false."
(call-with-temporary-output-file (proc (http-fetch/cached (string->uri url))))
(lambda (temp port)
(or (and (url-fetch url temp)
(call-with-input-file temp proc))
(if error-thunk
(error-thunk)
(leave (_ "~A: download failed~%") url))))))
(define (is-elpa-package? name elpa-pkg-spec) (define (is-elpa-package? name elpa-pkg-spec)
"Return true if the string NAME corresponds to the name of the package "Return true if the string NAME corresponds to the name of the package