#!/usr/bin/perl

#
# Files in -s directory that are used:
#
#    New.sbs		Lists new files to be installed in the sbs directory
#    New.clients	Lists new files to be installed in the clients directory
#    New.profile	Lists new files to be installed in the user's home
#    Replace.sbs	Lists files to be replaced ...
#    Replace.clients
#    Replace.profile
#    Remove.sbs		Lists files to be removed ...
#    Remove.clients
#    Remove.profile
#    Patches.sbs	Contains context diffs for changed text files
#    Patches.clients
#    Patches.profile
#    system.reg		Contains regedit scripts for SYSTEM.DAT (clients dir)
#    clients-user.reg	Contains regedit scripts for USER.DAT (clients dir)
#    profile-user.reg	Contains regedit scripts for USER.DAT (home dir)
#    sbs/		Contains new and replacement files/directories
#    clients/
#    profile/
#    Pre-check	not used (may contain script to do custom sanity checks)
#
#

use strict;
use Getopt::Std;
use IO::Handle;
use IO::File;
use IO::Pipe;

push(@INC, '/usr/lib');
require 'regfilterLib.pl';

#
# Default locations of patched directories/files:
#
my $sbs = "/local/win95/shared";
my $systemDat = "/source/local/win95/test/registry/template-big.dat";
my $clients = "/source/local/win95/test/machine-src";
my $profile = "/local/samba/admin";

my $Usage = "Usage: $0 [-Cnv] -f change-root -s dst-sbs-root -c dst-clients-root -p dst-profile-root
	-n	Do nothing, say what would be done
	-f dir	Where changes are to come from
	-s dir	Where sbs changes are to be applied
		(default: $sbs)
	-S reg	Where SYSTEM.DAT lives
		(default: $systemDat)
	-c dir	Where clients changes are to be applied
		(default: $clients)
	-p dir	Where user profile changes are to be applied
		(default: $profile)
	-N	Allow additional/missing entries in supposidly new keys
	-v	Verbose
	-C	Check only; don't even say what would be done
";

my %opt;
if (!&getopts('Cc:f:nNp:s:S:v', \%opt)) {
    print STDERR $Usage;
    exit 1;
}

if (@ARGV > 0) {
    print STDERR "$0: too many arguments\n";
    die $Usage;
}

my $echo = defined $opt{'n'} && $opt{'n'} ? "echo " : "";
my $verbose = defined $opt{'v'} ? $opt{'v'} : 0;
my $checkOnly = defined $opt{'C'} ? $opt{'C'} : undef;
my $from = defined $opt{'f'} ? $opt{'f'} : undef;
$sbs = defined $opt{'s'} ? $opt{'s'} : $sbs;
$clients = defined $opt{'c'} ? $opt{'c'} : $clients;
$profile = defined $opt{'p'} ? $opt{'p'} : $profile;
$systemDat = defined $opt{'S'} ? $opt{'S'} : $systemDat;
my $newKeyMerge = defined $opt{'N'} ? $opt{'N'} : 0;

if (!defined $from) {
    die "$0: -f flag must be specified\n$Usage";
}
die "$0: problem with source directory $from: $!\n" if (!-d $from);
die "$0: problem with sbs directory $sbs: $!\n" if (!-d $sbs);
die "$0: problem with clients directory $clients: $!\n" if (!-d $clients);
die "$0: problem with profile directory $profile: $!\n" if (!-d $profile);
die "$0: problem with profile directory $profile/Profile: $!\n" if (!-d "$profile/win95/Profile");
die "$0: problem with system registry $systemDat: $!\n" if (!-f $systemDat);

my $ok = 1;
my $regedit = "regedit";	# the program

$| = 1;

my $STDERR = new IO::Handle();
$STDERR->fdopen('STDERR', 'w');

