aboutsummaryrefslogtreecommitdiffstats
path: root/pullimap
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2016-03-09 21:15:41 +0100
committerGuilhem Moulin <guilhem@fripost.org>2016-03-09 21:15:41 +0100
commit1135600bcaacc7ad3a8d205f7987c5370dcc1688 (patch)
tree7af0993c6cdf19bde6dc92bc4361c5a48ad034fd /pullimap
parent435d6bb2731f0205ff0789e8abeca189e0a35204 (diff)
parentebacf74fdb3a507c6b0d865f4e9a8a6e59dbb10c (diff)
Merge branch 'master' into debian
Diffstat (limited to 'pullimap')
-rwxr-xr-xpullimap69
1 files changed, 42 insertions, 27 deletions
diff --git a/pullimap b/pullimap
index c16d6ac..02aedf6 100755
--- a/pullimap
+++ b/pullimap
@@ -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";