pkgsrc-Changes-HG archive

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index][Old Index]

[pkgsrc/trunk]: pkgsrc/pkgtools/pkglint/files Extended the check for absolute...



details:   https://anonhg.NetBSD.org/pkgsrc/rev/b30fd72c62da
branches:  trunk
changeset: 516184:b30fd72c62da
user:      rillig <rillig%pkgsrc.org@localhost>
date:      Sun Jul 16 10:30:27 2006 +0000

description:
Extended the check for absolute pathnames from Makefile-patches only to
all kinds of patches, especially source code.

diffstat:

 pkgtools/pkglint/files/pkglint.pl |  226 +++++++++++++++++++++++++++++--------
 1 files changed, 176 insertions(+), 50 deletions(-)

diffs (truncated from 429 to 300 lines):

diff -r bf34b30ac42a -r b30fd72c62da pkgtools/pkglint/files/pkglint.pl
--- a/pkgtools/pkglint/files/pkglint.pl Sun Jul 16 09:56:19 2006 +0000
+++ b/pkgtools/pkglint/files/pkglint.pl Sun Jul 16 10:30:27 2006 +0000
@@ -1,5 +1,5 @@
 #! @PERL@
-# $NetBSD: pkglint.pl,v 1.648 2006/07/15 07:31:45 rillig Exp $
+# $NetBSD: pkglint.pl,v 1.649 2006/07/16 10:30:27 rillig Exp $
 #
 
 # pkglint - static analyzer and checker for pkgsrc packages