#
# Ensure copies of the original registries are saved
#
if (!-e "$from/system-pre-share.dat") {
    if (system("cp $systemDat $from/system-pre-share.dat") != 0) {
	die "$0: couldn't save $systemDat to $from/system-pre-share.dat\n";
    }
}
if (!-e "$from/profile-user-pre-share.dat") {
    if (system("cp $clients/USER.DAT $from/profile-user-pre-share.dat") != 0) {
	die "$0: couldn't save $clients/USER.DAT to $from/profile-user-share-pre.dat\n";
    }
}

#
# Check nothing in New will replace existing file
#
$ok = 0 if (!&checkNew("$from/New.sbs", "$from/sbs", $sbs));
$ok = 0 if (!&checkNew("$from/New.clients", "$from/clients", $clients));
$ok = 0 if (!&checkNew("$from/New.profile", "$from/profile", $profile));

#
# Check everything in Replace exists
#
$ok = 0 if (!&checkReplace("$from/Replace.sbs", "$from/sbs", $sbs));
$ok = 0 if (!&checkReplace("$from/Replace.clients", "$from/clients", $clients));
$ok = 0 if (!&checkReplace("$from/Replace.profile", "$from/profile", $profile));

$ok = 0 if (!&checkRemove("$from/Remove.sbs", $sbs));
$ok = 0 if (!&checkRemove("$from/Remove.clients", $clients));
$ok = 0 if (!&checkRemove("$from/Remove.profile", $profile));

$ok = 0 if (!&checkRegChanges("$from/system.reg", "$systemDat"));
$ok = 0 if (!&checkRegChanges("$from/clients-user.reg", "$clients/USER.DAT"));
$ok = 0 if (!&checkRegChanges("$from/profile-user.reg", "$profile/win95/Profile/USER.DAT"));

#
# Check patched files exist
#
$ok = 0 if (!&checkPatches("$from/Patches.sbs", $sbs));
$ok = 0 if (!&checkPatches("$from/Patches.clients", $clients));
$ok = 0 if (!&checkPatches("$from/Patches.profile", $profile));

exit(1) if (!$ok);
exit(0) if ($checkOnly);



#
# Start making changes
#


exit 1 if !&applyPatches("$from/Patches.sbs", $sbs);
exit 1 if !&applyPatches("$from/Patches.clients", $clients);
exit 1 if !&applyPatches("$from/Patches.profile", $profile);

#
# Install new files/directories
#
exit 1 if !&applyNew("$from/New.sbs", "$from/sbs", $sbs);
exit 1 if !&applyNew("$from/New.clients", "$from/clients", $clients);
exit 1 if !&applyNew("$from/New.profile", "$from/profile", $profile);


#
# Replace existing files
#
exit 1 if !&applyReplace("$from/Replace.sbs", "$from/sbs", $sbs);
exit 1 if !&applyReplace("$from/Replace.clients", "$from/clients", $clients);
exit 1 if !&applyReplace("$from/Replace.profile", "$from/profile", $profile);


#
# Remove existing files
#
exit 1 if !&applyRemove("$from/Remove.sbs", $sbs);
exit 1 if !&applyRemove("$from/Remove.clients", $clients);
exit 1 if !&applyRemove("$from/Remove.profile", $profile);


#
# Patch registries
#
exit 1 if !&applyRegPatch("$from/system.reg", "$systemDat");
exit 1 if !&applyRegPatch("$from/clients-user.reg", "$clients/USER.DAT");
exit 1 if !&applyRegPatch("$from/profile-user.reg", "$profile/win95/Profile/USER.DAT");


if (-f "$from/Manual") {
    print "Note: some changes must be made manually:\n";
    system("sed 's/^/\t/' < $from/Manual");
}

exit 0;


