#!/usr/bin/perl
#
#    gen-app-changes - create diffs of two dos file systems (regutils package)
#    Copyright (C) 1998 Memorial University of Newfoundland
#    
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#    
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#    
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#    


#
# Program used to generate the changes that need to be applied to
# the sbs and user profiles to `install' some application.
# The general idea is you install w95 on a diskfull machine, take
# a snap shot of the disk, install the application and see what changed
# on the disk.  This program does the last step.  The `output' that
# is generated is designed to be used by the apply-app-changes.pl script.
#

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

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

my $prog = $0;
$prog =~ s:.*/::;



#
# Where the common ignore files live...
#
my $confDir = '/local/admin/win95/app-changes';

# Names (possibly path) of programs...
my $regdiff = '/usr/bin/regdiff';
my $regfilter = '/usr/bin/regfilter';
my $inidiff = '/usr/bin/inidiff';
my $fixlnk = '/usr/bin/fix-w9x-lnk.pl';
# A find that supports -iname and -print0
my $find = '/usr/bin/find';
# An xargs that supports -0
my $xargs = '/usr/bin/xargs';

# The pre-application-install file system
my $origDir = '/dump/w95-orig-install';
# The post-application-install file system
my $installDir = '/win95';
# Where to save the changes (will create a subdirectory here)
my $diffDir = '/dump/diffs';

# Name of the user who's profile is to be checked...
my $user = 'w95adm';
my $chownUserGroup = 'w95adm.wheel';

# Where the user's profile (USER.DAT) and related files are to be found
# (wrt $installDir)
my $profileDir = 'windows/Profiles';


my $Usage = "Usage: $prog [options] package-name
	-r	Re-use the diff -rc output (instead of generating it)
	-f      Force use of package-name (previous directory contents removed)
	-v      Verbose - generate running monologue
	-D dir	Change where diffs are rooted (from $diffDir)
	-O dir	Change original directory (from $origDir)
	-N dir	Change new directory (from $installDir)
	-u user	Set the user who's profile is to be checked (default: $user)
	-V	Print version number and exit.
    Creates $diffDir/PACKAGE-NAME/... with differences
    between $origDir and $installDir
";

my %opt;
if (!&getopts('frvD:O:N:u:V', \%opt)) {
    print STDERR $Usage;
    exit 1;
}
if (defined $opt{'V'}) {
    print "$prog: version 0.10\n";
    exit 0;
}

my $verbose = defined $opt{'v'} ? $opt{'v'} : 0;
my $force = defined $opt{'f'} ? $opt{'f'} : 0;
my $reuseDiff = defined $opt{'r'} ? $opt{'r'} : 0;
$diffDir = $opt{'D'} if defined $opt{'D'};
$origDir = $opt{'O'} if defined $opt{'O'};
$installDir = $opt{'N'} if defined $opt{'N'};
$user = $opt{'u'} if defined $opt{'u'};

# Strip trailing slashes...
$installDir =~ s:/+$::;
$origDir =~ s:/+$::;

if (@ARGV == 0) {
    print STDERR "$prog: missing package-name argument\n";
    die $Usage;
}

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

my $pkgName = shift;

umask(022);

my $file;
foreach $file (("$confDir/ign-system.reg",
		"$confDir/ign-clients-user.reg",
		"$confDir/ign-profile-user.reg",
		"$confDir/ign-files"))
{
    die "$prog: can't read $file - $!\n" if !-r $file;
}

my $ignFiles = &readIgnFiles("$confDir/ign-files", undef);


my $dir = $diffDir . '/' . $pkgName;
my $diffOut = "$dir/diff-rc.out";

$reuseDiff = 0 if ($reuseDiff && ! -e $diffOut);


# Add in app specific ignore files...
if (-f "$dir/ign-files") {
    $ignFiles = &readIgnFiles("$dir/ign-files", $ignFiles);
}


#
# Keep this up to date...
#
my @createdFilesDirs = (
	"$dir/diff-rc.out",
	"$dir/system.reg",
	"$dir/system-pre.dat",
	"$dir/system-post.dat",
	"$dir/clients-user.reg",
	"$dir/clients-user-pre.dat",
	"$dir/clients-user-post.dat",
	"$dir/profile-user.reg",
	"$dir/profile-user-post.dat",
	"$dir/Patches.sbs",
	"$dir/Patches.clients",
	"$dir/Patches.profile",
	"$dir/Patches-ini.sbs",
	"$dir/Patches-ini.clients",
	"$dir/Patches-ini.profile",
	"$dir/Replace.sbs",
	"$dir/Replace.clients",
	"$dir/Replace.profile",
	"$dir/New.sbs",
	"$dir/New.clients",
	"$dir/New.profile",
	"$dir/sbs",
	"$dir/clients",
	"$dir/profile",
    );

