# driver.pl
# main honeyclient engine
# Copyright (c) 2004-2005 Kathy Wang <knwang@synacklabs.net>

# driver.pl is executed after proxy.pl is started, and is responsible
# for driving IE browser, baselining, and running file and registry
# integrity checks. The user supplies a starting URL, which is read into
# domainfile.

#!/usr/bin/perl
use strict;
use Win32::Job;
use Getopt::Long;
use Config;


use Digest::MD5 qw(md5 md5_hex md5_base64);
use File::Find;
use Getopt::Long;
use strict;
use warnings;
use Win32;
use Win32::TieRegistry ( qw( KEY_READ ));

#$Registry->Delimiter("/");

my $cleanfile = "cleanfile.dat";
my $cleanreg = "cleanreg.dat";
my $checkfile = "checklist.txt";
my $excludefile = "exclude.txt";
my $changefile = "changes.txt";
my $recenturls = "recenturls.txt";

my @checklist = ();
my @checkdirs = ();
my %excludefilehash = ();
my %cleanfilehash = ();
my %currentfilehash = ();
my %newfilehash = ();
my %gonefilehash = ();
my %changedfilehash = ();
my %cleanreghash = ();
my %currentreghash = ();
my %newreghash = ();
my %gonereghash = ();
my %changedreghash = ();
my %optctl = ();
my $key;


my $domainname;
my $filename;
my $proxyjob = Win32::Job->new;
#my $iepath = "IEXPLORE.EXE";
my $iepath = "C:\\IEXPLORE.EXE";
my $cachepath = "C:\\Documents and Settings\\Administrator\\Local Settings\\Temporary Internet Files";
my $intfile = "intfile";
my $extfile = "extfile";
my $domainfile = "domainfile";
my $donefile = "donefile";
my $proxydonefile = "proxydone";
my %visited = ();
my %internals = ();
my %externals = ();
my %recent = ();
my $continue = 1;
my $binperl = "C:\\Perl\\bin\\perl";


# reg_recurse recursively finds all registry key strings and
# values, and writes them to a hash table.

