tripwire.pl

use strict;
use warnings;
use Any::Daemon;
use Digest::SHA1;
use Getopt::Long;
use Array::Utils qw(array_minus intersect);

my $dir=".";
my $check_freq=10; #number of seconds between checks.
my $username=$ENV{LOGNAME};
my $max_iterations=0; #max number of iterations, 0 means there is no maximum.
my $background=0; #flag to determine whether or not the daemon runs in the background.

GetOptions('d|dir=s'=>\$dir,
    'c|check_freq=i'=>\$check_freq,
    'u|username=s'=>\$username,
    'm|max_iterations=i'=>\$max_iterations,
    'b|background'=>\$background);

die "Check frequency must be positive" unless $check_freq>0;

die "No directory given" unless $dir;

die "The maximum number of iterations must be nonnegative" unless $max_iterations>=0;


my $daemon=Any::Daemon->new(user=>$username,workdir=>$dir);
$daemon->run(
    background=>$background,
    child_task=>\&check_dir,
    max_childs=>1,
    kill_childs=>sub{exit;}
    );

sub check_dir
{
    opendir(my $dh,$dir) or die $!;
    my @files=sort grep{(-f $_) and (-r $_)}readdir($dh);
    closedir($dh);

    unless(@files)
    {
        print "No readable files found in directory $dir.\n";
        exit 0;
    }

    my %data=();

    #file_data returns a hash ref of the form
    #{sha1=>$sha_digest,size=>$file_size}
    $data{$_}=file_data($_) foreach(@files);

    my $counter=1;

    while(1)
    {
        sleep $check_freq;

        opendir(my $dh,$dir) or die $!;
        my @updated_files=sort grep{(-f $_) and (-r $_)}readdir($dh);
        closedir($dh);

        my @deleted_files=array_minus(@files,@updated_files);

        foreach my $file(@deleted_files)
        {
            print "$file has been deleted or moved from directory $dir.\n\n";

            print "Was:\n";
            print "Size: " . $data{$file}->{size} . " bytes\n";
            print "SHA1: " . $data{$file}->{sha1} . "\n\n";
        }

        my %updated_data=();
        $updated_data{$_}=file_data($_) foreach (@updated_files);

        my @new_files=array_minus(@updated_files,@files);

        foreach my $file(@new_files)
        {
            print "New file: $file\n\n";
            print "Is now:\nSize: " . $updated_data{$file}->{size} . " bytes\n";
            print "SHA1: " . $updated_data{$file}->{sha1} . "\n\n";
        }

        my @intersection=intersect(@updated_files,@files);

        foreach my $file(@intersection)
        {
            unless(
                    ($data{$file}->{size} == $updated_data{$file}->{size})
                    and
                    ($data{$file}->{sha1} eq $updated_data{$file}->{sha1})
                )
            {
                print "$file changed.\n\n";
                print "Was:\n";
                print "Size: " . $data{$file}->{size} . " bytes\n";
                print "SHA1: " . $data{$file}->{sha1} . "\n\n";

                print "Is now:\n";
                print "Size: " . $updated_data{$file}->{size} . " bytes\n";
                print "SHA1: " . $updated_data{$file}->{sha1} . "\n\n";
            }
        }

        #updating old files and old data with new stuff
        @files=@updated_files;
        %data=%updated_data;

        if($max_iterations)
        {
            print "Iteration $counter complete.\n";
            if($counter==$max_iterations)
            {
                kill 'INT',getppid or die "Cannot signal " . getppid . " with SIGINT: $!";
                exit 0;
            }
            $counter++;
        }
    }


}

sub file_data
{
    my $file=shift;
    die "No argument given to file_data" unless defined $file;

    open(my $fh,"<",$file) or die $!;
    my $sha1=Digest::SHA1->new;
    $sha1->addfile($fh);
    my $digest=$sha1->hexdigest;
    close($fh);
    my $size = -s $file;
    return {sha1=>$digest,size=>$size};

}