22

✏️ Editing: find_dup_msgs.pl

#!/usr/bin/perl
# $Id$

use Mail::IMAPClient;
use Mozilla::LDAP::Conn;
use Getopt::Std;
use vars qw/$rootdn $opt_a/;
use Data::Dumper;

# It then connects to a user's mailhost and rummages around, 
#    looking for duplicate messages.
# It will optionally delete messages that are duplicates (based on 
#    msg-id header and number of bytes).
# For help, enter:
#	find_dup_msgs.pl -h  
#

getopts('ahdtvf:F:u:s:p:P:');

if ( $opt_h ) {
	print STDERR &usage;
	exit;
}

my $uid = $opt_u or die &usage;
$opt_s||='localhost';
$opt_p or die &usage;
$opt_P||=143;

$opt_t 		and 
	$opt_d 	and 
	die 	"ERROR: Don't specify -d and -t together.\n" . &usage;

my($pu,$pp) = get_admin();

print "Connecting to $host:$opt_P\n" if $opt_v;
my $imap = Imap->new(	Server	=> $opt_s,
			User	=> $opt_u,
			Password=> $opt_p,
			Port	=> $opt_P,
			Fast_io => 1,
) or die "couldn't connect to $host port $opt_P: $!\n";

my %folders; my %counts;

FOLDER: foreach my $f ( $opt_F ? $opt_F :  $imap->folders  ) {
	next if $opt_t and $f eq 'Trash';
	$folders{$f} = 0;
	$counts{$f} = $imap->message_count($f);
	print "Processing folder $f\n" if $opt_v;
	unless ( $imap->select($f)) {
		warn "Error selecting $f: " . $imap->LastError . "\n";
		next FOLDER;
	}
	my @msgs = $imap->search("ALL");
	my %hash = ();
	MESSAGE: foreach my $m (@msgs) {
		my $mid;
		if ($opt_a) {
			my $h = $imap->parse_headers(
				$m,"Date","Subject","From","Message-ID"
			) or next MESSAGE;
			$mid = 	"$h->{'Date'}[0]$;$h->{'Subject'}[0]$;".
				"$h->{'From'}[0]$;$h->{'Message-ID'}[0]";

} else {
			$mid = $imap->parse_headers(
				$m,
				"Message-ID"
			)->{'Message-ID'}[0] 
			or next MESSAGE;
		}
		my $size = $imap->size($m);
		if ( exists $hash{$mid} and $hash{$mid} == $size ) { 
			if ($opt_f) {
				open F,">>$opt_f" or 
					die "can't open $opt_f: $!\n";
				print F $imap->message_string($m),
					"___END OF SAVED MESSAGE___","\n";
				close F;
			}
			$imap->move("Trash",$m) if $opt_t;
			$imap->delete_message($m) if $opt_d;
			$folders{$f}++;
			print "Found a duplicate in ${f}; key = $mid\n" if $opt_v;

} else {

$hash{$mid} = $size;
		}
	}
	print "$f hash:\n",Data::Dumper::Dumper(\%hash) if $opt_v;
	$imap->expunge if ($opt_t or $opt_d);
}

my $total; 	my $totms; 
map { $total += $_} values %folders;
map { $totms += $_ } values %counts;
print 	"Found $total duplicate messages in ${uid}'s mailbox. ",
	"The breakdown is:\n",
	"\tFolder\tNumber of Duplicates\tNumber of Msgs in Folder\n",
	"\t------\t--------------------\t------------------------\n",
	map { "\t$_\t$folders{$_}\t$counts{$_}\n" } keys %folders,
	"\tTOTAL\t$total\t$totms\n"
;

sub usage {
	return "Usage:\n" .
		"\t$0 [-d|-t] [-v] [-f filename] [-a] [-P port] \\\n".
		"\t\t-s server -u user -p password\n\n" .
		"\t-a\t\tdo an especially aggressive search for duplicates\n".
		"\t-d\t\tdelete duplicates (default is to just report them)\n".
		"\t-f file\t\tsave deleted messages in file named 'file'\n" .
		"\t-F fldr\t\tOnly check the folder named 'fldr' (default is to check all folders)\n" .
		"\t-h\t\tprint this help message (all other options are ignored)\n" .
		"\t-p password\tspecify the target user's password\n" .
		"\t-P port\t\tspecify the port to connect to (default is 143)\n" .
		"\t-s server\tspecify the target mail server\n" .
		"\t-u uid\t\tspecify the target user\n" .
		"\t-t\t\tmove deleted messages to trash folder\n" .
		"\t-v\t\tprint verbose status messages while processing\n".
		"\n" ;
}

=head1 AUTHOR 
	
David J. Kernen

The Kernen Group, Inc.

imap@kernengroup.com

=head1 COPYRIGHT

This example is distributed with Mail::IMAPClient and 
subject to the same licensing requirements as Mail::IMAPClient.

=cut

# History:
# $Log: find_dup_msgs.pl,v $
# Revision 19991216.5  2003/06/12 21:38:32  dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# 	Makefile.PL Todo sample.perldb
# 	BodyStructure.pm
# 	Parse.grammar Parse.pod
#  	range.t
#  	Thread.grammar
#  	draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
#  	rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 1.1  2003/06/12 21:38:14  dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# 	Makefile.PL Todo sample.perldb
# 	BodyStructure.pm
# 	Parse.grammar Parse.pod
#  	range.t
#  	Thread.grammar
#  	draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
#  	rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.4  2002/08/23 14:34:51  dkernen
#
# Modified Files:	Changes IMAPClient.pm Makefile Makefile.PL test.txt for version 2.2.0
# Added Files: Makefile Makefile.PL Parse.grammar Parse.pm Parse.pod  version 2.2.0
# Added Files: parse.t  for version 2.2.0
# Added Files: bodystructure.t  for 2.2.0
# Modified Files: find_dup_msgs.pl  for v2.2.0
#
# Revision 1.6  2001/03/08 19:00:35  dkernen
#
# ----------------------------------------------------------------------
# Modified Files:
# 	copy_folder.pl 		delete_mailbox.pl 	find_dup_msgs.pl
# 	mbox_check.pl 		process_orphans.pl 	rename_id.pl
# 	scratch_indexes.pl
# to get ready for nsusmsg02 upgrade
# ----------------------------------------------------------------------
#
# Revision 1.5  2000/11/01 15:51:58  dkernen
#
# Modified Files: copy_folder.pl find_dup_msgs.pl restore_mbox.pl
#
# Revision 1.4  2000/04/13 21:17:18  dkernen
#
# Modified Files: find_dup_msgs.pl  - to add -a switch (for aggressive dup search)
# Added Files: 	copy_folder.pl 	  - a utility for copying a folder from one user's
# 				    mailbox to another's
#
# Revision 1.3  2000/03/14 16:40:21  dkernen
#
# Modified Files: find_dup_msgs.pl  -- to skip msgs with no message-id
#
# Revision 1.2  2000/03/13 19:05:50  dkernen
#
# Modified Files:
# 	delete_mailbox.pl find_dup_msgs.pl restore_mbox.pl -- to add cvs comments
# 	find_dup_msgs.pl -- to fix bug that occurred when -t (move-to-trash) switch is used
#

MR SKB