#! /usr/bin/perl
#-*- tab-width: 4; -*-
# ex:ts=4
#
# portlint - lint for port directory
#
# this version implemented/maintained by:
#   Michael Haro <mharo@FreeBSD.org>
# versions thru 2.x implemented by:
#	Jun-ichiro itojun Hagino <itojun@itojun.org>
#	Yoshishige Arai <ryo2@on.rim.or.jp>
#
# Copyright(c) 2000 by Michael Haro <mharo@FreeBSD.org>.
# Copyright(c) 1997 by Jun-ichiro Hagino <itojun@itojun.org>.
# All rights reserved.
# Freely redistributable.  Absolutely no warranty.
#
# $FreeBSD: ports/devel/portlint/src/portlint.pl,v 1.15 2000/03/20 18:03:01 mharo Exp $
# $Id: portlint.pl,v 1.44 2000/11/24 23:15:35 mharo Exp $
#

# My current idea is to have a bunch of really small
# functions that each do one (1) check and have main
# call all these functions on whatever files they operate on

#
# creating a new portlint check
# -----------------------------
# - create a seperate function to do the check in
# - the function should call &verbose to report no errors
#
# the reason we use seperate functions for everything is to make it 
# easy to disable indivisual checks with a command line option
# (there is a reason we are using Getopt::Long)

use Getopt::Long;
use LWP;
use strict;

########################################
# All global variables defined here
########################################

# my name
my ($prog) = ($0 =~ /([^\/]+)$/);

# version variables
my $major = 3;
my $minor = 0;
my $patchlevel = 0;
my $version = "$major.$minor.$patchlevel";

# Command line options hash
my %opts;

# number of warnings and fatal errors
my $nwarn = 0;
my $nfatal = 0;

my $patchcount = 0;
my %checkedurls;

&main;

errx(1, "got to end of main, but didn't exit");