if (!-e $dir && !mkdir($dir, 0777)) {
    die "$prog: can't make directory $dir - $!\n";
}

#
# Check if any files/dirs already exist
#
{
    my @createdStuff = @createdFilesDirs;
    # Don't trash diff output if it is to be re-used
    if ($reuseDiff) {
	@createdStuff = grep($_ ne $diffOut, @createdFilesDirs)
    }
    if (grep(-e $_, @createdStuff)) {
	if ($force) {
	    print STDERR "Removing selected contents of $dir...\n" if $verbose;
	    my $status = system('rm', '-rf', @createdStuff);
	    die "$prog: couldn't remove contents of directory $dir\n"
		    if (grep(-e $_, @createdStuff));
	} else {
	    die "$prog: directory $dir already contains diffs, patches, etc.\n";
	}
    }
}

print STDERR "Generating diffs...\n" if $verbose;
if (!$reuseDiff) {
    my $stat = system("diff -r -c '$origDir' '$installDir' > '$diffOut'");
    if ($stat != 0 && $stat != (1 << 8)) {
	die "$prog: error generating diffs (exit status $stat)\n";
    }
}

print STDERR "Processing diffs...\n" if $verbose;
if (!open(DIFF, "< $diffOut")) {
    die "$prog: error opening diff output $diffOut - $!\n";
}
my $inDiff = 0;
my($profUserRegChanged, $userRegChanged, $systemRegChanged) = (0, 0, 0);
my(@diffTxt, @diffIni, @diffBin, @added, @removed);
while (<DIFF>) {
    chomp;
    if (/^diff\s+(-[a-z]\s+)*\Q$origDir\E\/(.+) \Q$installDir\E\/(.+)$/o) {
	if ($2 ne $3) {
	    die "$prog: $diffOut:$.: diffed files have different names: $2 vs $3\n";
	}
	$file = $2;
	if (!&shouldIgnore($file, $ignFiles)) {
	    if ($file =~ /\.ini$/i) {
		push(@diffIni, $file);
	    } else {
		push(@diffTxt, $file);
	    }
	}
	$inDiff = 1;
    } elsif (/^Binary files \Q$origDir\E\/(.+) and \Q$installDir\E\/(.+) differ/o) {
	if ($1 ne $2) {
	    die "$prog: $diffOut:$.: diffed files have different names: $1 vs $2\n";
	}
	$file = $1;
	if (!&shouldIgnore($file, $ignFiles)) {
	    push(@diffBin, $file);
	}
	#
	# Treat registry files specially
	#
	if ($file eq 'windows/system.dat') {
	    $systemRegChanged = &diffRegistry(
		"$origDir/$file", "$installDir/$file",
		"system.dat", "HKEY_LOCAL_MACHINE",
		"$dir/system.reg",
		"$dir/system-pre.dat", "$dir/system-post.dat",
		"$confDir/ign-system.reg", "$dir/ign-system.reg");
	} elsif ($file eq 'windows/user.dat') {
	    $userRegChanged = &diffRegistry(
		"$origDir/$file", "$installDir/$file",
		"clients-user.dat", "HKEY_USERS",
		"$dir/clients-user.reg",
		"$dir/clients-user-pre.dat", "$dir/clients-user-post.dat",
		"$confDir/ign-clients-user.reg", "$dir/ign-clients-user.reg");
	} elsif ($file eq "windows/Profiles/$user/user.dat") {
	    $profUserRegChanged = &diffRegistry(
		"$origDir/$file", "$installDir/$file",
		"profile-user.dat", "HKEY_USERS",
		"$dir/profile-user.reg",
		"$dir/profile-user-pre.dat", "$dir/profile-user-post.dat",
		"$confDir/ign-profile-user.reg", "$dir/ign-profile-user.reg");
	}
	$inDiff = 0;
    } elsif (/^Only in \Q$origDir\E(|\/(.*)): (.+)$/) {
	$file = $2 eq '' ? $3 : "$2/$3";
	if (!&shouldIgnore($file, $ignFiles)) {
	    $file .= '/' if -d $file;
	    push(@removed, $file);
	}
	$inDiff = 0;
    } elsif (/^Only in \Q$installDir\E(|\/(.*)): (.+)$/) {
	$file = $2 eq '' ? $3 : "$2/$3";
	if (!&shouldIgnore($file, $ignFiles)) {
	    $file .= '/' if -d $file;
	    push(@added, $file);
	}
	$inDiff = 0;
    } else {
	if ($inDiff && /^(\*\*\*|---|[-!+ \\] )/) {
	    # skip it...
	} else {
	    die "$prog: $diffOut:$.: unrecognized line in diff: $_\n";
	}
    }
}
close(DIFF);

