#!/usr/bin/perl
# vim:ts=4:sw=4:si:fdm=marker:tw=100:ruler
#
# Note to vim newbies: this file uses vim folds. Type 'zR' in command mode to open all folds, or use
# :help folds or :help zo for more info.
#
# finddup.pl version 0.2.0 - DOCUMENTATION {{{
#
# Written by Roy Sigurd Karlsbakk <roy@karlsbakk.net>
# Licensed under GPLv2 - http://www.gnu.org/licenses/gpl-2.0.html
#
# In init mode, traverse through a directory, default "." and build an SQLite
# database of SHA256 and MD5 hashes for all files. Later, in check mode, scan
# through the SQLite database and report duplicate files. Since both hashes are
# checked, the chance of hash collisions should be minimal (e.g. zero).
#
# Usage:
# 
# First create the database with the hashes:
#
# ./finddup.pl --init [ --datapath /path/to/somewhere ]
#
# After that, check for duplicates:
#
# ./finddup.pl --show-duplicates [ --datapath /path/to/somewhere ]
#
# If path isn't given, default to current directory (.)
#
# CHANGELOG
#
# 0.0.1:
#   - Initial release
#
# 0.0.2:
#   - Initial usable release
#
# 0.0.3:
#   - Ignore non-readable files (skip them if md5_sum fails).
#
# 0.0.4:
#   - Skip non-ordniary files like devices, pipes etc
#
# 0.0.5:
#   - Don't follow symlinks unless --follow-symlinks or -F is given
#
# 0.0.6:
#   - Fix database initialization
#   - Add max and min size for both init and report
#
# 0.1.0:
#   - Fix: Don't report hardlinks as matches
#   - Fix: Don't checksum empty files
# 	- Feature: Add threading for supported OSes and files over a given limit (1MB standard).
#   - Feature: Add updating the index with --update, only updating the hashes for files that have a changed
#     mtime since last scan. This also adds new files.
#
# 0.1.1:
#   - Fix: Allow bundled arguments
#   - Feature: Add --cleanup to remove old files from index
#
# 0.1.2:
#   - Fix: A bunch
#
# 0.1.3:
#   - Feature: Added --hardlink-duplicates (unstable)
#   - Bug: --update can't handle hardlinks yet
#
# 0.1.4:
#   - Moved cleanup to updated - added notice for explicit cleanup, and removed cleanup from the
#     help page. Thanks to Håkon Struijk Holmen <haakonsh@gmail.com for feedback.
#
# 0.2.0>
#   - Fixed --path support for handle_duplicates so that filtering on path with --show-duplicates
#     works.
#
# TODO
#
# - Rewrite to relative paths, being compatible with crossmounting
# - Allow for reuse of database files found in subdirectories traversed.
# - Allow for other database backends - SQLite might be a bit light for larger setups
# - Update must take inode into account after --hardlink-duplicates
#
# Roy Sigurd Karlsbakk <roy@karlsbakk.net>
#
# }}}
# Libs and such {{{

use strict;
use warnings;
use Digest::MD5;
use Digest::SHA;
use DBI;
use Getopt::Long;
use Cwd;
# for profiling
use Time::HiRes qw/ time sleep /;
use File::Spec;
use threads ('yield',
			 'stack_size' => 64*4096,
			 'exit' => 'threads_only',
			 'stringify');

# }}}
# Globals and settings {{{

# Definitions
my $VERSION = "0.1.2";

# Globals
my ($dbh,$sth,$sql);
my $initiated_database = 0;
my $verbose = 0;
my $init = 0;
my $update = 0;
my $update_inodes = 0;
my $cleanup = 0;
my $show_duplicates = 0;
my $hardlink_duplicates = 0;
my $csv = 0;
my $quiet = 0;
my $version = 0;
my $profile_time = 0;
my %profile_points = (
);

