use warnings;
use strict;
-use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
+use Compress::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
use Config::Tiny ();
use Errno 'EWOULDBLOCK';
use IO::Select ();
if ($algo eq 'DEFLATE') {
my ($status, $d, $i);
my %args = ( -WindowBits => 0 - MAX_WBITS );
- ($d, $status) = Compress::Raw::Zlib::Deflate::->new(%args);
+ ($d, $status) = Compress::Zlib::deflateInit(%args);
$self->panic("Can't create deflation stream: ", $d->msg())
unless defined $d and $status == Z_OK;
- ($i, $status) = Compress::Raw::Zlib::Inflate::->new(%args);
+ ($i, $status) = Compress::Zlib::inflateInit(%args);
$self->panic("Can't create inflation stream: ", $i->msg())
unless defined $i and $status == Z_OK;
@$self{qw/_Z_DEFLATE _Z_INFLATE/} = ($d, $i);
$self->{_OUTRAWCOUNT} += $n;
if (defined (my $i = $self->{_Z_INFLATE})) {
- my $status = $i->inflate($buf, my $data);
+ my ($out, $status) = $i->inflate($buf);
$self->panic("Inflation failed: ", $i->msg()) unless $status == Z_OK;
- $buf = $data;
+ $buf = $out;
}
$self->{_OUTBUF} = $buf;
}
# $self->_write(@data)
-# Send the given @data to the IMAP server and flush the buffer. If a
-# compression layer is active, flush the deflation stream first.
+# Send the given @data to the IMAP server.
# Update the interal raw byte count, but the regular byte count must
-# have been updated earlier.
+# have been updated earlier (eg, by _send_cmd).
sub _write($@) {
my $self = shift;
- my @data = @_;
-
- if (defined (my $d = $self->{_Z_DEFLATE})) {
- my $status = $d->flush(my $buf, Z_SYNC_FLUSH);
- $self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
- push @data, $buf if $buf ne '';
+ foreach (@_) {
+ next if $_ eq '';
+ $self->{STDIN}->write($_) // $self->panic("Can't write: $!");
+ $self->{_INRAWCOUNT} += length($_);
}
-
- my $data = join '', @data;
- $self->{STDIN}->write($data) // $self->panic("Can't write: $!");
- $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
- $self->{_INRAWCOUNT} += length($data);
-}
-
-
-# $self->_z_deflate(@data)
-# Add the given @data to the deflation stream, and return the
-# compressed data.
-# This method is a noop if no compression layer is active.
-sub _z_deflate($@) {
- my $self = shift;
- my $data = join '', @_;
- $self->{_INCOUNT} += length($data);
- my $d = $self->{_Z_DEFLATE} // return @_;
-
- my $status = $d->deflate($data, my $buf);
- $self->panic("Deflation failed: ", $d->msg()) unless $status == Z_OK;
- return ($buf) if $buf ne '';
}
# $self->_z_flush([$type])
-# Flush the deflation stream, and return the compressed data.
+# Flush the deflation stream, and write the compressed data.
# This method is a noop if no compression layer is active.
sub _z_flush($;$) {
- my $self = shift;
+ my ($self,$t) = @_;
my $d = $self->{_Z_DEFLATE} // return;
- my $status = $d->flush(my $buf, @_);
+ my ($out, $status) = $d->flush($t);
$self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
- return ($buf) if $buf ne '';
+ $self->_write($out);
+}
+
+
+# $self->_send_cmd($tag, $command)
+# Send the given $command to the IMAP server.
+# If $command contains literals and the server supportes LITERAL+,
+# non-synchronizing literals are sent instead.
+# If a compression layer is active, $command is compressed before
+# being send.
+sub _send_cmd($) {
+ my ($self, $tag, $command) = @_;
+ my $litplus = $self->_capable('LITERAL+') ? 1 : 0;
+ my $d = $self->{_Z_DEFLATE};
+
+ my ($offset, $litlen) = (0, 0);
+ my $z_flush = 0; # whether to flush the dictionary after processing the next literal
+
+ while(1) {
+ my $lit = substr($command, $offset, $litlen) if $litlen > 0;
+ $offset += $litlen;
+
+ my ($line, $z_flush2);
+ my $idx = index($command, "\n", $offset);
+ if ($idx < 0) {
+ $line = substr($command, $offset);
+ }
+ else {
+ $line = substr($command, $offset, $idx-1-$offset);
+ $litlen = $litplus ? ($line =~ s/\{([0-9]+)\}\z/{$1+}/ ? $1 : $self->panic())
+ : ($line =~ /\{([0-9]+)\}\z/ ? $1 : $self->panic());
+ $z_flush2 = ($litlen > 4096 and # large literal
+ (uc ($self->{'use-binary'} // 'YES') eq 'NO'
+ or $line =~ /~\{[0-9]+\}\z/) # literal8, RFC 3516 BINARY
+ ) ? 1 : 0;
+ }
+ $self->logger('C: ', ($offset == 0 ? "$tag " : '[...]'), $line) if $self->{debug};
+
+ my @data = (($offset == 0 ? "$tag " : $lit), $line, "\r\n");
+ $self->{_INCOUNT} += length($_) foreach @data;
+ if (!defined $d) {
+ $self->_write(@data);
+ }
+ else {
+ for (my $i = 0; $i <= $#data; $i++) {
+ $self->_z_flush(Z_FULL_FLUSH) if $i == 0 and $z_flush;
+
+ my ($out, $status) = $d->deflate($data[$i]);
+ $self->panic("Deflation failed: ", $d->msg()) unless $status == Z_OK;
+ $self->_write($out);
+
+ $self->_z_flush(Z_FULL_FLUSH) if $i == 0 and $z_flush;
+ }
+ }
+
+ if (!$litplus or $idx < 0) {
+ $self->_z_flush(Z_SYNC_FLUSH) if defined $d;
+
+ $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
+ last if $idx < 0;
+ my $x = $self->_getline();
+ $x =~ /\A\+ / or $self->panic($x);
+ }
+
+ $z_flush = $z_flush2;
+ $offset = $idx+1;
+ }
}
# literals, mark literals as such and then the whole command in one
# go, otherwise send literals one at a time
my $tag = sprintf '%06d', $self->{_TAG}++;
- my $litplus;
-
- my @command = $self->_z_deflate("$tag ");
- my $dbg_cmd = "C: $tag ";
-
- while ($command =~ s/\A(.*?)\{([0-9]+)\}\r\n//) {
- my ($str, $len) = ($1, $2);
- my $lit = substr $command, 0, $len, ''; # consume the literal
- my $bin = substr($str,-1) eq '~' ? 1 : 0; # literal8, RFC 3516 BINARY
-
- $litplus //= $self->_capable('LITERAL+') ? '+' : '';
- push @command, $self->_z_deflate($str, "{$len$litplus}", "\r\n");
-
- $self->logger($dbg_cmd, $str, "{$len$litplus}") if $self->{debug};
- $dbg_cmd = 'C: [...]';
-
- unless ($litplus) {
- $self->_write(@command);
- my $x = $self->_getline();
- $x =~ /\A\+ / or $self->panic($x);
- @command = ();
- }
- if ($len > 4096 and (!$self->{'use-binary'} or $bin) and defined (my $d = $self->{_Z_DEFLATE})) {
- my ($status, $buf);
- # send a Z_FULL_FLUSH at the start and end of large non-text
- # literals, as hinted at in RFC 4978 section 4
- $status = $d->flush($buf, Z_FULL_FLUSH);
- $self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
- push @command, $buf if $buf ne '';
-
- undef $buf;
- $status = $d->deflate($lit, $buf);
- $self->panic("Deflation failed: ", $d->msg()) unless $status == Z_OK;
- push @command, $buf if $buf ne '';
-
- undef $buf;
- $status = $d->flush($buf, Z_FULL_FLUSH);
- $self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
- push @command, $buf if $buf ne '';
- }
- else {
- push @command, $self->_z_deflate($lit);
- }
- }
- push @command, $self->_z_deflate($command, "\r\n");
- $self->logger($dbg_cmd, $command) if $self->{debug};
- $self->_write(@command);
+ $self->_send_cmd($tag, $command);
my $r;
# wait for the answer
$x .= "\r\n";
$self->{_INCOUNT} += length($x);
$self->_write($x);
+ $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
}
}
else {
projects / interimap.git / commitdiff