#
# Save the info (perhaps build diff tree so can be applied?)
#

if (@diffTxt) {
    print STDERR "Generating patches for modified text files...\n" if $verbose;

    my(@profileFiles, @clientsFiles, @sbsFiles);
    &classifyFiles(\@diffTxt, \@profileFiles, \@clientsFiles, \@sbsFiles);

    if (@profileFiles) {
	&saveDiffs("$dir/Patches.profile", $origDir,
		$installDir, \&profileFileNameFilter,
		@profileFiles);
    }
    if (@clientsFiles) {
	&saveDiffs("$dir/Patches.clients", $origDir,
		$installDir, \&clientsFileNameFilter,
		@clientsFiles);
    }
    if (@sbsFiles) {
	&saveDiffs("$dir/Patches.sbs", $origDir,
		$installDir, \&sbsFileNameFilter,
		@sbsFiles);
    }
}
if (@diffIni) {
    print STDERR "Generating patches for modified ini files...\n" if $verbose;

    my(@profileFiles, @clientsFiles, @sbsFiles);
    &classifyFiles(\@diffIni, \@profileFiles, \@clientsFiles, \@sbsFiles);

    if (@profileFiles) {
	&saveIniDiffs("$dir/Patches-ini.profile", $origDir,
		$installDir, \&profileFileNameFilter,
		@profileFiles);
    }
    if (@clientsFiles) {
	&saveIniDiffs("$dir/Patches-ini.clients", $origDir,
		$installDir, \&clientsFileNameFilter,
		@clientsFiles);
    }
    if (@sbsFiles) {
	&saveIniDiffs("$dir/Patches-ini.sbs", $origDir,
		$installDir, \&sbsFileNameFilter,
		@sbsFiles);
    }
}
if (@diffBin) {
    print STDERR "Saving modified binaries files...\n" if $verbose;
    my(@profileFiles, @clientsFiles, @sbsFiles);
    &classifyFiles(\@diffBin, \@profileFiles, \@clientsFiles, \@sbsFiles);
    if (@profileFiles) {
	&copyList($installDir, "$dir/profile",
		\&profileFileNameFilter, @profileFiles);
	&saveList("$dir/Replace.profile", \&profileFileNameFilter,
		@profileFiles);
    }
    if (@clientsFiles) {
	&copyList($installDir, "$dir/clients", \&clientsFileNameFilter,
		@clientsFiles);
	&saveList("$dir/Replace.clients", \&clientsFileNameFilter, @clientsFiles);
    }
    if (@sbsFiles) {
	&copyList($installDir, "$dir/sbs", \&sbsFileNameFilter, @sbsFiles);
	&saveList("$dir/Replace.sbs", \&sbsFileNameFilter, @sbsFiles);
    }
}
if (@added) {
    print STDERR "Saving new files...\n" if $verbose;
    my(@profileFiles, @clientsFiles, @sbsFiles);
    &classifyFiles(\@added, \@profileFiles, \@clientsFiles, \@sbsFiles);
    if (@profileFiles) {
	&copyList($installDir, "$dir/profile",
		\&profileFileNameFilter, @profileFiles);
	&saveList("$dir/New.profile", \&profileFileNameFilter, @profileFiles);
    }
    if (@clientsFiles) {
	&copyList($installDir, "$dir/clients", \&clientsFileNameFilter, @clientsFiles);
	&saveList("$dir/New.clients", \&clientsFileNameFilter, @clientsFiles);
    }
    if (@sbsFiles) {
	&copyList($installDir, "$dir/sbs", \&sbsFileNameFilter, @sbsFiles);
	&saveList("$dir/New.sbs", \&sbsFileNameFilter, @sbsFiles);
    }
}
if (@removed) {
    print STDERR "Saving list of removed files...\n" if $verbose;
    my(@profileFiles, @clientsFiles, @sbsFiles);
    &classifyFiles(\@removed, \@profileFiles, \@clientsFiles, \@sbsFiles);
    if (@profileFiles) {
	&saveList("$dir/Remove.profile", \&profileFileNameFilter, @profileFiles);
    }
    if (@clientsFiles) {
	&saveList("$dir/Remove.clients", \&clientsFileNameFilter, @clientsFiles);
    }
    if (@sbsFiles) {
	&saveList("$dir/Remove.sbs", \&sbsFileNameFilter, @sbsFiles);
    }
}
if (-d "$dir/sbs" || -d "$dir/clients" || -d "$dir/profile") {
    print STDERR "Fixing short cut (.lnk) files\n" if $verbose;
    my $dirs = "";
    $dirs .= " $dir/profile" if -d "$dir/profile";
    $dirs .= " $dir/clients" if -d "$dir/clients";
    $dirs .= " $dir/sbs" if -d "$dir/sbs";
    my $cmd = "$find $dirs -iname '*.lnk' -print0 | $xargs -0 --no-run-if-empty $fixlnk";
    my $ret = system($cmd);
    if ($ret != 0) {
	print STDERR "$0: problem running find/fixlnk (status $ret)\n";
    }
}


