[bug#33875] `guix lint' warn of GitHub autogenerated source tarballs

Message ID 20181226084712.GQ2581@macbook41
State Accepted
Headers show
Series [bug#33875] `guix lint' warn of GitHub autogenerated source tarballs | expand

Checks

Context Check Description
cbaines/applying patch fail Apply failed

Commit Message

Efraim Flashner Dec. 26, 2018, 8:47 a.m. UTC
Forwarded from the discussion on guix-devel

Comments

Ludovic Courtès Dec. 26, 2018, 5:40 p.m. UTC | #1
Hello!

Efraim Flashner <efraim@flashner.co.il> skribis:

> From dcd8b207f932289cb3b35720af45f49f849b7c27 Mon Sep 17 00:00:00 2001
> From: Efraim Flashner <efraim@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.

Could you mention ‘source-unstable-tarball’ in doc/guix.texi?

Otherwise LGTM!

Please double-check that “make check TESTS=tests/lint.scm” passes and
that ‘./pre-inst-env guix lint -c source-unstable-tarball’ works.

Thanks!

Ludo’.
Efraim Flashner Dec. 27, 2018, 12:58 p.m. UTC | #2
On Wed, Dec 26, 2018 at 06:40:22PM +0100, Ludovic Courtès wrote:
> Hello!
> 
> Efraim Flashner <efraim@flashner.co.il> skribis:
> 
> > From dcd8b207f932289cb3b35720af45f49f849b7c27 Mon Sep 17 00:00:00 2001
> > From: Efraim Flashner <efraim@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.
> 
> Could you mention ‘source-unstable-tarball’ in doc/guix.texi?

Added

> 
> Otherwise LGTM!
> 
> Please double-check that “make check TESTS=tests/lint.scm” passes and
> that ‘./pre-inst-env guix lint -c source-unstable-tarball’ works.

‘./pre-inst-env guix lint -c source-unstable-tarball’ shows many many
autogenerated tarballs, and I made the checks pass.

> 
> Thanks!
> 
> Ludo’.

Pushed as c180017b6f7e9b6d23238c1fbaac986c435cd35e

Patch

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.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")
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"
   ""