# put main into a subroutine to take care of random global vars
sub main {
	my @varnames = ();
	my @sectvars = ();

	Getopt::Long::Configure("no_auto_abbrev", "no_getopt_compat",
							"bundling", "ignore_case");
	my $result = GetOptions(\%opts,
							"b",
							"checkall|a",
							"contblank|B=i",
							"committer|c",
							"patch",
							"patchfile=s",
							"display-makevars!",
							"display-options!",
							"help|h|H",
							"newport|N",
							"make_vars|M",
							"tabs|t",
							"warnings-fatal",
							"version|V",
							"verbose|v",
							);

	&usage if $result eq '' || $opts{help};
	&version if ($opts{version});

	my $portdir = $ARGV[0] ? $ARGV[0] : ".";
	&verbose("linting directory $portdir");
	chdir($portdir) || &err(1, "chdir $portdir");

# display-options if verbose and nodisplay-options is not defined
# or if display-options is defined
	if ((defined($opts{'display-options'}) && $opts{'display-options'} != 0 && $opts{'verbose'}) || ($opts{'verbose'} && !defined($opts{'display-options'})) || $opts{'display-options'} ) {
		foreach my $var (sort keys %opts) {
			print "option: $var = $opts{$var}\n";
		}
	}

# init stuff
	my $contblank = $opts{contblank} ? $opts{contblank} : 1;

my @varlist = (split(/\s+/, <<EOF));
PORTNAME PORTVERSION PORTREVISION PORTEPOCH PKGNAME PKGNAMEPREFIX
PKGNAMESUFFIX DISTNAME DISTFILES CATEGORIES MASTERDIR MAINTAINER
MASTER_SITES WRKDIR WRKSRC NO_WRKSUBDIR PATCHDIR SCRIPTDIR FILESDIR PKGDIR
COMMENT DESCR PLIST MD5_FILE .CURDIR VALID_CATEGORIES NO_CHECKSUM
MAN1 MAN2 MAN3 MAN4 MAN5 MAN6 MAN7 MAN8 MAN9 MANL MANN
EOF
	my %makevar = &getmakevars(@varlist);

@varlist = (split(/\s+/, <<EOF));
MASTER_SITE_AFTERSTEP MASTER_SITE_COMP_SOURCES MASTER_SITE_GNOME
MASTER_SITE_GNU MASTER_SITE_KDE MASTER_SITE_PERL_CPAN MASTER_SITE_PORTS_JP
MASTER_SITE_RUBY MASTER_SITE_SOURCEFORGE MASTER_SITE_SUNSITE MASTER_SITE_TCLTK
MASTER_SITE_TEX_CTAN MASTER_SITE_THEMES MASTER_SITE_WINDOWMAKER
MASTER_SITE_XCONTRIB MASTER_SITE_XFREE
EOF
	my %mastersites = &getmakevars(@varlist);

	my $pwd = $makevar{".CURDIR"};

# remove these in the future
	my $file;
	my ($whole, $linecnt, $linelen);

# Makefile checks
	$file = "Makefile";
	&verbose("checking $file");
	($whole, $linecnt, $linelen) = &loadfile($file);
	&whitespaceatend($file, $whole);
	&blanklines($file, $whole, $contblank);
	&lastline($file, $whole);
	&checkspaceindent($file, $whole);
	&tabaftervariable($file, $whole) if $opts{'tabs'};
	&checkparens($file, $whole) if $opts{'b'};
	&dupvarcheck($file, $whole);
	&nouservar($file, "NO_CHECKSUM", $makevar{NO_CHECKSUM});
	# any other vars that users define?
	&pkgname($file, $whole);
	&gzipflags($file, $whole);
	&mkdirflags($file, $whole);
	&is_interactive($file, $whole);
	&abspathname($file, $whole);
	&noportdocs($file, $whole, $makevar{PREFIX});

	# direct use of command names check
	# full paths check
	
	# check for duplicate var defs
	# check that MANX= foo.Y  has X == Y
	# check for duplicate manpage listings in MANX
	&propermansect(%makevar);
	# check for MASTER_SITES which are defined in bsd.port.mk

	# deal with Makefile sections
	my @sections = &sectionsplit($whole);
	my $idx = 0;

#MICHAEL:  add something to deal with master/slave/independent ports

	# section 0 - comment lines
	&commentsonly($file, $sections[$idx]);
	&sect0lines($file, $sections[$idx]);
	$idx++;

	# section 1 - PORTNAME/PORTVERSION
	&commentsstrip($sections[$idx]);
	@sectvars = split(/\s+/, <<EOF);
PORTNAME PORTVERSION PORTREVISION PORTEPOCH CATEGORIES MASTER_SITES
MASTER_SITE_SUBDIR PKGNAMEPREFIX PKGNAMESUFFIX DISTNAME EXTRACT_SUFX
DISTFILES DIST_SUBDIR EXTRACT_ONLY
EOF
	&checkorder($file, 'PORTNAME', $sections[$idx], @sectvars);
	# verify PORTNAME and PORTVERSION are set and valid
	# sanity check PORTNAME/PORTVERSION
	# check CATEGORIES is set
	# committer check - modules alias name warning
	&validcategories($makevar{VALID_CATEGORIES}, $makevar{CATEGORIES});
	# various CATEGORIES warnings / checks
	# check mastersites URLs
	# get makefile definations for variables and compare with make -V results
	# check for bogus EXTRACT_SUFX
	# DISTFILES check
	
	&addlist(\@varnames, \@sectvars);
	$idx++;

	# section 2 - PATCH_SITES/PATCHFILES (optional)
	@sectvars = split(/\s+/, <<EOF);
PATCH_SITES PATCH_SITE_SUBDIR PATCHFILES PATCH_DIST_STRIP
EOF
	&commentsstrip($sections[$idx]);
	# check if we have a section 2
	my $have_section2 = 0;
	foreach my $item (@sectvars) {
		if ($sections[$idx] =~ /$item/) {
			$have_section2 = 1;
		}
	}
	if ($have_section2) {
		&checkearlier($file, $sections[$idx], @varnames);
		&checkorder($file, 'PATCH_SITES', $sections[$idx], @sectvars);
		#remove checked lines from $section[$idx] before calling checkextra
		# thats how the current implementation (from portlint2 does it)
		#&checkextra($file, $sections[$idx], 'PATCH_SITES');
		&addlist(\@varnames, \@sectvars);
		$idx++;
	}

	# section 3 - MAINTAINER
	@sectvars = split(/\s+/, <<EOF);
MAINTAINER
EOF
	&commentsstrip($sections[$idx]);
	&checkearlier($file, $sections[$idx], @varnames);
	&maintainerexists($file, $sections[$idx], $makevar{MAINTAINER});
	&maintainervalidemail($file, $makevar{MAINTAINER});
	&maintaineremailappend($file, $sections[$idx]);
	&addlist(\@varnames, \@sectvars);
	$idx++;

	# section 4 - *_DEPENDS (optional)
	&commentsstrip($sections[$idx]);
	$idx++;

	# section 5 - rest (optional)
	@sectvars = split(/\s+/, <<EOF);
RESTRICTED NO_CDROM NO_PACKAGE NO_CONFIGURE NO_PATCH
EOF
	my $rest = join("\n\n", @sections[$idx .. $#sections]);
	&commentsstrip($rest);
	&checkearlier($file, $rest, @varnames);
	&restrictedcheck($file, $rest);
	&nocdromcheck($file, $rest);
	&nopackagecheck($file, $rest);
	&noconfigurecheck($file, $rest);
	&nopatchcheck($file, $rest);

# pkg-descr checks
	$file = "pkg-descr";
	$file = $makevar{DESCR} if $makevar{DESCR} ne "";
	$file =~ s,^$pwd/,,;
	&verbose("checking $file");
	($whole, $linecnt, $linelen) = &loadfile($file);
	&maxlines($file, $linecnt, 24);
	&maxchars($file, $linelen, 80);
	&descrwwwcheck($file, $whole);
	&whitespaceatend($file, $whole);
	&blanklines($file, $whole, $contblank);
	&lastline($file, $whole);

# pkg-comment checks
	$file = "pkg-comment";
	$file = $makevar{COMMENT} if $makevar{COMMENT} ne "";
	$file =~ s,^$pwd/,,;
	&verbose("checking $file");
	($whole, $linecnt, $linelen) = &loadfile($file);
	&maxlines($file, $linecnt, 1);
	&maxchars($file, $linelen, 70);
	&whitespaceatend($file, $whole);
	&lastline($file, $whole);

# pkg-plist checks
	$file = "pkg-plist";
	$file = $makevar{PLIST} if $makevar{PLIST} ne "";
	$file =~ s,^$pwd/,,;
	&verbose("checking $file");
	($whole, $linecnt, $linelen) = &loadfile($file);
	&whitespaceatend($file, $whole);
	&blanklines($file, $whole, 0);
	&lastline($file, $whole);
	&plistfullpath($file, $whole);
	&plistlibtool($file, $whole);
	&plistinfodir($file, $whole);
	&plistcommands($file, $whole);
	&plistinfofile($file, $whole);
	&plistman($file, $whole);
	# plist @exec/@unexec install-info ordering check
	# deal with multiple PLIST files

# distinfo checks
	$file = "distinfo";
	$file = $makevar{MD5_FILE} if $makevar{MD5_FILE} ne "";
	$file =~ s,^$pwd/,,;
	&verbose("checking $file");
	($whole, $linecnt, $linelen) = &loadfile($file);

# files/ related checks
	# check that there is only 1 file being patched per patch file
	# check that there is only 1 patch file for each file being patched
	# &lastline foreach file in patches/

# scripts/ related checks
	# &lastline foreach file in scripts/

# other checks
	&workdircheck;
	&warncrud(".");

# We are done.  Display number of warnings and errors
	if ($nfatal || $nwarn) {
		print "$nfatal fatal errors and $nwarn warnings found.\n";
	} else {
		print "looks fine.\n";
	}
	
	exit $nfatal;
}


###################################################
# Warning:  All work done beyond this point.  :-)
###################################################

#
# makefile related stuff
#
sub checkspaceindent {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /^        /) {  # 8 spaces
			&perror("WARN: $file $i: use a tab (not a space) to indent");
			$problem = 1;
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file has no space indentation problems");
	}
}

sub tabaftervariable {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /(\w+.?)= /) {
#MICHAEL: is 11 the right number?
			if (length($1) < 11) {
				&perror("WARN: $file $i: use a tab (not a space) after a variable name");
				$problem = 1;
			}
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file has no spaces after variable declarations");
	}
}

