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.
This commit is contained in:
Arun Isaac 2019-01-07 23:11:58 +05:30
parent 394207c1ee
commit 40fa21c22e
No known key found for this signature in database
GPG key ID: 2E25EE8B61802BB3
2 changed files with 17 additions and 7 deletions

View file

@ -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 @@ (define (follow-redirects-to-github uri)
(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)

View file

@ -6,7 +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>
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -775,7 +775,16 @@ (define-syntax-rule (with-warnings body ...)
(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 '()))