#!/usr/perl5/bin/perl -w
#
# Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
#ident	"%Z%%M%	%I%	%E% SMI"

require 5.6.1;
use strict;
use locale;
use Getopt::Std;

$ENV{"PATH"} = "/usr/bin";

my $basedir = `pwd`;
chomp($basedir);

my $mach = `uname -p`;
chomp($mach);

my @ignored_inputs;		# list of regexps for ignored inputs
my @ignored_lines;		# list of line numbers for @ignored_inputs

my @disallowed_dirs;		# list of directories we don't allow

my @allowed_files;		# list of regexps for allowed dependencies
my @allowed_lines;		# list of line numbers for @allowed_files

sub usage()
{
	die "usage: $0 [-UV] exception_list\n";
}

sub cleanpath($)
{
	my $path = $_[0];
	my @result = ();

	foreach (split(/\/+/, $path)) {
		next		if (/^$/ || /^\.$/);
		if (/^\.\.$/) {
			pop(@result);
		} else {
			push(@result, $_);
		}
	}
	return "/".(join "/", @result);
}

my %opts;

getopts('UV', \%opts) or usage;

my $unused = defined($opts{'U'});
my $verbose = defined($opts{'V'});

usage			if (scalar(@ARGV) == 0 || scalar(@ARGV) > 2);
my $in = $ARGV[0];
my $findarg = "$basedir/usr";
$findarg = "$basedir/".$ARGV[1]		if (scalar(@ARGV) >= 2);

open(IN, '<', $in) or die $in.": $!\n";
my $line = 0;

while (<IN>) {
	$line++;
	chomp;
	next		if (/^\s*$/ || /^\s*\#/);

	my $curline = $line;

	if (/^\s*for_([a-z0-9]+)\s+(.*)$/) {
		if ($1 ne $mach) {
			if ($1 ne "sparc" && $1 ne "i386") {
				die "$in:$line: unrecognized ISA \"$1\"\n";
			}
			next;		# skip this line, wrong architecture
		}
		$_ = $2;
	} elsif (/^\s*optional\s+(.*)$/) {
		$_ = $1;
		$curline = 0;		# mark it as already used
	}

	/^\s*([a-z_]+)\s+(.*)$/ or die "$in:$line: unrecognized line\n";
	my ($cmd, $arg) = ($1, $2);

	if ($cmd eq "ignore_re") {
		push(@ignored_inputs, $arg);
		push(@ignored_lines, $curline);

	} elsif ($cmd eq "ignore_file") {
		my $file = cleanpath("$arg");
		$file =~ s/^\///;
		push(@ignored_inputs, "^\Q$file\E\$");
		push(@ignored_lines, $curline);

	} elsif ($cmd eq "ignore_dir") {
		my $dir = cleanpath("$arg/");
		$dir =~ s/^\///;
		push(@ignored_inputs, "^\Q$dir\E");
		push(@ignored_lines, $curline);

	} elsif ($cmd eq "disallow_dir") {
		my $dir = cleanpath("/$arg");
		push(@disallowed_dirs, "^\Q$dir\E");

	} elsif ($cmd eq "allow_lib") {
		push(@allowed_files, "\Q/lib$arg.so\E[\.0-9]*\$");
		push(@allowed_lines, $curline);

	} elsif ($cmd eq "allow_file") {
		my $file = cleanpath("/$arg");
		push(@allowed_files, "^\Q$file\E\$");
		push(@allowed_lines, $curline);

	} elsif ($cmd eq "allow_dir") {
		my $dir = cleanpath("/$arg/");
		push(@allowed_files, "^\Q$dir\E");
		push(@allowed_lines, $curline);

	} else {
		die "$in:$line: unrecognized keyword \"$cmd\"\n";
	}
}

close(IN) or die "$in: $!\n";

if ($verbose) {
	print "ignored regexps:\n";
	for my $x (@ignored_inputs) {
		print "\t$x\n";
	}
	print "disallowed regexps:\n";
	for my $x (@disallowed_dirs) {
		print "\t$x\n";
	}
	print "allowed regexps:\n";
	for my $x (@allowed_files) {
		print "\t$x\n";
	}
	print "\n";
}

# compile the regexps for speed
for my $list (\@ignored_inputs, \@disallowed_dirs, \@allowed_files) {
	@$list = map qr/$_/, @$list;
}

open(FILES,
    "/usr/bin/find $findarg ".
	"-name SCCS -prune -o -name .make.state -type f -print |")
    or die "unable to run find: $!";

sub checkres($$$)
{
	my ($arg, $res, $lines) = @_;

	my $x = 0;

	for my $re (@$res) {
		if ($arg =~ /$re/) {
			$lines->[$x] = 0;
			return (1);
		}
		$x++;
	}
	return (0);
}

sub proc_list($@)
{
	my $dir = shift(@_);
	my @output = ();

	for my $arg (@_) {
		next			if ($arg =~ /^$/);
		$arg = $dir."/".$arg	if ($arg !~ /^\//);
		$arg = cleanpath($arg)	if ($arg =~ /\/[\.\/]/);

		push(@output, $arg);
	}
	return (@output);
}

sub proc_files($@)
{
	my $dir = shift(@_);
	my @output = ();

	for (proc_list($dir, @_)) {
		s/^\Q$basedir\E\///;		# remove basedir prefix

		# ignore files on the ignore list
		next	if (checkres($_, \@ignored_inputs, \@ignored_lines));

		push(@output, $_);
	}
	return (@output);
}

sub proc_deps($@)
{
	my $dir = shift(@_);
	my @output = ();

	for my $arg (proc_list($dir, @_)) {
		my $found = 0;

		# check if the file is in an interesting directory
		for my $rx (@disallowed_dirs) {
			$found = 1	if ($arg =~ /$rx/);
		}
		next	unless ($found);

		# now check the whitelist for allowed files
		next	if (checkres($arg, \@allowed_files, \@allowed_lines));

		push(@output, $arg);
	}
	return (@output);
}

my %bad;

while (<FILES>) {
	chomp($_);
	my $file = $_;

	$_ = "."		unless (s/^(.*)\/[^\/]*$/$1/);
	my $dir = $_;

	open(IN, "<", $file) or die "$file: $!";

	while (<IN>) {
		chomp($_);
		next		if (/^\t/);
		next		if (/^\.[^\.]/);	# make versions, etc.
		next		if (/^\s*$/);		# blank lines
		next		if (/^\s*\#/);		# comments

		if (/^(.*?):(.*)$/) {
			my @files = proc_files($dir, split(/\s+/, $1));
			my @deps = proc_deps($dir, split(/\s+/, $2));

			if (scalar(@deps) > 0) {
				for my $file (@files) {
					for my $dep (@deps) {
						$bad{$file}->{$dep} = 1;
					}
				}
			}
		}
	}
}

for my $file (sort keys %bad) {
	print "$file\n";
	for my $dep (sort keys %{$bad{$file}}) {
		print "\t$dep\n";
	}
}

if ($unused) {
	my @unused = grep($_, @ignored_lines, @allowed_lines);

	for my $line (@unused) {
		print "$in:$line: not used during processing\n"
	}
}