sub checkparens {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /\$\(([\w\d]+)\)/) {
			&perror("WARN: $file $i: use \${$1} instead of \$($1)");
			$problem = 1;
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file uses '{' and '}' around all variable names");
	}
}

sub dupvarcheck {
	my ($file, $whole) = @_;

	my %seenvar = ();
	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /^([\w\d]+)(.)?=/) {
			if ($seenvar{$1} != 1 && defined($2)) {
				&perror("WARN: $file $i: variable $1 initially defined ".
					"by '$2='");
				$problem = 1;
			}
			if ($seenvar{$1} == 1 && !defined($2)) {
				&perror("FATAL: $file $i: variable $1 is redefined.");
				$problem = 1;
			}
			$seenvar{$1} = 1;
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file has no duplicate variable definations");
	}
}

sub validcategories {
	my ($validcats, $catlist) = @_;
	foreach my $cat (split(/\s+/, $catlist)) {
		if ($validcats !~ m/$cat/) {
			&perror("FATAL: Makefile: $cat is not a valid category");
		} else {
			&verbose("$cat is a valid category");
		}
	}
}

sub propermansect {
	my (%vars) = @_;
	foreach my $sectname (split(/\s+/, <<EOF)) {
MAN1 MAN2 MAN3 MAN4 MAN5 MAN6 MAN7 MAN8 MAN9 MANL MANN
EOF
		$sectname =~ m/(.)$/;
		my $sect = $1;
		foreach my $page (split(/\s+/, $vars{$sectname})) {
			$page =~ m/(.+)\.(.)(\..+)?/;
			my $newsect = $2;
			if ($sect != $newsect) {
				&perror("WARN: Makefile: $page listed in $sectname");
				my $newprevlst = $vars{"MAN$sect"};
				$newprevlst =~ s/$page//;
				my $newnextlst = $vars{"MAN$newsect"};
				$newnextlst =~ s/$/ $page/;
				$newnextlst =~ s/^ //;
				&createpatch("Makefile", "^MAN$sect", "MAN$sect=\t$vars{'MAN' . $sect}", "MAN$sect=\t$newprevlst\nMAN$newsect=\t$newnextlst");
			}
		}
	}
}

# this function's params seem kinda ackward.  Oh well.
sub nouservar {
	my ($file, $varname, $varvalue) = @_;
	
	if ($varvalue ne "") {
		&perror("FATAL: $file: use of $varname is discouraged. ".
			"it is intended to be a user variable.");
	} else {
		&verbose("$varname not found in $file");
	}
}

sub pkgname {
	my ($file, $whole) = @_;
	
	if ($whole =~ m/\nPKGNAME\s*=/) {
		&perror("FATAL: $file: PKGNAME is obsoleted by PORTNAME, ".
			"PORTVERSION, PKGNAMEPREFIX and PKGNAMESUFFIX.");
	} else {
		&verbose("PKGNAME not found in $file");
	}
}

sub gzipflags {
	my ($file, $whole) = @_;

	if ($whole =~ m/\${GZIP_CMD}\s+-(\w+(\s+-)?)*(\d)/) {
		&perror("WARN: possible use of \'\${GZIP_CMD} -$3\' ".
			"found. \${GZIP_CMD} includes \'-\${GZIP}\' which ".
			"sets the compression level.");
	} else {
		&verbose("no compression level found after \${GZIP_CMD}");
	}
}

