From: Arun Isaac <arunisaac@systemreboot.net>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: 33801@debbugs.gnu.org
Subject: [bug#33801] import: github: Support source URIs that redirect to GitHub
Date: Sat, 22 Dec 2018 15:38:39 +0530 [thread overview]
Message-ID: <cu7y38han6g.fsf@systemreboot.net> (raw)
In-Reply-To: <877eg2q56k.fsf@gnu.org>
[-- 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
next prev parent reply other threads:[~2018-12-22 10:09 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-12-19 10:44 [bug#33801] import: github: Support source URIs that redirect to GitHub Arun Isaac
2018-12-19 21:47 ` Ludovic Courtès
2018-12-20 6:56 ` Arun Isaac
2018-12-20 10:55 ` Ludovic Courtès
2018-12-20 11:20 ` Arun Isaac
2018-12-20 11:22 ` Ludovic Courtès
2018-12-20 13:07 ` Arun Isaac
2018-12-20 16:28 ` Ludovic Courtès
2018-12-20 16:48 ` Arun Isaac
2018-12-21 12:27 ` Arun Isaac
2018-12-21 15:18 ` Ludovic Courtès
2018-12-22 10:08 ` Arun Isaac [this message]
2018-12-23 17:23 ` Ludovic Courtès
2019-01-05 23:18 ` Ludovic Courtès
2019-01-07 17:48 ` Arun Isaac
2019-01-08 8:40 ` Ludovic Courtès
2019-01-08 13:19 ` Arun Isaac
2019-01-09 14:11 ` bug#33801: " Ludovic Courtès
2019-01-10 7:45 ` [bug#33801] " Arun Isaac
2019-01-10 8:52 ` Ludovic Courtès
2019-01-10 10:12 ` Arun Isaac
2018-12-21 0:12 ` Eric Bavier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=cu7y38han6g.fsf@systemreboot.net \
--to=arunisaac@systemreboot.net \
--cc=33801@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.