mirror of
https://github.com/imapsync/imapsync.git
synced 2024-11-17 08:12:48 +01:00
218 lines
6.0 KiB
Perl
Executable File
218 lines
6.0 KiB
Perl
Executable File
#!/usr/local/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 and Mail::IMAPClient are Copyright (c) 2003
|
|
by The Kernen Group, Inc. All rights reserved.
|
|
|
|
This example is distributed with Mail::IMAPClient and
|
|
subject to the same licensing requirements as Mail::IMAPClient.
|
|
|
|
imtest is a utility distributed with Cyrus IMAP server,
|
|
Copyright (c) 1994-2000 Carnegie Mellon University.
|
|
All rights reserved.
|
|
|
|
=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
|
|
#
|