#!/usr/bin/perl

use 5.12.3;

use strict;

use warnings;

use Cwd qw(abs_path cwd);

use Digest::MD5 qw(md5_hex);

use IO::Handle qw(autoflush);

use File::Basename qw(basename dirname);

#use File::Slurp qw(read_file);

use diagnostics;

use threads qw(yield);

use threads::shared;

use Thread::Queue;

use Thread::Semaphore;

#use Fcntl qw(:flock);

use POSIX qw(SIGINT);

use POSIX qw(ceil);

chomp(my $cores = `grep -c ^processor /proc/cpuinfo`);

my (@lib, $mode);

# Path to and name of log file to be used for logging.

my $logf = "$ENV{HOME}/md5db.log";

# Delimiter used for database

my $delim = "\t\*\t";

# Array for storing the actual arguments used by the script internally.

# Might be useful for debugging.

my @cmd = (basename($0));

# Name of database file.

my $db = 'md5.db';

# Clear screen command.

my $clear = `clear && echo`;

# Creating a hash that will store the names of files that are

# too big to fit into RAM. We'll process them last.

# Creating a few shared variables.

# %err will be used for errors

# $n will be used to count the number of files processed

# %md5h is the database hash

my %err :shared;

my $n :shared = 0;

my %md5h :shared;

my %file_contents :shared;

my $stopping :shared = 0;

my $file_stack :shared = 0;

my $busy :shared = 0;

# This will be used to control access to the logger subroutine.

my $semaphore = Thread::Semaphore->new();

POSIX::sigaction(SIGINT, POSIX::SigAction->new(\&handler))

|| die "Error setting SIGINT handler: $!\n";

# Creating a custom POSIX signal handler.

# First we create a shared variable that will work as a SIGINT switch.

# Then we define the handler subroutine.

# If ^C is pressed for the first time,

# trip the switch and let the current threads finish.

# If ^C is pressed a second time, quit directly.

# Each subroutine to be used for starting threads will have to

# take notice of the state of the $saw_sigint variable.

my $saw_sigint :shared = 0;

sub handler {

	if ($saw_sigint == 1) {

		logger('int', $n);

		hash2file();

		exit;

	} else { $saw_sigint = 1; }

}

# Open file handle for the log file

open(my $LOG, '>>', $logf) or die "Can't open '$logf': $!";

# Make the $LOG file handle unbuffered for instant logging.

$LOG->autoflush(1);

# Duplicate STDERR as a regular file handle

open(my $SE, ">&STDERR") or die "Can't duplicate STDERR: $!";

### Subroutine for printing usage instructions

sub usage {

	my $s = basename($0);

	say <<"HELP"

Usage: $s [options] [directory 1] .. [directory N]

	-help Print this help message.

	-import Import MD5 sums to the database from already existing

	\*.MD5 files in each directory.

	-index Index new files in each directory.

	-test Test the MD5 sums of the files in the database to see if

	they've changed.

HELP

}

# This loop goes through the argument list as passed to the script

# by the user when ran.

foreach my $arg (@ARGV) {

	# If argument starts with a dash '-', interprete it as an option

	if ($arg =~ /^-/) {

		given ($arg) {

			# When '-import', set script mode to 'import', and call

			# the md5import subroutine later.

			when (/^-import$/) {

				if (!$mode) { push(@cmd, $arg); $mode = 'import'; }

			}

			# When '-help', set script mode to 'help', and print

			# usage instructions later.

			when (/^-help$/) {

				if (!$mode) { push(@cmd, $arg); $mode = 'help'; }

			}

			# When '-index', set script mode to 'index', and call

			# the md5index subroutine later.

			when (/^-index$/) {

				if (!$mode) { push(@cmd, $arg); $mode = 'index'; }

			}

			# When '-test', set the script mode to 'test', and call

			# the md5test subroutine later.

			when (/^-test$/) {

				if (!$mode) { push(@cmd, $arg); $mode = 'test'; }

			}

		}

	# If argument is a directory, include it in the @lib array

	} elsif (-d $arg) { push(@lib, $arg); push(@cmd, $arg); }

}

# If no switches were used, print usage instructions

	{ usage; exit; }

#say "@cmd\n";

# Subroutine for controlling the log file

# Applying a semaphore so multiple threads won't try to

# access it at once, just in case ;-)

