# 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;
}
}
}