#!/usr/bin/env perl
#
# This file is a part of KleanSweep.
#
# Copyright (C) 2005 Pawel Stolowski <pawel.stolowski@wp.pl>
#
# KleanSweep is free software; you can redestribute it and/or modify it
# under terms of GNU General Public License by Free Software Foundation.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY. See GPL for more details.
#

use File::Find;
use File::Compare;
use File::Temp;
use Digest::MD5;
use Getopt::Long;

#
# Produces list of files matching various search criterias.
#
# each output line contains concatenated tags and filename:
# tag:filename
# ...
#
# Possible tags:
#
# b - backup file
# d<id> - duplicated file (id is a unique number; files with same ids are duplicates)
# l - locale file
# m - dead menu entry file
# t - obsolete thumbnails
# E - orphaned Gentoo emerge' file
# R - orphaned RPM file
# D - orphaned Deb file
# s - broken symlink
# t - temporary file
# U - unused file
# y - empty dir 
# z - empty file
#
# Command-line options:
#
# -s                        search for broken symlinks
# -z                        search for empty files
# -y                        search for empty dirs
# -l                        search for unused locales
# -m                        search for broken menu entries
# -t                        search for obsolete thumbnails
# -b                        search for backup files with ext extension
# -d                        search for duplicated files
# --rpm                     perform rpm orphans check
# --portage                 perform emerge orphans check
# --deb                     perform deb orphans check
# --comp                    compare not only sums but contents when searching for duplicates
# --exclude <dir>           exclude dir from any checks
# --orphans-exclude <dir>   exclude dir from rpm/deb/portage orphans search
# --orphans-include <dir>   include dir in rpm/deb/portage orphans search
# --writable                ignore non-writable files
# --progress                show current directory
# --unused <days>           search for files not used recently
# 

our @path;
our %sizes;
our %mdsums;
our %inodes;
our $OUTPUT;
our %dupref;

our $seek_bak = 0;
our $seek_locale = 0;
our $seek_menus = 0;
our $seek_thumbs = 0;
our $seek_empty_files = 0;
our $seek_empty_dirs = 0;
our $seek_dup = 0;
our $seek_symlinks = 0;
our $seek_orpms = 0;
our $seek_odebs = 0;
our $seek_oemerge = 0;
our $seek_old = 0; # number of days, if greater than zero
our $only_writable = 0;
our $only_md5sum = 0;
our $dup_min_size = 1;
our $show_progress = 0;
our %rpm_files; # files registered in rpm database
our %deb_files; # files registered in deb database
our %emerge_files; # files registered in portage
our $currtime; # current time in seconds, used if seeking for old files

our $excludedirs_re;
our $orphexclude_re;
our $orphdirs_re;
our $bakfiles_re;
our $localedirs_re;
our $valid_locales_re;

our @localedirs = ('/usr/share/locale', '/usr/local/share/locale'); #parent locale directories (usually /usr/share/locale)
our @valid_locales; # country names considered valid (used) by the system

#
# calculates file checksum; basically a wrapper for Digest::MD5.
sub filesum
{
	my $file = shift;
	if (open(FILE, $file))
	{
		binmode(FILE);
		my $sum = Digest::MD5->new;
		$sum->addfile(*FILE);
		close(FILE);
		return $sum->hexdigest;
	}
	0;
}

#
# checks if file can be found in $PATH, just like 'which' does.
# assumes @path array is filled with paths.
sub which
{
	my $file = shift;
	return -e $file if $file =~ /^\//;
	foreach (@path)
	{
		return 1 if -e "$_/$file";
	}
	0;
}

sub escape_target
{
	my $target = shift;
	# backslash-escape special characters (: and \)
	$target =~ s/([,:\\])/\\$1/g;
	$target;
}