exit 0;


sub shouldIgnore
{
    my($file, $ignFilePats) = @_;

    $file =~ y/A-Z/a-z/;
    study $file;
    my $pat;
    foreach $pat (@$ignFilePats) {
	return 1 if $file =~ /$pat/;	# No /i needed - pat is lowercase...
    }
    return 0;
}

sub diffRegistry
{
    my($orig, $new, $type, $keyname, $outFile, $saveOrig, $saveNew, @ignRegFiles) = @_;

    print STDERR "Generating diffs for $type...\n" if $verbose;

    @ignRegFiles = grep(-f $_, @ignRegFiles);

    my $status = system("$regdiff -r -t $keyname $orig $new | $regfilter @ignRegFiles > $outFile");
    if ($status != 0) {
	die "$prog: error running regdiff/regfilter on $type (exit $status)\n";
    }
    if (system("cmp -s $orig $new") != 0) {
	my $stat = system("cp $orig $saveOrig");
	if ($stat != 0) {
	    die "$prog: error copying $orig to $saveOrig (status $stat)\n";
	}
	$stat = system("cp $new $saveNew");
	if ($stat != 0) {
	    die "$prog: error copying $new to $saveNew (status $stat)\n";
	}
    }
    if (!-s $outFile) {
	unlink($outFile);
	print STDERR "  (no useful diffs in $type)\n" if $verbose;
	return 0;
    }
    return 1;
}

sub saveList
{
    my($file, $fileFilter, @list) = @_;

    if (!open(OUT, "> $file")) {
	die "$prog: can't open $file - $!\n";
    }
    foreach (@list) {
	print OUT &$fileFilter($_), "\n";
    }
    if (!close(OUT)) {
	die "$prog: error writing to $file - $!\n";
    }
    return 1;
}

sub saveDiffs
{
    my($outFile, $origDir, $newDir, $fileFilter, @list) = @_;
    my($stat);
    my($nfile);

    foreach $file (@list) {
	if (!open(DIFF, "diff -c '$origDir/$file' '$newDir/$file' |")) {
	    die "$prog: error opening pipe to diff - $!\n";
	}
	if (!open(OUT, ">> $outFile")) {
	    die "$prog: error appending to $outFile - $!\n";
	}
	$nfile = &$fileFilter($file);
	while (<DIFF>) {
	    if ($. == 1) {
		if (!s:^\*\*\* \Q$origDir/$file\E:\*\*\* Orig/$nfile:) {
		    die "$prog: unexpected diff output, line 1: $_\n";
		}
	    } elsif ($. == 2) {
		if (!s:^--- \Q$newDir/$file\E:--- $nfile:) {
		    die "$prog: unexpected diff output, line 2: $_\n";
		}
	    }
	    print OUT $_;
	}
	if (!close(OUT)) {
	    die "$prog: error writing to $outFile - $!\n";
	}
	close(DIFF);
	if ($? != (1 << 8)) {
	    die "$prog: unexpected diff exit status - $?\n";
	}
    }
    return 1;
}

