diff options
| -rwxr-xr-x | interimap | 6 | ||||
| -rw-r--r-- | interimap.1 | 12 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 12 | ||||
| -rwxr-xr-x | pullimap | 69 | ||||
| -rw-r--r-- | pullimap.1 | 102 |
5 files changed, 151 insertions, 50 deletions
@@ -26,7 +26,7 @@ my $NAME = 'interimap'; use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat bundling auto_version/; use DBI (); -use Fcntl qw/F_GETFL F_SETFL FD_CLOEXEC/; +use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC/; use List::Util 'first'; use lib 'lib'; @@ -103,8 +103,8 @@ my ($DBFILE, $LOCKFILE, $LOGGER_FD); open $LOGGER_FD, '>>', $CONF->{_}->{logfile} or die "Can't open $CONF->{_}->{logfile}: $!\n"; $LOGGER_FD->autoflush(1); - my $flags = fcntl($LOGGER_FD, F_GETFL, 0) or die "fcntl F_GETFL: $!"; - fcntl($LOGGER_FD, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!"; + my $flags = fcntl($LOGGER_FD, F_GETFD, 0) or die "fcntl F_GETFD: $!"; + fcntl($LOGGER_FD, F_SETFD, $flags | FD_CLOEXEC) or die "fcntl F_SETFD: $!"; } elsif ($CONFIG{debug}) { $LOGGER_FD = \*STDERR; diff --git a/interimap.1 b/interimap.1 index 93e463e..3aabc3f 100644 --- a/interimap.1 +++ b/interimap.1 @@ -392,6 +392,12 @@ tunables in the \fBCONFIGURATION FILE\fR. Moreover, few IMAP servers have been tested so far. .SH AUTHOR -Written by Guilhem Moulin -.MT guilhem@fripost.org -.ME . +.ie \n[www-html] \{\ + Written by +. MTO guilhem@fripost.org "Guilhem Moulin" . +\} +.el \{\ + Written by Guilhem Moulin +. MT guilhem@fripost.org +. ME . +\} diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 785de38..73f55e8 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'; @@ -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}) { @@ -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}; } @@ -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. @@ -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"); @@ -25,7 +25,7 @@ our $VERSION = '0.3'; my $NAME = 'pullimap'; use Errno 'EINTR'; -use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET F_GETFL F_SETFL FD_CLOEXEC/; +use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET F_GETFD F_SETFD FD_CLOEXEC/; use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/; use List::Util 'first'; use Socket qw/PF_INET PF_INET6 SOCK_STREAM/; @@ -83,8 +83,8 @@ do { } sysopen($STATE, $statefile, O_CREAT|O_RDWR|O_DSYNC, 0600) or die "Can't open $statefile: $!"; - my $flags = fcntl($STATE, F_GETFL, 0) or die "fcntl F_GETFL: $!"; - fcntl($STATE, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!"; + my $flags = fcntl($STATE, F_GETFD, 0) or die "fcntl F_GETFD: $!"; + fcntl($STATE, F_SETFD, $flags | FD_CLOEXEC) or die "fcntl F_SETFD: $!"; flock($STATE, LOCK_EX) or die "Can't flock $statefile: $!"; }; @@ -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 ); }; @@ -236,20 +237,25 @@ sub purge() { unless ($days == 0) { my $now = time; - return if defined $LAST_PURGED and $now - $LAST_PURGED < 6*3600; # purge every 6h + return if defined $LAST_PURGED and $now - $LAST_PURGED < 43200; # purge every 12h $LAST_PURGED = $now; 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}; + $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 @@ -257,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) // 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"; @@ -15,10 +15,11 @@ to a SMTP or LMTP transmission channel. It can also remove old messages after a configurable retention period. .PP -A statefile is used to keep track of the mailbox's UIDVALIDITY and -UIDNEXT values. While \fBPullIMAP\fR is running, the statefile is also -used to keep track of UIDs being delivered, which avoids duplicate +A \fIstatefile\fR is used to keep track of the mailbox's UIDVALIDITY and +UIDNEXT values. While \fBPullIMAP\fR is running, the \fIstatefile\fR is +also used to keep track of UIDs being delivered, which avoids duplicate deliveries if the process is interrupted. +See the \fBCONTROL FLOW\fR section below. .SH OPTIONS .TP @@ -38,10 +39,10 @@ default) to avoid being logged out for inactivity. .TP .B \fB\-\-no\-delivery -Update the state file, but skip SMTP/LMTP delivery. This is mostly -useful for initializing the statefile when migrating to \fBPullIMAP\fR -from another equivalent program such as \fIgetmail\fR(1) or -\fIfetchmail\fR(1). +Update the \fIstatefile\fR, but skip SMTP/LMTP delivery. This is mostly +useful for initializing the \fIstatefile\fR when migrating to +\fBPullIMAP\fR from another equivalent program such as \fIgetmail\fR(1) +or \fIfetchmail\fR(1). .TP .B \-q\fR, \fB\-\-quiet\fR @@ -116,7 +117,7 @@ criterion ignoring time and timezone.) If \fIpurge\-after\fR is set to \(lq0\(rq then messages are deleted immediately after delivery. Otherwise \fBPullIMAP\fR issues an IMAP SEARCH command to list old messages; if \fB\-\-idle\fR is set then the -SEARCH command is issued again every 6 hours. +SEARCH command is issued again every 12 hours. .TP .I type @@ -234,7 +235,86 @@ for more information. File containing trusted certificates to use during server certificate authentication if \(lq\fISSL_verify\fR=YES\(rq. +.SH CONTROL FLOW +\fBPullIMAP\fR opens the \fIstatefile\fR corresponding to a given +configuration \fISECTION\fR with O_DSYNC to ensure that written data is +flushed to the underlying hardware by the time \fIwrite\fR(2) returns. +Moreover an exclusive lock is placed on the file descriptor immediately +after opening to prevent multiple \fBpullimap\fR processes from +accessing the \fIstatefile\fR concurrently. + +Each \fIstatefile\fR consists of a series of 32-bits big-endian +integers. Usually there are only two integers: +the first is the \fImailbox\fR's UIDVALIDITY value, and the second is +the \fImailbox\fR's last seen UIDNEXT value (\fBPullIMAP\fR then assumes +that all messages with UID smaller than this UIDNEXT value have already +been retrieved and delivered). +The IMAP4rev1 specification [RFC 3501] does not guaranty that untagged +FETCH responses are sent ordered by UID in response of an UID FETCH +command. Thus it would be unsafe for \fBPullIMAP\fR to update the +UIDNEXT value in the \fIstatefile\fR while the UID FETCH command is +progress. +Instead, for each untagged FETCH response received while while the UID +FETCH command is in progress, \fBPullIMAP\fR delivers the message BODY +to the SMTP or LMTP server specified with \fIdeliver\-method\fR then +appends the message UID to the \fIstatefile\fR. When the UID FETCH +command eventually terminates, \fBPullIMAP\fR updates the UIDNEXT value +in the \fIstatefile\fR and truncate the file down to 8 bytes. +Keeping track of message UIDs as they are received avoids duplicate in +the even of a crash or session loss while the UID FETCH command is in +progress. + +In more details, \fBPullIMAP\fR works as follows: + +.nr step 1 1 +.IP \n[step]. 4 +Issue an UID FETCH command to retrieve message ENVELOPE and BODY (and +UID) with UID bigger or equal than the UIDNEXT value found in the +\fIstatefile\fR. +While the UID FETCH command is in progress, perform the following +for each untagged FETCH response sent by the server: +.RS +\(bu +if no SMTP/LMTP transmission channel was opened, open one to the server +specified with \fIdeliver\-method\fR and send an EHLO (or LHO) command +with the domain given by \fIdeliver\-ehlo\fR; +.br +\(bu +perform a mail transaction (using SMTP pipelining [RFC 2920] if +possible) to send the retrieved message BODY to the SMTP or LMTP +session; and +.br +\(bu +append the message UID to the \fIstatefile\fR. +.RE + +.IP \n+[step]. +If a SMTP/LMTP transmission channel was opened, send a QUIT command to +close it gracefully. + +.IP \n+[step]. +Issue an UID STORE command to mark all retrieved messages (and stalled +UIDs found in the \fIstatefile\fR after the UIDNEXT value) as \\Seen. + +.IP \n+[step]. +Update the \fIstatefile\fR with the new UIDNEXT value. + +.IP \n+[step]. +Truncate the \fIstatefile\fR down to 8 bytes (so that it contains only +two 32-bits integers, respectively the \fImailbox\fR's UIDVALIDITY and +UIDNEXT values). + +.IP \n+[step]. +If \fB\-\-idle\fR was set, issue an IDLE command; stop idling and go +back to step 1. whenever a new message is received. + .SH AUTHOR -Written by Guilhem Moulin -.MT guilhem@fripost.org -.ME . +.ie \n[www-html] \{\ + Written by +. MTO guilhem@fripost.org "Guilhem Moulin" . +\} +.el \{\ + Written by Guilhem Moulin +. MT guilhem@fripost.org +. ME . +\} |