initial commit

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 => {
+#   ...
+# }
+#