sub mkdirflags {
	my ($file, $whole) = @_;

	if ($whole =~ m/\${MKDIR}\s+-p/) {
		&perror("WARN: possible use of \'\${MKDIR} -p\' ".
			"found. \${MKDIR} includes \'-p\' by default.");
	} else {
		&verbose("\${MKDIR} -p not found");
	}
}

#MICHAEL: should probably use make vars and not parse Makefile for this
#MICHAEL: not tested
sub is_interactive {
	my ($file, $whole) = @_;

	if ($whole =~ m/^IS_INTERACTIVE.?\s*=/m) {
		if ($whole !~ m/^(BATCH|FOR_CDROM).?\s*=/m) {
			&perror("WARN: use of IS_INTERACTIVE discouraged. provide batch mode by using BATCH and/or FOR_CDROM.");
		}
	} else {
		&verbose("$file: IS_INTERACTIVE not found");
	}
}

#MICHAEL: should probably use make vars and not parse Makefile for this
sub noportdocs {
	my ($file, $whole, $prefix) = @_;

#MICHAEL: I don't really care for this method of testing this
#MICHAEL: should probably use make vars and not parse Makefile for this
#MICHAEL: not tested
	if ($whole =~ m/\${PREFIX}\/share\// && $whole !~ m/^\.if \!defined\(NOPORTDOCS\)/m) {
		&perror("WARN: use \".if !defined(NOPORTDOCS)\" to wrap installation of files into $prefix/share/doc.");
	} else {
		&verbose("any files being installed into $prefix are fine");
	}
}

