~ruther/guix-local

eef01cfe8eac8dee8ecf727e4ca459ae065e15ea — Ludovic Courtès 8 years ago 1da3d2a
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(-)

M guix/scripts/lint.scm
M tests/lint.scm
M guix/scripts/lint.scm => guix/scripts/lint.scm +25 -3
@@ 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."

M tests/lint.scm => tests/lint.scm +14 -1
@@ 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