From 64dc8a1ed4e15ce456a699184a4fff263f2c902f Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 Sep 2015 00:44:05 +0200 Subject: Add support for the IMAP COMPRESS extension [RFC4978]. Also, add traffic statistics after closing the connection to the IMAP server. --- interimap | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'interimap') diff --git a/interimap b/interimap index af8b7fd..af2c510 100755 --- a/interimap +++ b/interimap @@ -109,7 +109,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 +241,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 +270,7 @@ foreach my $name (qw/local remote/) { @{$IMAP->{$_}}{qw/mailboxes delims/} = $IMAP->{$_}->{client}->list($LIST, @LIST_PARAMS) for qw/local remote/; + ############################################################################## # @@ -507,7 +510,7 @@ sub sync_mailbox_list() { } sync_mailbox_list(); -my ($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/; +($lIMAP, $rIMAP) = map {$IMAP->{$_}->{client}} qw/local remote/; ############################################################################# @@ -1215,7 +1218,4 @@ while(1) { sync_mailbox_list(); } -END { - $_->logout() foreach grep defined, ($lIMAP, $rIMAP); - cleanup(); -} +END { cleanup(); } -- cgit v1.2.3 From 1abb196660516f85b2ec13673aa28e6cf8a24b41 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 9 Sep 2015 16:05:36 +0200 Subject: Add support for the Binary Content extension [RFC3516]. Unfortunately as of Debian Wheezy it doesn't work for Dovecot with COMPRESS=DEFLATE [RFC4978] and non-synchronizing literals. perl -e 'use Compress::Raw::Zlib; print "a COMPRESS DEFLATE\r\n"; sleep 1; my $d = new Compress::Raw::Zlib::Deflate( -WindowBits => -15 ); $d->deflate("b APPEND TRASH ~{1+}\r\nx\r\n", my $buf); print $buf; $d->flush($buf, Z_SYNC_FLUSH); print $buf; sleep 1; ' | /usr/lib/dovecot/imap imap(guilhem): Panic: stream doesn't support seeking backwards Interestingly, it works just fine for non-binary literals: perl -e 'use Compress::Raw::Zlib; print "a COMPRESS DEFLATE\r\n"; sleep 1; my $d = new Compress::Raw::Zlib::Deflate( -WindowBits => -15 ); $d->deflate("b APPEND TRASH {1+}\r\nx\r\n", my $buf); print $buf; $d->flush($buf, Z_SYNC_FLUSH); print $buf; sleep 1; ' | /usr/lib/dovecot/imap However I can't reproduce the problem Dovecot 2.2.18 and Debian Sid (but it doesn't help to install Dovecot from testing to my Wheezy box.) --- interimap | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'interimap') diff --git a/interimap b/interimap index af2c510..81582f2 100755 --- a/interimap +++ b/interimap @@ -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); @@ -511,6 +512,10 @@ sub sync_mailbox_list() { sync_mailbox_list(); ($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[]'; ############################################################################# @@ -592,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]; @@ -964,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; @@ -1030,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}}); -- cgit v1.2.3