# Settings
my $sqlitedb_old = 'finddup.db';
my $sqlitedb = $ENV{"HOME"} . '/.finddup.db';
my $min_fsize_for_thread = 1024**2;
my $data_path = getcwd();
my $help = 0;
my $unstable = 0;
my $follow_symlinks = 0;
my $no_recalc = 0;
my $min_size = undef;
my $max_size = undef;
my $xdev = 0;
my $verify = 0;
my $force = 0;
my $debug = 0;
my $no_cleanup = 0;
my @exclude = ();
my @use_hashes = ('md5','sha256');
my ($md5_thread,$sha256_thread);
my %os_supporting_threads = (
	linux => 1,
);
# Which hashes do we support?
my %goodstuff = (
	md4 => 0,
	md5 => 1,
	sha1 => 0,
	sha224 => 1,
	sha256 => 1,
	sha384 => 1,
	sha512 => 1,
);

# Don't buffer stdout # why not?
$|++;

# }}}
# sub profile_point([name]) - add time to a given profiling point sub profile_point(name) {{{

sub profile_point {
	my $name = shift;
	my $current_time = time;
	my $diff = $current_time-$profile_time;
	$profile_time = $current_time;

	return if($diff == $current_time);
	return unless defined($name);

	if(!defined($profile_points{$name})){
		$profile_points{$name} = 0;
	}
	$profile_points{$name} = $profile_points{$name}+$diff;
}

# }}}
# sub profiling_print {{{

sub profiling_print {
	my $key;
	my $value;
	print "Profiling output:\n";
	while(($key, $value) = each(%profile_points)){
		print "$key used $value seconds\n";
	}
}

# }}}
# sub calc_numeric() - Calculate numeric with [kMGT] {{{

sub calc_numeric {
	my $num = shift;
	return undef unless(defined($num));

	if ($num =~ m/(\d+)([kmgt])?/i) {
		my $n = $1;
		my $e = $2;
		if (lc($e) eq "k") {
			return $n * 1024;
		} elsif (lc($e) eq "m") {
			return $n * 1024**2;
		} elsif (lc($e) eq "g") {
			return $n * 1024**3;
		} elsif (lc($e) eq "t") {
			return $n * 1024**4;
		} else {
			return $n;
		}
	}
}

# }}}
# sub cleanup() {{{
#
# Syntax: cleanup(path);
# path being the path to start recursing
#
# Recursively scan through a directory and remove files not found there
sub cleanup {
	my $dh;
	my $path = shift;
	my $count=0;
	my $sql = "SELECT filename FROM hashes";
	$sth = $dbh->prepare($sql);
	$sth->execute or die "Can't execute query: $sql\n";
	while ((my $fname) = $sth->fetchrow) {
		my $sqlfname = $fname;
		$sqlfname =~ s/\'/\'\'/gsm;
		$count++;
		unless ( -e $fname) {
			print "REMOVE $fname\n" if ($verbose); 
			my $sql2 = "DELETE FROM hashes WHERE filename = '$sqlfname'";
			my $sth2 = $dbh->prepare($sql2) or warn "Can't prepare query: $sql2\n";
			$sth2->execute or warn "Can't execute query: $sql2\n";
		}
	}
}

# }}}
# sub datefromctime() - Get date from ctime {{{

	sub datefromctime {
		my $ctime = shift || die "need filename";
		my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
		$year += 1900;
		return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);
	}

# }}}
# sub db_init() - Initialize database {{{

	sub db_init {
		# Drop old table
		$sql = "DROP TABLE IF EXISTS hashes";
		$sth = $dbh->prepare($sql);
		$sth->execute() or die 'wtf?';

		# Create a new one
		$sql = "CREATE TABLE hashes(
				filename varchar(500) NOT NULL UNIQUE,
				inode integer,
				size integer,
				mtime integer,
				dev integer,
				md5 varchar(32),
				sha256 varchar(64))";
		$sth = $dbh->prepare($sql);
		unless ($sth->execute()) {
			print_sql($sql);
			die 'wtf?';
		}
	}

# }}}
# sub handle_duplicates() - Handle duplicated files {{{