#
# main subroutine used by find. performs all requested tests on each file.
sub process_entry
{
	my $tag;
	my $target; # symlink / menu entry / thumbnail target
	my $fname = $File::Find::name;
	if ( -l )
	{
		return if ($only_writable && ! -w);
		$tag = 's' if $seek_symlinks && ! -e readlink;
		if ($seek_symlinks && ! -e ($target = readlink))
		{
			$tag = 's'.&escape_target($target).',';
		}
	}
	elsif ( -f )
	{
		return if ($only_writable && ! -w);
		my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$fsize,$atime,$mtime,$ctime,$blksize,$bloks) = stat($fname);
		$inodes{$fname} = $dev.$ino;
		$tag .= 'b' if $seek_bak && /(?:$bakfiles_re)$/oi;
		$tag .= 'z' if $seek_empty_files && -f && -z;
		$tag .= 'l' if $seek_locale && $fname =~ /\.mo$/ && $fname =~ /^(?:$localedirs_re)/o && $File::Find::dir !~ /$valid_locales_re/o;
		$tag .= 'U' if $seek_old && ($currtime - $atime) > $seek_old;
		if ($seek_thumbs && $fname =~ /\.thumbnails\/(?:fail|large|normal)\/[a-f0-9]{32}\.png$/)
		{
			{
				if (open(FILE, "identify -verbose $fname |"))
				{
					while (<FILE>)
					{
						if (/\s*Thumb::URI:\s+file:\/\/(.+)/)
						{
							last if -e $1;
							close(FILE);
							$tag .= 't'.&escape_target($1).',';
					}
					}
					close(FILE);
				}
			}
		}
		if ($seek_orpms && $File::Find::dir =~ /^($orphdirs_re)/o && $File::Find::dir !~ /^($orphexclude_re)/o)
		{
			if (defined $rpm_files{$fname})
			{
				delete $rpm_files{$fname}; #free up some memory
			}
			else
			{
				$tag .= 'R';
			}
		}
		if ($seek_odebs && $File::Find::dir =~ /^($orphdirs_re)/o && $File::Find::dir !~ /^($orphexclude_re)/o)
		{
			if (defined $deb_files{$fname})
			{
				delete $deb_files{$fname};
			}
			else
			{
				$tag .= 'D';
			}
		}
		if ($seek_oemerge && $File::Find::dir =~ /^($orphdirs_re)/o && $File::Find::dir !~ /^($orphexclude_re)/o)
		{
			if (defined $emerge_files{$fname})
			{
				delete $emerge_files{$fname}; #free up some memory
			}
			else
			{
				$tag .= 'E';
			}
		}
		if ($seek_menus && /\.desktop$/)
		{
			my $exec = '';
			my $tryexec = '';
			if (open(FILE, $fname))
			{
				while (<FILE>)
				{
					if (/^\s*TryExec\s*=\s*([\w\/\.,-:]+)/)
					{
						$tryexec = $1;
						last;
					}
					elsif (/^\s*Exec\s*=\s*([\w\/\.,-:]+)/)
					{
						$exec = $1;
					}
				}
				close(FILE);
				$exec = $tryexec if $tryexec ne '';
				if ($exec ne '' && ! &which($exec))
				{
					$tag = 'm'.&escape_target($exec).',';
				}
			}
		}
		if ($seek_dup && $fsize >= $dup_min_size)
		{
			my $add = 1;
			if (defined $sizes{$fsize})
			{
				my $md;
				if (scalar @{$sizes{$fsize}} == 1)
				{
					my $prevfile = @{$sizes{$fsize}}->[0];
					$mdsums{$prevfile} = &filesum($prevfile);
				}
				$mdsums{$fname} = ($md = &filesum($fname));
				foreach (@{$sizes{$fsize}})
				{
					if ($md eq $mdsums{$_} && ($only_md5sum || &compare($fname, $_) == 0))
					{
						$duptag = $inodes{$_}.'d';
						print $OUTPUT "$duptag\:$_\n" if ! defined $dupref{$inodes{$_}};
						$dupref{$inodes{$_}}++;
						$inodes{$fname} = $inodes{$_};
						$tag .= 'd';
						$add = 0;
						last;
					}
				}
			}
			push(@{$sizes{$fsize}}, $fname) if $add == 1;
		}
	}
	print $OUTPUT "$inodes{$fname}$tag:$fname\n" if $tag ne '';
}

#
# filter out globally excluded directories
sub preprocess_dir
{
	print $OUTPUT '@:'.$File::Find::dir."\n" if $show_progress;
	#print $OUTPUT 'y:'.$File::Find::dir."\n" if ($seek_empty_dirs && scalar @_ == 2);
	grep { (! -d) || "$File::Find::dir/$_" !~ /$excludedirs_re/o } @_;
}

#
# returns true if dir exists and is absolute path
sub checkdir
{
	my $dir = shift;
	return $dir =~ /^\// && -d $dir;
}

#
# creates regular expression for matching paths from given array
sub build_paths_re
{
	@_ = grep { checkdir $_ } @_;
	$re = join('|', @_);
	$re =~ s/\//\\\//g;
	return $re;
}

