diff options
Diffstat (limited to 'pullimap')
| -rwxr-xr-x | pullimap | 31 |
1 files changed, 31 insertions, 0 deletions
@@ -62,6 +62,7 @@ my $CONF = read_config( delete $CONFIG{config} // $NAME, , 'deliver-method' => qr/\A((?:[ls]mtp:)?\[.*\](?::\d+)?)\z/ , 'deliver-ehlo' => qr/\A(\P{Control}+)\z/ , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/ + , 'purge-after' => qr/\A(\d+)d\z/ )->{$ARGV[0]}; my ($MAILBOX, $STATE); @@ -220,6 +221,34 @@ sub smtp_send(@) { $CONF->{'logger-fd'} = \*STDERR if $CONFIG{debug}; my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/} ); +# Remove messages with UID < UIDNEXT and INTERNALDATE at most +# $CONF->{'purge-after'} days ago. +my $LAST_PURGED; +sub purge() { + my $days = $CONF->{'purge-after'} // return; + $days =~ s/d$//; + my ($uidnext) = $IMAP->get_cache('UIDNEXT'); + return unless 1<$uidnext; + my $set = "1:".($uidnext-1); + + my $now = time; + return if defined $LAST_PURGED and $now - $LAST_PURGED < 6*3600; + $LAST_PURGED = $now; + + unless ($days == 0) { + my @now = gmtime($now - $days*86400); + my @m = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; # RFC 3501's date-month + my $date = sprintf("%02d-%s-%04d", $now[3], $m[$now[4]], $now[5]+1900); + my @uid = $IMAP->search("UID $set BEFORE $date"); + return unless @uid; + + $set = compact_set(@uid); + $IMAP->log("Removing ".($#uid+1)." UID(s) $set") unless $CONFIG{quiet}; + } + $IMAP->silent_store($set, '+', '\Deleted'); + $IMAP->expunge($set); +} + # Use BODY.PEEK[] so if something gets wrong, unpulled messages # won't be marked as \Seen in the mailbox my $ATTRS = "ENVELOPE INTERNALDATE BODY.PEEK[]"; @@ -288,6 +317,7 @@ do { } } pull($ignore); + purge(); }; exit 0 unless defined $CONFIG{idle}; @@ -295,4 +325,5 @@ $CONFIG{idle} = 1740 if defined $CONFIG{idle} and $CONFIG{idle} == 0; # 29 mins while(1) { my $r = $IMAP->idle($CONFIG{idle}, sub() { $IMAP->has_new_mails($MAILBOX) }); pull() if $r; + purge(); } |