sub
checkNew
{
    my($file, $src, $dst) = @_;
    my($ok) = 1;

    if (-f $file) {
	print "Checking contents of $file\n" if ($verbose);
	my $in = new IO::File($file, "r");
	if (!defined $in) {
	    print STDERR "$0: can't open $file - $!\n";
	    return 0;
	}
	while (<$in>) {
	    chomp;
	    if (/"/) {
		print STDERR "$0: file contains double-quote: $file\n";
		$ok = 0;
	    }
	    if (! -e "$src/$_") {
		print STDERR "$0: New file missing from source directory: $src/$_\n";
		$ok = 0;
	    }
	    my $x = &checkExist($file, $dst, $_);
	    if (!defined $x) {
		$ok = 0;
	    } elsif ($x ne '') {
		my $status = system("cmp -s '$src/$_' '$dst/$x'");
		if ($status != 0) {
		    $ok = 0;
		    if ($x eq $_) {
			print STDERR "$0: New file already exists: $dst/$_\n";
		    } else {
			print STDERR "$0: Case mismatch for new file $dst/$_: file $dst/$x exists\n";
		    }
		} elsif ($x ne $_) {
		    print STDERR "$0: warning: new file $src/$_ already exists with different name: $dst/$x\n";
		}
	    }
#	    if (-e "$dst/$_") {
#		print STDERR "$0: New file already exists: $dst/$_\n";
#		$ok = 0;
#	    }
#	    $tmp = $_;
#	    $tmp =~ s:/+$::;		# strip trailing /s
#	    if ($tmp =~ m:/:) {
#		$tmp =~ s:/+[^/]+$::;	# strip last part
#		if (! -d "$dst/$tmp") {
#		    print STDERR "$0: New file's directory doesn't exist: $dst/$_\n";
#		    $ok = 0;
#		}
#	    }
	}
	$in->close;
    }
    return $ok;
}

sub
checkReplace
{
    my($file, $src, $dst) = @_;
    my($ok) = 1;

    if (-f $file) {
	print "Checking contents of $file\n" if ($verbose);
	my $in = new IO::File($file, "r");
	if (!defined $in) {
	    print STDERR "$0: can't open $file - $!\n";
	    return 0;
	}
	while (<$in>) {
	    chomp;
	    if (/"/) {
		print STDERR "$0: file contains double-quote: $file\n";
		$ok = 0;
	    }
	    if (! -f "$src/$_") {
		print STDERR "$0: Replace file missing from source directory: $src/$_\n";
		$ok = 0;
	    }
	    my $x = &checkExist($file, $dst, $_);
	    if (!defined $x) {
		$ok = 0;
	    } elsif ($x eq '') {
		print STDERR "$0: Replace file does not exist: $dst/$_\n";
		$ok = 0;
	    } elsif ($x ne '') {
		if ($x ne $_) {
		    print STDERR "$0: Case mismatch for replacement file $dst/$_: file $dst/$x exists\n";
		    $ok = 0;
		}
	    }
	}
	$in->close;
    }

    return $ok;
}

sub
checkRemove
{
    my($file, $dst) = @_;
    my($ok) = 1;

    if (-f $file) {
	print "Checking contents of $file\n" if ($verbose);
	my $in = new IO::File($file, "r");
	if (!defined $in) {
	    print STDERR "$0: can't open $file - $!\n";
	    return 0;
	}
	while (<$in>) {
	    chomp;
	    if (/"/) {
		print STDERR "$0: file contains double-quote: $file\n";
		$ok = 0;
	    }
	    my $x = &checkExist($file, $dst, $_);
	    if (!defined $x) {
		$ok = 0;
	    } elsif ($x eq '') {
		print STDERR "$0: Remove file does not exist: $dst/$_\n";
		$ok = 0;
	    } elsif ($x ne '') {
		if ($x ne $_) {
		    print STDERR "$0: Case mismatch for remove file $dst/$_: file $dst/$x exists\n";
		    $ok = 0;
		}
	    }
	}
	$in->close;
    }

    return $ok;
}

