On Fri, Dec 21, 2018 at 09:50:51PM +0100, Ludovic Courtès wrote:
> Hi!
>
> Efraim Flashner <efr...@flashner.co.il> skribis:
>
> > Here's what I currently have. I don't think I've tried running the tests
> > I've written yet, and Ludo said there was a better way to check if the
> > download was a git-fetch or a url-fetch. As the logic is currently
> > written it'll flag any package hosted on github owned by 'archive' or
> > any package named 'archive' in addition to the ones we want.
>
> OK. I think you’re pretty much there anyway, so please don’t drop the
> ball. ;-)
>
> Some comments follow:
>
> > From 8a07c8aea1f23db48a9e69956ad15f79f0f70e35 Mon Sep 17 00:00:00 2001
> > From: Efraim Flashner <efr...@flashner.co.il>
> > Date: Tue, 23 Oct 2018 12:01:53 +0300
> > Subject: [PATCH] lint: Add checker 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:
> > not-github", source-unstable-tarball: git-fetch"): New tests.
>
> [...]
>
> > +(define (check-source-unstable-tarball package)
> > + "Emit a warning if PACKAGE's source is an autogenerated tarball."
> > + (define (github-tarball? origin)
> > + (string-contains origin "github.com"))
> > + (define (autogenerated-tarball? origin)
> > + (string-contains origin "/archive/"))
> > + (let ((origin (package-source package)))
> > + (unless (not origin) ; check for '(source #f)'
> > + (let ((uri (origin-uri origin))
> > + (dl-method (origin-method origin)))
> > + (unless (not (pk dl-method "url-fetch"))
> > + (when (and (github-tarball? uri)
> > + (autogenerated-tarball? uri))
> > + (emit-warning package
> > + (G_ "the source URI should not be an autogenerated
> > tarball")
> > + 'source)))))))
>
> You should use ‘origin-uris’ (plural), which always returns a list of
> URIs, and iterate on them (see ‘check-mirror-url’ as an example.)That works really well > > Also, when you have a URI, you can obtain just the host part and decode > the path part like this: > > --8<---------------cut here---------------start------------->8--- > scheme@(guile-user)> (string->uri > "https://github.com/foo/bar/archive/whatnot";) > $2 = #<<uri> scheme: https userinfo: #f host: "github.com" port: #f path: > "/foo/bar/archive/whatnot" query: #f fragment: #f> > scheme@(guile-user)> (uri-host $2) > $3 = "github.com" > scheme@(guile-user)> (split-and-decode-uri-path (uri-path $2)) > $4 = ("foo" "bar" "archive" "whatnot") > --8<---------------cut here---------------end--------------->8--- > > That way you should be able to get more accurate matching than with > ‘string-contains’. Does that make sense? 'third' from srfi-1 also helped a lot, considering how the github uris are formatted. > > The tests look good… but could you make sure they pass? :-) pfft, little things :) (forgot to export check-source-unstable-tarball) > > Thank you! > > Ludo’. Next version attached -- Efraim Flashner <efr...@flashner.co.il> אפרים פלשנר GPG key = A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351 Confidentiality cannot be guaranteed on emails sent or received unencrypted
From dcd8b207f932289cb3b35720af45f49f849b7c27 Mon Sep 17 00:00:00 2001
From: Efraim Flashner <efr...@flashner.co.il>
Date: Tue, 25 Dec 2018 16:29:12 +0200
Subject: [PATCH] lint: Add checker 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.
---
guix/scripts/lint.scm | 23 ++++++++++++-
tests/lint.scm | 80 +++++++++++++++++++++++++++++++++++++++++++
2 files changed, 102 insertions(+), 1 deletion(-)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 354f6f703..2c1c7ec66 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -7,7 +7,7 @@
;;; Copyright © 2016 Hartmut Goebel <h.goe...@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alez...@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <m...@tobias.gr>
-;;; Copyright © 2017 Efraim Flashner <efr...@flashner.co.il>
+;;; Copyright © 2017, 2018 Efraim Flashner <efr...@flashner.co.il>
;;; Copyright © 2018 Arun Isaac <arunis...@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")
diff --git a/tests/lint.scm b/tests/lint.scm
index d4aa7c0e8..fe12bebd8 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -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"
""
--
2.20.1
signature.asc
Description: PGP signature