sub logger {

	$semaphore->down();

	my($arg, $sw, @fn, $n);

	# Creating a variable to hold the current time.

	my $now = localtime(time);

	# Array of accepted switches to this subroutine

	my @larg = qw{start int gone corr diff end};

	# Loop through all the arguments passed to this subroutine

	# Perform checks that decide which variable the arguments are to

	# be assigned to.

	CHECK: while (@_) {

			$arg = shift(@_);

			# If $arg is a switch, set the $sw variable and start

			# the next iteration of the CHECK loop.

			foreach (@larg) {

				if ($_ eq $arg) { $sw = $arg; next CHECK; }

			}

			# If $arg is a number assign it to $n, if it's a file

			# add it to @fn.

			if ($arg =~ /^[0-9]*$/) { $n = $arg; }

			else { push(@fn, $arg); }

	}

	given ($sw) {

		# Starts writing the log.

		when ('start') {

			say $LOG "\n**** Logging started on $now ****\n";

			say $LOG "Running script in '$mode' mode.\n";

		}

		# When the script is interrupted by user pressing ^C,

		# say so in STDOUT, close the log.

		when ('int') {

			say "\nInterrupted by user!\n";

			say $LOG $n . " file(s) were tested.";

			say $LOG "\n**** Logging ended on $now ****\n";

			close $LOG or die "Can't close '$LOG': $!";

		}

		# Called when file has been deleted or moved.

		when ('gone') {

			say $LOG $fn[0] . "\n\t" . "has been (re)moved.\n";

			$err{$fn[0]} = "has been (re)moved.\n";

		}

		# Called when file has been corrupted.

		when ('corr') {

			say $LOG $fn[0] . "\n\t" .

			"has been corrupted.\n";

			$err{$fn[0]} = "has been corrupted.\n";

		}

		when ('diff') {

			say $LOG $fn[0] . "\n\t" .

				"doesn't match the hash in database.\n";

			$err{$fn[0]} = "doesn't match the hash in database.\n";

		}

		# Called when done, and to close the log.

		# If no errors occurred write "Everything is OK!" to the log.

		# If errors occurred print the %err hash.

		# Either way, print number of files processed.

		when ('end') {

			if (!%err) {

				say $LOG "\nEverything is OK!\n";

			} else {

				say "\n**** Errors Occurred ****\n";

				foreach my $fn (sort keys %err) {

					say $SE $fn . "\n\t" . $err{$fn};

				}

			}

			say $LOG $n . " file(s) were tested.\n" if ($n);

			say $LOG "\n**** Logging ended on $now ****\n";

			close $LOG or die "Can't close '$LOG': $!";

		}

	}

	$semaphore->up();

}

# Subroutine for reading a database file into the database hash.

# This is the first subroutine that will be executed and all others

# depend upon it, cause without it we don't have a

# database hash to work with.

sub file2hash {

	# The format string which is used for parsing the database file

	my $format = qr/^.*\t\*\t[[:alnum:]]{32}$/;

	my (@dbfile, @gone);

	# Open the database file and read it into the @dbfile variable

	open(MD5DB, '<', $db) or die "Can't open '$db': $!";

	chomp (@dbfile = (<MD5DB>));

	close(MD5DB) or die "Can't close '$db': $!";

	# Loop through all the lines in the database file and split

	# them before storing in the database hash.

	# Also, print each line to STDOUT for debug purposes

	foreach my $line (@dbfile) {

		# If current line matches the proper database file format,

		# continue.

		if ($line =~ /$format/) {

			my ($fn, $hash) = (split(/\Q$delim/, $line));

			# If $fn is a real file and not already in the hash,

			# continue.

			if (-f $fn && ! $md5h{$fn}) {

					$md5h{$fn} = $hash;

					say "$fn". "$delim" . "$hash";

			# Saves the names of deleted or moved files in '@gone'

			# for printing at the end of this subroutine.

			} else { push(@gone, $fn); }

		}

	}

	# Clears the screen, thereby scrolling past the database file print

	print $clear;

	# Loops through the @gone array and logs every file name

	# that's been deleted or moved.

	foreach my $fn (@gone) { logger('gone', $fn); }

}

# Subroutine for printing the database hash to the database file

sub hash2file {

	open(MD5DB, '>', "$db") or die "Can't open '$db': $!";

	# Loops through all the keys in the database hash and prints

	# the entries (divided by the $delim variable) to the database file.

	foreach my $k (sort keys %md5h) {

		say MD5DB $k . $delim . $md5h{$k};

	}

	close(MD5DB) or die "Can't close '$db': $!";

}

# Subroutine for finding files

# Finds all the files inside the directory name passed to it,

# and sorts the output before storing it in the @files array.

sub getfiles {

	my $dn = shift;

	my @files;

	open(FIND, '-|', qq(find -L "$dn" -type f -name "*"))

	or die "Can\'t run 'find': $!";

	while (my $fn = (<FIND>)) {

			chomp($fn);

			$fn =~ s($dn/)();

			push(@files, $fn) if (-f $fn && $fn ne basename($db));

	}

	close(FIND) or die "Can't close 'find': $!";

	return @files;

}

			}

		}

	}