diff options
Diffstat (limited to 'guix/import/elpa.scm')
| -rw-r--r-- | guix/import/elpa.scm | 63 |
1 files changed, 54 insertions, 9 deletions
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index b3a3a963a6..37fc2b80fe 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +20,7 @@ (define-module (guix import elpa) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) + #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) @@ -26,13 +28,17 @@ #:use-module (srfi srfi-26) #:use-module ((guix download) #:select (download-to-store)) #:use-module (guix import utils) + #:use-module (guix http-client) #:use-module (guix store) #:use-module (guix ui) #:use-module (guix hash) #:use-module (guix base32) + #:use-module (guix upstream) + #:use-module (guix packages) #:use-module ((guix utils) #:select (call-with-temporary-output-file memoize)) - #:export (elpa->guix-package)) + #:export (elpa->guix-package + %elpa-updater)) (define (elpa-dependencies->names deps) "Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of @@ -74,20 +80,16 @@ NAMES (strings)." (let ((url (and=> (elpa-url repo) (cut string-append <> "/archive-contents")))) (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)))) (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 file. Returns the value returned by PROC. On error call ERROR-THUNK and return its value or leave if it's false." - (call-with-temporary-output-file - (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)))))) + (proc (http-fetch/cached (string->uri url)))) (define (is-elpa-package? name elpa-pkg-spec) "Return true if the string NAME corresponds to the name of the package @@ -231,4 +233,47 @@ type '<elpa-package>'." (let ((pkg (fetch-elpa-package name repo))) (and=> pkg elpa-package->sexp))) + +;;; +;;; Updates. +;;; + +(define (latest-release package) + "Return an <upstream-release> for the latest release of PACKAGE. PACKAGE +may be a Guix package name such as \"emacs-debbugs\" or an upstream name such +as \"debbugs\"." + (define name + (if (string-prefix? "emacs-" package) + (string-drop package 6) + package)) + + (let* ((repo 'gnu) + (info (elpa-package-info name repo)) + (version (match info + ((name raw-version . _) + (elpa-version->string raw-version)))) + (url (match info + ((_ raw-version reqs synopsis kind . rest) + (package-source-url kind name version repo))))) + (upstream-source + (package package) + (version version) + (urls (list url)) + (signature-urls (list (string-append url ".sig")))))) + +(define (package-from-gnu.org? package) + "Return true if PACKAGE is from elpa.gnu.org." + (match (and=> (package-source package) origin-uri) + ((? string? uri) + (let ((uri (string->uri uri))) + (and uri (string=? (uri-host uri) "elpa.gnu.org")))) + (_ #f))) + +(define %elpa-updater + ;; The ELPA updater. We restrict it to packages hosted on elpa.gnu.org + ;; because for other repositories, we typically grab the source elsewhere. + (upstream-updater 'elpa + package-from-gnu.org? + latest-release)) + ;;; elpa.scm ends here |