#!/usr/bin/perl -w

#
# tar2d2: Testing of Archivers for Reference of Restored Disk Data
#   (a little helpful droid)
#
#   a tool to help evaluate the forensic footprints of archive programs
#   (like tar, star, zip, etc.).  tar2d2 runs the archiver (in extraction
#   mode) and gathers data on the files extracted.  This is useful in
#   conducting forensic evaluations of archive tools to test for artifacts
#   left by the programs under evaluation
#
#  usage: tar2d2 [-d level | --debug level] [-v | --verbose] 
#		 [-c configfile | --configifile] [--nocleanup]
#                testdirectory datafile
#
#    -d level      : turn on debugging, currently level = non-zero
#    -v verbose    : display mismaches between test and control groups
#    -c configfile : filename with configuration data in XML format
#                    if none is specified, it will be created as the
#                    file "config" if no such file currently exists
#    --nocleanup   : don't delete the directory containing extracted files
#
#    testdirectory : the directory in which to run the tests
#    datafile      : the file in which to store the resultant test data
#
#
#
# Note that this uses the XML::Simple packge available from CPAN
# Refer to documentation for data file format (stored in XML)
#
#
#
# Copyright 2004 Frank Adelstein.  All Rights Reserved.
#
# Permission to use, copy, modify, and distribute this
# software is hereby granted without fee, provided that
# the copyright notice and permission notice are not removed.
#


# packages we use
use Getopt::Long;
use Digest::MD5;
use XML::Simple;
use Cwd;
use File::Spec::Functions;
use File::Glob ':glob';


my %results;
my %std;
my $configptr;

my $timestr = localtime();
my $cwd = cwd();
my $keyname = "result";

##################
# global options #
##################
my $version = "1.0";
my $verbose = 0;
my $debug = 0;
my $nocleanup = 0;
my $configfile = "";
my $defaultconfigname = "config";

if (!GetOptions ("verbose"	=> \$verbose, 
		 "nocleanup"	=> \$nocleanup,
		 "debug=i"	=> \$debug,
		 "configfile=s"	=> \$configfile)) {
    usage();
    exit 0;
}

if ($configfile ne "") {
    # read in config file 
    $configptr = XMLin ($configfile);
} else {
    # default configuration if no config file specified
    $configptr = {
	          'extractionProg'	=> '/bin/tar',
		  'extractionFlags'	=> 'xf',
		  'archiveFile'	=> '/tmp/sans.tar',
		  'numberofTrials'	=> '1',
		  'stddir'		=> '/mnt/hack/forensic_challenge_mount',
	         };
    # create a config file if none was specified and the file doesn't exist
    if (! -e $defaultconfigname) {
	print "Creating config file named \"$defaultconfigname\"\n";
	writeXML($defaultconfigname, $configptr);
    }
}

# check for required arguments
if ($#ARGV != 1) {
    usage();
    exit (1);
}

my ($testdirectory, $datafile) = (shift, shift);


# build the command to execute
my $cmd = $configptr->{'extractionProg'} . " " . 
          $configptr->{'extractionFlags'} . " " .
          $configptr->{'archiveFile'};


