>From a42eda6b9631cc28dfdd02d2c8bb02eabb2626b9 Mon Sep 17 00:00:00 2001 From: Ben Woodcroft Date: Sun, 15 Nov 2015 10:18:05 +1000 Subject: [PATCH] import: Add github-updater. * guix/import/github.scm: New file. * guix/scripts/refresh.scm (%updaters): Add %GITHUB-UPDATER. * doc/guix.texi (Invoking guix refresh): Mention it. --- doc/guix.texi | 14 ++++ guix/import/github.scm | 167 +++++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/refresh.scm | 5 +- 3 files changed, 185 insertions(+), 1 deletion(-) create mode 100644 guix/import/github.scm diff --git a/doc/guix.texi b/doc/guix.texi index 06d70ba..f6b7368 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16,6 +16,7 @@ Copyright @copyright{} 2013 Nikita address@hidden Copyright @copyright{} 2015 Mathieu address@hidden Copyright @copyright{} 2014 Pierre-Antoine address@hidden Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer +Copyright @copyright{} 2015 Ben Woodcroft Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -4354,6 +4355,16 @@ attempt is made to automatically retrieve it from a public key server; when it's successful, the key is added to the user's keyring; otherwise, @command{guix refresh} reports an error. +The @code{github} updater uses the address@hidden://developer.github.com/v3/, GitHub API} to query for new +releases. When used repeatedly e.g. when refreshing all packages, GitHub +will eventually refuse to answer any further API requests. By default 60 +API requests per hour are allowed, and a full refresh on all GitHub +packages in Guix requires more than this. Authentication with GitHub +through the use of an API token alleviates these limits. To use an API +token, set the environment variable @code{GUIX_GITHUB_TOKEN} to a token +procured from @uref{https://github.com/settings/tokens} or otherwise. + The following options are supported: @table @code @@ -4415,6 +4426,8 @@ the updater for @uref{http://elpa.gnu.org/, ELPA} packages; the updater for @uref{http://cran.r-project.org/, CRAN} packages; @item pypi the updater for @uref{https://pypi.python.org, PyPI} packages. address@hidden github +the updater for @uref{https://github.com, GitHub} packages. @end table For instance, the following commands only checks for updates of Emacs @@ -4501,6 +4514,7 @@ Use @var{host} as the OpenPGP key server when importing a public key. @end table + @node Invoking guix lint @section Invoking @command{guix lint} The @command{guix lint} is meant to help package developers avoid common diff --git a/guix/import/github.scm b/guix/import/github.scm new file mode 100644 index 0000000..2ed477e --- /dev/null +++ b/guix/import/github.scm @@ -0,0 +1,167 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ben Woodcroft +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +;; TODO: Are all of these imports used? +(define-module (guix import github) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (json) + #:use-module (guix utils) + #:use-module ((guix download) #:prefix download:) + #:use-module (guix import utils) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (gnu packages) + #:export (%github-updater)) + +(define (json-fetch* url) + "Return a list/hash representation of the JSON resource URL, or #f on +failure." + (call-with-output-file "/dev/null" + (lambda (null) + (with-error-to-port null + (lambda () + (call-with-temporary-output-file + (lambda (temp port) + (and (url-fetch url temp) + (call-with-input-file temp json->scm))))))))) + +;; TODO: is there some code from elsewhere in guix that can be used instead of +;; redefining? +(define (find-extension url) + "Return the extension of the archive e.g. '.tar.gz' given a URL, or +false if none is recognized" + (find (lambda x (string-suffix? (first x) url)) + (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar"))) + +(define (github-package? package) + "Return true if PACKAGE is a package from GitHub." + + (define (github-url? url) + (and + (string-prefix? "https://github.com/" url) + (let ((ext (find-extension url))) + (and ext + (or + (string-suffix? + (string-append "/archive/v" (package-version package) ext) url) + (string-suffix? + (string-append "/archive/" (package-version package) ext) url) + (string-suffix? + (string-append "/archive/" (package-name package) "-" + (package-version package) ext) + url) + (string-suffix? + (string-append "/releases/download/v" (package-version package) + "/" (package-name package) "-" + (package-version package) ext) + url) + (string-suffix? + (string-append "/releases/download/" (package-version package) + "/" (package-name package) "-" + (package-version package) ext) + url)))))) + + (let ((source-url (and=> (package-source package) origin-uri)) + (fetch-method (and=> (package-source package) origin-method))) + (and (eq? fetch-method download:url-fetch) + (match source-url + ((? string?) + (github-url? source-url)) + ((source-url ...) + (any github-url? source-url)))))) + +(define (github-user-slash-repository url) + "Return a string e.g. arq5x/bedtools2 of the owner and the name of the +repository separated by a forward slash, from a string URL of the form +'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'" + (let ((splits (string-split url #\/))) + (string-append (list-ref splits 3) "/" (list-ref splits 4)))) + +(define %github-token + ;; Token to be passed to Github.com to avoid the 60-request per hour + ;; limit, or #f. + ;; QUESTION: is there a need to check that the token looks like a token, for + ;; security, since it gets used in a fetch as is? + (make-parameter (getenv "GUIX_GITHUB_TOKEN"))) + +(define (latest-released-version url package-name) + "Return a string of the newest released version name given a string URL like +'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of +the package e.g. 'bedtools2'. Return #f if there is no releases" + (let* ((token (%github-token)) + (api-url (string-append + "https://api.github.com/repos/" + (github-user-slash-repository url) + "/releases")) + (json (json-fetch* + (if token + (string-append api-url "?access_token=" token) + api-url)))) + (if (eq? json #f) + (if token + (error "Error downloading release information through the GitHub +API when using a GitHub token") + (error "Error downloading release information through the GitHub +API. This may be fixed by using an access token and setting the environment +variable GUIX_GITHUB_TOKEN, for instance one procured from +https://github.com/settings/tokens")) + (let ((proper-releases + (filter + (lambda (x) + ;; example pre-release: + ;; https://github.com/wwood/OrfM/releases/tag/v0.5.1 + ;; or an all-prerelease set + ;; https://github.com/powertab/powertabeditor/releases + (eq? (assoc-ref (hash-table->alist x) "prerelease") #f)) + json))) + (if (eq? (length proper-releases) 0) #f ;empty releases list + (let* + ((tag (assoc-ref (hash-table->alist (first proper-releases)) + "tag_name")) + (name-length (string-length package-name))) + ;; some tags include the name of the package e.g. "fdupes-1.51" + ;; so remove these + (if (and (< name-length (string-length tag)) + (string=? (string-append package-name "-") + (substring tag 0 (+ name-length 1)))) + (substring tag (+ name-length 1)) + ;; some tags start with a "v" e.g. "v0.25.0" + ;; where some are just the version number + (if (eq? (string-ref tag 0) #\v) + (substring tag 1) tag)))))))) + +(define (latest-release guix-package) + "Return an for the latest release of GUIX-PACKAGE." + (let* ((pkg (specification->package guix-package)) + (source-uri (origin-uri (package-source pkg))) + (name (package-name pkg)) + (version (latest-released-version source-uri name))) + (if version + (upstream-source + (package guix-package) + (version version) + (urls (list source-uri))) + #f))) + +(define %github-updater + (upstream-updater + (name 'github) + (description "Updater for GitHub packages") + (pred github-package?) + (latest latest-release))) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index a5834d1..adbcf28 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015 Alex Kost +;;; Copyright © 2015 Ben Woodcroft ;;; ;;; This file is part of GNU Guix. ;;; @@ -34,6 +35,7 @@ #:select (%gnu-updater %gnome-updater)) #:use-module (guix import elpa) #:use-module (guix import cran) + #:use-module (guix import github) #:use-module (guix gnupg) #:use-module (gnu packages) #:use-module ((gnu packages commencement) #:select (%final-inputs)) @@ -195,7 +197,8 @@ unavailable optional dependencies such as Guile-JSON." %gnome-updater %elpa-updater %cran-updater - ((guix import pypi) => %pypi-updater))) + ((guix import pypi) => %pypi-updater) + %github-updater)) (define (lookup-updater name) "Return the updater called NAME." -- 2.5.0