summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@ens-lyon.org>2011-10-25 22:01:00 +0200
committerGuilhem Moulin <guilhem.moulin@ens-lyon.org>2011-10-25 22:01:52 +0200
commitdc82b3f724d9613ef1bf517475e099ad46deff1f (patch)
treef2c6d93e79738e432da13429cfe7b13f6c58345b
initial commit
-rwxr-xr-ximapurge.pl86
-rw-r--r--imapurge.rc18
2 files changed, 104 insertions, 0 deletions
diff --git a/imapurge.pl b/imapurge.pl
new file mode 100755
index 0000000..3b657a5
--- /dev/null
+++ b/imapurge.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/perl -w
+
+use Mail::IMAPClient;
+use IO::Socket::SSL;;
+use File::Spec::Functions qw /catfile/;
+use Env qw /HOME/;
+use strict;
+
+my $confile = catfile ($HOME, '.imapurge.rc');
+die "Can't read `" .$confile. "'\n" unless -f $confile;
+my %accounts = do $confile;
+
+
+# Remotely delete mails that have been sent >90 days ago
+my $oldest = 90;
+
+# Account name => {
+# hostname => 'imap.example.com',
+# username => 'username',
+# password => '******',
+# ignore => [ 'folder1', 'folder2' ], # Optional (default: [])
+# only => [ 'folder3', 'folder4' ], # Optional (default: [])
+# oldest => 24 * 60 * 60 * 365 # Optional (default: $oldest)
+# }
+#
+#
+
+
+my $count = 0;
+while (my ($account,$config) = each %accounts) {
+ my $n = &prune ($config);
+ print $account, ": ", $n, "\n";
+ $count += $n;
+}
+print "-----------\n";
+print "Total: $count emails have been deleted.\n";
+
+
+
+
+sub prune {
+ my $config = $_[0];
+
+ my $socket = IO::Socket::SSL->new(
+ PeerAddr => $config->{hostname},
+ PeerPort => 993,
+ ) or die "Can't create SSL socket: $@\n";
+
+ my $client = Mail::IMAPClient->new(
+ Socket => $socket,
+ User => $config->{username},
+ Password => $config->{password},
+ SSL => 1,
+ Uid => 1,
+ ) or die "Can't login: $@\n";
+
+ my $maxdate = $oldest;
+ $maxdate = $config->{oldest} if exists $config->{oldest};
+ $maxdate *= 24 * 60 * 60; # Convert seconds to days
+ $maxdate = $client->Rfc3501_date(time-$maxdate);
+
+ my $count = 0;
+ my @folders = $client->folders or die "Can't list folders: $@\n";
+
+ foreach my $folder (@folders) {
+ next if exists $config->{ignore}
+ && grep {$_ eq $folder} @{$config->{ignore}};
+ next if exists $config->{only}
+ && not (grep {$_ eq $folder} @{$config->{only}});
+
+ if ($client->select($folder)) {
+ my @msgs = $client->sentbefore($maxdate);
+ if (@msgs) {
+ $count += $#msgs;
+ my $del = $client->delete_message(\@msgs)
+ or die "Can't delete messages: $@\n";
+ warn " Folder `$folder': only $del message deleted, out of $#msgs\n"
+ unless $del == $#msgs+1;
+ }
+ $client->close or die "Can't close: $@\n";
+ }
+ }
+
+ $client->logout() or die "Can't logout: $@\n";
+ return $count;
+}
diff --git a/imapurge.rc b/imapurge.rc
new file mode 100644
index 0000000..ad7dd26
--- /dev/null
+++ b/imapurge.rc
@@ -0,0 +1,18 @@
+#########################################################################
+# This is a sample configuration file for IMAPurge. Extend it and place #
+# in `~/.imapurge.rc' #
+#########################################################################
+
+
+# Account name => {
+# hostname => 'imap.example.com',
+# username => 'username',
+# password => '******',
+# ignore => [ 'folder1', 'folder2' ], # Optional (default: [])
+# only => [ 'folder3', 'folder4' ], # Optional (default: [])
+# oldest => 90 # Optional (default: $oldest) (the unit is days)
+# },
+# Account name => {
+# ...
+# }
+#