sub saveIniDiffs
{
    my($outFile, $origDir, $newDir, $fileFilter, @list) = @_;

    if (!open(OUT, ">> $outFile")) {
	die "$prog: error appending to $outFile - $!\n";
    }
    foreach $file (@list) {
	my $nfile = &$fileFilter($file);
	print OUT "inidiff $file\n";
	if (!open(DIFF, "$inidiff '$origDir/$file' '$newDir/$file' |")) {
	    die "$prog: error opening pipe to diff - $!\n";
	}
	my $last = undef;
	while (<DIFF>) {
	    $last = $_;
	    print OUT "\t", $_;
	}
	if (defined $last && $last !~ /\n$/) {
	    die "$prog: inidiff output didn't end in a newline\n";
	}
	close(DIFF);
	if ($? != 0) {
	    die "$prog: unexpected inidiff exit status - $?\n";
	}
    }
    if (!close(OUT)) {
	die "$prog: error writing to $outFile - $!\n";
    }
    return 1;
}

sub copyList
{
    my($fromDir, $toDir, $fileFilter, @files) = @_;
    my($fromFile, $toFile);

    if (! -d $fromDir) {
	die "$prog: copyList from directory $fromDir does not exist\n";
    }
    return 1 if !@files;
    if (! -d $toDir) {
	&mkfilepath("", "$toDir/foo");
	#if (!mkdir($toDir, 0777)) {
	#    die "$prog: can't make directory $toDir - $!\n";
	#}
    }
    foreach $file (@files) {
	$fromFile = "$fromDir/$file";
	$toFile = &$fileFilter($file);
	if (-e "$toDir/$toFile") {
	    die "$prog: $toDir/$toFile already exists - won't copy over it\n";
	}
	&mkfilepath($toDir, $toFile);
	my $stat = system("cp -rp '$fromFile' '$toDir/$toFile'");
	if ($stat != 0) {
	    die "$prog: error copying $fromFile to $toFile (exit status $stat)\n";
	}
	$stat = system("chmod -R a+rX '$toDir/$toFile'");
	if ($stat != 0) {
	    die "$prog: error chmod'ing $toFile (exit status $stat)\n";
	}
	$stat = system("$find '$toDir/$toFile' -type f -perm +0100 -print0 | $xargs -0 --no-run-if-empty chmod a-x");
	if ($stat != 0) {
	    die "$prog: error removing execute bits on $toFile (exit status $stat)\n";
	}
	$stat = system("chown -R $chownUserGroup '$toDir/$toFile'");
	if ($stat != 0) {
	    die "$prog: error chown'ing $toFile (exit status $stat)\n";
	}
    }
    return 1;
}

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

    return 1 if $file !~ m:/:;
    $file =~ s:/+[^/]*$::;

    my $part;
    foreach $part (split('/', $file)) {
	$dir .= "/$part";
	if (!-d $dir) {
	    if (!mkdir($dir, 0777)) {
		die "$prog: can't make directory $dir - $!\n";
	    }
	}
    }
    return 1;
}

sub readIgnFiles
{
    my($file, $prev) = @_;
    my $files = defined $prev ? $prev : [];

    if (!open(IN, "< $file")) {
	die "$prog: can't open $file - $!\n";
    }
    while (<IN>) {
	next if (/^\s*($|#)/);
	s/^\s+//; s/\s+$//;
	s/\$USER\$/$user/g;
	y/A-Z/a-z/;
	push(@$files, $_);
    }
    close(IN);
    return $files;
}

sub lowerCaseArray
{
    my($array) = @_;
    my($e, @newArray);

    my $elem;
    foreach $elem (@$array) {
	($e = $elem) =~ y/A-Z/a-z/;
	push(@newArray, $e);
    }
    return @newArray;
}

sub nullFileNameFilter
{
    my($file) = @_;
    return $file;
}

sub classifyFiles
{
    my($all, $profile, $clients, $sbs) = @_;

    my $file;
    foreach $file (@{$all}) {
	if (m:^$profileDir/:io) {
	    push(@$profile, $file);
	} elsif (m:^windows/(win|system|control).ini$:i) {
	    push(@$clients, $file);
	} else {
	    push(@$sbs, $file);
	}
    }
}

sub profileFileNameFilter
{
    my($file) = @_;
    $file =~ s:^$profileDir/$user:win95/Profile:;
    $file =~ s:^$profileDir/:win95/:;
    return $file;
}

sub clientsFileNameFilter
{
    my($file) = @_;
    $file =~ s:^windows/system/:SYSTEM/:i;
    $file =~ s:^(system|win|control\.ini)$:\U$1\E:;
    return $file;
}

sub sbsFileNameFilter
{
    my($file) = @_;
    $file =~ s:^windows/system/:SYSTEM/:i;
    $file =~ s:^windows/fonts/:FONTS/:i;
    $file =~ s:^windows/::;
    return $file;
}