##############################
# get the standard directory #
##############################
$std{$keyname} = {
    'basename'	=> ($configptr->{'stddir'}=~/^\//) ?
	$configptr->{'stddir'} :
	catfile ($cwd, 	$configptr->{'stddir'}),
    };

$std{$keyname}->{'numberoffiles'} = 
    gatherResults ($configptr->{'stddir'}, "", $std{$keyname}, 0);
writeXML($datafile . ".std", \%std);

for (my $i=0; $i < $configptr->{'numberofTrials'}; $i++) {

    # create a hash reference
    $results{$keyname} = { 
			 'rundate'	=> $timestr,
			 'command'	=> $cmd,
			 'name'		=> "PID $$, run $i",
			 'basename'	=> ($testdirectory=~/^\//) ?
					    $testdirectory :
					    catfile ($cwd, $testdirectory),
			 'preserved'	=> {},
			 'overwritten'	=> {},
			 };


    ###############################
    # check if directory is clean #
    ###############################
    die "directory $testdirectory is not clean" 
	unless isClean ($testdirectory);


    ###############
    # run program #
    ###############
    # set the current working directory for running the program
    chdir $testdirectory;
    runProg ($results{$keyname}, 
	     $configptr->{'extractionProg'}, 
	     $configptr->{'extractionFlags'}, 
	     $configptr->{'archiveFile'});

    # restore our previous directory
    chdir $cwd;


    ##################
    # gather results #
    ##################
    $results{$keyname}->{'numberoffiles'} = 
	gatherResults ($testdirectory, "", $results{$keyname}, 0);

    # optional debugging
    if ($debug) {
	printAll (\%results);
    }


    ####################################
    # compare data results to standard #
    ####################################
    compareFiles(\%results, \%std);

    ############################
    # save results to XML file #
    ############################
    writeXML($datafile, \%results);

    ############
    # clean up #
    ############
    cleanup ($testdirectory) unless $nocleanup;
}		# endif for ()

exit (0);

#
# usage () : print usage (error) message
#
sub usage {
    print "tar2d2 Version: $version\n";
    print "usage: $0 [options] directory datafile\n";
    print "    where directory is (empty) directory to use for file extraction\n";
    print "        datafile is filename to store results data (in XML)\n";
    print "    and options are:\n";
    print "        -v or --verbose : prints verbose output (shows matches)\n";
    print "        -d value or --debug=value : sets debugging to value (integer)\n";
    print "        -c filename or --configfile filename : specifies the config file name\n";
}

#
# clean up ( $dir )
#
# recursively delete all files starting from but not including $dir
#     $dir  :  file or directory to start recursive deletion
#
sub cleanup {

    my ($dir) = @_;
    # delete the contents of that directory
    if (-d $dir) {
      foreach (bsd_glob("$dir/*")) {
        cleanupR ($_);
      }
    }
    return;
}

#
# cleanupR ( $dir )
#
# recursively delete all files starting from but not including $dir
#     $dir  :  file or directory to start recursive deletion
sub cleanupR {

    my ($dir) = @_;
    # delete the contents of that directory
    if (-d $dir) {
      foreach (bsd_glob("$dir/*")) {
        cleanupR ($_);
      }
      rmdir $dir || warn "can't rmdir directory $dir";
    } else {
      unlink $dir || warn "can't unlink file $dir";
    }
    return;
}


#
# writeXML ( $file, $hashptr)
#
#    $file    : name of XML data file to write
#    $hashptr : pointer to hash to write out as XML
#
sub writeXML {

    my ($file, $hashptr) = @_;

    open (XML, ">", $file) || die "Can't open $file for write";
    my $xml = XMLout ($hashptr,
		      rootname => 'main', 
		      xmldecl => 1, 
		      noattr => 1);
    print XML $xml;
    close XML;
}

#
# gatherResults ( $base, $dir, $hasptr, $index )
#
#     $base    : base path of recursion, will not be put in file names
#     $dir     : current directory component, call with ""
#     $hashptr : pointer to hash to store data structure
#     $index   : index into <file> array, call with 0
#
# Note: returns number of files gathered on success but calls die() on error.
#

sub gatherResults {

    my ($basename, $dir, $hashptr, $i) = @_;

    if (!defined($hashptr->{'file'})) {
	# allocate a hash reference (that'll be filled in below)
	$hashptr->{'file'} = [];
    }

    opendir (DIR, catfile ($basename, $dir)) || 
	die "can't open directory $dir";
    foreach (readdir DIR) {
	# skip the . and .. directory entries
	next if ($_ eq "." || $_ eq "..");

	# process the extracted file
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks) = 
		stat (catfile ($basename, $dir, $_ ) );

	# save the data for the file
	$hashptr->{'file'}->[$i] = {
	    # note: we only save the relative path, 
	    # basename saved elsewhere
	    'name'	=> catfile ($dir, $_),
	    'dev'	=> $dev,
	    'ino'	=> $ino,
	    'mode'	=> $mode,
	    'nlink'	=> $nlink,
	    'uid'	=> $uid,
	    'gid'	=> $gid,
	    'rdev'	=> $rdev,
	    'size'	=> $size,
	    'atime'	=> $atime,
	    'mtime'	=> $mtime,
	    'ctime'	=> $ctime,
	    'blksize'	=> $blksize,
	    'blocks'	=> $blocks,
	    'MD5'	=> MD5hash(catfile ($basename, $dir, $_))
	    };
	$i++;

	if (-d catfile($basename, $dir, $_)) {
	    # if this is a directory, recursively call gatherResults()
	    $i = gatherResults ($basename, catfile ($dir, $_), $hashptr, $i);
	}

    }
    closedir DIR;
    return $i;
}

#
# MD5hash (file) 
# 
#   file : file name to compute hash
# returns: MD5 hash (as a 32 character hex string) 
#          or 0 if $file is a directory
#
sub MD5hash {

    my ($file) = @_;

    if (-d $file) {
	return 0;
    }
    open (FILE, "<", $file) || die "can't read in file $file for MD5hash";
    binmode (FILE);
    my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
    close FILE;
    return $md5;
}


#
# runProg ( )
#
sub runProg {

    # FIXME!!! we need to trap STDOUT and STDERR
    my ($hashref, $c1, $c2, $c3) = @_;
    my ($start, $stop, $rc);

    $start = time;
    system ($c1, $c2, $c3);
    $rc = $? >> 8;
    $stop = time;

    if ($rc ne 0) { 
	print "warning: return code for command was $rc!\n";
    }

    $hashref->{'start'} = $start;
    $hashref->{'stop'} = $stop;
    $hashref->{'rc'} = $rc;

}


#
# isClean ( $dir )
#
#  checks if $dir is clean (empty and is a directory) 
#  returns true if clean, 0 otherwise.
#
sub isClean {

    my ($testdir) = @_;

    # do some checks on the test directory
    if (-e $testdir ) {
	# it exists
	if (! -d $testdir) {
	    # not a directory
	    print "error: $testdir must be a directory\n";
	    return 0;
	} elsif (!isEmptyDir($testdirectory)) {
	    # directory, but not empty
	    print "error: $testdir must be empty\n";
	    return 0;
	}
    } else {
	print "$testdir must exist\n";
	return 0;
    }
    return 1;
}

#
# compareFiles ($dataptr, $stdptr)
#
#    $dataptr  : pointer to hash structure containing data from experiment
#    $stdptr   : pointer to hash structure containing control data
#
# compare the results in the data against the control group
# Iterate through the files in the data structures and compare
# the results in one data structure with the other
#
#
sub compareFiles {

    my ($dataptr, $stdptr) = @_;
    my ($k, $k1, $i, $a);
    my %preserved;
    my %overwritten;
    my %fileptr;

    foreach $k (keys %$dataptr) {
	# testruns.XX
	my $href = $dataptr->{$k};
	foreach $k1 (keys %$href ) {
	    # properties
	    if ($k1 eq "file") {
		# file tag
		for ($i = 0; $i <= $#{$dataptr->{$k}->{$k1}}; $i++) {
		    # file name
		    # get the file in the control group
		    $fileptr = findFile ($dataptr->{$k}->{$k1}->[$i]->{'name'}, $stdptr);
		    if ($fileptr == 0) {
			print "file $dataptr->{$k}->{$k1}->[$i]->{'name'} not found in control!\n";
			next;
		    }

		    foreach $a (keys %{$dataptr->{$k}->{$k1}->[$i]}) {
			# stat value for data
			my $adata = $dataptr->{$k}->{$k1}->[$i]->{$a};
			# stat value for control
			my $astd = $fileptr->{$a};
			if ($adata eq $astd) {
			    # value is preserved
			    $dataptr->{$k}->{'preserved'}->{$a}++;
			} else {
			    # value is overwritten
			    $dataptr->{$k}->{'overwritten'}{$a}++;
			    if ($verbose) {
				print "$dataptr->{$k}->{$k1}->[$i]->{'name'}: $a: $adata != $astd\n";
			    }		# endif ($verbose)
			}		# endif ($adata eq $astd)
		    }			# end foreach $a
		}			# end for (i)
	    }				# endif ($k1 eq 'file')
	}				# end foreach $k1
    }					# end foreah $k
}					# end sub compareFiles

#
# findFile ( $name, $ptr )
#
#       $name   :  name of file to find
#       $ptr    :  pointer to hash to search for file (control hash)
#
#   returns a pointer to the hash entry for the file (<file>)
#           or 0 if not found
#
sub findFile {
    my ($name, $hashptr) = @_;
    my $i;
    for ($i = 0; $i <= $#{$hashptr->{'result'}->{'file'}}; $i++) {
	# look through all the file names
	if ($hashptr->{'result'}->{'file'}->[$i]->{'name'} eq $name) {
	    return $hashptr->{'result'}->{'file'}->[$i];
	}
    }
    print "$name not found!!\n";
    return 0;
}

#
# printAll ($hashptr)
#
#    $hashptr  : pointer to hash structure containing data
#
# print the data structure (mostly used for debugging)
#
sub printAll {

    my ($results) = @_;
    my ($k, $k1, $i, $a);

    foreach $k (keys %$results) {
	# testruns.XX
	my $href = $results->{$k};
	foreach $k1 (keys %$href ) {
	    # properties
	    if ($k1 eq "file") {
		# file tag
		for ($i = 0; $i < $#{$results->{$k}->{$k1}}; $i++) {
		    # file name
		    foreach $a (keys %{$results->{$k}->{$k1}->[$i]}) {
			# stat information
			print "results->{$k}->{$k1}->[$i]->{$a} = $results->{$k}->{$k1}->[$i]->{$a}\n";
		    }
		}
	    } else {
		print "result->{$k}->{$k1} = $results->{$k}->{$k1} \n";
	    }
	}
    }
}



#
# isEmptyDir ($dir) 
#
# subroutine to check if a directory ($dir) is empty
# returns 1 if empty, 0 if not empty
#
sub isEmptyDir {

    my ($dir) = @_;

    opendir (DIR, $dir) || die "can't open directory $dir";
    foreach (readdir DIR) {
	# skip the . and .. directory entries
	next if ($_ eq "." || $_ eq "..");
	# the directory is not empty if we get here
	closedir DIR;
	return 0;
    }
    closedir DIR;
    return 1;
}