sub handle_duplicates {
	my @hashes;
	my $count=0;
	my $waste=0;
	my $mode = shift;
	my $path = shift;

	#print "DEBUG: handle_duplicates($mode,\"$path\")\n" if ($debug);
	#$path = File::Spec->rel2abs($path) ;

	print "DEBUG: handle_duplicates($mode,\"$path\")\n" if ($debug);

	die "Smells like fish - fix the code!"
		unless ($mode eq "show" or $mode eq "hardlink" or $mode eq "csv");

	$sql = "SELECT md5,sha256
			FROM hashes
			GROUP BY md5,sha256
			HAVING COUNT(sha256) > 1
			AND COUNT(md5) > 1";
	$sql .= " AND size < $max_size" if (defined($max_size));
	$sql .= " AND size > $min_size" if (defined($min_size));
	$sql .= " AND filename like '$path%'" if (defined($path));

	print "DEBUG: SQL[1] = $sql\n" if ($debug);
	$sth = $dbh->prepare($sql);
	$sth->execute or die "Can't execute query: $sql\n";
	while (my ($md5,$sha256) = $sth->fetchrow) {
		$hashes[$count]{'md5'} = $md5;
		$hashes[$count]{'sha256'} = $sha256;
		$count++;
	}
	$count=0; # for newshow
	print "entrynum;filesize;filename\n" if ($mode eq "csv");
	foreach my $h (@hashes) {
		$sql = "SELECT filename,size,inode
				FROM hashes
				WHERE md5 = '" . $h->{'md5'} . "'
				AND sha256 = '" . $h->{'sha256'} . "'
				GROUP BY inode
				ORDER BY filename";
		print "DEBUG: SQL[2] = $sql\n" if ($debug);
		$sth = $dbh->prepare($sql);
		$sth->execute or die "Can't execute query: $sql\n";

		if ($mode eq "show") {
			my ($filename,$size,$inode) = $sth->fetchrow;
			my $s = "$filename matches: \n" unless ($quiet);
			while (my ($filename2,$size2) = $sth->fetchrow) {
				$s .= " \\- " . $filename2 . "\n" unless ($quiet);
				$waste += $size2;
				print "WASTE $size2 (" . human_readable($size2) . "B)\n" if ($verbose);
			}
			print "$s\n" unless ($quiet);
		} elsif ($mode eq "csv") {
			my ($filename,$size,$inode) = $sth->fetchrow;
			printf("%d;%d;%s\n",$count,$size,$filename);
			while (my ($filename2,$size2) = $sth->fetchrow) {
				$waste += $size2;
				printf("%d;%d;%s\n",$count,$size2,$filename2);
			}
			$count++;
		} elsif ($mode eq "hardlink") {
			my ($filename,$size,$inode) = $sth->fetchrow;
			while (my ($filename2) = $sth->fetchrow) {
				if (-e $filename2) {
					unless ($force) {
						warn "Won't replace existing file $filename2 without --force\n";
						next;
					} else {
						unless (unlink ($filename2)) {
							warn "Can't unlink(\"$filename2\"): $!\n";
							next;
						}
					}
				}
				link($filename,$filename2);
				print "LINK  $filename2\n" if ($verbose);
				my $sql2 = "UPDATE hashes
							SET inode = $inode
							WHERE filename = '$filename2'";
				$dbh->do($sql) || warn "erm...";
			}
		} else {
			die "FISHY!";
		}
	}
	my $hwaste = human_readable($waste);
	print "Total space wasted: " . $hwaste . "B ($waste bytes)\n" if ($mode eq "show" or ($mode eq "csv" and $verbose));
}

# }}}
# sub hash_file() - Create hash of a file {{{

	sub hash_file {
		my $file = shift || die "need filename";
		my $hash = shift || die "need pot!";
		my $digest;

		die "Unsupported hash: $hash\n" unless ($goodstuff{$hash});

		unless (open(F, $file)) {
			print STDERR "Can't open '$file' for reading: $!\n";
			return undef;
		}
		binmode(F);

		if ($hash eq "md5") {
			$digest = Digest::MD5->new;
		} elsif ($hash eq "sha224") {
			$digest = Digest::SHA->new(256);
		} elsif ($hash eq "sha256") {
			$digest = Digest::SHA->new(256);
		} elsif ($hash eq "sha384") {
			$digest = Digest::SHA->new(384);
		} elsif ($hash eq "sha512") {
			$digest = Digest::SHA->new(512);
		} else {
			die "Need more hash!\n";
		}
		$digest->addfile(*F);
		close(F);

		return $digest->b64digest;
	}

