kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

import: Add github-updater.

Browse Source 
* guix/import/github.scm: New file.
* guix/scripts/refresh.scm (%updaters): Add %GITHUB-UPDATER.
* doc/guix.texi (Invoking guix refresh): Mention it.
* Makefile.am (MODULES): Add gnu/import/github.scm.
This commit is contained in:
Ben Woodcroft 2015-11-15 10:18:05 +10:00
parent 22572d56cb
commit 917a2a58ec
4 changed files with 216 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -109,6 +109,7 @@ MODULES = \
guix/import/cran.scm \
guix/import/hackage.scm \
guix/import/elpa.scm \
guix/import/github.scm \
guix/scripts.scm \
guix/scripts/download.scm \
guix/scripts/build.scm \

15
doc/guix.texi
View File

@ -17,6 +17,7 @@ Copyright @copyright{} 2015 Mathieu Lirzin@*
Copyright @copyright{} 2014 Pierre-Antoine Rault@*
Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
Copyright @copyright{} 2015, 2016 Leo Famulari
Copyright @copyright{} 2016 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
@ -4660,6 +4661,8 @@ the updater for @uref{http://www.bioconductor.org/, Bioconductor} R packages;
the updater for @uref{https://pypi.python.org, PyPI} packages.
@item gem
the updater for @uref{https://rubygems.org, RubyGems} packages.
@item github
the updater for @uref{https://github.com, GitHub} packages.
@end table
For instance, the following command only checks for updates of Emacs
@ -4746,6 +4749,18 @@ Use @var{host} as the OpenPGP key server when importing a public key.
@end table
The @code{github} updater uses the
@uref{https://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.
@node Invoking guix lint
@section Invoking @command{guix lint}
The @command{guix lint} command is meant to help package developers avoid

198
guix/import/github.scm Normal file
View File

@ -0,0 +1,198 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(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)
#:use-module (web uri)
#: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)))))))))
(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 (updated-github-url old-package new-version)
;; Return a url for the OLD-PACKAGE with NEW-VERSION. If no source url in
;; the OLD-PACKAGE is a GitHub url, then return false.
(define (updated-url url)
(if (string-prefix? "https://github.com/" url)
(let ((ext (find-extension url))
(name (package-name old-package))
(version (package-version old-package))
(prefix (string-append "https://github.com/"
(github-user-slash-repository url)))
(repo (github-repository url)))
(cond
((string-suffix? (string-append "/tarball/v" version) url)
(string-append prefix "/tarball/v" new-version))
((string-suffix? (string-append "/tarball/" version) url)
(string-append prefix "/tarball/" new-version))
((string-suffix? (string-append "/archive/v" version ext) url)
(string-append prefix "/archive/v" new-version ext))
((string-suffix? (string-append "/archive/" version ext) url)
(string-append prefix "/archive/" new-version ext))
((string-suffix? (string-append "/archive/" name "-" version ext)
url)
(string-append prefix "/archive/" name "-" new-version ext))
((string-suffix? (string-append "/releases/download/v" version "/"
name "-" version ext)
url)
(string-append prefix "/releases/download/v" new-version "/" name
"-" new-version ext))
((string-suffix? (string-append "/releases/download/" version "/"
name "-" version ext)
url)
(string-append prefix "/releases/download/" new-version "/" name
"-" new-version ext))
((string-suffix? (string-append "/releases/download/" version "/"
repo "-" version ext)
url)
(string-append prefix "/releases/download/" new-version "/" repo
"-" new-version ext))
((string-suffix? (string-append "/releases/download/" repo "-"
version "/" repo "-" version ext)
url)
(string-append "/releases/download/" repo "-" version "/" repo "-"
version ext))
(#t #f))) ; Some URLs are not recognised.
#f))
(let ((source-url (and=> (package-source old-package) origin-uri))
(fetch-method (and=> (package-source old-package) origin-method)))
(if (eq? fetch-method download:url-fetch)
(match source-url
((? string?)
(updated-url source-url))
((source-url ...)
(find updated-url source-url)))
#f)))
(define (github-package? package)
"Return true if PACKAGE is a package from GitHub, else false."
(not (eq? #f (updated-github-url package "dummy"))))
(define (github-repository url)
"Return a string e.g. bedtools2 of the name of the repository, from a string
URL of the form 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'"
(match (string-split (uri-path (string->uri url)) #\/)
((_ owner project . rest)
(string-append project))))
(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'"
(match (string-split (uri-path (string->uri url)) #\/)
((_ owner project . rest)
(string-append owner "/" project))))
(define %github-token
;; Token to be passed to Github.com to avoid the 60-request per hour
;; limit, or #f.
(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
(not (hash-ref x "prerelease")))
json)))
(match proper-releases
(() ;empty release list
#f)
((release . rest) ;one or more releases
(let ((tag (hash-ref release "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 <upstream-source> for the latest release of GUIX-PACKAGE."
(let* ((pkg (specification->package guix-package))
(source-uri (origin-uri (package-source pkg)))
(name (package-name pkg))
(newest-version (latest-released-version source-uri name)))
(if newest-version
(upstream-source
(package pkg)
(version newest-version)
(urls (list (updated-github-url pkg newest-version))))
#f))) ; On GitHub but no proper releases
(define %github-updater
(upstream-updater
(name 'github)
(description "Updater for GitHub packages")
(pred github-package?)
(latest latest-release)))

3
guix/scripts/refresh.scm
View File

@ -199,7 +199,8 @@ unavailable optional dependencies such as Guile-JSON."
%cran-updater
%bioconductor-updater
((guix import pypi) => %pypi-updater)
((guix import gem) => %gem-updater)))
((guix import gem) => %gem-updater)
((guix import github) => %github-updater)))
(define (lookup-updater name)
"Return the updater called NAME."