diff options
Diffstat (limited to 'interimap')
| -rwxr-xr-x | interimap | 28 |
1 files changed, 17 insertions, 11 deletions
@@ -74,6 +74,7 @@ my $CONF = read_config( delete $CONFIG{config} // $NAME , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ , '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/ + , 'use-binary' => qr/\A(YES|NO)\z/i, ); my ($DBFILE, $LOCKFILE, $LOGGER_FD); @@ -109,7 +110,9 @@ my ($DBFILE, $LOCKFILE, $LOGGER_FD); my $DBH; # Clean after us +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; @@ -239,13 +242,13 @@ $LIST .= $#ARGV == 0 ? Net::IMAP::InterIMAP::quote($ARGV[0]) : ('('.join(' ',map {Net::IMAP::InterIMAP::quote($_)} @ARGV).')') if @ARGV; -my $IMAP; foreach my $name (qw/local remote/) { my %config = %{$CONF->{$name}}; $config{$_} = $CONFIG{$_} foreach grep {defined $CONFIG{$_}} qw/quiet debug/; $config{enable} = 'QRESYNC'; $config{name} = $name; $config{'logger-fd'} = $LOGGER_FD if defined $LOGGER_FD; + $config{'compress'} //= ($name eq 'local' ? 'NO' : 'YES'); $IMAP->{$name} = { client => Net::IMAP::InterIMAP::->new(%config) }; my $client = $IMAP->{$name}->{client}; @@ -268,6 +271,7 @@ foreach my $name (qw/local remote/) { @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/; + ############################################################################## # @@ -507,7 +511,11 @@ sub sync_mailbox_list() { } sync_mailbox_list(); -my ($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/; +($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/; +my $ATTRS = 'MODSEQ FLAGS INTERNALDATE '. + (((!defined $CONF->{_} or uc ($CONF->{_}->{'use-binary'} // 'YES') eq 'YES') and + !$lIMAP->incapable('BINARY') and !$rIMAP->incapable('BINARY')) + ? 'BINARY' : 'BODY').'.PEEK[]'; ############################################################################# @@ -589,10 +597,10 @@ sub download_missing($$$@) { my ($buff, $bufflen) = ([], 0); undef $buff if ($target eq 'local' ? $lIMAP : $rIMAP)->incapable('MULTIAPPEND'); - my $attrs = join ' ', qw/MODSEQ FLAGS INTERNALDATE ENVELOPE BODY.PEEK[]/; + my $attrs = $ATTRS.' ENVELOPE'; ($source eq 'local' ? $lIMAP : $rIMAP)->fetch(compact_set(@set), "($attrs)", sub($) { my $mail = shift; - return unless exists $mail->{RFC822}; # not for us + return unless exists $mail->{RFC822} or exists $mail->{BINARY}; # not for us my $uid = $mail->{UID}; my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4]; @@ -961,9 +969,10 @@ sub sync_known_messages($$) { # after the FETCH. sub callback_new_message($$$$;$$$) { my ($idx, $mailbox, $name, $mail, $UIDs, $buff, $bufflen) = @_; - return unless exists $mail->{RFC822}; # not for us - my $length = length $mail->{RFC822}; + my $length = defined $mail->{RFC822} ? length($mail->{RFC822}) + : defined $mail->{BINARY} ? length($mail->{BINARY}) + : return; # not for us if ($length == 0) { msg("$name($mailbox)", "WARNING: Ignoring new 0-length message (UID $mail->{UID})"); return; @@ -1027,7 +1036,7 @@ sub sync_messages($$;$$) { my $bufflen = 0; my @tUIDs; - ($source eq 'remote' ? $rIMAP : $lIMAP)->pull_new_messages(sub($) { + ($source eq 'remote' ? $rIMAP : $lIMAP)->pull_new_messages($ATTRS, sub($) { callback_new_message($idx, $mailbox, $source, shift, \@tUIDs, $buff, \$bufflen) }, @{$ignore{$source}}); @@ -1215,7 +1224,4 @@ while(1) { sync_mailbox_list(); } -END { - $_->logout() foreach grep defined, ($lIMAP, $rIMAP); - cleanup(); -} +END { cleanup(); } |