@@ -523,79 +523,95 @@
 
 sub log_fatal($$) {
        my ($self, $text) = @_;
+
        $self->show_source(*STDERR);
        PkgLint::Logging::log_fatal($self->fname, $self->[LINES], $text);
 }
 sub log_error($$) {
        my ($self, $text) = @_;
+
        $self->show_source(*STDOUT);
        PkgLint::Logging::log_error($self->fname, $self->[LINES], $text);
 }
 sub log_warning($$) {
        my ($self, $text) = @_;
+
        $self->show_source(*STDOUT);
        PkgLint::Logging::log_warning($self->fname, $self->[LINES], $text);
 }
 sub log_note($$) {
        my ($self, $text) = @_;
+
        $self->show_source(*STDOUT);
        PkgLint::Logging::log_note($self->fname, $self->[LINES], $text);
 }
 sub log_debug($$) {
        my ($self, $text) = @_;
+
        $self->show_source(*STDOUT);
        PkgLint::Logging::log_debug($self->fname, $self->[LINES], $text);
 }
 sub explain_error($@) {
        my ($self, @texts) = @_;
+
        PkgLint::Logging::explain_error($self->fname, $self->[LINES], @texts);
 }
 sub explain_warning($@) {
        my ($self, @texts) = @_;
+
        PkgLint::Logging::explain_warning($self->fname, $self->[LINES], @texts);
 }
 sub explain_note($@) {
        my ($self, @texts) = @_;
+
        PkgLint::Logging::explain_note($self->fname, $self->[LINES], @texts);
 }
 sub explain_info($@) {
        my ($self, @texts) = @_;
+
        PkgLint::Logging::explain_info($self->fname, $self->[LINES], @texts);
 }
 
 sub to_string($) {
        my ($self) = @_;
+
        return $self->fname . ":" . $self->[LINES] . ": " . $self->[TEXT];
 }
 
 sub prepend_before($$) {
        my ($self, $text) = @_;
+
        unshift(@{$self->[BEFORE]}, [0, "$text\n"]);
        $self->[CHANGED] = true;
 }
 sub append_before($$) {
        my ($self, $text) = @_;
+
        push(@{$self->[BEFORE]}, [0, "$text\n"]);
        $self->[CHANGED] = true;
 }
 sub prepend_after($$) {
        my ($self, $text) = @_;
+
        unshift(@{$self->[AFTER]}, [0, "$text\n"]);
        $self->[CHANGED] = true;
 }
 sub append_after($$) {
        my ($self, $text) = @_;
+
        push(@{$self->[AFTER]}, [0, "$text\n"]);
        $self->[CHANGED] = true;
 }
 sub delete($) {
        my ($self) = @_;
+
        $self->[PHYSLINES] = [];
        $self->[CHANGED] = true;
 }
 sub replace($$$) {
        my ($self, $from, $to) = @_;
        my $phys = $self->[PHYSLINES];
+
        foreach my $i (0..$#{$phys}) {
                if ($phys->[$i]->[0] != 0 && $phys->[$i]->[1] =~ s/\Q$from\E/$to/g) {
                        $self->[CHANGED] = true;
@@ -2031,12 +2047,17 @@
                "o" => qr"(?:^|/)options\.mk$",
        };
 
+       my $regex_acl_entry = qr"^(?:
+                 \$([\w_]+)                    # $acl_name
+               | ([\w.*]+|_):([adpsu]*)        # file*mask:perms
+               ) (?:\,\s*|$)"x;
+
        if (!defined($acltext)) {
                return undef;
        }
 
        $acls = [];
-       while ($acltext =~ s,^(?:\$([\w_]+)|([\w.*]+|_):([adpsu]*))(?:\,\s*|$),,) {
+       while ($acltext =~ s,$regex_acl_entry,,) {
                my ($acldef, $subject, $perms) = ($1, $2, $3);
 
                if (defined($acldef)) {
@@ -2606,8 +2627,12 @@
        return $rv;
 }
 
-# Return whether this file is likely to contain shell commands or not.
-sub may_contain_shell_commands($$) {
+# Guess the type of file based on the filename. This is used to select
+# the proper subroutine for detecting absolute pathnames.
+#
+# Returns one of "source", "shell", "make", "text", "ignore", "unknown".
+#
+sub get_filetype($$) {
        my ($line, $fname) = @_;
        my $basename = basename($fname);
 
@@ -2615,31 +2640,38 @@
        # influence the type of contents.
        $basename =~ s,\.in$,,;
 
-       # Configure scripts generated by Perl or Shell scripts cannot
-       # be properly parsed by $regex_shellword.
-       if ($basename =~ qr"^Makefile\.(?:SH|PL)$") {
-               return false;
-       }
-
        # Let's assume that everything else that looks like a Makefile
        # is indeed a Makefile.
-       if ($basename =~ qr"^(?:[Mm]akefile(?:\..*|)|.*\.mk)$") {
-               return true;
-       }
-
-       # There are too many false positives for the sed(1) expressions
-       # in configure scripts, so return false.
+       if ($basename =~ qr"^I?[Mm]akefile(?:\..*|)?|.*\.ma?k$") {
+               return "make";
+       }
+
+       # Too many false positives.
        if ($basename =~ qr"^configure(?:|\.ac)$") {
-               return false;
-       }
-
-       if ($basename =~ qr"\.(?:c|cc|cxx|C|h|cpp|hpp|s|y|l|pl|sh|el|tex|texi|info|\d+|man)$") {
-               return false;
-       }
-
-       $opt_debug_misc and $line->log_warning("Don't know if ${fname} is likely to contain shell commands.");
-
-       return dont_know;
+               $opt_debug_unchecked and $line->log_debug("Skipped check for absolute pathnames.");
+               return "ignore";
+       }
+
+       if ($basename =~ qr"\.(?:sh|m4)$"i) {
+               return "shell";
+       }
+
+       if ($basename =~ qr"\.(?:cc?|cpp|cxx|el|hh?|hpp|l|pl|pm|py|s|t|y)$"i) {
+               return "source";
+       }
+
+       if ($basename =~ qr"^.+\.(?:\d+|conf|html|info|man|po|tex|texi|texinfo|txt|xml)$"i) {
+               return "text";
+       }
+
+       # Filenames without extension are hard to guess right. :(
+       if ($basename !~ qr"\.") {
+               return "unknown";
+       }
+
+       $line->log_debug("Don't know the file type of ${fname}.");
+
+       return "unknown";
 }
 
 # Returns the list of subdirectories of a directory, except "CVS".
@@ -3271,6 +3303,30 @@
 }
 
 #
+# Subroutines to check part of a single line.
+#
+
+sub checkword_absolute_pathname($$) {
+       my ($line, $word) = @_;
+
+       $opt_debug_trace and $line->log_debug("checkword_absolute_pathname(\"${word}\")");
+
+       if ($word =~ qr"^/dev/(?:null|tty|zero)$") {
+               # These are defined by POSIX.
+
+       } elsif ($word !~ qr"/(?:[a-z]|\$[({])") {
+               # Assume that all pathnames start with a lowercase letter.
+
+       } else {
+               $line->log_warning("Found absolute pathname: ${word}");
+               $line->explain_warning(
+                       "Absolute pathnames are often an indicator for unportable code. As",
+                       "pkgsrc aims to be a portable system, absolute pathnames should be",
+                       "avoided whenever possible.");
+       }
+}
+
+#
 # Subroutines to check a single line.
 #
 
@@ -3343,11 +3399,44 @@
        checkline_rcsid_regex($line, quotemeta($prefix), $prefix);
 }
 
-sub checkline_absolute_pathname($$) {
+# Checks whether the line contains text that looks like absolute
+# pathnames, assuming that the file uses the common syntax with
+# single or double quotes to represent strings.
+#
+sub checkline_source_absolute_pathname($$) {
+       my ($line, $text) = @_;
+       my ($abspath);
+
+       $opt_debug_trace and $line->log_debug("checkline_source_absolute_pathname(${text})");
+
+       if ($text =~ qr"(.*)\"(/[^\"]*)\"") {
+               my ($before, $string) = ($1, $2);
+
+               
+               if ($before =~ qr"[A-Z_]+\s*") {
+                       # allowed: PREFIX "/bin/foo"
+
+               } elsif ($string =~ qr"^/[*/]") {
+                       # This is more likely to be a C or C++ comment.
+
+               } elsif ($string !~ qr"^/\w") {
+                       # Assume that pathnames start with a letter or digit.
+
+               } else {
+                       $abspath = $string;
+               }
+       }
+
+       if (defined($abspath)) {
+               checkword_absolute_pathname($line, $abspath);
+       }
+}
+
+sub checkline_mk_absolute_pathname($$) {
        my ($line, $text) = @_;
        my $abspath;
 
-       $opt_debug_trace and $line->log_debug("checkline_absolute_pathname(${text})");
+       $opt_debug_trace and $line->log_debug("checkline_mk_absolute_pathname(${text})");
 
        # In the GNU coding standards, DESTDIR is defined as a (usually
        # empty) prefix that can be used to install files to a different
@@ -3356,15 +3445,36 @@
        # Another commonly used context is in assignments like
        # "bindir=/bin".
        if ($text =~ qr"(?:^|\$\{DESTDIR\}|\$\(DESTDIR\)|[\w_]+\s*=\s*)(/(?:[^\"'\`\s]|\"[^\"*]\"|'[^']*'|\`[^\`]*\`)*)") {
-               $abspath = $1;
-       }
-
-       if (defined($abspath) && $abspath ne "/dev/null") {
-               $line->log_warning("Found absolute pathname: ${abspath}");
-               $line->explain_warning(
-                       "Absolute pathnames are often an indicator for unportable code. As",
-                       "pkgsrc aims to be a portable system, absolute pathnames should be",
-                       "avoided whenever possible.");
+               my $path = $1;
+
+               if ($path =~ qr"^/\w") {
+                       $abspath = $path;
+               }
+       }
+
+       if (defined($abspath)) {



Home | Main Index | Thread Index | Old Index