sub reg_recurse {
    my @values = ();
    my @subkeys = ();
    my $newkey;
    my $newstring;
    my $valstring;
    my $keystring = shift;
    my $hashref = shift;

#    print"keystring: $keystring\n";

    $newkey = $Registry->{$keystring} ;

    if(defined($newkey)){
#       @values = $newkey->ValueNames;
#       @subkeys = $newkey->SubKeyNames;

#       print "Newkey gives: $newkey\n";
        @values = grep( m#^\\#, keys(%{$newkey}));
        @subkeys = grep(! m#^\\#, keys(%{$newkey}));

        foreach my $subkey(@subkeys) {
            $newstring = $keystring.$subkey;
            reg_recurse($newstring, $hashref);
        }
        if(($values[0]) && ($values[0] =~ /\w+/)) {
            foreach my $value (@values) {
                if($valstring) {
                    $valstring = $valstring . " -:-:- " . $value;
                } else {
                    $valstring = $value;
                }
            }
            $$hashref{$keystring} = $valstring;
        }
    }
}

# found takes input from checklist.txt, which is a file created by the
# user specifying which directory to baseline and check. As long as the
# directory is not in exludefile.txt, then proceed with check.

sub found {
    my $foundfile = $File::Find::name;
    if (-f $foundfile) {
	if(!($excludefilehash{$foundfile})) {
	    push @checklist, $foundfile;
#	    print "checking $foundfile\n";
	}
    }
}

# integrityrun does a baseline of files and registry key values if one does
# not already exist. After each domain is visited, files hashes and registry 
# key values are checked to see if their values have changed. In addition,
# if files were created or deleted, this is noted as well.

sub integrityrun {
    my $init = shift;

    open CHECK, "$checkfile" or die "Cannot open $checkfile: $!\nYou should create a checklist before running this, please see README\n";
    while(<CHECK>) {
	chomp;
	push @checkdirs, $_;
    }
    close CHECK;
    
    if(open EXCLUDE, "$excludefile") {
	while (<EXCLUDE>) {
	    chomp;
	    $excludefilehash{$_} = 1;
	}
	close EXCLUDE;
    }    

    print "Searching files...\n";
    foreach my $checkdir(@checkdirs) {
	find (\&found, "$checkdir");
    }

    print "Searching Registry...\n";
    foreach my $key (keys(%{$Registry->{"HKEY_CLASSES_ROOT\\"}})) {
	reg_recurse("HKEY_CLASSES_ROOT\\".$key, \%currentreghash);
    }

    if($init) {
	print "Initializing...\n";
	open CLEANFILE, ">$cleanfile" or die "Cannot open $cleanfile: $!\n";
	open CLEANREG, ">$cleanreg" or die "Cannot open $cleanreg: $!\n";
	foreach my $file (@checklist) {
	    if(open HASHFILE, "$file") {
		my $md5ctx = Digest::MD5->new;
		$md5ctx->addfile(*HASHFILE);
		my $md5string = $md5ctx->hexdigest;
		print CLEANFILE "$file:$md5string\n";
		close(HASHFILE);
	    }
	}
	foreach $key (keys(%currentreghash)) {
	    print CLEANREG "$key :: $currentreghash{$key}\n";
	}
	close(CLEANREG);
	close(CLEANFILE);
    } else {
	open CLEANFILE, "$cleanfile" or die "Cannot open $cleanfile: $!\n";
	while(<CLEANFILE>) {
	    my $line = $_;
	    chomp($line);
	    if($line =~ /(.+):(\w+)/) {
		$cleanfilehash{$1} = $2;
	    } else {
		print "Malformed line in $cleanfile: $line\n";
	    }
	}
	close CLEANFILE;
	open CLEANREG, "$cleanreg"  or die "Cannot open $cleanreg: $!\n";
	while(<CLEANREG>) {
	    my $line = $_;
	    chomp($line);
	    if($line =~ /(.+) :: (.+)/) {
		$cleanreghash{$1} = $2;
	    } else {
		print "Malformed line in $cleanreg: $line\n";
	    }
	}
	close CLEANREG;
	foreach my $file (@checklist) {
	    if(open HASHFILE, "$file") {
		my $md5ctx = Digest::MD5->new;
		$md5ctx->addfile(*HASHFILE);
		close(HASHFILE);
		$currentfilehash{$file} = $md5ctx->hexdigest;
		if($cleanfilehash{$file}) {
		    if($cleanfilehash{$file} eq $currentfilehash{$file}) {
			
		    } else {
			$changedfilehash{$file} = $currentfilehash{$file};
		    }
		} else {
		    $newfilehash{$file} = $currentfilehash{$file};
		}
	    }
	}
	
#	foreach $key (keys %cleanreghash) {
#	    print "Clean: $key\n";
#	}
	foreach $key (keys %currentreghash) {
#	    print "Checking reg key $key : ";
	    if($cleanreghash{$key}) {
#		print "Matched\n";
		if($cleanreghash{$key} eq $currentreghash{$key}) {
		} else {
		    $changedreghash{$key} = $currentreghash{$key};
		}
	    } else {
#		print "Unmatched\n";
		$newreghash{$key} = $currentreghash{$key};
	    }
	}
	
	foreach $key (keys %cleanfilehash) {
	    if(!($currentfilehash{$key})) {
		$gonefilehash{$key} = $cleanfilehash{$key};
	    }
	}
	
	foreach $key (keys %cleanreghash) {
	    if(!($currentreghash{$key})) {
		$gonereghash{$key} = $cleanfilehash{$key};
	    }
	}
	
	if((scalar(keys %gonefilehash) > 0) ||
	   (scalar(keys %newfilehash) > 0) ||
	   (scalar(keys %changedfilehash) > 0) ||
	   (scalar(keys %gonereghash) > 0) ||
	   (scalar(keys %newreghash) > 0) ||
	   (scalar(keys %changedreghash) > 0)) {
	    open CHANGES, ">$changefile" or die "Cannot open $changefile: $!\n";
	    
	    print CHANGES "Files deleted:\n";
	    foreach $key(keys %gonefilehash) {
		print CHANGES "$key\n";
	    }
	    print CHANGES "\n\n";
	    print CHANGES "Files added:\n";
	    foreach $key(keys %newfilehash) {
		print CHANGES "$key\n";
	    }
	    print CHANGES "\n\n";
	    print CHANGES "Files modified:\n";
	    foreach $key(keys %changedfilehash) {
		print CHANGES "$key\n";
	    }
	    print CHANGES "\n\n";
	    print CHANGES "Registry entries deleted:\n";
	    foreach $key(keys %gonereghash) {
		print CHANGES "$key -> $gonereghash{$key}\n";
	    }
	    print CHANGES "\n\n";
	    print CHANGES "Registry entries added:\n";
	    foreach $key(keys %newreghash) {
		print CHANGES "$key -> $newreghash{$key}\n";
	    }
	    print CHANGES "\n\n";
	    print CHANGES "Registry entries modified:\n";
	    foreach $key(keys %changedreghash) {
		print CHANGES "$key :: Old -> $cleanreghash{$key} Now -> $currentreghash{$key}\n";
	    }
	    print CHANGES "\n\n";
	    close CHANGES;
	}
    }
}


sub watcher {
    if(-f $proxydonefile) {
	unlink $proxydonefile;	
	return(1);
    } else {
	return(0);
    }
}

sub wipe_cache {
    my $wipefile = $File::Find::name;
    if (-f $wipefile) {
	unlink $wipefile;
    }
}

sub integrityinit {
    integrityrun(1);
}

sub integritycheck {
   # my %recenthash = shift;

    integrityrun(0);
    if (-f $changefile) {
	print "Integrity file has changed, or you didn't delete a changefile from a previous run\nSee $changefile for a list of what integrity checks failed";
	return(1);
    } else {
	return(0);
    }
}

# visit is where IE is actually spawned. visit also makes sure that the
# same domain is not visited more than once. Internal links are parsed and
# resolved properly as 'INTERNAL'.

sub visit {
    my $baseurl = shift;

    print "Visiting $baseurl\n";

#    print "VISITED:\n";
#    foreach my $thing (keys %visited) {
#	print "$thing\n";
#    }
#    print "INTERNAL:\n";
#    foreach my $thing (keys %internals) {
#	print "$thing\n";
#    }
#    print "EXTERNAL:\n";
#    foreach my $thing (keys %externals) {
#	print "$thing\n";
#    }

    if ($baseurl =~ /(http:\/\/)?([A-Za-z0-9\.\-]+)(\/\S*)?/) {
	$domainname = $2;
	$filename = $3;
    }
    if (!$baseurl) {
	print ("Usage: driver.pl <url>");
    }

    open DOMAIN, ">$domainfile" or die "Cannot open $domainfile: $!\n";
    print DOMAIN "$domainname\n";
    close DOMAIN;

#    print "Visiting $filename with $iepath\n";

    my $iexplorejob = Win32::Job->new;
    sleep(1);
    if(($filename) && ($filename =~ /^\//)) {
	$iexplorejob->spawn(undef, "$iepath http://127.0.0.1$filename");
    } elsif ($filename) {
	$iexplorejob->spawn(undef, "$iepath http://127.0.0.1/$filename");
    } else {
	$iexplorejob->spawn(undef, "$iepath http://127.0.0.1/");
    }
print "bar\n";

    $iexplorejob->watch(\&watcher, 1);

#    print "Job returned\n";

    open INTERNAL, "$intfile" or die "Cannot open $intfile: $!\n";
    while(<INTERNAL>) {
	my $intline = $_;
	chomp $intline;
	if($intline =~ /^http:\/\//) {
	    
	} else {
	    $intline = $domainname . $intline;
	}
	my $lcint = lc($intline);
#	print "lcint: $lcint\n";
	if((!($visited{$lcint})) && (!($internals{$lcint}))) {
	    $internals{$lcint} = 1;
	}
    }
    close(INTERNAL);
    
    open EXTERNAL, "$extfile" or die "Cannot open $extfile: $!\n";
    while(<EXTERNAL>) {
	my $extline = $_;
	chomp $extline;
	my $lcext = lc($extline);
	if((!($visited{$lcext})) && (!($externals{$lcext}))) {
	    $externals{$lcext} = 1;
	}
    }
    close(EXTERNAL);
}

# This is the main program. It grabs the user URL input and checks if
# the '-r' option is part of that user input. '-r' means visit all internal
# links as well as external links until there are no more links to visit.
# This part of the script ends when integrity checks fail (file or registry
# modified), or when there are no more URLs to access from the external
# URL list.

&GetOptions(\%optctl, "r");

my $starturl = shift;
$internals{$starturl} = 1;

#call integrity baselining
#

print "Clearing cache\n";

find (\&wipe_cache, "$cachepath");

integrityinit();

while ($continue) {
    while(scalar(keys(%internals)) > 0) {
	foreach my $url (keys (%internals)) {
	    if(!($visited{$url})) {
		$visited{$url} = 1;
		$recent{$url} = 1;
		delete $internals{$url};
		visit($url);
	    }
	}
    }
    open VISITED, ">visited" or die "Cannot open visited: $!\n";
    foreach my $urls (keys %visited) {
	print VISITED $urls;
	print VISITED "\n";
    }
    close VISITED;
    open EXTERNALS, ">externalsfound" or die "Cannot open externalsfound: $!\n";
    foreach my $external (keys %externals) {
	print EXTERNALS "$external\n";
    }
    close EXTERNALS;

    if(integritycheck() != 0) {
	open RECENT, ">$recenturls" or die "Could not open $recenturls: $!\n";
	foreach my $url (keys %recent) {
	    print RECENT "$url\n";
	}
	close RECENT;
	print "Integrity check failed - See possible offending URLs in $recenturls\n";
	$continue = 0;	
    } else {
	print "Integrity check succeeded\n";
	%recent = ();
	if($optctl{"r"}) {
	    my @sites = keys(%externals);
	    my $newsite = shift (@sites);
	    if($newsite) {
		delete $externals{$newsite};
		$internals{$newsite} = 1;
		print "Clearing cache\n";
		find (\&wipe_cache, "$cachepath");
	    } else {
		$continue = 0;
	    }
	} else {
	    $continue = 0;
	}
    }
}