guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

lint: Check for unstable tarballs. 

* guix/scripts/lint.scm (check-source-unstable-tarball): New procedure.
(%checkers): Add it.
* tests/lint.scm ("source-unstable-tarball", "source-unstable-tarball:
source #f", "source-unstable-tarball: valid", "source-unstable-tarball:
package named archive", "source-unstable-tarball: not-github",
"source-unstable-tarball: git-fetch"): New tests.
* doc/guix.texi (Invoking guix lint): Document it.
This commit is contained in:
Efraim Flashner 2018-12-25 16:29:12 +02:00
parent 039ccc7118
commit c180017b6f
Signed by untrusted user: efraim
GPG Key ID: 41AAE7DCCA3D8351
3 changed files with 107 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/guix.texi
View File

@ -7704,6 +7704,11 @@ 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 source-unstable-tarball
Parse the @code{source} URL to determine if a tarball from GitHub is
autogenerated or if it is a release tarball. Unfortunately GitHub's
autogenerated tarballs are sometimes regenerated.
@item cve
@cindex security vulnerabilities
@cindex CVE, Common Vulnerabilities and Exposures

23
guix/scripts/lint.scm
View File

@ -7,7 +7,7 @@
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
@ -76,6 +76,7 @@
check-home-page
check-source
check-source-file-name
check-source-unstable-tarball
check-mirror-url
check-github-url
check-license
@ -752,6 +753,22 @@ descriptions maintained upstream."
(G_ "the source file name should contain the package name")
'source))))
(define (check-source-unstable-tarball package)
"Emit a warning if PACKAGE's source is an autogenerated tarball."
(define (check-source-uri uri)
(when (and (string=? (uri-host (string->uri uri)) "github.com")
(string=? (third (split-and-decode-uri-path
(uri-path (string->uri uri))))
"archive"))
(emit-warning package
(G_ "the source URI should not be an autogenerated tarball")
'source)))
(let ((origin (package-source package)))
(when (and (origin? origin)
(eqv? (origin-method origin) url-fetch))
(let ((uris (origin-uris origin)))
(for-each check-source-uri uris)))))
(define (check-mirror-url package)
"Check whether PACKAGE uses source URLs that should be 'mirror://'."
(define (check-mirror-uri uri) ;XXX: could be optimized
@ -1098,6 +1115,10 @@ or a list thereof")
(name 'source-file-name)
(description "Validate file names of sources")
(check check-source-file-name))
(lint-checker
(name 'source-unstable-tarball)
(description "Check for autogenerated tarballs")
(check check-source-unstable-tarball))
(lint-checker
(name 'derivation)
(description "Report failure to compile a package to a derivation")

80
tests/lint.scm
View File

@ -572,6 +572,86 @@
(check-source-file-name pkg)))
"file name should contain the package name"))))
(test-assert "source-unstable-tarball"
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(source
(origin
(method url-fetch)
(uri "https://github.com/example/example/archive/v0.0.tar.gz")
(sha256 %null-sha256))))))
(check-source-unstable-tarball pkg)))
"source URI should not be an autogenerated tarball"))
(test-assert "source-unstable-tarball: source #f"
(not
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(source #f))))
(check-source-unstable-tarball pkg)))
"source URI should not be an autogenerated tarball"))))
(test-assert "source-unstable-tarball: valid"
(not
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(source
(origin
(method url-fetch)
(uri "https://github.com/example/example/releases/download/x-0.0/x-0.0.tar.gz")
(sha256 %null-sha256))))))
(check-source-unstable-tarball pkg)))
"source URI should not be an autogenerated tarball"))))
(test-assert "source-unstable-tarball: package named archive"
(not
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(source
(origin
(method url-fetch)
(uri "https://github.com/example/archive/releases/download/x-0.0/x-0.0.tar.gz")
(sha256 %null-sha256))))))
(check-source-unstable-tarball pkg)))
"source URI should not be an autogenerated tarball"))))
(test-assert "source-unstable-tarball: not-github"
(not
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(source
(origin
(method url-fetch)
(uri "https://bitbucket.org/archive/example/download/x-0.0.tar.gz")
(sha256 %null-sha256))))))
(check-source-unstable-tarball pkg)))
"source URI should not be an autogenerated tarball"))))
(test-assert "source-unstable-tarball: git-fetch"
(not
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/archive/example.git")
(commit "0")))
(sha256 %null-sha256))))))
(check-source-unstable-tarball pkg)))
"source URI should not be an autogenerated tarball"))))
(test-skip (if (http-server-can-listen?) 0 1))
(test-equal "source: 200"
""