#
# Check nothing new in *.reg will replace existing entries
# check old values in *.reg are the same (need to add wild card or pattern)
#
sub
checkRegChanges
{
    my($regDiffs, $dstDat) = @_;
    my($curKey, $isNew);
    my(%remKey);
    my(%newKey);
    my($ok) = 1;
    my($ret);

    return 1 if (!-f $regDiffs);

    print "Checking contents of $regDiffs\n" if ($verbose);

    my $in = new IO::File($regDiffs, "r");
    if (!defined $in) {
	print STDERR "$0: can't open $regDiffs - $!\n";
	return 0;
    }
    my $keyInfo;
    my %keyChanges;
    while (1) {
	$keyInfo = regfilter::readKey($in);
	if (!defined $keyInfo) {
	    print STDERR
		"$0: problem with $regDiffs - $regfilter::errorString\n";
	    $in->close;
	    return 0;
	}
	last if !%$keyInfo;
	my($lowerKey) = $keyInfo->{'key'};
	$lowerKey =~ tr/A-Z/a-z/;
	$keyChanges{$lowerKey} = $keyInfo;
    }
    $in->close;

    $in = new IO::Pipe;
    my $x;
    if (!$in->reader("$regedit -f '$dstDat'")) {
	print STDERR "$0: can't open pipe to regedit - $!\n";
	return 0;
    }
    my $cInfo;
    while (1) {
	$keyInfo = &regfilter::readKey($in);
	if (!defined $keyInfo) {
	    print STDERR
"$0: problem with output from regedit -f $dstDat - $regfilter::errorString\n";
	    $in->close;
	    return 0;
	}
	last if !%$keyInfo;
	my($lowerKey) = $keyInfo->{'key'};
	$lowerKey =~ tr/A-Z/a-z/;
	$cInfo = $keyChanges{$lowerKey};
	next if (!defined $cInfo);
	if ($cInfo->{'status'} eq 'd') {		# deleted
	    delete $keyChanges{$lowerKey};
	} elsif ($cInfo->{'status'} eq 'n') {		# new
	    # see if contents exactly the same
	    my %currentFields = ();
	    my $tmpok = 1;
	    my $f;
	    foreach $f (@{$keyInfo->{'entries'}}) {
		my $lowerName = $f->{'name'};
		$lowerName =~ tr/A-Z/a-z/;
		$currentFields{$lowerName} = $f;
	    }
	    foreach $f (@{$cInfo->{'entries'}}) {
		my $lowerName = $f->{'name'};
		$lowerName =~ tr/A-Z/a-z/;
		if (!defined $currentFields{$lowerName}) {
		    if (!$newKeyMerge) {
			print STDERR "Problem in entry $f->{'name'} - not in current registry\n";
			$tmpok = 0;
		    }
		} elsif ($currentFields{$lowerName}->{'value'} ne
		    $f->{'value'})
		{
		    print STDERR "Problem in entry $f->{'name'} - different in reg diffs\n";
		    $tmpok = 0;
		}
		delete $currentFields{$lowerName};
	    }
	    if (!$newKeyMerge) {
		foreach $f (values %currentFields) {
		    print STDERR "Problem in entry $f->{'name'} - not in reg diffs\n";
		    $tmpok = 0;
		}
	    }
	    if (!$tmpok) {
		print STDERR "Full key from reg diffs ($regDiffs):\n";
		regfilter::printKey($STDERR, $cInfo);
		print STDERR "Full key from current registry ($dstDat):\n";
		regfilter::printKey($STDERR, $keyInfo);
		print STDERR "\n";
		$ok = 0;
	    }
	    delete $keyChanges{$lowerKey};
	} elsif ($cInfo->{'status'} eq 'e') {		# existing, entry change
	    my %currentFields = ();
	    my $tmpok = 1;
	    my $f;
	    foreach $f (@{$keyInfo->{'entries'}}) {
		my $lowerName = $f->{'name'};
		$lowerName =~ tr/A-Z/a-z/;
		$currentFields{$lowerName} = $f;
	    }
	    foreach $f (@{$cInfo->{'entries'}}) {
		my $lowerName = $f->{'name'};
		$lowerName =~ tr/A-Z/a-z/;
		if (!defined $f->{'value'}) {			# deleted
		    ; # don't care...
		} elsif (!defined $f->{'oldValue'}) {
		    print STDERR
"$0: problem with oldValue (from readKey: key $cInfo->{'key'}, entry $f->{'name'}) in $regDiffs\n";
		    $in->close;
		    return 0;
		} elsif ($f->{'oldValue'} eq 'new') {		# new
		    next if (!defined $currentFields{$lowerName}
			    || $currentFields{$lowerName}->{'value'}
				eq $f->{'value'});
		    $tmpok = 0;
		    print STDERR "Problem in entry $f->{'name'} - new entry already exists\n";
		} else {					# changed
		    if (!defined $currentFields{$lowerName}) {
			# Problem as other key entries may be missing from diff
			print STDERR "Problem in entry $f->{'name'} - entry not in reg diffs\n";
			$tmpok = 0;
			next;
		    }
		    if ($currentFields{$lowerName}->{'value'} eq $f->{'value'}
			|| $currentFields{$lowerName}->{'value'}
			    eq $f->{'oldValue'})
		    {
			next;
		    }
		    $tmpok = 0;
		    print STDERR "Problem in entry $f->{'name'} - entry values don't match\n";
		}
	    }
	    if (!$tmpok) {
		print STDERR "Full key from changes ($regDiffs):\n";
		regfilter::printKey($STDERR, $cInfo);
		print STDERR "Full key from current registry ($dstDat):\n";
		regfilter::printKey($STDERR, $keyInfo);
		$ok = 0;
	    }
	    delete $keyChanges{$lowerKey};
	} else {
	    print STDERR
    "$0: problem with status from regfilter::readKey: $cInfo->{'status'}\n";
	    $in->close;
	    return 0;
	}
    }
    $in->close;
    $ret = $?;
    if ($ret) {
	print STDERR "$0: regedit -f $dstDat failed (status $ret)\n";
	$ok = 0;
    }

    # See what is left in changes (but wasn't in current registry)
    foreach $cInfo (values %keyChanges) {
	if ($cInfo->{'status'} eq 'n' || $cInfo->{'status'} eq 'd') {
	    next;
	}
	print STDERR "changed key $cInfo->{'key'} from $regDiffs not in $dstDat\n";
	$ok = 0;
    }

    return $ok;
}

