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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit eef01cfe8eac8dee8ecf727e4ca459ae065e15ea
Author: Ludovic Courtès <address@hidden>
Date:   Tue Nov 28 15:05:55 2017 +0100

    lint: 'patch-file-names' checks for file name length.
    
    Reported at <https://bugs.gnu.org/27943>
    by Danny Milosavljevic <address@hidden>.
    
    * 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.
---
 guix/scripts/lint.scm | 28 +++++++++++++++++++++++++---
 tests/lint.scm        | 15 ++++++++++++++-
 2 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 8840b1a..7300e55 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 1d0fc47..064f3d1 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 <address@hidden>
 ;;; Copyright © 2014, 2015, 2016 Eric Bavier <address@hidden>
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <address@hidden>
 ;;; Copyright © 2016 Hartmut Goebel <address@hidden>
 ;;; Copyright © 2017 Alex Kost <address@hidden>
@@ -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