diff options
Diffstat (limited to 'interimap')
| -rwxr-xr-x | interimap | 170 |
1 files changed, 85 insertions, 85 deletions
@@ -53,7 +53,7 @@ sub usage(;$) { } my @COMMANDS = qw/repair delete rename/; -usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q target=s@ debug help|h watch:i/, @COMMANDS); +usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q target=s@ debug help|h watch:i notify/, @COMMANDS); usage(0) if $CONFIG{help}; my $COMMAND = do { my @command = grep {exists $CONFIG{$_}} @COMMANDS; @@ -61,9 +61,9 @@ my $COMMAND = do { $command[0] }; usage(1) if defined $COMMAND and (($COMMAND eq 'delete' and !@ARGV) or ($COMMAND eq 'rename' and $#ARGV != 1)); -usage(1) if defined $COMMAND and defined $CONFIG{watch}; +usage(1) if defined $COMMAND and (defined $CONFIG{watch} or defined $CONFIG{notify}); usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete'or $COMMAND eq 'rename')); -$CONFIG{watch} = 60 if defined $CONFIG{watch} and $CONFIG{watch} == 0; +$CONFIG{watch} = $CONFIG{notify} ? 900 : 60 unless $CONFIG{watch}; @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive die "Invalid mailbox name $_" foreach grep !/\A([\x01-\x7F]+)\z/, @ARGV; @@ -76,7 +76,7 @@ my $CONF = read_config( delete $CONFIG{config} // $NAME , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/ , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ ); -my ($DBFILE, $LOCKFILE, $LOGGER_FD); +my ($DBFILE, $LOGGER_FD); { $DBFILE = $CONF->{_}->{database} if defined $CONF->{_}; @@ -94,8 +94,6 @@ my ($DBFILE, $LOCKFILE, $LOGGER_FD); } } - $LOCKFILE = $DBFILE =~ s/([^\/]+)\z/.$1.lck/r; - if (defined $CONF->{_} and defined $CONF->{_}->{logfile}) { require 'POSIX.pm'; require 'Time/HiRes.pm'; @@ -116,7 +114,6 @@ my ($IMAP, $lIMAP, $rIMAP); sub cleanup() { undef $_ foreach grep defined, ($IMAP, $lIMAP, $rIMAP); logger(undef, "Cleaning up...") if $CONFIG{debug}; - unlink $LOCKFILE if defined $LOCKFILE and -f $LOCKFILE; close $LOGGER_FD if defined $LOGGER_FD; $DBH->disconnect() if defined $DBH; } @@ -125,33 +122,16 @@ $SIG{TERM} = sub { cleanup(); exit 0; }; ############################################################################# -# Lock the database -{ - if (-f $LOCKFILE) { - open my $lock, '<', $LOCKFILE or die "Can't open $LOCKFILE: $!\n"; - my $pid = <$lock>; - close $lock; - chomp $pid; - my $msg = "LOCKFILE '$LOCKFILE' exists."; - undef $LOCKFILE; # don't delete the lockfile - $msg .= " (Is PID $pid running?)" if defined $pid and $pid =~ /^[0-9]+$/; - die $msg, "\n"; - } - - open my $lock, '>', $LOCKFILE or die "Can't open $LOCKFILE: $!\n"; - print $lock $$, "\n"; - close $lock; -} - - -############################################################################# # Open the database and create tables $DBH = DBI::->connect("dbi:SQLite:dbname=$DBFILE", undef, undef, { AutoCommit => 0, RaiseError => 1, sqlite_see_if_its_a_number => 1, # see if the bind values are numbers or not + sqlite_use_immediate_transaction => 1, }); +$DBH->sqlite_busy_timeout(250); +$DBH->do('PRAGMA locking_mode = EXCLUSIVE'); $DBH->do('PRAGMA foreign_keys = ON'); @@ -236,10 +216,13 @@ logger(undef, ">>> $NAME $VERSION"); my $LIST = '"" '; my @LIST_PARAMS; +my %LIST_PARAMS_STATUS = (STATUS => [qw/UIDVALIDITY UIDNEXT HIGHESTMODSEQ/]); if (!defined $COMMAND or $COMMAND eq 'repair') { $LIST = '('.uc($CONF->{_}->{'list-select-opts'}).') '.$LIST if defined $CONF->{_}->{'list-select-opts'}; $LIST .= (defined $CONF->{_}->{'list-mailbox'} ? '('.$CONF->{_}->{'list-mailbox'}.')' : '*') unless @ARGV; - @LIST_PARAMS = ('SUBSCRIBED', 'STATUS (UIDVALIDITY UIDNEXT HIGHESTMODSEQ)'); + @LIST_PARAMS = ('SUBSCRIBED'); + push @LIST_PARAMS, map { "$_ (".join(' ', @{$LIST_PARAMS_STATUS{$_}}).")" } keys %LIST_PARAMS_STATUS + unless $CONFIG{notify}; } $LIST .= $#ARGV == 0 ? Net::IMAP::InterIMAP::quote($ARGV[0]) : ('('.join(' ',map {Net::IMAP::InterIMAP::quote($_)} @ARGV).')') if @ARGV; @@ -257,20 +240,8 @@ foreach my $name (qw/local remote/) { $IMAP->{$name} = { client => Net::IMAP::InterIMAP::->new(%config) }; my $client = $IMAP->{$name}->{client}; - die "Non $_-capable IMAP server.\n" foreach $client->incapable(qw/LIST-EXTENDED LIST-STATUS UIDPLUS/); - # XXX We should start by listing all mailboxes matching the user's LIST - # criterion, then issue "SET NOTIFY (mailboxes ... (...))". But this - # crashes the IMAP client: - # http://dovecot.org/pipermail/dovecot/2015-July/101473.html - #my $mailboxes = $client->list((uc $config{'subscribed-only'} eq 'TRUE' ? '(SUBSCRIBED)' : '' ) - # .$config{mailboxes}, 'SUBSCRIBED'); - # $client->notify('SELECTED', 'MAILBOXES ('.join(' ', keys %$mailboxes).')'); - # XXX NOTIFY doesn't work as expected for INBOX - # http://dovecot.org/pipermail/dovecot/2015-July/101514.html - #$client->notify(qw/SELECTED SUBSCRIBED/) if $CONFIG{watch}; - # XXX We shouldn't need to ask for STATUS responses here, and use - # NOTIFY's STATUS indicator instead. However Dovecot violates RFC - # 5464: http://dovecot.org/pipermail/dovecot/2015-July/101474.html + die "Non $_-capable IMAP server.\n" foreach $client->incapable(qw/LIST-EXTENDED UIDPLUS/); + die "Non LIST-STATUS-capable IMAP server.\n" if !$CONFIG{notify} and $client->incapable('LIST-STATUS'); } @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/; @@ -425,9 +396,8 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { ############################################################################## # Synchronize mailbox and subscription lists -my @MAILBOXES; sub sync_mailbox_list() { - my %mailboxes; + my (%mailboxes, @mailboxes); $mailboxes{$_} = 1 foreach keys %{$IMAP->{local}->{mailboxes}}; $mailboxes{$_} = 1 foreach keys %{$IMAP->{remote}->{mailboxes}}; my $sth_subscribe = $DBH->prepare(q{UPDATE mailboxes SET subscribed = ? WHERE idx = ?}); @@ -444,7 +414,7 @@ sub sync_mailbox_list() { }; check_delim($mailbox); # ensure that the delimiter match - push @MAILBOXES, $mailbox unless grep {lc $_ eq lc '\NoSelect'} @attrs; + push @mailboxes, $mailbox unless grep {lc $_ eq lc '\NoSelect'} @attrs; $STH_GET_INDEX->execute($mailbox); my ($idx,$subscribed) = $STH_GET_INDEX->fetchrow_array(); @@ -512,9 +482,10 @@ sub sync_mailbox_list() { $DBH->commit(); } } + return @mailboxes; } -sync_mailbox_list(); +my @MAILBOXES = sync_mailbox_list(); ($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/; my $ATTRS = join ' ', qw/MODSEQ FLAGS INTERNALDATE BODY.PEEK[]/; @@ -1066,26 +1037,6 @@ sub sync_messages($$;$$) { } -# Wait up to $timout seconds for notifications on either IMAP server. -# Then issue a NOOP so the connection doesn't terminate for inactivity. -sub wait_notifications(;$) { - my $timeout = shift // 300; - - while ($timeout > 0) { - my $r1 = $lIMAP->slurp(); - my $r2 = $rIMAP->slurp(); - last if $r1 or $r2; # got update! - - sleep 1; - if (--$timeout == 0) { - $lIMAP->noop(); - $rIMAP->noop(); - # might have got updates so exit the loop - } - } -} - - ############################################################################# # Resume interrupted mailbox syncs (before initializing the cache). # @@ -1166,7 +1117,27 @@ if (defined $COMMAND and $COMMAND eq 'repair') { } -while(1) { +if ($CONFIG{notify}) { + # Be notified of new messages with EXISTS/RECENT responses, but don't + # receive unsolicited FETCH responses with a RFC822/BODY[]. It costs us an + # extra roundtrip, but we need to sync FLAG updates and VANISHED responses + # in batch mode, update the HIGHESTMODSEQ, and *then* issue an explicit UID + # FETCH command to get new message, and process each FETCH response with a + # RFC822/BODY[] attribute as they arrive. + my $mailboxes = join(' ', map {Net::IMAP::InterIMAP::quote($_)} @MAILBOXES); + my %mailboxes = map { $_ => [qw/MessageNew MessageExpunge FlagChange/] } + ( "MAILBOXES ($mailboxes)", 'SELECTED' ); + my %personal = ( personal => [qw/MailboxName SubscriptionChange/] ); + + foreach ($lIMAP, $rIMAP) { + # require STATUS responses for our @MAILBOXES only + $_->notify('SET STATUS', %mailboxes); + $_->notify('SET', %mailboxes, %personal); + } +} + + +sub loop() { while(@MAILBOXES) { if (defined $MAILBOX and ($lIMAP->is_dirty($MAILBOX) or $rIMAP->is_dirty($MAILBOX))) { # $MAILBOX is dirty on either the local or remote mailbox @@ -1202,26 +1173,55 @@ while(1) { sync_messages($IDX, $MAILBOX); } } - # clean state! - exit 0 unless $CONFIG{watch}; - - # we need to issue a NOOP command or go back to AUTH state since the - # LIST command may not report the correct HIGHESTMODSEQ value for - # the mailbox currently selected. - if (defined $MAILBOX) { - # Prefer UNSELECT over NOOP commands as it requires a single command per cycle - if ($lIMAP->incapable('UNSELECT') or $rIMAP->incapable('UNSELECT')) { - $_->noop() foreach ($lIMAP, $rIMAP); - } else { - $_->unselect() foreach ($lIMAP, $rIMAP); - undef $MAILBOX; - } +} +sub notify(@) { + # TODO: interpret LIST responses to detect mailbox + # creation/deletion/subcription/unsubscription + # mailbox creation + # * LIST () "/" test + # mailbox subscribtion + # * LIST (\Subscribed) "/" test + # mailbox unsubscribtion + # * LIST () "/" test + # mailbox renaming + # * LIST () "/" test2 ("OLDNAME" (test)) + # mailbox deletion + # * LIST (\NonExistent) "/" test2 + unless (Net::IMAP::InterIMAP::slurp(\@_, $CONFIG{watch}, \&Net::IMAP::InterIMAP::is_dirty)) { + $_->noop() foreach @_; + } +} + +unless (defined $CONFIG{watch}) { + loop(); + exit 0; +} + +while (1) { + loop(); + + if ($CONFIG{notify}) { + notify($lIMAP, $rIMAP); } + else { + # we need to issue a NOOP command or go back to AUTH state since the + # LIST command may not report the correct HIGHESTMODSEQ value for + # the mailbox currently selected + if (defined $MAILBOX) { + # Prefer UNSELECT over NOOP commands as it requires a single command per cycle + if ($lIMAP->incapable('UNSELECT') or $rIMAP->incapable('UNSELECT')) { + $_->noop() foreach ($lIMAP, $rIMAP); + } else { + $_->unselect() foreach ($lIMAP, $rIMAP); + undef $MAILBOX; + } + } - sleep $CONFIG{watch}; - # Refresh the mailbox list and status - @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/; - sync_mailbox_list(); + sleep $CONFIG{watch}; + # refresh the mailbox list and status + @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/; + @MAILBOXES = sync_mailbox_list(); + } } END { cleanup(); } |