sub
checkPatches
{
    my($file, $dst) = @_;
    my($ok) = 1;

    if (-f $file) {
	print "Checking contents of $file\n" if ($verbose);
	my $in = new IO::File($file, "r");
	if (!defined $in) {
	    print STDERR "$0: can't open $file - $!\n";
	    return 0;
	}
	while (<$in>) {
	    if (/^--- (.*\S)\s+\w\w\w \w\w\w\s+\d+\s+\d\d:\d\d:\d\d\s+\d\d\d\d/) {
		my $patchedFile = $1;
		my $x = &checkExist($file, $dst, $patchedFile);
		if (!defined $x) {
		    $ok = 0;
		} elsif ($x eq '') {
		    print STDERR "$0: can't find file to patch in dst: $dst/$patchedFile\n";
		    $ok = 0;
		} elsif ($x ne '') {
		    if ($x ne $patchedFile) {
			print STDERR "$0: Case mismatch in file to patch $dst/$patchedFile: file $dst/$x exists\n";
			$ok = 0;
		    }
		}
	    }
	}
	$in->close;
	if ($ok) {
	    print "    Running patch in check mode on $file\n" if ($verbose);
	    my $ret = system("(cd $dst && patch -C -p0) < $file");
	    if ($ret) {
		print STDERR "$0: patch check on $file failed (status $ret)\n";
		$ok = 0;
	    }
	}
    }

    return $ok;
}

