#!/bin/sh -- # This comment tells perl not to loop!
#
#ident		"@(#)chkclasses.sh 1.7     94/05/26 SMI"
#
#  chkclasses.sh
#
#	Copyright (c) 1994 by Sun Microsystems, Inc.
eval 'exec /usr/dist/exe/perl -S $0 ${1+"$@"}'
if 0;

#
# Constants/Globals
#
$name = "chkclasses.sh";
$name =~ s/\.sh$//;
$commondir = "common_files";
$workdir = "/tmp/classwork.$$";
@exclude_classes = ("none", "renamenew");
@keepfiles = ();

#
# quit (code)
#
sub quit {
	local($code) = @_;

	system("rm -rf $workdir");
	exit($code);
}

#
# error (warn, error, errno, errstring)
#
sub error {
	local($warn, $error, $errno, $errstring) = @_;
	local($fmt);

	if ($errno == 0) {
		$fmt = ($warn == 1) ? "WARNING: %s.\n" : "$name: %s.\n";
		$errno = 1;
	} else {
		$fmt = ($warn == 1) ? "WARNING: %s: %s.\n" : "$name: %s: %s.\n";
	}
	printf STDERR $fmt, $error, $errstring;
	&quit($errno) if ($warn == 0);
}

#
# warn (errno, error)
#
sub warn {
	local($errno, $error) = @_;
	local($errstring) = $! if ($errno != 0);

	&error(1, $error, $errno, $errstring) if (! $quiet);
};

#
# fatal (errno, error)
#
sub fatal {
	local($errno, $error) = @_;
	local($errstring) = $! if ($errno != 0);

	&error(0, $error, $errno, $errstring);
};

#
# sighandler
#
sub sighandler {
	local($signame) = @_;

	&fatal(0, "Caught signal SIG$signame -- exiting ..");
}

#
# usage ()
#
sub usage {
	print STDERR "\
Usage:
	$name -b <basedir> -c <cmpdir> -p <pkgdir> [-a <arch>]
	  [-C|-E <class>[,<class>..]] [-rmxkvlq]

	  -b <basedir>	Root directory of the base tree.
	  -c <cmpdir>	Root directory of the compare tree.
	  -p <pkgdir>	Root directory of the package definition tree.
	  -a <arch>	Specify the architecture.
	  -C <class>	A comma separated list of classes to test.
	  -E <class>	A comma separated list of classes exclude from test.
	  -r		Disable re-entrant testing.
	  -m		Disable modification testing.
	  -x		Display context diffs.
	  -k		Keep copies of files which failed a test.
	  -v		Verbose, list all files tested.
	  -l		Generate a list of classes and files only.
	  -q		Quite mode.

";
	exit 1;
}

#
# chkdir (dir)
#
# Ensure the a directory is a directory and that we have read and execute
# permission.
#
sub chkdir {
	local($dir) = @_;

	opendir(DIR, $dir) || &fatal($!, $dir);
	closedir(DIR);
	&fatal($!=13, $dir) if (! -x $dir);
	return(1);
}

#
# getarch (cmpdir, arch)
#
# Determine the architecture test type.  If given an arch via the command line,
# map it to a known supported test type.  Otherwise, look in the compare proto
# area.
#
$archmap{'sun4'}  = 'sparc';
$archmap{'sun4c'} = 'sparc';
$archmap{'sun4d'} = 'sparc';
$archmap{'sun4e'} = 'sparc';
$archmap{'sun4m'} = 'sparc';
$archmap{'sparc'} = 'sparc';
$archmap{'i386'}  = 'i386';
sub getarch {
	local($cmpdir, $arch) = @_;
	local($a, $link);

	if ($arch ne "") {
		$a = $archmap{$arch};
		&fatal(0, "undefined architecture $arch") if ($a eq "");
		return($a);
	} else {
		# The arch command cannot be used here because it uses uname
		# which will only look at the current running kernel.  So,
		# look at the supported arch files in usr/kvm until we find
		# one linked to true.
		foreach $a (keys %archmap) {
			$link = readlink("$cmpdir/usr/kvm/$a") || next;
			return($archmap{$a}) if ($link =~ /\/true$/o);
		}
		&fatal(0, "cannot determine architecture from $cmpdir");
	}
}