#MICHAEL: not tested, just "ported" from portlint2 so not even checked
#         for validity
sub abspathname {
	my($file, $whole) = @_;
	my($s, $i, %cmdnames);
	my($pre);

	# ignore parameter string to echo command
	$whole =~ s/[ \t][\@-]?(echo|\$[\{\(]ECHO[\}\)]|\$[\{\(]ECHO_MSG[\}\)])[ \t]+("(\\'|\\"|[^"])*"|'(\\'|\\"|[^"])*')[ \t]*[;\n]//;

	&verbose("OK: checking direct use of full pathnames in $file.");
	foreach my $s (split(/\n+/, $whole)) {
		$i = '';
		if ($s =~ /(^|[ \t\@'"-])(\/[\w\d])/) {
			# suspected pathnames are recorded.
			$i = $2 . $';
			$pre = $` . $1;

			if ($pre =~ /MASTER_SITE_SUBDIR/) {
				# MASTER_SITE_SUBDIR lines are ok.
				$i = '';
			}
		}
		if ($i ne '') {
			$i =~ s/\s.*$//;
			$i =~ s/['"].*$//;
			$i = substr($i, 0, 20) . '...' if (20 < length($i));
			&perror("WARN: possible use of absolute pathname ".
				"\"$i\", in $file.") unless ($i =~ m,^/compat/,);
		}
	}

	&verbose("OK: checking direct use of pathnames, phase 1.");
#MICHAEL: shouldn't hard code these paths
%cmdnames = split(/\n|\t+/, <<EOF);
/usr/ports	\${PORTSDIR} instead
/usr/local	\${PREFIX} or \${LOCALBASE}, as appropriate
/usr/X11R6	\${PREFIX} or \${X11BASE}, as appropriate
EOF
	foreach my $i (keys %cmdnames) {
		if ($whole =~ /$i/) {
			&perror("WARN: possible direct use of \"$&\" ".
				"found in $file. if so, use $cmdnames{$i}.");
		}
	}

	&verbose("OK: checking direct use of pathnames, phase 2.");
%cmdnames = split(/\n|\t+/, <<EOF);
distfiles	\${DISTDIR} instead
pkg			\${PKGDIR} instead
files		\${FILESDIR} instead
scripts		\${SCRIPTDIR} instead
patches		\${PATCHDIR} instead
work		\${WRKDIR} instead
EOF
	foreach my $i (keys %cmdnames) {
		if ($whole =~ /(\.\/|\$[\{\(]\.CURDIR[\}\)]\/|[ \t])(\b$i)\//) {
			&perror("WARN: possible direct use of \"$i\" ".
				"found in $file. if so, use $cmdnames{$i}.");
		}
	}
}

#MICHAEL: not tested, just "ported" from portlint2 so not even checked
#         for validity
sub is_predefined {
	my($url, %predefined) = @_;
	my($site);
	my($subdir);
	if ($site = (grep($url =~ $_, keys %predefined))[0]) {
		$url =~ /$site/;
		$subdir = $';
		$subdir =~ s/\/$//;
		&perror("WARN: how about using ".
			"\${MASTER_SITE_$predefined{$site}} with ".
			"\"MASTER_SITE_SUBDIR=$subdir\", instead of \"$url\?");
	}
}

sub sectionsplit {
	my ($whole) = @_;

	# keep comment, blank line, comment in the same section
	$whole =~ s/(#.*\n)\n+(#.*)/$1$2/g;
	my @sections = split(/\n\n+/, $whole);
	for (my $i = 0; $i <= $#sections; $i++) {
		if ($sections[$i] !~ /\n$/) {
			$sections[$i] .= "\n";
		}
	}

	return @sections;
}

#MICHAEL: should probably check the order of the lines
sub sect0lines {
	my ($file, $whole) = @_;

	my @linestocheck = split(/\n/, <<EOF);
New Ports Collection Makefile For
Whom
Date Created
EOF

	foreach my $item (@linestocheck) {
		if ($whole !~ m/^#\s*$item:\s+\S/mi) {
			&perror("FATAL: no '$item' line in comment section of $file.");
		} else {
			&verbose("'$item' line found");
		}
	}

	if ($whole =~ m/^Version Required/im) {
		&perror("WARN: $file: Version required is no longer needed in the comment section.");
	}

	if ($whole !~ m/^#(\s+)\$FreeBSD([^\$]*)\$$/m) {
		&perror("FATAL: $file: no \$FreeBSD\$ line in comment section.");
	} else {
		if ($1 ne " ") {
			 &perror("WARN: $file: please use single whitespace right before ".
				"\$FreeBSD\$ tag.");
		}
		if ($2 ne "" && $opts{newport}) {
			&perror("WARN: $file: for new port, make \$FreeBSD\$ tag in ".
				"comment section empty, to make CVS happy.");
		} elsif ($2 eq "" && $opts{newport} != 1) {
			&perror("WARN: $file: \$FreeBSD\$ tag in comment section should ".
				"not be empty");
		}
	}
}

sub commentsonly {
	my ($file, $whole) = @_;
	
	if ($whole =~ m/^[^#]/m) {
		&perror("FATAL: non-comment line in comment section of $file.");
	} else {
		&verbose("only comments found in comments section.");
	}
}

# Warning: this function modifies the argument passed
sub commentsstrip {
	$_[0] =~ s/^#.*$//mg;
	$_[0] =~ s/\n+/\n/g;
}

sub maintainerexists {
	my ($file, $whole, $makevar) = @_;
	
	if ($whole !~ m/^MAINTAINER[?]?=/m && ($makevar eq "" || $makevar eq "ports\@FreeBSD.org")) {
		&perror("FATAL: no MAINTAINER listed in $file.");
	} else {
		&verbose("maintainer found.");
	}
}

sub maintainervalidemail {
	my ($file, $makevar) = @_;
	
	if ($makevar !~ m/[A-z0-9]+\@[A-z0-9]+\.[A-z0-9]+/) {
		&perror("WARNING: maintainer email address does not appear to be valid.");
	} else {
		&verbose("maintainer appears to have a valid email address");
	}
}

sub maintaineremailappend {
	my ($file, $whole) = @_;
	if ($whole =~ m/^MAINTAINER\+=/m) {
		&perror("FATAL: MAINTAINER can not be assigned using +=.");
	} else {
		&verbose("maintainer email not appended.");
	}
}

sub restrictedcheck {
	my ($file, $whole) = @_;
	if ($whole =~ m/^RESTRICTED[+?]?=/m) {
		&perror("WARN: \"RESTRICTED\" found. do not forget to update ports/LEGAL");
	} else {
		&verbose("RESTRICTED not found in $file.");
	}
}

sub nocdromcheck {
	my ($file, $whole) = @_;
	if ($whole =~ m/^NO_CDROM[+?]?=/m) {
		&perror("WARN: \"NO_CDROM\" found. do not forget to update ports/LEGAL");
	} else {
		&verbose("NO_CDROM not found in $file.");
	}
}

sub nopackagecheck {
	my ($file, $whole) = @_;
	if ($whole =~ m/^NO_PACKAGE[+?]?=/m) {
		&perror("WARN: \"NO_PACKAGE\" found. do not forget to update ports/LEGAL");
	} else {
		&verbose("NO_PACKAGE not found in $file.");
	}
}

sub noconfigurecheck {
	my ($file, $whole) = @_;
	if ($whole =~ m/^NO_CONFIGURE[+?]?=/m) {
		&perror("FATAL: \"NO_CONFIGURE\" is obsolete. remove this.");
	} else {
		&verbose("NO_CONFIGURE not found in $file.");
	}
}

sub nopatchcheck {
	my ($file, $whole) = @_;
	if ($whole =~ m/^NO_PATCH[+?]?=/m) {
		&perror("FATAL: \"NO_PATCH\" is obsolete. remove this.");
	} else {
		&verbose("NO_PATCH not found in $file.");
	}
}

#XXX

#
# pkg/ related stuff
#
sub descrwwwcheck {
	my ($file, $whole) = @_;

	if ($whole =~ m,http://,) {
		my $has_url = 0;
		my $has_www = 0;
		foreach my $line (grep($_ =~ "http://", split(/\n+/, $whole))) {
			$has_url = 1;
			$line =~ m,(http://[\w\-\.]+),;
			my $url = $1;
			&geturlstatus($url);
			if ($line =~ m,WWW:[ \t]+http://,) {
				$has_www = 1;
			}
		}

		if ($has_url && ! $has_www) {
			&perror("FATAL: $file: contains a URL but no WWW:");
		} else {
			&verbose("$file a URL is prefixed with WWW:");
		}
	}
}

sub commentstylecheck {
	my ($file, $whole) = @_;
	
	if ($whole !~ /^["0-9A-Z]/) {
		&perror("WARN: $file: Line should begin with a capital letter")
	}
	if ($whole =~ /\.$/) {
		&perror("WARN: $file: Line should end without a period.");
	}
}

sub plistfullpath {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /^\//) {
			&perror("FATAL: $file $i: use of full pathname is not allowed.");
			$problem = 1;
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file doesn't use full paths");
	}
}

sub plistlibtool {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /\.la$/) {
			&perror("WARN: $file $i: installing libtool archives, ".
				"please use USE_LIBTOOL in Makefile if possible");
			$problem = 1;
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file doesn't include .la files");
	}
}

sub plistinfodir {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /^info\/dir$/) {
			&perror("FATAL: $file $i: use install-info to add/remove an ".
				"entry from \"info/dir\", don't install info/dir");
			$problem = 1;
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file no info/dir file found");
	}
}

sub plistcommands {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /^\@/) {
			if ($line =~ /^\@(cwd|cd)[ \t]+(\S+)/) {
				&perror("WARN: $file $i: use of \@$1 is discouraged");
				$problem=1;
			} elsif ($line =~ /^\@unexec[ \t]+rmdir/ && $line !~ /true$/) {
				&perror("WARN: $file $i: use \"\@dirrm\" instead of \"\@unexec rmdir\".");
				$problem=1;
			} elsif ($line =~ /^\@(owner|group)\s/) {
				&perror("WARN: $file $i: \@$1 should not be needed in PLIST");
				$problem=1;
			} elsif ($line =~ /^\@(dirrm|option|exec|unexec|comment)/) {
				; # no check made
			} else {
				&perror("WARN: $file $i: ".
					"unknown PLIST directive \"$line\"");
			}
		}
		$i++;
	}
	if (! $problem) {
		&verbose("$file has no package-list @ command problems");
	}
}

sub plistinfofile {
	my ($file, $whole) = @_;

	my @exec_info = ();
	my @unexec_info = ();
	my @infofiles = ();

	my $problem = 0;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /^\@exec[ \t]+install-info\s+(\%D\/)?(.+)\s+.+$/) {
			push(@exec_info, $2);
		} elsif ($line =~ /^\@unexec[ \t]+install-info[ \t]+--delete\s+(\%D\/)?(.+)\s+(.+)$/) {
			push(@unexec_info, $2);
		} elsif ($line =~ /^info\/.*info$/) {
			push(@infofiles, $line);
		}
	}

# check that every infofile has an exec install-info and unexec install-info
	foreach my $if (@infofiles) {
		if (! &contains($if, @exec_info)) {
			&perror("FATAL: $file: you need an '\@exec install-info \%D/$if \%D/info/dir' line");
			$problem = 1;
		}
		if (! &contains($if, @unexec_info)) {
			&perror("FATAL: $file: you need an '\@unexec install-info --delete \%D/$if \%D/info/dir' line");
			$problem = 1;
		}
	}
	if (! $problem) {
		&verbose("$file has no problems with info files");
	}
}

sub plistman {
	my ($file, $whole) = @_;

	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ m#man/([^/]+/)?man(.)/([^\.]+\.(.))(\.gz)?$#) {
			my $mansect = $2;
			my $manpage = $3;
			my $manpagesect = $4;
			my $mancompress = $5;
			&perror("WARN: $file $i: $manpage should be listed in Makefile, not PLIST");
			if ($mansect != $manpagesect) {
				&perror("FATAL: $file $i: $manpage is being installed into section $mansect but lists itself as section $manpagesect.");
			}
		}
	}
	if (! $problem) {
		&verbose("$file has no manpages listed in the PLIST");
	}
}

#
# files/ related stuff
#

#
# patches/ related stuff
#

#
# scripts/ related stuff
#

#
# other checks
#

sub workdircheck {
	if (-e "work") {
		&perror("FATAL: be sure to 'make clean' before ".
			"submitting/committing.");
	} else {
		&verbose("work directory doesn't exist");
	}
}

sub warncrud {
	my ($dir) = @_;

	my @ls = ();
	my $problem = 0;

	opendir(D, $dir) || errx(1, "opendir .");
	@ls = readdir(D);
	closedir(D);
	foreach my $item (@ls) {
		next if ($item =~ /^(\.|\.\.|CVS)$/);
		warncrud("$dir/$item") if (-d "$dir/$item");
		if ($item =~ /~$/) {
			&perror("FATAL: $dir/$item: for safety, be sure to cleanup ".
				"editor backup files before submitting/committing.");
			$problem = 1;
		}
		if ($item =~ /\.rej$/ || $item =~ /\.orig$/) {
			&perror("FATAL: $dir/$item: for safety, be sure to cleanup ".
				"patch backup files before submitting/committing.");
			$problem = 1;
		}
		if (-z "$item") {
			&perror("FATAL: $item: empty file and should be removed.");
			$problem = 1;
		}
	}

	if (! $problem) {
		&verbose("no crud found in $dir");
	}
}


#
# general checking
#

sub loadfile {
	my ($file) = @_;
	my $linecnt = 0;
	my $maxlinelen = 0;
	my $len;
	my $whole = "";
	
	if (!open(F, "< $file")) {
		&perror("FATAL: unable to open $file");
		return ("", 0, 0);
	}
	while(<F>) {
		$whole .= $_;
		$linecnt++;
		$len = length(chomp($_));
		$maxlinelen = $len if ($len > $maxlinelen);
	}
	close(F);

	if ($whole =~ /[\033\200-\377]/) {
		&perror("WARN: $file: including iso-8859-1, or ".
			"other local characters.  Should be a plain ascii file");
	}

	return ($whole, $linecnt, $maxlinelen);
}

sub urlcheck {
	my ($url) = @_;
	if ($url !~ m#^\w+://#) {
		&perror("WARN: \"$url\" doesn't appear to be a URL to me.");
	}
	if ($url !~ m#/$#) {
		&perror("FATAL: URL \"$url\" should end with \"/\".");
	}
	if ($url =~ m#://[^/]*:/#) {
		&perror("FATAL: URL \"$url\" contains extra \":\".");
	}
	if ($url =~ m#(www.freebsd.org)/~.+/#i) {
		&perror("WARN: URL \"$url\", $1 should be people.FreeBSD.org");
	}
}

sub geturlstatus {
	my ($url) = @_;

	return if $checkedurls{"$url"} == 1;

	my $ua = new LWP::UserAgent;
	my $request = new HTTP::Request('GET', $url);
	my $response = $ua->request($request);

	my ($statuscode, $statusmessage) = split(/ /, $response->status_line, 2);

	if ($statuscode != 200) {
		&perror("WARN: URL \'$url\' returned error $statuscode, $statusmessage");
	}
	$checkedurls{"$url"} = 1;
}

sub maxlines {
	my ($file, $count, $max) = @_;

	if ($count > $max) {
		&perror("WARN: $file exceeds $max lines, make it shorter if possible. (currently $count lines)");
	} else {
		&verbose("$file has $count line(s).");
	}
}

sub maxchars {
	my ($file, $count, $max) = @_;

	if ($count > $max) {
		&perror("WARN: $file: includes lines that exceed $max characters.");
	} else {
		&verbose("$file has at most $max characters per line.");
	}
}

sub whitespaceatend {
	my ($file, $whole) = @_;
	
	my $problem = 0;
	my $i = 1;
	foreach my $line (split(/\n/, $whole)) {
		if ($line =~ /[ \t]$/) {
			&perror("WARN: $file $i: whitespace before end of line");
			$problem = 1;
		}
		$i++;
	}

	if (! $problem) {
		&verbose("$file has no whitespace before the end of a line");
	}
}

#MICHAEL: maybe include the line number this is found on
sub blanklines {
	my ($file, $whole, $contblank) = @_;
	
	my $blanks = "\n" x ($contblank + 2);

	if ($whole =~ /$blanks/) {
		&perror("FATAL: $file: contiguous blank lines (> $contblank lines) found");
	} else {
		&verbose("$file has no contiguous blank lines");
	}
}

sub lastline {
	my ($file, $whole) = @_;

	my $problems = 0;
	
	if ($whole !~ /\n$/) {
		&perror("FATAL: $file: last line needs to be terminated by a \\n");
		$problems=1;
	}
	if ($whole =~ /\n([ \t]*\n)+$/) {
		&perror("WARN: $file: last line seems to be blank.");
		$problems=1;
	}
	if (! $problems) {
		&verbose("last line of $file looks good to me");
	}
}


#
# portlint general functions
#
sub contains {
	my ($search, @list) = @_;

	for (@list) {
		return 1 if m/^\Q$search\E$/;
	}
	return 0;
}

#MICHAEL: not tested
sub checkorder {
	my ($file, $section, $whole, @order) = @_;

	my @items = ();
	foreach my $i (split(/\n/, $whole)) {
		$i =~ s/[+?]?=.*$//m;
		push(@items, $i) if ($i =~ m/^\w/);
	}
	
	my $j = -1;
	my $invalidorder = 0;
	while ($#items >= 0) {
		my $i = shift(@items);
		my $k = 0;
		while ($k <= $#order && $order[$k] ne $i) {
			$k++;
		}
		if ($order[$k] eq $i) {
			if ($k < $j) {
				&perror("FATAL: $i appears out-of-order.");
				$invalidorder++;
			} else {
				&verbose("OK: seen $i, in order.");
			}
			$j = $k;
		} else {
			&perror("FATAL: $file: extra item \"$i\" placed in the section $section.");
		}
	}
	if ($invalidorder) {
		&perror("FATAL: order must be " . join('/', @order) . '.');
	} else {
		&verbose("OK: $section section is ordered properly.");
	}
}

sub checkearlier {
	my ($file, $whole, @varnames) = @_;

	my $i;
	foreach my $i (@varnames) {
		if ($whole =~ /\n$i[?+]?=/) {
			&perror("WARN: \"$i\" has to appear earlier in $file.");
		}
	}
}

#MICHAEL: not tested, just "ported" from portlint2 so not even checked
#         for validity
sub checkextra {
	my ($file, $whole, $section) = @_;

	$whole = "\n" . $whole if ($whole !~ /^\n/);
	$whole =~ s/\n#[^\n]*/\n/g;
	$whole =~ s/\n\n+/\n/g;
	$whole =~ s/^\s+//;
	$whole =~ s/\s+$//;
	return if ($whole eq '');

	if ($whole =~ /^([\w\d]+)/) {
		&perror("WARN: $file: extra item placed in the $section section, ".
			"for example, \"$1\".");
	} else {
		&perror("WARN: $file: extra item placed in the $section section.");
	}
}

sub getmakevars {
	my (@varlist) = @_;
	my %hash;
	my $cmd = "make -DPORTLINTING $opts{makeenv} MASTER_SITE_BACKUP=''";
	my $i = 0;

	for (@varlist) {
		$cmd .= " -V $_";
	}

	for (split(/\n/, `$cmd`)) {
		$hash{$varlist[$i]} = $_;
		if ((defined($opts{'display-makevars'}) && $opts{'display-makevars'} != 0 && $opts{'verbose'}) || ($opts{'verbose'} && !defined($opts{'display-makevars'})) || $opts{'display-makevars'} ) {
			print "makevar: $varlist[$i] = $_\n";
		}
		$i++;
	}

	return %hash;
}

sub createpatch {
	my ($file, $pattern, $old, $new) = @_;

	return if ($opts{'patch'} ne 1);
	my $patchfile = "portlint.patch";
	$patchfile = $opts{'patchfile'} if $opts{'patchfile'} ne "";
	$patchfile = "$patchfile-$patchcount";

#MICHAEL: not sure if patch creation is correct
	my ($oldline, $oldlen, $newline, $newlen);
	my $oldout;
	my $newout;

	# stupid hack that I don't believe is the right way to do this
	my $beginning = 0;
	$pattern =~ s/^(\^)//;
	$beginning = 1 if $1 ne "";

	open(F, "$file") || die "$!";
	while(<F>) {
		if ($beginning) {
			last if (m/(^$pattern)/);
		} else {
			last if (m/($pattern)/);
		}
	}
	$oldline = $.;
	$newline = $.;
	if ($1 eq "") {
		warnx("unable to match pattern \'$pattern\' in file $file");
		return;
	}
	close(F);
	foreach my $line (split(/\n/, $old)) {
		$oldout .= "- $line\n";
		$oldlen++;
	}
	foreach my $line (split(/\n/, $new)) {
		$newout .= "+ $line\n";
		$newlen++;
	}

	errx(1, "\`$patchfile\' file already exists.  I can't handle this yet") if ( -e "$patchfile");
	open(DIFF, ">>$patchfile");
	print DIFF <<EOF;
--- $file
+++ $file
@@ -$oldline +$newline,$newlen @@
EOF
	print DIFF "$oldout$newout";
}

sub addlist {
	my ($varnames, $varlist) = @_;

	foreach my $item (@$varlist) {
		push(@$varnames, $item);
	}
}

sub perror {
	my ($msg) = @_;

	warnx("perror called w/o WARN or FATAL") if ($msg !~ /^(WARN|FATAL):/);

	$msg =~ s/^WARN/FATAL/ if ($opts{'warnings-fatal'});
	$nfatal++ if ($msg =~ /^FATAL/);
	$nwarn++ if ($msg =~ /^WARN/);
	$msg =~ s/WARN:/WARN: /;
	print "$msg\n";
}

sub verbose {
	my ($msg) = @_;

	print "GOOD: $msg\n" if ($opts{verbose});
}

# eventually usage should be copied into the portlint manpage
# so for now this might be a little too verbose

sub usage {
	print STDERR <<EOF;
usage: $prog [options] [port_directory]
    -B#, --contblank#  allow # contiguous blank lines (default: 1 line)
    -b  warn \$(VARIABLE)
    -t, --tabs         nit pick about use of spaces.
    -v, --verbose      verbose mode
    --warnings-fatal   treat warnings as fatals.
    --patch            create a portlint generated patchfile with suggested
                       changes which can be applied to the port.
    --patchfile=name   change the name of the portlint generated patch file.

put something here about how the following options can be disabled with 'no'
    --display-makevars display variables taken from make.
                       defaults to on when in verbose mode.  May
                       be disabled by --nodisplay-options
    --display-options  show which command line options were seen.
                       defaults to on when in verbose mode.  May
                       be disabled by --nodisplay-options


un-implemented portlint 2.2.2 flags:
    -a  additional check for scripts/* and pkg/*
    -c  committer mode
    -M  set make variables (ex. PORTSDIR=/usr/ports.work)
    -N  writing a new port
EOF
		exit 0;
}

sub version {
	print "$prog version $version\n";
	exit 0;
}

#
# functions to deal with internal errors
#
sub warn {
	my ($msg) = @_;
		print STDERR $prog . ": " . $msg . "$!\n";
}

sub warnx {
		my ($msg) = @_;
		print STDERR $prog . ": " . $msg . "\n";
}

sub err {
		my ($ex, $msg) = @_;
		warnx("WARNING: err called incorrectly") if (($ex !~ m/^\d+/) || ($msg eq ""));
		print STDERR $prog . ": " . $msg . ": $!\n";
		exit $ex;
}

sub errx {
		my ($ex,$msg) = @_;
		warnx("WARNING: errx called incorrectly") if (($ex !~ m/^\d+/) || ($msg eq ""));
		print STDERR $prog . ": " . $msg . "\n";
		exit $ex;
}
