diff options
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 24 | ||||
| -rwxr-xr-x | pullimap | 31 |
2 files changed, 51 insertions, 4 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index efa6b92..01fb6a9 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1287,8 +1287,9 @@ sub push_flag_updates($$@) { # $self->silent_store($set, $mod, @flags) -# Set / Add / Update the flags list on the UID $set. -# /!\ There is no guaranty that message flags have been set! +# Set / Add / Remove the flags list on the UID $set, depending on the +# value of $mod ('' / '+' / '-'). +# /!\ There is no guaranty that message flags are successfully updated! sub silent_store($$$@) { my $self = shift; my $set = shift; @@ -1297,6 +1298,19 @@ sub silent_store($$$@) { } +# $self->expunge($set) +# Exunge the given UID $set. +# /!\ There is no guaranty that messages are successfully expunged! +sub expunge($$) { + my $self = shift; + my $set = shift; + + $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.") + unless $self->_capable('UIDPLUS'); + $self->_send("UID EXPUNGE $set"); +} + + ############################################################################# # Private methods @@ -2220,8 +2234,10 @@ sub _resp($$;$$$) { } elsif (/\A([0-9]+) EXPUNGE\z/) { # /!\ No bookkeeping since there is no internal cache mapping sequence numbers to UIDs - $self->panic("$1 <= $cache->{EXISTS}") if $1 <= $cache->{EXISTS}; # sanity check - $self->fail("RFC 7162 violation! Got an EXPUNGE response with QRESYNC enabled.") if $self->_enabled('QRESYNC'); + if ($self->_enabled('QRESYNC')) { + $self->panic("$1 <= $cache->{EXISTS}") if $1 <= $cache->{EXISTS}; # sanity check + $self->fail("RFC 7162 violation! Got an EXPUNGE response with QRESYNC enabled."); + } $cache->{EXISTS}--; # explicit EXISTS responses are optional } elsif (/\ASEARCH((?: [0-9]+)*)\z/) { @@ -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(); } |