>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