summaryrefslogtreecommitdiffstats
path: root/imapurge.pl
blob: 6623ba8c10f1f8bfd7d2880d75119dfc573147a6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
#!/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;
die "Error in `" .$confile. "'\n" if $@ || not %accounts;


# 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;
}