Add an option "purge-after" to remove old messages.

1 files changed, 31 insertions, 0 deletions

diff --git a/pullimap b/pullimap
index cca0ee8..7e737f2 100755
--- a/pullimap
+++ b/pullimap
@@ -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();
 }