# }}}
# sub human_readable() {{{

	sub human_readable {
		my $num = shift;
		return $num unless(is_numeric($num));
		return sprintf("%dk", round($num/1024**1)) if ($num < 1024**2);
		return sprintf("%dM", round($num/1024**2)) if ($num < 1024**3);
		return sprintf("%dG", round($num/1024**3)) if ($num < 1024**4);
		return sprintf("%dT", round($num/1024**4)) if ($num < 1024**5);
		return sprintf("%dP", round($num/1024**5)) if ($num < 1024**6);
		return sprintf("%dE", round($num/1024**6)) if ($num < 1024**7);
		return sprintf("%dZ", round($num/1024**7)) if ($num < 1024**8);
		return sprintf("%dE", round($num/1024**8)) if ($num < 1024**9);
		return $num;
	}

# }}}
# sub is_numeric() {{{
	sub is_numeric {
		my $s = shift;
		return ($s =~ /^\d+$/);
	}

# }}}
# sub print_sql() {{{

	sub print_sql {
		my $sql = shift;
		$sql =~ s/\s+/ /gmi;
		print "SQL = $sql\n";
	}

# }}}
# sub recursively_read_dir() {{{
#
# Syntax: recursedir(path, mode, rescan_inodes);
# path being the path to start recursing, mode being either 'init' or 'update'
#
# Recursively scan through a directory. If md5_file didn't succeed, skip and
# ingore the file. md5_file() will print a warning.
sub recursively_read_dir {
	my $dh;
	my $path = shift;
	my $mode = shift;
	my $rescan_inodes = shift;
	die "Need mode!\n" unless (defined($mode));

# Sanity check and init_db if needed
	if ($mode eq "init") {
		unless ($initiated_database) {
			$initiated_database=1;
			&db_init;
		}
	} elsif ($mode eq "update") {
	} else {
		die "Invalid mode '$mode'\n"
	}

# Check for excludes
# FIXME - seems this uses a global @exclude
	my $matches = 0;
	foreach my $ex (@exclude) {
		$matches++ if ($path =~ $ex);
	}
	return if ($matches);

# Open and read directory
	unless (opendir($dh, $path)) {
		print STDERR "can't opendir $data_path: $!";
		return;
	}
	my @dnames = sort readdir($dh);
	closedir $dh;

# Traverse it
	foreach my $dname (@dnames) {
		next if ($dname eq '.' or $dname eq '..');
		my $fname = "$path/$dname";

		if (!$follow_symlinks and -l "$fname") {
			print "SYMLINK $fname\n" if ($verbose);
		} elsif ( -d "$fname") {
			&recursively_read_dir("$fname", $mode);
		} elsif (-f "$fname" && ! -z "$fname" ) {
			my @fstat = stat($fname);
			my $dev = $fstat[0];
			my $inode = $fstat[1];
			my $fsize = $fstat[7];
			my $mtime = $fstat[9];
			if (defined($min_size) and $fsize < $min_size) {
				print "SKIP    $fname (< min size)\n" if ($verbose); 
			} elsif (defined($max_size) and $fsize > $max_size) {
				print "SKIP    $fname (> max size)\n" if ($verbose); 
				next;
			} else {
				if ($mode eq "init") {
					print "ADD     $fname" if ($verbose); 
					my ($md5,$sha256);
					# Don't create a new thread if the file is small. Perl threading is slow, so
					# better not use it for tiny stuff...
					profile_point("rest") if($verbose);
					if (use_threads($fsize)) {
						$md5_thread = threads->create(\&hash_file, $fname, "md5");
						$sha256_thread = threads->create(\&hash_file, $fname, "sha256");
						($md5) = $md5_thread->join();
						($sha256) = $sha256_thread->join();
					} else {
						$md5 = hash_file($fname, "md5");
						$sha256 = hash_file($fname, "sha256");
					}
					profile_point("hash") if($verbose);
					my $sqlfname = "$fname";
					$sqlfname =~ s/\'/\'\'/g;
					$sql = "INSERT INTO hashes(filename, inode, size, mtime, dev, md5, sha256)
							VALUES ('$sqlfname', '$inode', '$fsize', '$mtime', '$dev', '$md5', '$sha256')";
					$sth = $dbh->prepare($sql);
					$sth->execute or die "Can't execute query: $sql\n";
					print "\n" if ($verbose); 
					profile_point("sql") if($verbose);
				} elsif ($mode eq "update") {
					my $sqlfname = $fname;
					$sqlfname =~ s/\'/\'\'/gsm;
					$sql = "SELECT mtime FROM hashes WHERE filename = '$sqlfname' AND inode = '$inode' AND dev = '$dev'";
					$sth = $dbh->prepare($sql) or die "Can't prepare query: $sql\n";
					$sth->execute or die "Can't execute query: $sql\n";
					my $stored_mtime = undef;
					if (($stored_mtime) = $sth->fetchrow) {
						if ($stored_mtime == $mtime) {
							print "SKIP    $fname\n"  if ($verbose > 1); 
							next;
						}
					}
					print "UPDATE  $fname" if ($verbose); 
					my ($md5,$sha256);
					if (use_threads($fsize)) {
						$md5_thread = threads->create(\&hash_file, $fname, "md5");
						$sha256_thread = threads->create(\&hash_file, $fname, "sha256");
						($md5) = $md5_thread->join();
						($sha256) = $sha256_thread->join();
					} else {
						$md5 = hash_file($fname, "md5");
						$sha256 = hash_file($fname, "sha256");
					}
					$sqlfname = "$fname";
					$sqlfname =~ s/\'/\'\'/g;
# CREATE TABLE hashes(filename varchar(500) not null, inode integer, size integer, mtime integer, dev integer, md5 varchar(32), sha256 varchar(64))
					$sql = "REPLACE INTO hashes(filename, inode, size, mtime, dev, md5, sha256)
							VALUES ('$sqlfname', '$inode', '$fsize', '$mtime', '$dev', '$md5', '$sha256')";
					$sth = $dbh->prepare($sql);
					$sth->execute or die "Can't execute query: $sql\n";
					print "\n" if ($verbose); 
				} else {
					die "wtf? I shouldn't have reached here - mode = $mode";
				}
			}
		} else {
			print "SKIP   $fname\n" if ($verbose);
		}
	}
}

