From e69c927ac798156e99407b4b00c15f446d4ca4d6 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 Mar 2016 15:34:39 +0100 Subject: typo: F_[GS]ETFL → F_[GS]ETFD MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/Net/IMAP/InterIMAP.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 785de38..5e9028e 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -23,7 +23,7 @@ use strict; use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/; use Config::Tiny (); use Errno 'EINTR'; -use Fcntl qw/F_GETFL F_SETFL FD_CLOEXEC/; +use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use Net::SSLeay (); use List::Util qw/all first/; use POSIX ':signal_h'; @@ -1375,8 +1375,8 @@ sub _tcp_connect($$$) { next if $! == EINTR; # try again if connect(2) was interrupted by a signal next SOCKETS; } - my $flags = fcntl($s, F_GETFL, 0) or $self->panic("fcntl F_GETFL: $!"); - fcntl($s, F_SETFL, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFL: $!"); + my $flags = fcntl($s, F_GETFD, 0) or $self->panic("fcntl F_GETFD: $!"); + fcntl($s, F_SETFD, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFD: $!"); return $s; } $self->fail("Can't connect to $host:$port"); -- cgit v1.2.3 From 2676ef52da48625a2d260169d815717313a0613d Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 Mar 2016 16:02:29 +0100 Subject: wibble --- lib/Net/IMAP/InterIMAP.pm | 2 +- pullimap | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 5e9028e..bd69d87 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -887,7 +887,7 @@ sub append($$@) { delete $vanished2{$_} foreach keys %vanished; my $VANISHED = scalar(keys %vanished2); # number of messages VANISHED meanwhile $cache->{EXISTS} += $#_+1 if defined $cache->{EXISTS} and $cache->{EXISTS} + $VANISHED == $EXISTS; - $cache->{UIDNEXT} = $UIDNEXT if ($cache->{UIDNEXT} // 1) < $UIDNEXT; + $cache->{UIDNEXT} = $UIDNEXT if ($cache->{UIDNEXT} // 1) < $UIDNEXT; } unless ($self->{quiet}) { diff --git a/pullimap b/pullimap index b620891..a1f82e2 100755 --- a/pullimap +++ b/pullimap @@ -110,6 +110,7 @@ sub writeUID($) { ; $offset < 4 ; $offset += syswrite($STATE, $uid, 4-$offset, $offset) // die "Can't syswrite: $!" ) {} + # no need to sync (or flush) since $STATE is opened with O_DSYNC } @@ -218,10 +219,10 @@ sub smtp_send(@) { # Initialize the cache from the statefile, then pull new messages from # the remote mailbox # -$CONF->{'logger-fd'} = \*STDERR if $CONFIG{debug}; my $IMAP = do { my %config = (%$CONF, %CONFIG{qw/quiet debug/}, name => $ARGV[0]); $config{keepalive} = 1 if defined $CONFIG{idle}; + $config{'logger-fd'} = \*STDERR if $CONFIG{debug}; Net::IMAP::InterIMAP::->new( %config ); }; @@ -287,7 +288,7 @@ sub pull(;$) { $IMAP->silent_store(compact_set(@$ignore, @uid), '+', '\Seen') if @$ignore or @uid; # update the statefile - sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!"; + sysseek($STATE, 4, SEEK_SET) or die "Can't seek: $!"; my ($uidnext) = $IMAP->get_cache('UIDNEXT'); writeUID($uidnext); truncate($STATE, 8) // die "Can't truncate"; -- cgit v1.2.3 From 5c5f8134e5bbedf71a63e377d49c0962fe1ba1ad Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 Mar 2016 20:59:14 +0100 Subject: pullimap: keep trying to pull new messages after issuing any IMAP command. Indeed we might get an untagged EXISTS response, meaning that a new message has been received meanwhile. --- lib/Net/IMAP/InterIMAP.pm | 2 +- pullimap | 58 +++++++++++++++++++++++++++++------------------ 2 files changed, 37 insertions(+), 23 deletions(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index bd69d87..bad49da 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1053,7 +1053,7 @@ sub uidvalidity($;$) { } -# $self->set_cache(@attributes) +# $self->get_cache(@attributes) # Return the persistent cache for the mailbox currently selected. If # some @attributes are given, return the list of values corresponding # to these attributes. diff --git a/pullimap b/pullimap index a1f82e2..02aedf6 100755 --- a/pullimap +++ b/pullimap @@ -244,13 +244,18 @@ sub purge() { 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}; + $set = @uid ? compact_set(@uid) : undef; + $IMAP->log("Removing ".($#uid+1)." UID(s) $set") if defined $set and !$CONFIG{quiet}; } - $IMAP->silent_store($set, '+', '\Deleted'); - $IMAP->expunge($set); + + if (defined $set) { + $IMAP->silent_store($set, '+', '\Deleted'); + $IMAP->expunge($set); + } + + # pull messages that have been received in the meantime + pull() if $IMAP->has_new_mails($MAILBOX); } # Use BODY.PEEK[] so if something gets wrong, unpulled messages @@ -258,37 +263,46 @@ sub purge() { my $ATTRS = "ENVELOPE INTERNALDATE"; $ATTRS .= " BODY.PEEK[]" unless $CONFIG{'no-delivery'}; +sub pull_callback($$) { + my ($uids, $mail) = @_; + return unless exists $mail->{RFC822} or $CONFIG{'no-delivery'}; # 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] : ''; + $IMAP->log("UID $uid from <$from> ($mail->{INTERNALDATE})") unless $CONFIG{quiet}; + + sendmail($from, $mail->{RFC822}) unless $CONFIG{'no-delivery'}; + + push @$uids, $uid; + writeUID($uid); +} + # 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} or $CONFIG{'no-delivery'}; # 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] : ''; - $IMAP->log("UID $uid from <$from> ($mail->{INTERNALDATE})") unless $CONFIG{quiet}; + my $callback = sub($) { pull_callback(\@uid, shift) }; - sendmail($from, $mail->{RFC822}) unless $CONFIG{'no-delivery'}; + do { + # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids) in the statefile + $IMAP->pull_new_messages($ATTRS, $callback, @$ignore); - 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; + } + # repeat if we got a message in the meantime + while ($IMAP->has_new_mails($MAILBOX)); # terminate the SMTP transmission channel gracefully, cf RFC 5321 section 4.5.3.2 smtp_send('QUIT' => '221') if defined $SMTP; undef $SMTP; - # 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) or die "Can't seek: $!"; + my $p = sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!"; + die "Couldn't seek to 4" unless $p == 4; # safety check my ($uidnext) = $IMAP->get_cache('UIDNEXT'); writeUID($uidnext); truncate($STATE, 8) // die "Can't truncate"; -- cgit v1.2.3 From ebacf74fdb3a507c6b0d865f4e9a8a6e59dbb10c Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 Mar 2016 21:14:40 +0100 Subject: Net::IMAP::InterIMAP: don't print undefined cache values in debug messages. --- lib/Net/IMAP/InterIMAP.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/Net') diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index bad49da..73f55e8 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1027,7 +1027,7 @@ sub set_cache($$%) { } $self->logger("Update last clean state for $mailbox: ". - '('.join(' ', map {"$_ $cache->{$_}"} keys %$cache).')') + '('.join(' ', map {"$_ $cache->{$_}"} grep {defined $cache->{$_}} keys %$cache).')') if $self->{debug}; } -- cgit v1.2.3