Extended the check for absolute pathnames from Makefile-patches only to

all kinds of patches, especially source code.

1 files changed, 165 insertions, 39 deletions

diff --git a/pkgtools/pkglint/files/pkglint.pl b/pkgtools/pkglint/files/pkglint.pl
index d3e18981bb6..c0b6325e134 100644
--- a/pkgtools/pkglint/files/pkglint.pl
+++ b/pkgtools/pkglint/files/pkglint.pl
@@ -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 show_source($$) {
 
 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 @@ sub parse_acls($$) {
 		"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 @@ sub is_emptydir($) {
 	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 @@ sub may_contain_shell_commands($$) {
 	# 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;
+	if ($basename =~ qr"^I?[Mm]akefile(?:\..*|)?|.*\.ma?k$") {
+		return "make";
 	}
 
-	# There are too many false positives for the sed(1) expressions
-	# in configure scripts, so return false.
+	# Too many false positives.
 	if ($basename =~ qr"^configure(?:|\.ac)$") {
-		return false;
+		$opt_debug_unchecked and $line->log_debug("Skipped check for absolute pathnames.");
+		return "ignore";
 	}
 
-	if ($basename =~ qr"\.(?:c|cc|cxx|C|h|cpp|hpp|s|y|l|pl|sh|el|tex|texi|info|\d+|man)$") {
-		return false;
+	if ($basename =~ qr"\.(?:sh|m4)$"i) {
+		return "shell";
 	}
 
-	$opt_debug_misc and $line->log_warning("Don't know if ${fname} is likely to contain shell commands.");
+	if ($basename =~ qr"\.(?:cc?|cpp|cxx|el|hh?|hpp|l|pl|pm|py|s|t|y)$"i) {
+		return "source";
+	}
 
-	return dont_know;
+	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 @@ sub load_package_Makefile($$$) {
 }
 
 #
+# 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 @@ sub checkline_rcsid($$) {
 	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 @@ sub checkline_absolute_pathname($$) {
 	# Another commonly used context is in assignments like
 	# "bindir=/bin".
 	if ($text =~ qr"(?:^|\$\{DESTDIR\}|\$\(DESTDIR\)|[\w_]+\s*=\s*)(/(?:[^\"'\`\s]|\"[^\"*]\"|'[^']*'|\`[^\`]*\`)*)") {
-		$abspath = $1;
+		my $path = $1;
+
+		if ($path =~ qr"^/\w") {
+			$abspath = $path;
+		}
 	}
 
-	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.");
+	if (defined($abspath)) {
+		checkword_absolute_pathname($line, $abspath);
+	}
+}
+
+# Last resort if the file does not look like a Makefile or typical
+# source code. All strings that look like pathnames and start with
+# one of the typical Unix prefixes are found.
+#
+sub checkline_other_absolute_pathname($$) {
+	my ($line, $text) = @_;
+
+	$opt_debug_trace and $line->log_debug("checkline_other_absolute_pathname(\"${text}\")");
+
+	if ($text =~ qr"^(.*?)(/(?:bin|dev|etc|home|lib|mnt|opt|proc|sbin|tmp|usr|var)/[\w./\-]*)(.*)$") {
+		my ($before, $path, $after) = ($1, $2, $3);
+
+		if ($before =~ qr"\@$") {
+			# Something like @PREFIX@/bin
+
+		} else {
+			checkword_absolute_pathname($line, $path);
+		}
 	}
 }
 
@@ -4067,7 +4177,7 @@ sub checkline_mk_shelltext($$) {
 		}
 
 		if (($state != SCST_PAX_S && $state != SCST_SED_E && $state != SCST_CASE_LABEL)) {
-			checkline_absolute_pathname($line, $shellword);
+			checkline_mk_absolute_pathname($line, $shellword);
 		}
 
 		if (($state == SCST_INSTALL_D || $state == SCST_MKDIR) && $shellword =~ qr"^\$\{PREFIX(?:|:Q)\}/") {
@@ -4656,13 +4766,13 @@ sub checkline_mk_vartype_basic($$$$$$$$) {
 		if ($value_novar !~ qr"^[-0-9A-Za-z._~+%*?/\[\]]*$") {
 			$line->log_warning("\"${value}\" is not a valid pathname mask.");
 		}
-		checkline_absolute_pathname($line, $value);
+		checkline_mk_absolute_pathname($line, $value);
 
 	} elsif ($type eq "Pathname") {
 		if ($value_novar !~ qr"^[-0-9A-Za-z._~+%/]*$") {
 			$line->log_warning("\"${value}\" is not a valid pathname.");
 		}
-		checkline_absolute_pathname($line, $value);
+		checkline_mk_absolute_pathname($line, $value);
 
 	} elsif ($type eq "Perl5Packlist") {
 		if ($value ne $value_novar) {
@@ -6134,7 +6244,7 @@ sub checkfile_patch($) {
 	my ($fname) = @_;
 	my ($strings);
 	my ($state, $redostate, $nextstate, $dellines, $addlines, $hunks);
-	my ($seen_comment, $current_fname, $patched_files);
+	my ($seen_comment, $current_fname, $current_ftype, $patched_files);
 	my ($leading_context_lines, $trailing_context_lines, $context_scanning_leading);
 
 	# Abbreviations used:
@@ -6209,16 +6319,27 @@ sub checkfile_patch($) {
 
 		# XXX: This check is not as accurate as the similar one in
 		# checkline_mk_shelltext().
-		if (defined($current_fname) && may_contain_shell_commands($line, $current_fname) == true) {
-			my ($mm, $rest) = match_all($text, $regex_shellword);
+		if (defined($current_fname)) {
+			if ($current_ftype eq "shell" || $current_ftype eq "make") {
+				my ($mm, $rest) = match_all($text, $regex_shellword);
 
-			foreach my $m (@{$mm}) {
-				my $shellword = $m->text(1);
+				foreach my $m (@{$mm}) {
+					my $shellword = $m->text(1);
 
-				if ($shellword =~ qr"^#") {
-					last;
+					if ($shellword =~ qr"^#") {
+						last;
+					}
+					checkline_mk_absolute_pathname($line, $shellword);
 				}
-				checkline_absolute_pathname($line, $shellword);
+
+			} elsif ($current_ftype eq "source") {
+				checkline_source_absolute_pathname($line, $text);
+
+			} elsif ($current_ftype eq "ignore") {
+				# Ignore it.
+
+			} else {
+				checkline_other_absolute_pathname($line, $text);
 			}
 		}
 	};
@@ -6320,6 +6441,7 @@ sub checkfile_patch($) {
 			$opt_warn_space and $line->log_note("Empty line expected.");
 		}], [PST_CFA, re_patch_cfa, PST_CH, sub() {
 			$current_fname = $m->text(1);
+			$current_ftype = get_filetype($line, $current_fname);
 			$patched_files++;
 			$hunks = 0;
 		}], [PST_CH, re_patch_ch, PST_CHD, sub() {
@@ -6371,6 +6493,7 @@ sub checkfile_patch($) {
 			#
 		}], [PST_UFA, re_patch_ufa, PST_UH, sub() {
 			$current_fname = $m->text(1);
+			$current_ftype = get_filetype($line, $current_fname);
 			$patched_files++;
 			$hunks = 0;
 		}], [PST_UH, re_patch_uh, PST_UL, sub() {
@@ -6423,6 +6546,7 @@ sub checkfile_patch($) {
 	$patched_files = 0;
 	$seen_comment = false;
 	$current_fname = undef;
+	$current_ftype = undef;
 	$hunks = undef;
 
 	for (my $lineno = 0; $lineno <= $#{$strings}; ) {
@@ -6581,6 +6705,8 @@ sub checkfile_PLIST($) {
 
 				if (exists($all_files->{"man/man1/${basename}.1"})) {
 					# Fine.
+				} elsif (exists($all_files->{"man/man6/${basename}.6"})) {
+					# Fine.
 				} elsif (exists($all_files->{"\${IMAKE_MAN_DIR}/${basename}.\${IMAKE_MANNEWSUFFIX}"})) {
 					# Fine.
 				} else {