aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/Net/IMAP/InterIMAP.pm30
-rwxr-xr-xpullimap81
2 files changed, 78 insertions, 33 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 15682b3..2898905 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -968,6 +968,35 @@ sub slurp($;$$) {
}
+# $self->idle([$timeout, $stopwhen])
+# Enter IDLE (RFC 2177) for $timout seconds (by default 29 mins), or
+# when the callback $stopwhen returns true.
+# Return false if the timeout was reached, and true if IDLE was
+# stopped due the callback.
+sub idle($$$) {
+ my ($self, $timeout, $stopwhen) = @_;
+ $timeout //= 1740; # 29 mins
+
+ $self->fail("Server did not advertise IDLE (RFC 2177) capability.")
+ unless $self->_capable('IDLE');
+
+ my $tag = $self->_cmd_init('IDLE');
+ $self->_cmd_flush();
+
+ for (; $timeout > 0; $timeout--) {
+ $self->slurp('IDLE', sub() {$timeout = -1 if $stopwhen->()});
+ sleep 1 if $timeout > 0;
+ }
+
+ # done idling
+ $self->_cmd_extend('DONE');
+ $self->_cmd_flush();
+ $self->_recv($tag);
+
+ return $timeout < 0 ? 1 : 0;
+}
+
+
# $self->set_cache( $mailbox, STATE )
# Initialize or update the persistent cache, that is, associate a
# known $mailbox with the last known (synced) state:
@@ -2294,6 +2323,7 @@ sub _resp($$;$$$) {
else {
$self->panic("Unexpected response: ", $_);
}
+ $callback->() if defined $callback and $cmd eq 'IDLE';
}
diff --git a/pullimap b/pullimap
index f9b9d0d..2c9b45d 100755
--- a/pullimap
+++ b/pullimap
@@ -47,7 +47,7 @@ sub usage(;$) {
exit $rv;
}
-usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h/);
+usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h idle:i/);
usage(0) if $CONFIG{help};
usage(1) unless $#ARGV == 0 and $ARGV[0] ne '_';
@@ -225,10 +225,47 @@ sub smtp_send(@) {
# the remote mailbox
#
my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/}, 'logger-fd' => $LOGGER_FD );
+
+# use BODY.PEEK[] so if something gets wrong, unpulled messages
+# won't be marked as \Seen in the mailbox
+my $ATTRS = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
+
+# Pull new messages from IMAP and deliver them to SMTP, then update the
+# statefile
+sub pull(;$) {
+ my $ignore = shift // [];
+ my @uid;
+
+ # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids) in the statefile
+ $IMAP->pull_new_messages($ATTRS, sub($) {
+ my $mail = shift;
+ return unless exists $mail->{RFC822}; # not for us
+
+ my $uid = $mail->{UID};
+ my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
+ $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
+ print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
+
+ sendmail($from, $mail->{RFC822});
+
+ push @uid, $uid;
+ writeUID($uid);
+ }, @$ignore);
+
+ # now that everything has been deliverd, mark @ignore and @uid as \Seen
+ $IMAP->silent_store(compact_set(@$ignore, @uid), '+', '\Seen') if @$ignore or @uid;
+
+ # update the statefile
+ sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!";
+ my ($uidnext) = $IMAP->get_cache('UIDNEXT');
+ writeUID($uidnext);
+ truncate($STATE, 8) // die "Can't truncate";
+}
+
do {
my $uidvalidity = readUID();
my $uidnext = readUID();
- my @ignore;
+ my $ignore = [];
$IMAP->set_cache($MAILBOX, UIDVALIDITY => $uidvalidity, UIDNEXT => $uidnext);
$IMAP->select($MAILBOX);
@@ -249,37 +286,15 @@ do {
# have already been delivered, but the process exited before the
# statefile was updated
while (defined (my $uid = readUID())) {
- push @ignore, $uid;
+ push @$ignore, $uid;
}
}
-
- # use BODY.PEEK[] so if something gets wrong, unpulled messages
- # won't be marked as \Seen in the mailbox
- my $attrs = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
- my @uid;
-
- # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids)
- $IMAP->pull_new_messages($attrs, sub($) {
- my $mail = shift;
- return unless exists $mail->{RFC822}; # not for us
-
- my $uid = $mail->{UID};
- my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
- $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
- print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
-
- sendmail($from, $mail->{RFC822});
-
- push @uid, $uid;
- writeUID($uid);
- }, @ignore);
-
- # now that everything has been deliverd, mark @ignore and @uid as \Seen
- $IMAP->silent_store(compact_set(@ignore, @uid), '+', '\Seen') if @ignore or @uid;
-
- # update the statefile
- sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!";
- ($uidnext) = $IMAP->get_cache('UIDNEXT');
- writeUID($uidnext);
- truncate($STATE, 8) // die "Can't truncate";
+ pull($ignore);
};
+exit 0 unless defined $CONFIG{idle};
+
+$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;
+}