#
# readpkgdir (dir)
#
# Recursively decend looking for package definition directories.
#
sub readpkgdir {
	local($dir) = @_;
	local($d, $p);
	local(*PDIR, *plist);
	
	if (! opendir(PDIR, $dir)) {
		&warn($!, "opendir($dir)");
		return;
	}
	local(@ls) = readdir(PDIR);	# Read the entire dir
	closedir(PDIR);
	@ls = @ls[2..$#ls];		# Skip . and ..
	# Assume a package if it contains a pkginfo and prototype.
	if (grep(/^pkginfo.*/, @ls) > 0 && grep(/^prototype.*/, @ls) > 0) {
		return($dir);
	}
	foreach $d (@ls) {
		$p = $dir . "/$d";
		next if (! -d $p);
		local(@l) = &readpkgdir($p);
		push(@plist, @l);
	}
	return(@plist);
}

#
# getpkglist (pkgdir)
#
# Create a list of packages.  Find a directories in the pkgdir which have
# a pkginfo and prototype file.
#
sub getpkglist {
	local($pkgdir) = @_;
	local($pkglist);

	@pkglist = &readpkgdir($pkgdir);
	return(@pkglist);
}

#
# readproto (pkgdir, pkg, protofile)
#
# Recursively read a prototype file.
#
sub readproto {
	local($pkgdir, $pkg, $protofile) = @_;
	local($line, $type, $class, $fpath, *PROTO);

	if (! open(PROTO, $protofile)) {
		&warn($!, $protofile);
		return;
	}
	while ($line = <PROTO>) {
		$line =~ s/^\s*//;
		next if ($line =~ /^#/);
		if ($line =~ /^!/) {
			# Look for include files.  If found, recurse and read.
			if ($line =~ /^!include\s+(\S+)/o) {
				&readproto($pkgdir, $pkgname,
				  "$pkgdir/$pkg/$1");
			}
			next;
		}
		# Look for content lines with the following syntax:
		#  [<part #>] <type> <class> <path>[=<path>] <everything else>
		if ($line =~
		  /^\d*\s*([fevdxlpcbis])\s+(\w{1,12})\s+([^=\s]+)(=\S+)*/o)
		{
			$type = $1;
			$class = $2;
			if ($4 ne "") {		# Different source path.
				$fpath = $4;
				$fpath =~ s/^=//;
			} else {
				$fpath = $3;
			}
			next if ($type ne 'e');
			# Skip anything in the exclude list.
			next if (grep(/^$class$/, @exclude_classes) == 1);
			# If there is a specific list of classes, it must
			# match one of those.
			next if ($#classonlylist >= 0 && grep(/^$class$/,
			  @classonlylist) == 0);
			if ($classlist{$class} ne "") {
				$classlist{$class} .= " $pkgname:$fpath";
			} else {
				$classlist{$class} = "$pkgname:$fpath";
			}
		}
	}
	close(PROTO);
}

#
# getclasslist (arch, [pkg, ...])
#
# Read the prototype files for all of the packages and build an associative
# array of classes (the global classlist).  Each entry in a class will be of
# the form pkgname:path.  It is assumed that the prototype files are named
# either prototype or prototype_$arch.
#
sub getclasslist {
	local($arch, @pkglist) = @_;
	local($pkg, $pkgdir, $pkgname, $protofile);

	foreach $pkg (@pkglist) {
		$pkg =~ /(.*)\/([^\/]+$)/o;
		$pkgdir = $1;
		$pkgname = $2;
		$protofile = (-f "$pkg/prototype") ? "$pkg/prototype" :
		  "$pkg/prototype_$arch";
		&readproto($pkgdir, $pkgname, $protofile);
	}
}

#
# genlist (verbose)
#
# Generate a list of files found in the package definitions.  If verbose,
# make it a report including the classes and package names.
#
sub genlist {
	local($verbose) = @_;
	local($key, $files, $f, $string, $pkg, $fpath);
	local($ul) = "========================================";

	foreach $key (sort(keys %classlist)) {
		@files = split(/\s/, $classlist{$key});
		@files = sort(@files);
		if ($verbose) {
			$string = "Class: $key";
			print "\n$string\n";
			printf "%s\n\n", substr($ul, 0, length($string));
		}
		foreach $f (@files) {
			($pkg, $fpath) = split(/:/, $f);
			if ($verbose) {
				printf "%s%s%s\n", $pkg, (length($pkg) < 8) ?
				  "\t\t" : "\t", $fpath;
			} else {
				print "$fpath\n";
			}
		}
	}
}

#
# mkpath (path)
#
# Ensure all directory components of a path exist.
#
sub mkpath {
	local($path) = @_;

	$path =~ s/^\///;
	local(@plist) = split(/\//, $path);
	local($mpath) = "";
	while ($#plist > 0) {
		$mpath .= "/" . shift(@plist);
		mkdir($mpath, 0777) if (! -d $mpath);
	}
}

#
# copyfile (from, to)
#
sub copyfile {
	local($from, $to) = @_;
	local(*FROM, *TO);

	unlink($to) if (-f $to);
	if (! open(FROM, $from)) {
		&warn($!, "open($from)");
		return(0);
	}
	if (! open(TO, ">$to")) {
		&warn($!, "create($to)");
		return(0);
	}
	while (<FROM>) {
		print TO $_;
	}
	close(FROM);
	close(TO);
	return(1);
}

#
# printdiffs (diffs, diffargs, dest, cmp)
#
sub printdiffs {
	local($diffs, $diffargs, $dest, $cmp) = @_;
	local(*DIFFS);

	print "\n";
	if (! ($diffargs =~ /-C/)) {
		print "< $dest\n";
		print "> $cmp\n\n";
	}
	open(DIFFS, $diffs);
	while (<DIFFS>) {
		print $_;
	}
	close(DIFFS);
	print "\n";
}

#
# readxdiffs (list1, list2, diffs)
#
# Read a context diffs file filling in the $list1 and $list2 lists.  If
# "!" line is found, this indicates a line that is completely different
# between the two files; return an immediate failure.
#
sub readxdiffs {
	local($list1, $list2, $diffs) = @_;
	local($diffvar, *DIFFS);

	open(DIFFS, $diffs);
	$_ = <DIFFS>;
	return(1) if (/^No differences/o);
	while (<DIFFS>) {
		if (/^\*\*\* /o) {
			$diffvar = $list1;
		} elsif (/^--- /o) {
			$diffvar = $list2;
		} elsif (/^[\+-] (.*)/o) {
			eval "push(@$diffvar, \$1)";
		} elsif (/^! /o) {
			return(0);
		}
	}
	close(DIFFS);
	return(1);
}

#
# readdiffs (list1, list2, diffs)
#
# Read a diffs file filling in the $list1 and $list2 lists.
#
sub readdiffs {
	local($list1, $list2, $numbers, $diffs) = @_;
	local($lnum, $rnum);
	local(*DIFFS);

	open(DIFFS, $diffs);
	while (<DIFFS>) {
		if ($numbers == 1 && /^(\d+),?\d*[acd](\d+),?\d*/) {
			$lnum = $1;
			$rnum = $2;
		} elsif (/^< /) {
			if ($numbers) {
				s/^< /$lnum: /;
				++$lnum;
			} else {
				s/^< //;
			}
			eval "push(@$list1, \$_)";
		} elsif (/^> /) {
			if ($numbers) {
				s/^> /$rnum: /;
				++$rnum;
			} else {
				s/^> //;
			}
			eval "push(@$list2, \$_)";
		}
	}
	close(DIFFS);
	return(1);
}

#
# checkdiffs (diffs, diffargs)
#
# Attempt to recognize a diffs file if two files are functionally equivalent.
# The algorithm used here is simplistic.  The add/deletes of one file must
# exactly match the add/deletes of the other.
#
sub checkdiffs {
	local($diffs, $diffargs) = @_;
	local($ok);

	@destdlist = ();
	@cmpdlist = ();
	$ok = ($diffargs =~ /-C/) ? &readxdiffs("destdlist", "cmpdlist",
	  $diffs) : &readdiffs("destdlist", "cmpdlist", 0, $diffs);
	return(0) if (! $ok);
	return(1) if ($#destdlist < 0 && $#cmpdlist < 0);
	return(0) if ($#destdlist != $#cmpdlist);
	@destdlist = sort(@destdlist);
	@cmpdlist = sort(@cmpdlist);
	while ($#destdlist >= 0) {
		return(0) if (pop(@destdlist) ne pop(@cmpdlist));
	}
	return(1);
}

#
# checkmoddiffs (dest)
#
# Ensure that all the added and deleted lines from the user's file are the
# same in the upgraded file.
#
sub checkmoddiffs {
	local($dest) = @_;
	local($line, $newdellist, $i);
	local(*DEST);

	@newdellist = ();
	open(DEST, $dest);
	while (<DEST>) {
		$i = 0;
		foreach $line (@modaddlist) {
			$line =~ s/^\d+: //;
			if ("$_" eq "$line") {
				splice(@modaddlist, $i, 1);
				last;
			}
			++$i;
		}
		$i = 0;
		foreach $line (@moddellist) {
			$line =~ s/^\d+: //;
			if ("$_" eq "$line") {
				push(@newdelist, splice(@moddellist, $i, 1));
				last;
			}
			++$i;
		}
	}
	@moddellist = @newdellist;
	return ($#modaddlist >= 0 || $#moddellist >= 0 ? 0 : 1);
}

#
# testclass (class, arch, basedir, cmpdir, pkgdir, reenter, mod, verbose)
#
# Test a class action script for a class.  The script is assumed to be in
# $pkgdir/$commondir/i.$class and may optionally have the architecture
# appended.
#
sub testclass {
	local($class, $arch, $basedir, $cmpdir, $pkgdir, $reenter, $mod,
	  $diffargs, $verbose) = @_;
	local($script) = "$pkgdir/i.$class";
	local($diff) = "$workdir/classdiff";
	local($moddiff) = "$workdir/moddiff";
	local($f, $line);

	$script = "$pkgdir/$commondir/i.$class" if (! -f $script);
	if (! -f $script) {
		$script .= "_$arch";
		if (! -f $script) {
			&warn(0,
			  "Can't find class action script for class $class");
			return;
		}
	}
	local(@files) = split(/\s/, $classlist{$class});
	@files = sort(@files);
	foreach $f (@files) {
		local($pkg, $fpath) = split(/:/, $f);
		local($base) = "$basedir/$fpath";
		local($cmp) = "$cmpdir/$fpath";
		if (! -r $base) {
			$! = 13 if (-f $base);	# File exists but unreadable
			&warn($!, "class: $class, pkg: $pkg, $base");
			next;
		}
		if (! -r $cmp) {
			$! = 13 if (-f $cmp);	# File exists but unreadable
			&warn($!, "class: $class, pkg: $pkg, $cmp");
			next;
		}
		print "\nTesting class: $class, pkg: $pkg, $fpath ...\n" if
		  ($verbose);
		# Since some of the class action scripts work on the complete
		# path relative to BASEDIR, install the work file in it's
		# path relative to the work directory.
		local($dest) = "$workdir/$fpath";
		&mkpath($dest);
		next if (! &copyfile($base, $dest));
		system("echo $cmp $dest | BASEDIR=$workdir UPDATE=yes sh $script >/dev/null");
		system("diff $diffargs $dest $cmp >$diff");
		if (! &checkdiffs($diff, $diffargs)) {
			print "\nFAILED - Test: class: $class, pkg: $pkg\n";
			&printdiffs($diff, $diffargs, $dest, $cmp);
			push(@keepfiles, $fpath);
			next;
		}
		if ($reenter) {
			# Re-entrant testing.  Run the class action script
			# again with the same (and possibly modified) dest.
			print "\nRe-entrant testing class: $class, pkg: $pkg, $fpath ...\n" if ($verbose);
			system("echo $cmp $dest | BASEDIR=$workdir UPDATE=yes sh $script >/dev/null");
			system("diff $diffargs $dest $cmp >$diff");
			if (! &checkdiffs($diff, $diffargs)) {
				print "\nFAILED - Re-entrant Test: class: $class, pkg: $pkg\n";
				&printdiffs($diff, $diffargs, $dest, $cmp);
				push(@keepfiles, $fpath);
				next;
			}
		}
 		next if (! $mod);
 		local($modfile) = "$base.mod";
		if (! -r $modfile) {
			$! = 13 if (-f $modfile);
			&warn($!, "class: $class, pkg: $pkg, $modfile");
 			next;
 		}
		print "\nMod testing class: $class, pkg: $pkg, $fpath ...\n" if
		  ($verbose);
		system("diff $base $modfile >$moddiff");
		if (-z $moddiff) {
			&warn(0,
			  "class: $class, pkg: $pkg, $modfile: no differences");
			next;
		}
		@modaddlist = ();
		@moddellist = ();
		&readdiffs("moddellist", "modaddlist", 1, $moddiff);
		next if (! &copyfile($modfile, $dest));
		system(
		  "echo $cmp $dest | BASEDIR=$workdir UPDATE=yes sh $script >/dev/null");
		if (! &checkmoddiffs($dest)) {
			print
			  "\nFAILED - Mod Test: class: $class, pkg: $pkg\n";
			print "\nThe following lines were not added to the upgraded file:\n\n" if ($#modaddlist >= 0);
			foreach $line (@modaddlist) {
				print $line;
			}
			print "\nThe following deleted lines reappeared in the upgraded file:\n\n" if ($#moddellist >= 0);
			foreach $line (@moddellist) {
				print $line;
			}
			push(@keepfiles, $fpath);
			next;
		}
	}
}

#
# testclasses (arch, basedir, cmpdir, pkgdir, reenter, mod, diffargs, verbose)
#
sub testclasses {
	local($arch, $basedir, $cmpdir, $pkgdir, $reenter, $mod, $diffargs,
	  $verbose) = @_;
	local($key);

	foreach $key (sort(keys %classlist)) {
		&testclass($key, $arch, $basedir, $cmpdir, $pkgdir, $reenter,
		  $mod, $diffargs, $verbose);
	}
}

#
# savekeep ()
#
sub savekeep {
	local($whoami) = (getpwuid($>))[0];
	local($keepdir) = "/tmp/class.keep.$whoami";

	if ($whoami eq "" || (! -d $keepdir && !mkdir($keepdir, 0755))) {
		warn(0, "Unable to create keep directory");
		return;
	}
	system("(cd $workdir; tar cf - " . join(" ", @keepfiles) .  ") | (cd $keepdir; tar xfBp -)");
}

#
# Main
#

# Command line arguments.
require "getopts.pl";
&Getopts('b:c:p:a:C:E:rmvxklq') || &usage();
local($basedir) = $opt_b if ($opt_b ne "");
local($cmpdir) = $opt_c if ($opt_c ne "");
local($pkgdir) = $opt_p if ($opt_p ne "");
&usage() if ($basedir eq "" || $cmpdir eq "" || $pkgdir eq "");
&chkdir($basedir) && &chkdir($cmpdir) && &chkdir($pkgdir);
local($arch) = &getarch($cmpdir, $opt_a);
# classonlylist is need in a low level, recursive function.  It is too
# expensive to pass down, so make it global.
@classonlylist = split(/\s*,\s*/, $opt_C) if ($opt_C ne "");
push(@exclude_classes, split(/\s*,\s*/, $opt_E)) if ($opt_E ne "");
local($reenter) = ($opt_r eq "") ? 1 : 0;
local($mod) =  ($opt_m eq "") ? 1 : 0;
local($diffargs) = "-C 1" if ($opt_x ne "");
local($keep) = $opt_k;
local($verbose) = $opt_v;
local($listonly) = $opt_l;
# Needed in the low-level routine, warn();
$quiet = $opt_q;

# Unbuffer STDERR & STDOUT.  Useful when both are redirected to a pipe or
# file, thus messages appear in their proper order.
select(STDERR); $| = 1;
select(STDOUT); $| = 1;

# Install signal handlers
$SIG{'INT'} = sighandler;
$SIG{'QUIT'} = sighandler;
$SIG{'TERM'} = sighandler;

local(@pkglist) = &getpkglist($pkgdir);

mkdir($workdir, 0777) || &fatal($!, "mkdir($workdir)");
&getclasslist($arch, @pkglist);
if (! %classlist) {
	&warn(0, "No editable classes found");
	&quit(0);
}

if ($listonly) {
	&genlist($verbose);
	&quit(0);
}

&testclasses($arch, $basedir, $cmpdir, $pkgdir, $reenter, $mod, $diffargs,
  $verbose);
&savekeep() if ($#keepfiles >= 0 && $keep);

&quit(0);
