[bug#33801] import: github: Support source URIs that redirect to GitHub

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

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


Many GitHub hosted packages (for example, youtube-dl) present source
tarballs for download on their website
(https://yt-dl.org/downloads/latest/youtube-dl-2018.12.17.tar.gz). But
these URIs just redirect to GitHub. Currently, our GitHub refresher
does not cover these packages. This patch addresses that.


[-- Attachment #2: 0001-import-github-Support-source-URIs-that-redirect-to-G.patch --]
[-- Type: text/x-patch, Size: 4175 bytes --]

From 90f756fd6f7df50236023e120cb040f6e5d1718c Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Wed, 19 Dec 2018 15:59:52 +0530
Subject: [PATCH] import: github: Support source URIs that redirect to GitHub.

* guix/import/github.scm (follow-redirects-to-github): New function.
(updated-github-url)[updated-url]: For source URIs on other domains, replace
all instances of the old version with the new version.
(latest-release)[origin-github-uri]: If necessary, follow redirects to find
the GitHub URI.
---
 guix/import/github.scm | 34 ++++++++++++++++++++++++++++++----
 1 file changed, 30 insertions(+), 4 deletions(-)

diff --git a/guix/import/github.scm b/guix/import/github.scm
index af9f56e1d..d4d582b6a 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,8 @@
 
 (define-module (guix import github)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -29,6 +32,8 @@
   #:use-module (guix packages)
   #:use-module (guix upstream)
   #:use-module (guix http-client)
+  #:use-module (web client)
+  #:use-module (web response)
   #:use-module (web uri)
   #:export (%github-updater))
 
@@ -39,12 +44,27 @@ false if none is recognized"
         (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar"
               ".tgz" ".tbz" ".love")))
 
+(define (follow-redirects-to-github uri)
+  "Follow redirects of URI until a GitHub URI is found. Return that GitHub
+URI. If no GitHub URI is found, return #f."
+  (define (follow-redirect uri)
+    (receive (response body) (http-get uri #:streaming? #t)
+      (case (response-code response)
+        ((301 302)
+         (uri->string (assoc-ref (response-headers response) 'location)))
+        (else #f))))
+
+  (if (string-prefix? "https://github.com/" uri)
+      uri
+      (and=> (follow-redirect uri)
+             follow-redirects-to-github)))
+
 (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)
+    (if (follow-redirects-to-github url)
         (let ((ext     (or (find-extension url) ""))
               (name    (package-name old-package))
               (version (package-version old-package))
@@ -83,7 +103,13 @@ false if none is recognized"
                             url)
             (string-append "/releases/download/" repo "-" version "/" repo "-"
                            version ext))
-           (#t #f))) ; Some URLs are not recognised.
+           ;; As a last resort, attempt to replace all instances of the old
+           ;; version with the new version. This is necessary to handle URIs
+           ;; hosted on other domains that redirect to GitHub. We do not know
+           ;; the internal structure of these URIs and cannot handle them more
+           ;; intelligently.
+           (else (regexp-substitute/global
+                  #f version url 'pre new-version 'post))))
         #f))
 
   (let ((source-url (and=> (package-source old-package) origin-uri))
@@ -212,9 +238,9 @@ https://github.com/settings/tokens"))
   (define (origin-github-uri origin)
     (match (origin-uri origin)
       ((? string? url)
-       url)                                       ;surely a github.com URL
+       (follow-redirects-to-github url))
       ((urls ...)
-       (find (cut string-contains <> "github.com") urls))))
+       (find follow-redirects-to-github urls))))
 
   (let* ((source-uri (origin-github-uri (package-source pkg)))
          (name (package-name pkg))
-- 
2.19.2

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hi,

Arun Isaac <arunisaac@systemreboot.net> skribis:

> Many GitHub hosted packages (for example, youtube-dl) present source
> tarballs for download on their website
> (https://yt-dl.org/downloads/latest/youtube-dl-2018.12.17.tar.gz). But
> these URIs just redirect to GitHub. Currently, our GitHub refresher
> does not cover these packages. This patch addresses that.

Good idea!  Do you know how many packages fall into that category?

> From 90f756fd6f7df50236023e120cb040f6e5d1718c Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Wed, 19 Dec 2018 15:59:52 +0530
> Subject: [PATCH] import: github: Support source URIs that redirect to GitHub.
>
> * guix/import/github.scm (follow-redirects-to-github): New function.
> (updated-github-url)[updated-url]: For source URIs on other domains, replace
> all instances of the old version with the new version.
> (latest-release)[origin-github-uri]: If necessary, follow redirects to find
> the GitHub URI.

[...]

> +(define (follow-redirects-to-github uri)
> +  "Follow redirects of URI until a GitHub URI is found. Return that GitHub
> +URI. If no GitHub URI is found, return #f."

Perhaps add the yt-dl.org example as a comment here.

> +  (define (follow-redirect uri)
> +    (receive (response body) (http-get uri #:streaming? #t)

Add: (close-port body).

Otherwise LGTM, thanks!

Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

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


> Do you know how many packages fall into that category?

With this patch, we have a problem estimating the coverage using `guix
refresh -L'. Now, to estimate coverage, we need to make HTTP requests
for every single source tarball in Guix to determine if it redirects to
GitHub. This is an enormous number of HTTP requests! When I ran `guix
refresh -L', it took a very long time to finish coverage estimation. So,
I cancelled the command. Any better way to handle this?

>> +(define (follow-redirects-to-github uri)
>> +  "Follow redirects of URI until a GitHub URI is found. Return that GitHub
>> +URI. If no GitHub URI is found, return #f."
>
> Perhaps add the yt-dl.org example as a comment here.

I added a reference to the youtube-dl package in the comments. I also
added a few more comments in other places.

>> +  (define (follow-redirect uri)
>> +    (receive (response body) (http-get uri #:streaming? #t)
>
> Add: (close-port body).

I switched to using (http-head uri) instead of (http-get uri
#:streaming? #t). So, (close-port body) should no longer be required.

I also modified follow-redirects-to-github to avoid following redirects
on mirror and file URIs.

Please find attached a new patch.


[-- Attachment #2: 0001-import-github-Support-source-URIs-that-redirect-to-G.patch --]
[-- Type: text/x-patch, Size: 4666 bytes --]

From 7fa1daaf44720fa31813e4f07a2c49a2540a0526 Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Wed, 19 Dec 2018 15:59:52 +0530
Subject: [PATCH] import: github: Support source URIs that redirect to GitHub.

* guix/import/github.scm (follow-redirects-to-github): New function.
(updated-github-url)[updated-url]: For source URIs on other domains, replace
all instances of the old version with the new version.
(latest-release)[origin-github-uri]: If necessary, follow redirects to find
the GitHub URI.
---
 guix/import/github.scm | 41 +++++++++++++++++++++++++++++++++++++----
 1 file changed, 37 insertions(+), 4 deletions(-)

diff --git a/guix/import/github.scm b/guix/import/github.scm
index af9f56e1d..8db7db305 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,8 @@
 
 (define-module (guix import github)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -29,6 +32,8 @@
   #:use-module (guix packages)
   #:use-module (guix upstream)
   #:use-module (guix http-client)
+  #:use-module (web client)
+  #:use-module (web response)
   #:use-module (web uri)
   #:export (%github-updater))
 
@@ -39,12 +44,30 @@ false if none is recognized"
         (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar"
               ".tgz" ".tbz" ".love")))
 
+(define (follow-redirects-to-github uri)
+  "Follow redirects of URI until a GitHub URI is found. Return that GitHub
+URI. If no GitHub URI is found, return #f."
+  (define (follow-redirect uri)
+    (receive (response body) (http-head uri)
+      (case (response-code response)
+        ((301 302)
+         (uri->string (assoc-ref (response-headers response) 'location)))
+        (else #f))))
+
+  (cond
+   ((string-prefix? "https://github.com/" uri) uri)
+   ((string-prefix? "http" uri)
+    (and=> (follow-redirect uri) follow-redirects-to-github))
+   ;; Do not attempt to follow redirects on URIs other than http and https
+   ;; (such as mirror, file)
+   (else #f)))
+
 (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)
+    (if (follow-redirects-to-github url)
         (let ((ext     (or (find-extension url) ""))
               (name    (package-name old-package))
               (version (package-version old-package))
@@ -83,7 +106,14 @@ false if none is recognized"
                             url)
             (string-append "/releases/download/" repo "-" version "/" repo "-"
                            version ext))
-           (#t #f))) ; Some URLs are not recognised.
+           ;; As a last resort, attempt to replace all instances of the old
+           ;; version with the new version. This is necessary to handle URIs
+           ;; hosted on other domains that redirect to GitHub (for an example,
+           ;; see the youtube-dl package). We do not know the internal
+           ;; structure of these URIs and cannot handle them more
+           ;; intelligently.
+           (else (regexp-substitute/global
+                  #f version url 'pre new-version 'post))))
         #f))
 
   (let ((source-url (and=> (package-source old-package) origin-uri))
@@ -210,11 +240,14 @@ https://github.com/settings/tokens"))
 (define (latest-release pkg)
   "Return an <upstream-source> for the latest release of PKG."
   (define (origin-github-uri origin)
+    ;; We follow redirects to GitHub because the origin URI might appear to be
+    ;; hosted on some other domain but just redirects to GitHub. For example,
+    ;; see the youtube-dl package.
     (match (origin-uri origin)
       ((? string? url)
-       url)                                       ;surely a github.com URL
+       (follow-redirects-to-github url))
       ((urls ...)
-       (find (cut string-contains <> "github.com") urls))))
+       (find follow-redirects-to-github urls))))
 
   (let* ((source-uri (origin-github-uri (package-source pkg)))
          (name (package-name pkg))
-- 
2.19.2

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hi,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> Do you know how many packages fall into that category?
>
> With this patch, we have a problem estimating the coverage using `guix
> refresh -L'. Now, to estimate coverage, we need to make HTTP requests
> for every single source tarball in Guix to determine if it redirects to
> GitHub. This is an enormous number of HTTP requests! When I ran `guix
> refresh -L', it took a very long time to finish coverage estimation. So,
> I cancelled the command. Any better way to handle this?

Ouch, that’s a problem indeed.  We could maintain a cache of redirects,
although that wouldn’t be a real solution.

Hmm, now that I think about it, shouldn’t we store the github.com URL
directly for these packages?  We could add a new lint check along the
lines of the ‘check-mirror-url’ procedure that would allow us to find
out which URLs need to be changed.  If we took that route, the changes
you made to the importer would no longer be necessary.  :-/

WDYT?

Thanks,
Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

> Hmm, now that I think about it, shouldn’t we store the github.com URL
> directly for these packages?  We could add a new lint check along the
> lines of the ‘check-mirror-url’ procedure that would allow us to find
> out which URLs need to be changed.  If we took that route, the changes
> you made to the importer would no longer be necessary.  :-/

My changes only took a small amount of effort. I don't have much of an
issue with them being made obsolete. Shall I proceed with creating a
lint check along the lines of what you proposed?

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> Hmm, now that I think about it, shouldn’t we store the github.com URL
>> directly for these packages?  We could add a new lint check along the
>> lines of the ‘check-mirror-url’ procedure that would allow us to find
>> out which URLs need to be changed.  If we took that route, the changes
>> you made to the importer would no longer be necessary.  :-/
>
> My changes only took a small amount of effort. I don't have much of an
> issue with them being made obsolete. Shall I proceed with creating a
> lint check along the lines of what you proposed?

Yes, if that sounds good to you, please do!

Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

> We could maintain a cache of redirects, although that wouldn’t be a
> real solution.
>
> Hmm, now that I think about it, shouldn’t we store the github.com URL
> directly for these packages?  We could add a new lint check along the
> lines of the ‘check-mirror-url’ procedure that would allow us to find
> out which URLs need to be changed.  If we took that route, the changes
> you made to the importer would no longer be necessary.  :-/

On the other hand, if we constrain our updater predicates to not perform
network operations, we would be restricting what we can achieve with
updaters. For example, suppose in the future we have a cgit-updater to
update packages hosted using cgit. The only way to detect that would be
using some kind of network operation. The way our updaters currently
work, we will only ever be able to properly handle centralized platforms
like GitHub, PyPI, etc. And, that's a pity.

Another solution, though somewhat inelegant and tedious, would be to add
an `updater' field to the package specification so that the packager can
explicitly specify what updater to use.

WDYT?

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> We could maintain a cache of redirects, although that wouldn’t be a
>> real solution.
>>
>> Hmm, now that I think about it, shouldn’t we store the github.com URL
>> directly for these packages?  We could add a new lint check along the
>> lines of the ‘check-mirror-url’ procedure that would allow us to find
>> out which URLs need to be changed.  If we took that route, the changes
>> you made to the importer would no longer be necessary.  :-/
>
> On the other hand, if we constrain our updater predicates to not perform
> network operations, we would be restricting what we can achieve with
> updaters. For example, suppose in the future we have a cgit-updater to
> update packages hosted using cgit. The only way to detect that would be
> using some kind of network operation. The way our updaters currently
> work, we will only ever be able to properly handle centralized platforms
> like GitHub, PyPI, etc. And, that's a pity.

We can use heuristics in many cases to determine whether an updater
applies to a package; most of the time, that’s only based on the URL,
and it might also work for many cgit instances—those that have “/cgit”
in their URL.

Then again, I expect that a growing number of packages will be obtained
through ‘git-fetch’, and the updater for such a thing is trivial
(interestingly it’s not yet implemented though :-)).

So I feel like at present we don’t have strong evidence that that the
simple URL-based approach would not scale.

WDYT?

> Another solution, though somewhat inelegant and tedious, would be to add
> an `updater' field to the package specification so that the packager can
> explicitly specify what updater to use.

That could be useful to handle corner cases, but it should remain the
exception.

Thanks,
Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

> We can use heuristics in many cases to determine whether an updater
> applies to a package; most of the time, that’s only based on the URL,
> and it might also work for many cgit instances—those that have “/cgit”
> in their URL.
>
> Then again, I expect that a growing number of packages will be obtained
> through ‘git-fetch’, and the updater for such a thing is trivial
> (interestingly it’s not yet implemented though :-)).
>
> So I feel like at present we don’t have strong evidence that that the
> simple URL-based approach would not scale.

Agreed! Better to not complicate things beyond what is necessary at this
point. I am not confident that good heuristics exist. But, if we do use
git-fetch for the majority of our packages, like you said, updating will
be trivial.

I will proceed with the lint check as discussed earlier.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Eric Bavier]

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

On Thu, 20 Dec 2018 17:28:42 +0100
Ludovic Courtès <ludo@gnu.org> wrote:

> Then again, I expect that a growing number of packages will be obtained
> through ‘git-fetch’, and the updater for such a thing is trivial
> (interestingly it’s not yet implemented though :-)).

See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=33809

`~Eric

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

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


> I will proceed with the lint check as discussed earlier.

Please find attached the lint check patch.


[-- Attachment #2: 0001-guix-lint-Check-for-source-URIs-redirecting-to-GitHu.patch --]
[-- Type: text/x-patch, Size: 3117 bytes --]

From 65c540c549c1f2a415b54ccc04dec4b1406bb5eb Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Fri, 21 Dec 2018 17:48:55 +0530
Subject: [PATCH] guix: lint: Check for source URIs redirecting to GitHub.

* guix/scripts/lint.scm (check-github-uri): New procedure.
(%checkers): Add it.
---
 guix/scripts/lint.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 2314f3b28..4fb2578c9 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,8 +45,10 @@
   #:use-module (guix cve)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
+  #:use-module (web client)
   #:use-module (web uri)
   #:use-module ((guix build download)
                 #:select (maybe-expand-mirrors
@@ -773,6 +776,37 @@ descriptions maintained upstream."
       (let ((uris (origin-uris origin)))
         (for-each check-mirror-uri uris)))))
 
+(define (check-github-uri package)
+  "Check whether PACKAGE uses source URLs that redirect to GitHub."
+  (define (follow-redirect uri)
+    (receive (response body) (http-head uri)
+      (case (response-code response)
+        ((301 302)
+         (uri->string (assoc-ref (response-headers response) 'location)))
+        (else #f))))
+
+  (define (follow-redirects-to-github uri)
+    (cond
+     ((string-prefix? "https://github.com/" uri) uri)
+     ((string-prefix? "http" uri)
+      (and=> (follow-redirect uri) follow-redirects-to-github))
+     ;; Do not attempt to follow redirects on URIs other than http and https
+     ;; (such as mirror, file)
+     (else #f)))
+
+  (let ((origin (package-source package)))
+    (when (and (origin? origin)
+               (eqv? (origin-method origin) url-fetch))
+      (for-each
+       (lambda (uri)
+         (and=> (follow-redirects-to-github uri)
+                (lambda (github-uri)
+                  (emit-warning
+                   package
+                   (format #f (G_ "URL should be '~a'") github-uri)
+                   'source))))
+       (origin-uris origin)))))
+
 (define (check-derivation package)
   "Emit a warning if we fail to compile PACKAGE to a derivation."
   (define (try system)
@@ -1055,6 +1089,10 @@ or a list thereof")
      (name        'mirror-url)
      (description "Suggest 'mirror://' URLs")
      (check       check-mirror-url))
+   (lint-checker
+     (name        'github-uri)
+     (description "Suggest GitHub URIs")
+     (check       check-github-uri))
    (lint-checker
      (name        'source-file-name)
      (description "Validate file names of sources")
-- 
2.19.2

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hello!

Arun Isaac <arunisaac@systemreboot.net> skribis:

> From 65c540c549c1f2a415b54ccc04dec4b1406bb5eb Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Fri, 21 Dec 2018 17:48:55 +0530
> Subject: [PATCH] guix: lint: Check for source URIs redirecting to GitHub.
>
> * guix/scripts/lint.scm (check-github-uri): New procedure.
> (%checkers): Add it.

Overall LGTM.  Two things:

  1. Could you add tests in tests/lint.scm?  You can use the same
     strategy as the the ‘source’ tests there.  Let me know if you have
     questions.

  2. Could you add it to doc/guix.texi?

Thank you!

Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

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


Please find attached an updated patch.


[-- Attachment #2: 0001-guix-lint-Check-for-source-URIs-redirecting-to-GitHu.patch --]
[-- Type: text/x-patch, Size: 6429 bytes --]

From de88021c9a73d28f11bc2e060098484bd414da62 Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Fri, 21 Dec 2018 17:48:55 +0530
Subject: [PATCH] guix: lint: Check for source URIs redirecting to GitHub.

* guix/scripts/lint.scm (check-github-uri): New procedure.
(%checkers): Add it.
* doc/guix.texi (Invoking guix lint): Document it.
* tests/lint.scm ("github-url", "github-url: one suggestion"): New tests.
---
 doc/guix.texi         | 10 ++++++----
 guix/scripts/lint.scm | 39 +++++++++++++++++++++++++++++++++++++++
 tests/lint.scm        | 28 ++++++++++++++++++++++++++++
 3 files changed, 73 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8f6a8b3ed..62e0454cc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7659,12 +7659,14 @@ Identify inputs that should most likely be native inputs.
 @item source
 @itemx home-page
 @itemx mirror-url
+@itemx github-url
 @itemx source-file-name
 Probe @code{home-page} and @code{source} URLs and report those that are
-invalid.  Suggest a @code{mirror://} URL when applicable.  Check that
-the source file name is meaningful, e.g.@: is not
-just a version number or ``git-checkout'', without a declared
-@code{file-name} (@pxref{origin Reference}).
+invalid.  Suggest a @code{mirror://} URL when applicable.  If the
+@code{source} URL redirects to a GitHub URL, recommend usage of the GitHub
+URL.  Check that the source file name is meaningful, e.g.@: is not just a
+version number or ``git-checkout'', without a declared @code{file-name}
+(@pxref{origin Reference}).
 
 @item cve
 @cindex security vulnerabilities
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 2314f3b28..354f6f703 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,8 +45,10 @@
   #:use-module (guix cve)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
+  #:use-module (web client)
   #:use-module (web uri)
   #:use-module ((guix build download)
                 #:select (maybe-expand-mirrors
@@ -74,6 +77,7 @@
             check-source
             check-source-file-name
             check-mirror-url
+            check-github-url
             check-license
             check-vulnerabilities
             check-for-updates
@@ -773,6 +777,37 @@ descriptions maintained upstream."
       (let ((uris (origin-uris origin)))
         (for-each check-mirror-uri uris)))))
 
+(define (check-github-url package)
+  "Check whether PACKAGE uses source URLs that redirect to GitHub."
+  (define (follow-redirect uri)
+    (receive (response body) (http-head uri)
+      (case (response-code response)
+        ((301 302)
+         (uri->string (assoc-ref (response-headers response) 'location)))
+        (else #f))))
+
+  (define (follow-redirects-to-github uri)
+    (cond
+     ((string-prefix? "https://github.com/" uri) uri)
+     ((string-prefix? "http" uri)
+      (and=> (follow-redirect uri) follow-redirects-to-github))
+     ;; Do not attempt to follow redirects on URIs other than http and https
+     ;; (such as mirror, file)
+     (else #f)))
+
+  (let ((origin (package-source package)))
+    (when (and (origin? origin)
+               (eqv? (origin-method origin) url-fetch))
+      (for-each
+       (lambda (uri)
+         (and=> (follow-redirects-to-github uri)
+                (lambda (github-uri)
+                  (emit-warning
+                   package
+                   (format #f (G_ "URL should be '~a'") github-uri)
+                   'source))))
+       (origin-uris origin)))))
+
 (define (check-derivation package)
   "Emit a warning if we fail to compile PACKAGE to a derivation."
   (define (try system)
@@ -1055,6 +1090,10 @@ or a list thereof")
      (name        'mirror-url)
      (description "Suggest 'mirror://' URLs")
      (check       check-mirror-url))
+   (lint-checker
+     (name        'github-uri)
+     (description "Suggest GitHub URIs")
+     (check       check-github-url))
    (lint-checker
      (name        'source-file-name)
      (description "Validate file names of sources")
diff --git a/tests/lint.scm b/tests/lint.scm
index 300153e24..d4aa7c0e8 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -669,6 +670,33 @@
        (check-mirror-url (dummy-package "x" (source source)))))
    "mirror://gnu/foo/foo.tar.gz"))
 
+(test-assert "github-url"
+  (string-null?
+   (with-warnings
+     (with-http-server 200 %long-string
+       (check-github-url
+        (dummy-package "x" (source
+                            (origin
+                              (method url-fetch)
+                              (uri (%local-url))
+                              (sha256 %null-sha256)))))))))
+
+(let ((github-url "https://github.com/foo/bar/bar-1.0.tar.gz"))
+  (test-assert "github-url: one suggestion"
+    (string-contains
+     (with-warnings
+       (with-http-server (301 `((location . ,(string->uri github-url)))) ""
+         (let ((initial-uri (%local-url)))
+           (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+             (with-http-server (302 `((location . ,(string->uri initial-uri)))) ""
+               (check-github-url
+                (dummy-package "x" (source
+                                    (origin
+                                      (method url-fetch)
+                                      (uri (%local-url))
+                                      (sha256 %null-sha256))))))))))
+     github-url)))
+
 (test-assert "cve"
   (mock ((guix scripts lint) package-vulnerabilities (const '()))
         (string-null?
-- 
2.19.2

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hi Arun,

Arun Isaac <arunisaac@systemreboot.net> skribis:

> From de88021c9a73d28f11bc2e060098484bd414da62 Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Fri, 21 Dec 2018 17:48:55 +0530
> Subject: [PATCH] guix: lint: Check for source URIs redirecting to GitHub.
>
> * guix/scripts/lint.scm (check-github-uri): New procedure.
> (%checkers): Add it.
> * doc/guix.texi (Invoking guix lint): Document it.
> * tests/lint.scm ("github-url", "github-url: one suggestion"): New tests.

LGTM, thank you!

Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hello,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>>From de88021c9a73d28f11bc2e060098484bd414da62 Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Fri, 21 Dec 2018 17:48:55 +0530
> Subject: [PATCH] guix: lint: Check for source URIs redirecting to GitHub.
>
> * guix/scripts/lint.scm (check-github-uri): New procedure.
> (%checkers): Add it.
> * doc/guix.texi (Invoking guix lint): Document it.
> * tests/lint.scm ("github-url", "github-url: one suggestion"): New tests.

I just realized that the warning also triggers when the URL is already a
github.com URL:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix lint -c github-uri stellarium
gnu/packages/astronomy.scm:135:12: stellarium@0.18.1: URL should be 'https://github.com/Stellarium/stellarium/releases/download/v0.18.1/stellarium-0.18.1.tar.gz'
--8<---------------cut here---------------end--------------->8---

I think that’s because the above URL redirects to
<https://github-production-release-asset-2e65be.s3.amazonaws.com/18719856/7aec3148-7d35-11e8-9ad9-0a369f8ccc41?X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=AKIAIWNJYAX4CSVEH53A%2F20190105%2Fus-east-1%2Fs3%2Faws4_request&X-Amz-Date=20190105T231113Z&X-Amz-Expires=300&X-Amz-Signature=fc2594a6b3dbfd2e841317adaec1ca71482bf20f2c53e8eb7e7c343f950f74ce&X-Amz-SignedHeaders=host&actor_id=0&response-content-disposition=attachment%3B%20filename%3Dstellarium-0.18.1.tar.gz&response-content-type=application%2Foctet-stream>.

Any idea how we could avoid that?

Thanks,
Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

[-- Attachment #1.1: Type: text/plain, Size: 632 bytes --]


> I just realized that the warning also triggers when the URL is already a
> github.com URL:

> --8<---------------cut here---------------start------------->8---
> $ ./pre-inst-env guix lint -c github-uri stellarium
> gnu/packages/astronomy.scm:135:12: stellarium@0.18.1: URL should be 'https://github.com/Stellarium/stellarium/releases/download/v0.18.1/stellarium-0.18.1.tar.gz'
> --8<---------------cut here---------------end--------------->8---

This is a simple mistake on my part and it's not because stellarium's
origin URI redirects to the github-production-release-asset URI. Please
find attached a patch addressing this.


[-- Attachment #1.2: 0001-guix-lint-Warn-only-if-GitHub-URI-is-not-same-as-the.patch --]
[-- Type: text/x-patch, Size: 1680 bytes --]

From a8bc92f507e35b54afdd24a42f0aa45ff7cb2c0b Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Mon, 7 Jan 2019 23:11:58 +0530
Subject: [PATCH] guix: lint: Warn only if GitHub URI is not same as the
 package URI.

* guix/scripts/lint.scm (check-github-url): Warn only if the GitHub URI
obtained after following redirects is not same as the original URI.
---
 guix/scripts/lint.scm | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 9acec4857..0f315a935 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -8,7 +8,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -820,10 +820,11 @@ descriptions maintained upstream."
        (lambda (uri)
          (and=> (follow-redirects-to-github uri)
                 (lambda (github-uri)
-                  (emit-warning
-                   package
-                   (format #f (G_ "URL should be '~a'") github-uri)
-                   'source))))
+                  (unless (string=? github-uri uri)
+                    (emit-warning
+                     package
+                     (format #f (G_ "URL should be '~a'") github-uri)
+                     'source)))))
        (origin-uris origin)))))
 
 (define (check-derivation package)
-- 
2.19.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hello,

Arun Isaac <arunisaac@systemreboot.net> skribis:

> This is a simple mistake on my part and it's not because stellarium's
> origin URI redirects to the github-production-release-asset URI. Please
> find attached a patch addressing this.
>
> From a8bc92f507e35b54afdd24a42f0aa45ff7cb2c0b Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Mon, 7 Jan 2019 23:11:58 +0530
> Subject: [PATCH] guix: lint: Warn only if GitHub URI is not same as the
>  package URI.
>
> * guix/scripts/lint.scm (check-github-url): Warn only if the GitHub URI
> obtained after following redirects is not same as the original URI.

Oh, I see.  Perhaps we should add a test to catch this specific case so
that it doesn’t pop up again?

Otherwise LGTM.

Thanks,
Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

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


> Perhaps we should add a test to catch this specific case so that it
> doesn’t pop up again?

Yes, we should. But, there is a problem. "make check
TESTS=tests/lint.scm" fails with the following error message even on
master.

make[4]: *** [Makefile:4920: tests/lint.log] Error 1
make[4]: Leaving directory '/home/foo/guix'
make[3]: *** [Makefile:4902: check-TESTS] Error 2
make[3]: Leaving directory '/home/foo/guix'
make[2]: *** [Makefile:5145: check-am] Error 2
make[2]: Leaving directory '/home/foo/guix'
make[1]: *** [Makefile:4679: check-recursive] Error 1
make[1]: Leaving directory '/home/foo/guix'
make: *** [Makefile:5147: check] Error 2

On examining tests/lint.log, I find the following error message.

gnu/packages/lisp.scm:3806:7: In procedure inputs:
error: xclip: unbound variable

But, this makes no sense to me. Any idea what's happening?

Should I immediately push the patch I sent in the last mail, and then
deal with this problem separately? Without that patch, the linter is
faulty and might annoy people.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

bug#33801: import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hello Arun,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> Perhaps we should add a test to catch this specific case so that it
>> doesn’t pop up again?
>
> Yes, we should. But, there is a problem. "make check
> TESTS=tests/lint.scm" fails with the following error message even on
> master.
>
> make[4]: *** [Makefile:4920: tests/lint.log] Error 1
> make[4]: Leaving directory '/home/foo/guix'
> make[3]: *** [Makefile:4902: check-TESTS] Error 2
> make[3]: Leaving directory '/home/foo/guix'
> make[2]: *** [Makefile:5145: check-am] Error 2
> make[2]: Leaving directory '/home/foo/guix'
> make[1]: *** [Makefile:4679: check-recursive] Error 1
> make[1]: Leaving directory '/home/foo/guix'
> make: *** [Makefile:5147: check] Error 2
>
> On examining tests/lint.log, I find the following error message.
>
> gnu/packages/lisp.scm:3806:7: In procedure inputs:
> error: xclip: unbound variable
>
> But, this makes no sense to me. Any idea what's happening?

Ouch.  This is fixed by 804b9b18ac9188ffb6c6891cbb9241c6a80ed7c8.  I
think we were just lucky it didn’t bite before.

> Should I immediately push the patch I sent in the last mail, and then
> deal with this problem separately? Without that patch, the linter is
> faulty and might annoy people.

You can recheck your patch and push it I guess.

Thanks,
Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

[-- Attachment #1.1: Type: text/plain, Size: 352 bytes --]


>> gnu/packages/lisp.scm:3806:7: In procedure inputs:
>> error: xclip: unbound variable
>
> Ouch.  This is fixed by 804b9b18ac9188ffb6c6891cbb9241c6a80ed7c8.  I
> think we were just lucky it didn’t bite before.

Ok.

> You can recheck your patch and push it I guess.

Please find attached an updated patch complete with the test case.


[-- Attachment #1.2: 0001-guix-lint-Warn-only-if-GitHub-URI-is-not-same-as-the.patch --]
[-- Type: text/x-patch, Size: 2636 bytes --]

From 2711c58b8d713bf87e2a01d21a4bc6c77ccc7b7d Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Mon, 7 Jan 2019 23:11:58 +0530
Subject: [PATCH] guix: lint: Warn only if GitHub URI is not same as the
 package URI.

* guix/scripts/lint.scm (check-github-url): Warn only if the GitHub URI
obtained after following redirects is not same as the original URI.
* tests/lint.scm ("github-url: already the correct github url"): New test.
---
 guix/scripts/lint.scm | 11 ++++++-----
 tests/lint.scm        | 11 ++++++++++-
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 9acec4857..0f315a935 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -8,7 +8,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -820,10 +820,11 @@ descriptions maintained upstream."
        (lambda (uri)
          (and=> (follow-redirects-to-github uri)
                 (lambda (github-uri)
-                  (emit-warning
-                   package
-                   (format #f (G_ "URL should be '~a'") github-uri)
-                   'source))))
+                  (unless (string=? github-uri uri)
+                    (emit-warning
+                     package
+                     (format #f (G_ "URL should be '~a'") github-uri)
+                     'source)))))
        (origin-uris origin)))))
 
 (define (check-derivation package)
diff --git a/tests/lint.scm b/tests/lint.scm
index fe12bebd8..521e9fb40 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -775,7 +775,16 @@
                                       (method url-fetch)
                                       (uri (%local-url))
                                       (sha256 %null-sha256))))))))))
-     github-url)))
+     github-url))
+  (test-assert "github-url: already the correct github url"
+    (string-null?
+     (with-warnings
+       (check-github-url
+        (dummy-package "x" (source
+                            (origin
+                              (method url-fetch)
+                              (uri github-url)
+                              (sha256 %null-sha256)))))))))
 
 (test-assert "cve"
   (mock ((guix scripts lint) package-vulnerabilities (const '()))
-- 
2.19.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Ludovic Courtès]

Hello,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> You can recheck your patch and push it I guess.
>
> Please find attached an updated patch complete with the test case.
>
> From 2711c58b8d713bf87e2a01d21a4bc6c77ccc7b7d Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Mon, 7 Jan 2019 23:11:58 +0530
> Subject: [PATCH] guix: lint: Warn only if GitHub URI is not same as the
>  package URI.
>
> * guix/scripts/lint.scm (check-github-url): Warn only if the GitHub URI
> obtained after following redirects is not same as the original URI.
> * tests/lint.scm ("github-url: already the correct github url"): New test.

Alright, please push!

Thank you,
Ludo’.

[bug#33801] import: github: Support source URIs that redirect to GitHub

[Arun Isaac]

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


> Alright, please push!

Done!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]