####################################################################################
#
# Execution starts here
#
####################################################################################

my @excludedirs;
my @orphexcludedirs;
my @orphdirs;

$localedirs_re = build_paths_re(@localedirs);
$bakfiles_re = '\.bak|\.old|\.save|\.tmp|~|-';

@path = split(':', $ENV{'PATH'});

GetOptions('z' => \$seek_empty_files,
	   'y' => \$seek_empty_dirs,
	   'l' => \$seek_locale,
	   's' => \$seek_symlinks,
	   'm' => \$seek_menus,
	   't' => \$seek_thumbs,
	   'b' => \$seek_bak,
	   'rpm' => \$seek_orpms,
	   'deb' => \$seek_odebs,
	   'portage' => \$seek_oemerge,
	   'd' => \$seek_dup,
	   'unused=i' => \$seek_old,
	   'comp' => \$only_md5sum,
   	   'writable' => \$only_writable,
	   'exclude=s' => \@excludedirs,
	   'orphans-exclude=s' => \@orphexcludedirs,
	   'orphans-include=s' => \@orphdirs,
	   'progress' => \$show_progress
   );

#
# filter-out non-existing dirs from provided paths
@excludedirs = grep { checkdir $_ } @excludedirs;
@orphdirs =  grep { checkdir $_ } @orphdirs;
@orphexcludedirs = grep { checkdir $_ } @orphexcludedirs;
#
# set default include / exclude dirs if no paths
@excludedirs = ('/proc', '/sys', '/mnt', '/media', '/cdrom', '/dev') if ! scalar @excludedirs;
@orphdirs = ('/bin', '/sbin', '/boot', '/etc', '/usr') if ! scalar @orphdirs;
@orphexcludedirs = ('/tmp') if ! scalar @orphexcludedirs;

$excludedirs_re = build_paths_re(@excludedirs);
$orphexclude_re = build_paths_re(@orphexcludedirs);
$orphdirs_re = build_paths_re(@orphdirs);

if ($seek_thumbs && ! which('identify'))
{
	$seek_thumbs = 0;
}

if ($seek_old)
{
	$currtime = time();
	$seek_old = $seek_old * 24 * 3600; # convert days to seconds
}
   
if ($seek_locale)
{
	#
	# build array of valid locale names
	foreach (@user_locales, $ENV{'LANG'}, 'C')
	{
		push(@valid_locales, "\/$1") if /^([a-zA-Z_]+)/;
	}
	$valid_locales_re = join('|', @valid_locales);
}
   
$OUTPUT = \*STDOUT;

my $start_dir = shift;
$start_dir = $ENV{'HOME'} if ($start_dir eq '' || ! -d $start_dir);

#######################################################################
# RPM-based distros support
#######################################################################
if ($seek_orpms && which('rpm') && open(RPMFILES, 'rpm -qal|'))
{

	while (<RPMFILES>) 
	{
		chomp;
		$rpm_files{$_} = 1;
	}
	close(RPMFILES);
}
else
{
	$seek_orpms = 0;
}

#######################################################################
# GENTOO portage support with equery
#######################################################################
if ($seek_oemerge && which('equery') && open(EMERGEFILES, 'equery -C list -i|'))
{
	while (<EMERGEFILES>)
	{
		if (/^\w+?-\w+?\/(.+?)-\d/)
		{
			if (open(QUERY, "equery -C files $1|"))
			{
				while (<QUERY>)
				{
					next if ! /^\//;
					chomp;
					if (/^\s->\s/) # match symlink entry
					{
						$emerge_files{$1} = 1;
					}
					else
					{
						$emerge_files{$_} = 1;
					}
				}
				close(QUERY);
			}
		}
	}
	close(EMERGEFILES);
}
else
{
	$seek_oemerge = 0;
}

#######################################################################
# Debian support with dpkg
#######################################################################
if ($seek_odebs && which('dpkg') && open(DEBS, 'COLUMNS=200 dpkg -l|'))
{
	while (<DEBS>) 
	{
		if (/^[ih].\s+(\w+)/)
		{
			if (open(DEBFILES, "dpkg -L $1 |")) 
			{
				while (<DEBFILES>)
				{
					chomp;
					$deb_files{$_} = 1;
				}
				close(DEBFILES);
			}
		}
	}
	close(DEBS);
}
else
{
	$seek_odebs = 0;
}

#######################################################################
# start seeking
#######################################################################
find({wanted => \&process_entry, preprocess => \&preprocess_dir}, $start_dir);