sub
applyPatches
{
    my($file, $dst) = @_;

    if (-f $file) {
	print "Applying $file\n" if ($verbose);
	my $ret = system("(cd $dst && $echo patch -p0) < $file");
	if ($ret) {
	    print STDERR "$0: patch failed (status $ret)\n";
	    print STDERR "$0: rejected patch files:\n";
	    system("cd $dst && find . -name \*.rej");
	    return 0;
	}
    }

    return 1;
}

sub
applyNew
{
    my($file, $src, $dst) = @_;

    if (-f $file) {
	print "Installing files in $file\n" if ($verbose);
	my $in = new IO::File($file, "r");
	if (!defined $in) {
	    print STDERR "$0: can't open $file - $!\n";
	    return 0;
	}
	while (<$in>) {
	    chomp;
	    my $ret = system("$echo cp -rp '$src/$_' '$dst/$_'");
	    if ($ret) {
		print STDERR "$0: error copying new file/dir $_ to $dst (status $ret)\n";
		return 0;
	    }
	}
	$in->close;
    }
    return 1;
}

sub
applyReplace
{
    my($file, $src, $dst) = @_;

    if (-f $file) {
	print "Replacing files in $dst\n" if ($verbose);
	my $in = new IO::File($file, "r");
	if (!defined $in) {
	    print STDERR "$0: can't open $file - $!\n";
	    return 0;
	}
	while (<$in>) {
	    chomp;
	    my $ret = system("$echo cp -p '$src/$_' '$dst/$_'");
	    if ($ret) {
		print STDERR "$0: error copying new file $_ to $dst (status $ret)\n";
		return 0;
	    }
	}
	$in->close;
    }
    return 1;
}

sub
applyRemove
{
    my($file, $dst) = @_;

    if (-f $file) {
	print "Removing files in $dst\n" if ($verbose);
	my $in = new IO::File($file, "r");
	if (!defined $in) {
	    print STDERR "$0: can't open $file - $!\n";
	    return 0;
	}
	while (<$in>) {
	    chomp;
	    my $ret = system("$echo rm -- '$dst/$_'");
	    if ($ret) {
		print STDERR "$0: error removing new file $_ to $dst (status $ret)\n";
		return 0;
	    }
	}
	$in->close;
    }
    return 1;
}

sub
applyRegPatch
{
    my($file, $datFile) = @_;

    if (-f "$file") {
	print "Patching $datFile\n" if ($verbose);
	my $ret = system("$echo $regedit -f $datFile -i $file");
	if ($ret) {
	    print STDERR "$0: error patching $datFile from $file (status $ret)\n";
	    return 0;
	}
    }
    return 1;
}

sub
checkExist
{
    my($where, $origDir, $path) = @_;
    my $dir = $origDir;
    my $file;

    $path =~ s:/+$::;	# strip trailing /
    if ($path =~ m:/:) {
	my $pre;
	($pre, $file) = ($path =~ m:^(.+)/+([^/]+)$:);
	my $part;
	foreach $part (split('/', $pre)) {
	    my $x = &existsIgnCase($dir, $part);
	    return undef if (!defined $x);
	    if ($x ne '' && $x ne $part) {
		print STDERR "$0: case mismatch between $dir/$part and $dir/$x (path from $where)\n";
		return undef;
	    }
	    $dir .= "/$part";
	}
    } else {
	$file = $path;
    }
    my $x = &existsIgnCase($dir, $file);
    if (defined $x && $x ne '') {
	if ($dir ne $origDir) {
	    $x = substr($dir, length($origDir) + 1) . '/' . $x;
	}
    }
    return $x;
}

sub
existsIgnCase
{
    my($dir, $file) = @_;

    if (!opendir(DIR, $dir)) {
	print STDERR "$0: can't open directory $dir - $!\n";
	return undef;
    }
    my $ent;
    while (defined ($ent = readdir(DIR))) {
	if ($ent =~ /^\Q$file\E$/i) {
	    closedir(DIR);
	    return $ent;
	}
    }
    closedir(DIR);
    return '';
}
