[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/05: lint: 'patch-file-names' checks for file name length.
From: |
Ludovic Courtès |
Subject: |
05/05: lint: 'patch-file-names' checks for file name length. |
Date: |
Tue, 28 Nov 2017 09:20:57 -0500 (EST) |
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