# }}}
# sub round() {{{

	sub round {
		my $num = shift;
		return sprintf("%d", $num+0.5);
	}
# }}}
# sub stripspaces() {{{

sub stripspaces {
	my $s = shift;
	return undef unless (defined($s));
	$s =~ s/\s+/ /gm;
	return $s;
}

# }}}
# sub syntax() - Show program syntax {{{

sub syntax {
	my $cause = shift;
	$cause = "something strange" unless (defined($cause));
	my $syntaxline = "";
	$syntaxline = "SYNTAX: $cause" unless ($cause eq "HELP!");
	print <<EOTEXT;
$0 < -I | -S | -C | -S | -H > [ optional parameters ]
$syntaxline
Mode parameters:
    --init -I                 Initialize the database - for first time run
    --update -U               Remove missing files from the database and update the hashes for
                              changed files.
    --cleanup -C              Remove missing files from the database (
    --show-duplicates -S      Show duplicate files and total space taken by
                              duplicates (waste)
    --hardlink-duplicates -H  Hardlink duplicates. Requires --force to
	                          overwrite existing files.

	Only one mode parameter can be given!

Optional parameters:
    --datapath -p             Use datapath given, not current directory
    --verbose -v              Be verbose - list all files and actions (debug)
    --unstable                Enable untested features
    --quiet -Q                Just show summeries
    --follow-symlinks -F      Follow symlinks
    --max-size size[kmgt]     Ignore files larger than size
    --min-size size[kmgt]     Ignore files smaller than size
    --exclude regex           Ignore dirs matching regex - additional
                              --exclude statements can be given
    --no-cleanup              Used with --update - exclude --cleanup with an --update.
	--debug                   Print debug information
    --version -V              Display version and exit
EOTEXT
	exit 1;
}

# }}}
# sub use_threads() {{{

	sub use_threads {
		my $fsize = shift;
		return 0 unless ($os_supporting_threads{$^O});
		return ($fsize > $min_fsize_for_thread);
	}

# }}}
# sub version() {{{

	sub version {
		print "$0 version $VERSION\n";
		exit 0;
	}

# }}}

# Parse program arguments {{{

Getopt::Long::Configure ("bundling");
my $result = GetOptions (
# modes
	"init"					=> \$init,					"I"	=> \$init,
	"update"				=> \$update,				"U"	=> \$update,
	"cleanup"				=> \$cleanup,				"C"	=> \$cleanup,
	"show-duplicates"		=> \$show_duplicates,		"S"	=> \$show_duplicates,
	"hardlink-duplicates"	=> \$hardlink_duplicates,	"H"	=> \$hardlink_duplicates,

# opts
	"verbose+"				=> \$verbose,				"v+" => \$verbose, 
	"datapath=s"			=> \$data_path,				"p=s" => \$data_path,
	"help"					=> \$help,					"h" => \$help,
	"version"				=> \$version,				"V" => \$version,
	"quiet"					=> \$quiet,					"Q" => \$quiet,
	"debug"					=> \$debug,					"D" => \$debug,
	"csv"					=> \$csv,
	"follow-symlinks"		=> \$follow_symlinks,
	"update-inodes"			=> \$update_inodes,
	"no-recalc"				=> \$no_recalc,
	"min-size=s"			=> \$min_size,
	"max-size=s"			=> \$max_size,
	"exclude=s"				=> \@exclude,
	"verify"				=> \$verify,
	"force"					=> \$force,
	"no-cleanup"			=> \$no_cleanup,
	"unstable"				=> \$unstable,
);
&version if ($version);
&syntax("HELP!") if ($help);
&syntax("Unstable feature chosen without --unstable") if ($hardlink_duplicates and not $unstable);
$min_size = calc_numeric($min_size); 
$max_size = calc_numeric($max_size); 
$data_path = File::Spec->rel2abs($data_path) if (defined($data_path));
my $okcount = 0;
$okcount++ if ($init);
$okcount++ if ($update);
$okcount++ if ($show_duplicates);
$okcount++ if ($hardlink_duplicates);
$okcount++ if ($cleanup);
$okcount++ if ($csv);
if ($okcount == 0) {
	&syntax("Missing required argument");
} elsif ($okcount > 1) {
	&syntax("Conflicting arguments [$okcount]");
}

&syntax("unknown data path") unless (-d $data_path);


# }}}
# Main program {{{

# Use './finddup.db' if it exists. Otherwise, use ~/.finddup.db
$sqlitedb = $sqlitedb_old if ( -f $sqlitedb_old );

# Don't overwrite existing database unless --force is given
if ($init and -f $sqlitedb and !$force) {
	print "Use --force to foribly overwrite and possibly corrupt an existing\n";
	print "  database. Move the file ($sqlitedb) away or delete it manually to\n";
	print "  avoid this message.\n";
	exit(1);
}

print "DEBUG: chdir($data_path)\n" if ($debug);
die "Can't chdir($data_path): $!\n" unless (chdir($data_path));

print "DEBUG: \$dbh = DBI->connect(\"dbi:SQLite:dbname=$sqlitedb\",\"\",\"\");\n" if ($debug);
$dbh = DBI->connect("dbi:SQLite:dbname=$sqlitedb","","");
$dbh->do("PRAGMA synchronous = OFF");
# 100M cache
$dbh->do("PRAGMA cache_size = 100000");

if ($init) {
	&recursively_read_dir($data_path, "init", 0);
} elsif ($update) {
	&cleanup unless ($no_cleanup);
	&recursively_read_dir($data_path, "update", $update_inodes);
} elsif ($show_duplicates) {
	&handle_duplicates("show", $data_path);
} elsif ($csv) {
	&handle_duplicates("csv", $data_path);
} elsif ($hardlink_duplicates) {
	&handle_duplicates("hardlink");
} elsif ($cleanup) {
	print "NOTICE: Explicit cleanup is no longer required, and called by update automatically\n"
		if ($verbose);
	&cleanup;
} else {
	&syntax("WTF????");
}

if($verbose){
	&profiling_print;
}

# clean up
# $dbh->disconnect;

exit(0);

# }}}

