This is a work in progress.
#!/usr/bin/perl -w
use strict;
$|++;
use Date::Manip;
use Getopt::Long qw(:config bundling ignore_case_always);
use Mail::IMAPClient;
=head1 NAME
imap - A utility for uncommon but useful IMAP mailbox functions.
=cut
# Many concepts and some code taken from
# imapsync (http://www.linux-france.org/prj/imapsync/dist/)
# and Mail::IMAPClient
# (http://search.cpan.org/~markov/Mail-IMAPClient-3.08/lib/Mail/IMAPClient.pod)
my $program_name = $0;
my ($analyze, $append, $dateheader, $debug, $dry, $dump, $file, $folder,
$help, $host, $id, $listfolders, $password, $receivedheader, $stdin,
$syncinternaldates, $timeout, $timezone, $user);
# Set defaults
$receivedheader = 1;
$timeout = 15;
get_options();
if (!$password) {
print 'Password: ';
$password = ;
chomp $password;
}
$dry and print STDERR "Dry run: no changes will be made\n";
$debug and $host and print STDERR "host: $host\n";
$debug and $timeout and print STDERR "timeout: $timeout\n";
$debug and $user and print STDERR "user: $user\n";
$debug and $password and print STDERR "password: " . '*' x length($password) .
"\n";
$debug and $folder and print STDERR "folder: $folder\n";
$host || missing_option("--host");
$user || missing_option("--user");
if ($timezone) {
Date_Init("TZ=$timezone");
}
my $imap = Mail::IMAPClient->new(
Server => $host,
Timeout => $timeout,
User => $user,
Password => $password,
Peek => 1,
) or die "Cannot connect to $host as $user: $@";
$debug and print STDERR "Peek: " . $imap->Peek() . "\n";
if ($folder) {
$imap->select($folder) or die "Could not select folder: $@\n";
}
if ($listfolders) {
list_folders();
} elsif ($analyze) {
analyze_folder();
} elsif ($dump) {
$id || missing_option("--id");
dump_message($id);
} elsif ($append) {
append_message();
} else {
fix_dates();
}
exit;
sub list_folders {
my @folders = $imap->folders or die "Could not get folders: $@\n";
print join(', ', @folders) . "\n";
}
sub analyze_folder {
my @folders;
if ($folder) {
@folders = ($folder);
} else {
@folders = $imap->folders or die "Could not get folders: $@\n";
}
foreach my $f (@folders) {
print "\nFolder: $f\n";
$imap->select($f) or die "Could not select folder: $@\n";
my @messages = $imap->messages;
my $number_of_messages = scalar(@messages);
print " Total messages: $number_of_messages\n";
my ($largest_size, $smallest_size, $total_size);
foreach my $message (@messages) {
my $size = $imap->size($message) or die "Could not get size: $@\n";
$total_size += $size;
if (!defined($largest_size) || $size > $largest_size) {
$largest_size = $size;
}
if (!defined($smallest_size) || $size < $smallest_size) {
$smallest_size = $size;
}
}
if ($number_of_messages > 0) {
print " Total size: " . format_size($total_size) . "\n";
print " Largest message: " . format_size($largest_size) . "\n";
print " Smallest message: " . format_size($smallest_size) . "\n";
print " Average message: " . format_size($total_size /
$number_of_messages) . "\n";
}
}
}
sub dump_message {
my ($message) = @_;
$debug and print STDERR "\nMessage $message\n";
my $internaldate = $imap->internaldate($message);
my $date = $imap->date($message);
my $receivedheader = $imap->get_header($message, 'Received');
my ($rfc2060_internaldate, $rfc2060_date, $rfc2060_receiveddate);
if ($internaldate) {
$rfc2060_internaldate = UnixDate($internaldate,
"%d-%b-%Y %k:%M:%S %z");
}
if ($date) {
$rfc2060_date = UnixDate($date, "%d-%b-%Y %k:%M:%S %z");
}
if ($receivedheader) {
$receivedheader =~ s/.*;\s*//;
$rfc2060_receiveddate = UnixDate($receivedheader,
"%d-%b-%Y %k:%M:%S %z");
}
my $size = $imap->size($message) or die "Could not get size: $@\n";
$debug and print STDERR " size: $size\n";
my @flags = $imap->flags($message) or die "Could not get flags: $@\n";
my $flags = join(' ', @flags);
$debug and $flags and print STDERR " flags: $flags\n";
if ($debug) {
print STDERR " internaldate: " . ($rfc2060_internaldate ?
$rfc2060_internaldate : '(empty)');
print STDERR " (parsed from: '" . ($internaldate ? $internaldate :
'(empty)') . "')\n";
print STDERR " date: " . ($rfc2060_date ? $rfc2060_date :
'(empty)');
print STDERR " (parsed from: '" . ($date ? $date : '(empty)') . "')\n";
print STDERR " receiveddate: " . ($rfc2060_receiveddate ?
$rfc2060_receiveddate : '(empty)');
print STDERR " (parsed from: '" . ($receivedheader ? $receivedheader :
'(empty)') . "')\n";
}
my $message_string = $imap->message_string($message);
$debug and $message_string and print STDERR "message_string length: " .
length($message_string) . "\n";
print $message_string;
}
sub append_message {
my $new_id = $imap->append_file($folder, $file) or die
"Could not append_file: $@\n";
$debug and print STDERR "Id: $new_id\n";
}
sub fix_dates {
my @messages = $imap->messages or die "Could not get messages: $@\n";
foreach my $message (@messages) {
$debug and print STDERR "\nMessage $message\n";
my $internaldate = $imap->internaldate($message);
my $date = $imap->date($message);
my $receivedheader = $imap->get_header($message, 'Received');
my ($rfc2060_internaldate, $rfc2060_date, $rfc2060_receiveddate);
if ($internaldate) {
$rfc2060_internaldate = UnixDate($internaldate,
"%d-%b-%Y %k:%M:%S %z");
}
if ($date) {
$rfc2060_date = UnixDate($date, "%d-%b-%Y %k:%M:%S %z");
}
if ($receivedheader) {
$receivedheader =~ s/.*;\s*//;
$rfc2060_receiveddate = UnixDate($receivedheader,
"%d-%b-%Y %k:%M:%S %z");
}
my $size = $imap->size($message) or die "Could not get size: $@\n";
$debug and print STDERR " size: $size\n";
my @flags = $imap->flags($message);
my $flags;
if (@flags) {
$flags = join(' ', @flags);
}
$debug and print STDERR " flags: " . ($flags ? $flags : '(empty)') .
"\n";
if ($debug) {
print STDERR " internaldate: " . ($rfc2060_internaldate ?
$rfc2060_internaldate : '(empty)');
print STDERR " (parsed from: '" . ($internaldate ? $internaldate :
'(empty)') . "')\n";
print STDERR " date: " . ($rfc2060_date ? $rfc2060_date :
'(empty)');
print STDERR " (parsed from: '" . ($date ? $date : '(empty)') . "')\n";
print STDERR " receiveddate: " . ($rfc2060_receiveddate ?
$rfc2060_receiveddate : '(empty)');
print STDERR " (parsed from: '" . ($receivedheader ? $receivedheader :
'(empty)') . "')\n";
}
if ($rfc2060_internaldate and $rfc2060_date) {
# if (abs($parsedinternaldate - $parseddate) > 86400) {
if (1) {
$debug and print STDERR "correcting dates.\n";
my $message_string = $imap->message_string($message);
$debug and $message_string and print STDERR
"message_string length: " . length($message_string) . "\n";
my $date = $rfc2060_receiveddate;
if ($dateheader and $rfc2060_date) {
$date = $rfc2060_date;
}
$debug and print STDERR "Using date: " . ($date ? $date :
'(empty)') . "\n";
if (!$dry) {
my $uid = $imap->append_string($folder, $message_string, $flags,
$date) or die "Could not append_string: $@\n";
$debug and print STDERR "uid: $uid\n";
}
} else {
$debug and print STDERR "no date correction necessary.\n";
}
}
}
}
sub format_size {
my ($size) = @_;
my $formatted_size;
if ($size < 1024 * 1024) {
$formatted_size = sprintf("%.1f KB", $size / 1024);
} else {
$formatted_size = sprintf("%.1f MB", $size / 1024 / 1024);
}
return $formatted_size;
}
sub get_options {
my $num_opt = scalar(@ARGV);
my $opt_ret = GetOptions(
'analyze' => \$analyze,
'append|add' => \$append,
'dateheader!' => \$dateheader,
'debug!' => \$debug,
'dry!' => \$dry,
'dump' => \$dump,
'file=s' => \$file,
'folder=s' => \$folder,
'help|?' => \$help,
'host=s' => \$host,
'id=i' => \$id,
'listfolders' => \$listfolders,
'password=s' => \$password,
'receivedheader!' => \$receivedheader,
'' => \$stdin,
'timeout=i' => \$timeout,
'timezone=s' => \$timezone,
'user=s' => \$user,
);
$debug and print STDERR "get_options: [$opt_ret]\n";
usage() and exit if ($help or !$num_opt);
}
sub missing_option {
my ($option) = @_;
die "$option option must be specified. See $program_name --help for more information.\n";
}
sub usage {
print <<EOF;
usage: $program_name [options]
OPTIONS
--analyze
Display statistics on all folders, or on a single folder specified with
--folder. No changes are made. This is a good first choice before
performing other operations.
--debug
Print debugging messages
--dry
Show operations as they would happen, but actually do nothing (dry run).
This is highly recommended to test the effect of all options before
operations that make changes on the mailbox.
--folder
Specify the IMAP mailbox folder name on which to operate. Most
operations act on messages in a single folder and should be run
separately for each desired folder. Folder naming conventions vary
between servers, so use --folders to get a list of all folders from the
IMAP server. Folder names can contain spaces, so quote as appropriate,
for example:
--folder 'My Old Stuff'
--folder My\ Old\ Stuff
--help
Print this help message
--host
Specify the IMAP server name
--listfolders
List all available folders in the mailbox. This is a good choice before
performing other operations.
--password
Specify the IMAP mailbox password. Caution: using this option can
expose your password to any user on your system. Instead, it's
preferable to omit this option. You will then be prompted for the
password.
--timezone
Set timezone to a specific value. Can be any value recognized by
Date::Manip. Be sure to quote numeric values. For example:
--timezone '-0800'
--timezone PST
--user
Specify the IMAP mailbox user name
EXAMPLES
$program_name --host imap.example.com --user myusername --listfolders
$program_name --host imap.example.com --user myusername --analyze
EOF
}