Re: `guix lint' warn of GitHub autogenerated source tarballs

[Efraim Flashner <efraim@flashner.co.il>]

[-- Attachment #1.1: Type: text/plain, Size: 1081 bytes --]

On Wed, Dec 19, 2018 at 11:13:56PM +0530, Arun Isaac wrote:
> 
> >>> Now that we are avoiding GitHub autogenerated source tarballs since
> >>they
> >>> are unstable and cause hash mismatch errors, can we have `guix lint'
> >>> emit a warning if these autogenerated source tarballs are used?
> >>
> > I think I just posted a paste on IRC but haven't sent a patch
> > yet. I'll grab it and submit it, it's almost done, just needs some
> > cleaning up and tightening the test cases.
> 
> Great, thank you!
> 

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.

-- 
Efraim Flashner   <efraim@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

[-- Attachment #1.2: 0001-lint-Add-checker-for-unstable-tarballs.patch --]
[-- Type: text/plain, Size: 5763 bytes --]

From 8a07c8aea1f23db48a9e69956ad15f79f0f70e35 Mon Sep 17 00:00:00 2001
From: Efraim Flashner <efraim@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.
---
 guix/scripts/lint.scm | 23 ++++++++++++++-
 tests/lint.scm        | 68 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 90 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index e477bf0dd..cce7af66c 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>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -747,6 +747,23 @@ 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 (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)))))))
+
 (define (check-mirror-url package)
   "Check whether PACKAGE uses source URLs that should be 'mirror://'."
   (define (check-mirror-uri uri)                  ;XXX: could be optimized
@@ -1051,6 +1068,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 ab0e8b9a8..723a35107 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -571,6 +571,74 @@
          (check-source-file-name pkg)))
      "file name should contain the package name"))))
 
+(test-assert "source-unstable-tarball"
+  (not
+    (->bool
+     (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: 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.19.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]