lint: 'patch-file-names' checks for file name length.

Reported at <https://bugs.gnu.org/27943>
by Danny Milosavljevic <dannym@scratchpost.org>.

* guix/scripts/lint.scm (%distro-directory): New variable.
(check-patch-file-names): Add check for the file name length.
* tests/lint.scm ("patches: file name too long"): New test.

2 files changed, 39 insertions, 4 deletions

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 8840b1acb5..7300e55de2 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -587,24 +587,46 @@ from ~a")
                                     (package-home-page package))
                     'home-page)))))
 
+(define %distro-directory
+  (dirname (search-path %load-path "gnu.scm")))
+
 (define (check-patch-file-names package)
   "Emit a warning if the patches requires by PACKAGE are badly named or if the
 patch could not be found."
   (guard (c ((message-condition? c)     ;raised by 'search-patch'
              (emit-warning package (condition-message c)
                            'patch-file-names)))
+    (define patches
+      (or (and=> (package-source package) origin-patches)
+          '()))
+
     (unless (every (match-lambda        ;patch starts with package name?
                      ((? string? patch)
                       (and=> (string-contains (basename patch)
                                               (package-name package))
                              zero?))
                      (_  #f))     ;must be an <origin> or something like that.
-                   (or (and=> (package-source package) origin-patches)
-                       '()))
+                   patches)
       (emit-warning
        package
        (G_ "file names of patches should start with the package name")
-       'patch-file-names))))
+       'patch-file-names))
+
+    ;; Check whether we're reaching tar's maximum file name length.
+    (let ((prefix (string-length %distro-directory))
+          (margin (string-length "guix-0.13.0-10-123456789/"))
+          (max    99))
+      (for-each (match-lambda
+                  ((? string? patch)
+                   (when (> (+ margin (- (string-length patch) prefix))
+                            max)
+                     (emit-warning
+                      package
+                      (format #f (G_ "~a: file name is too long")
+                              (basename patch))
+                      'patch-file-names)))
+                  (_ #f))
+                patches))))
 
 (define (escape-quotes str)
   "Replace any quote character in STR by an escaped quote character."
diff --git a/tests/lint.scm b/tests/lint.scm
index 1d0fc4708c..064f3d177e 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@@ -331,6 +331,19 @@
          (check-patch-file-names pkg)))
      "file names of patches should start with the package name")))
 
+(test-assert "patches: file name too long"
+  (->bool
+   (string-contains
+     (with-warnings
+       (let ((pkg (dummy-package "x"
+                    (source
+                     (dummy-origin
+                      (patches (list (string-append "x-"
+                                                    (make-string 100 #\a)
+                                                    ".patch"))))))))
+         (check-patch-file-names pkg)))
+     "file name is too long")))
+
 (test-assert "patches: not found"
   (->bool
    (string-contains