Re: [PATCH] draft addition of github updater

[Ben Woodcroft <b.woodcroft@uq.edu.au>]

[-- Attachment #1: Type: text/plain, Size: 10055 bytes --]

Hi again,

Thanks for the comments Ludo.

Unfortunately I found a further bug - the updated URL for the new 
package was actually the old URL not the updated one, and fixing this 
required some refactoring.

I'm afraid I'm almost out of time for this until the end of March, so if 
there are any further substantive changes we might have to let this slip 
the upcoming release, unless someone else can continue this work. Soz..

One way in which this could be improved in the future would be to accept 
odd source GitHub URLs and return the newest version, but error out when 
the URL needs to be guessed. That way, at least all GitHub-sourced 
packages can be checked for updates even if they cannot all be updated 
in place. I don't think this would be especially hard to implement and 
would be quite reliable.

On 04/01/16 06:46, Ludovic Courtès wrote:
> Ben Woodcroft<b.woodcroft@uq.edu.au>  skribis:
>
>> It seems I miscounted before, but now it is 129 of 146 github
>> "release" packages recognised with 28 suggesting an update - see the
>> end of email for details. There is one false positive:
>>
>> gnu/packages/ocaml.scm:202:13: camlp4 would be upgraded from 4.02+6 to
>> 4.02.0+1
>>
>> This happens because the newer versions were not made as official
>> releases just tags, so the newer versions are omitted from the API
>> response, plus there's the odd version numbering scheme. Guix is up to
>> date.
> I guess we could filter out such downgrades by adding a call to
> ‘version>?’, no?

My impression is that code elsewhere (yours?) already does this, but 
version>? does not work as intended for this corner case.

[...]

>>> I guess (guix import github) could contain something like:
>>>
>>>     (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")))
>>>
>>> and we’d need to document that, or maybe write a message hinting at it
>>> when we know the limit has been reached.
>>>
>>> WDYT?
>> Seems we were all thinking the same thing - I've integrated
>> this. Should we check that the token matches ^[0-9a-f]+$ for security
>> and UI?
> I think it’s fine as is.  There’s no security issue on the client side
> AFAICS.

OK

>>> I was thinking we could have a generic Git updater that would look
>>> for available tags upstream. I wonder how efficient that would be
>>> compared to using the GitHub-specific API, and if there would be
>>> other differences. What are your thoughts on this?
>> This sounds like an excellent idea, but I was unable to find any way
>> to fetch tags without a clone first. A clone could take a long time
>> and a lot of bandwidth I would imagine. Also there's no way to discern
>> regular releases from pre-releases I don't think. It is a bit unclear
>> to me how conservative these updaters should be, are tags sufficiently
>> synonymous with releases so as to be reported by refresh?
> I think we’d have to hard-code heuristics to distinguish release tags
> from other tags.  Typically, again, considering only tags that match
> ‘v[0-9\.]+’.
>
> Well, future work!  :-)

OK.

>>  From a42eda6b9631cc28dfdd02d2c8bb02eabb2626b9 Mon Sep 17 00:00:00 2001
>> From: Ben Woodcroft<donttrustben@gmail.com>
>> 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.
> [...]
>
>> +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.
> Good!  Please make sure to leave two spaces after end-of-sentence periods.
>
> Also, maybe this paragraph should be moved after the @table that lists
> updaters?  Otherwise it mentions the ‘github’ updater before it has been
> introduced.

OK. I moved it to the end of the refresh section, not just after the table.

[...]
>> +(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)))))))))
> Rather use (guix http-client) and something like:
>
>    (let ((port (http-fetch url)))
>      (dynamic-wind
>        (const #t)
>        (lambda ()
>          (json->scm port))
>        (lambda ()
>          (close-port port))))
>
> This avoids the temporary file creation etc.

This sounds preferable but did not work as I kept getting 403 forbidden. 
Displaying the URI for instance with (string-append uri "\n") gives the 
below. I understand the error is trivial, but just wanted to communicate 
the URI object.

ERROR: In procedure string-append:
ERROR: In procedure string-append: Wrong type (expecting string): 
#<<uri> scheme: https userinfo: #f host: "api.github.com" port: #f path: 
"/repos/torognes/vsearch/releases" query: 
"access_token=27907952ef87f3691d592b9dcd93cd4b6f20625f" fragment: #f>

>> +;; 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")))
> Remove this procedure and use (file-extension url) instead, from (guix utils).

I figured there was something out there. The problem is file-extension 
returns, for example, "gz" when we are after "tar.gz".

>> +(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))))
> Rather write it as:
>
>    (match (string-split (uri-path (string->uri url)) #\/)
>      ((owner project . rest)
>       (string-append owner "/" project)))
>
>> +    (if (eq? json #f)
> Rather: (if (not json).
>
> However, ‘http-fetch’ raises an &http-error condition when something
> goes wrong (it never returns #f.)  So…

Since we aren't using http-fetch for the above reasons I tried to use 
(if (not json)), but this did not work because "(if (list of hashes))" 
throws a Wrong type to apply error.

>> +        (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"))
> … this can be removed, and the whole thing becomes:
>
>    (guard (c ((http-get-error? c)
>               (warning (_ "failed to access ~a: ~a (~a)~%")
>                        (uri->string (http-get-error-uri c))
>                        (http-get-error-code c)
>                        (http-get-error-reason c))))
>      …)

I've not used for now.

>> +        (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))
> Simply: (not (hash-ref x "prerelease")).

OK.

>> +          (if (eq? (length proper-releases) 0) #f ;empty releases list
>> +              (let*
>> +                  ((tag (assoc-ref (hash-table->alist (first proper-releases))
>> +                                   "tag_name"))
> Rather:
>
>    (match proper-releases
>      (()                       ;empty release list
>       #f)
>      ((release . rest)         ;one or more releases
>       (let* ((tag (hash-ref release "tag_name")) …)
>         …)))

OK.

>> +(define (latest-release guix-package)
>> +  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
>> +  (let* ((pkg (specification->package guix-package))
> Someone (Ricardo?) proposed recently to pass a package object instead of
> a package name to ‘latest-release’.
>
> We should do that ideally before this patch goes in, or otherwise soon.

As discussed in the other thread, let's just proceed without waiting for 
Ricardo's efforts.

>> -                 ((guix import pypi) => %pypi-updater)))
>> +                 ((guix import pypi) => %pypi-updater)
>> +                 %github-updater))
> Write it as:
>
>    ((guix import github) => %github-updater)
>
> so that users who do not have guile-json can still use ‘guix refresh’.

OK.

> Could you send an updated patch?  Looks like we’re almost there.

Not quite there it seems.

Thanks.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-import-Add-github-updater.patch --]
[-- Type: text/x-patch; name="0001-import-Add-github-updater.patch", Size: 12694 bytes --]

From e75c5f2b76fd5a3074a230b6764eb4cc879fa582 Mon Sep 17 00:00:00 2001
From: Ben Woodcroft <donttrustben@gmail.com>
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            |  15 ++++
 guix/import/github.scm   | 198 +++++++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/refresh.scm |   4 +-
 3 files changed, 216 insertions(+), 1 deletion(-)
 create mode 100644 guix/import/github.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index b991cc1..0b76dac 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
@@ -4573,6 +4574,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
@@ -4659,6 +4662,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
diff --git a/guix/import/github.scm b/guix/import/github.scm
new file mode 100644
index 0000000..c696dcb
--- /dev/null
+++ b/guix/import/github.scm
@@ -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)))
+
+
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index bb38f09..24e97c7 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -43,6 +43,7 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
+  #:use-module (guix import github)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -199,7 +200,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."
-- 
2.6.3