Replace IO::Socket::SSL dependency by the lower level Net::SSLeay.

Also,

  * Rename the 'SSL_verify_trusted_peer', 'SSL_ca_path', and
    'SSL_cipher_list' options to 'SSL_CApath', 'SSL_verify' and
    'SSL_cipherlist', respectively.
  * Add an option 'SSL_CAfile' to specify a file containing trusted
    certificates to use during server certificate authentication.
  * Replace Compress::Zlib dependency by the lower level
    Compress::Raw::Zlib.

5 files changed, 186 insertions, 121 deletions

diff --git a/Changelog b/Changelog
index 754e0fd..303e309 100644
--- a/Changelog
+++ b/Changelog
@@ -16,6 +16,12 @@ interimap (0.2) upstream;
     and NO_COMPRESSION to the compiled-in CTX options.
   * Use SSL_MODE_AUTO_RETRY to avoid SSL_read failures during a
     handshake.
+  * Rename the 'SSL_verify_trusted_peer', 'SSL_ca_path', and
+    'SSL_cipher_list' options to 'SSL_CApath', 'SSL_verify' and
+	'SSL_cipherlist', respectively.
+  * Add an option 'SSL_CAfile' to specify a file containing trusted
+    certificates to use during server certificate authentication.
+  * Replace IO::Socket::SSL dependency by the lower level Net::SSLeay.
 
  -- Guilhem Moulin <guilhem@guilhem.org>  Wed, 09 Sep 2015 00:44:35 +0200
 
diff --git a/INSTALL b/INSTALL
index f27952b..486cdbc 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,6 +1,6 @@
 InterIMAP depends on the following Perl modules:
 
-  - Compress::Zlib (core module)
+  - Compress::Raw::Zlib (core module)
   - Config::Tiny
   - DBI
   - DBD::SQLite
@@ -8,8 +8,8 @@ InterIMAP depends on the following Perl modules:
   - Getopt::Long (core module)
   - MIME::Base64 (core module) if authentication is required
   - IO::Select (core module)
-  - IO::Socket::INET (core module) for 'type=imap'
-  - IO::Socket::SSL for 'type=imaps' (or 'type=imap' and 'STARTTLS=YES')
+  - IO::Socket::INET (core module) for 'type=imap' or 'type=imaps'
+  - Net::SSLeay
   - List::Util (core module)
   - POSIX (core module)
   - Socket (core module)
@@ -18,7 +18,7 @@ InterIMAP depends on the following Perl modules:
 On Debian GNU/Linux systems, these modules can be installed with the
 following command:
 
-  apt-get install libconfig-tiny-perl libdbi-perl libdbd-sqlite3-perl libio-socket-ssl-perl
+  apt-get install libconfig-tiny-perl libdbi-perl libdbd-sqlite3-perl libnet-ssleay-perl
 
 However Debian GNU/Linux users can also use gbp(1) from git-buildpackage
 to build their own package:
diff --git a/interimap.1 b/interimap.1
index 988fa16..7ac8204 100644
--- a/interimap.1
+++ b/interimap.1
@@ -282,33 +282,6 @@ pre\-authenticated connections, depending on the chosen authentication
 mechanism.
 
 .TP
-.I SSL_cipher_list
-Cipher list to use for the connection.
-See \fIciphers\fR(1ssl) for the format of such list.
-
-.TP
-.I SSL_fingerprint
-Fingerprint of the server certificate in the form
-\fIALGO\fR$\fIDIGEST_HEX\fR, where \fIALGO\fR is the used algorithm
-(default \(lqsha256\(rq).
-Attempting to connect to a server with a non-matching certificate
-fingerprint causes \fBInterIMAP\fR to abort the connection immediately
-after the SSL/TLS handshake.
-
-.TP
-.I SSL_verify_trusted_peer
-Whether to verify that the peer certificate has been signed by a trusted
-Certificate Authority.  Note that using \fISSL_fingerprint\fR to specify
-the fingerprint of the server certificate is orthogonal and does not
-rely on Certificate Authorities.
-(Default: \(lqYES\(rq.)
-
-.TP
-.I SSL_ca_path
-Directory containing the certificate(s) of the trusted Certificate
-Authorities, used for server certificate verification.
-
-.TP
 .I compress
 Whether to use the IMAP COMPRESS extension [RFC4978] for servers
 advertizing it.
@@ -333,6 +306,42 @@ This option is only available in the default section, and is ignored if
 either server does not advertize \(lqBINARY\(rq in its capability list.
 (Default: \(lqYES\(rq.)
 
+.TP
+.I SSL_cipher_list
+The cipher list to send to the server.  Although the server determines
+which cipher suite is used, it should take the first supported cipher in
+the list sent by the client.  See \fBciphers\fR(1ssl) for more
+information.
+
+.TP
+.I SSL_fingerprint
+Fingerprint of the server certificate (or its public key) in the form
+\fIALGO\fR$\fIDIGEST_HEX\fR, where \fIALGO\fR is the used algorithm
+(default \(lqsha256\(rq).
+Attempting to connect to a server with a non-matching certificate
+fingerprint causes \fBInterIMAP\fR to abort the connection immediately
+after the SSL/TLS handshake.
+
+.TP
+.I SSL_verify
+Whether to verify the server certificate chain.
+Note that using \fISSL_fingerprint\fR to specify the fingerprint of the
+server certificate is an orthogonal authentication measure as it ignores
+the CA chain.
+(Default: \(lqYES\(rq.)
+
+.TP
+.I SSL_CApath
+Directory to use for server certificate verification if
+\(lq\fISSL_verify\fR=YES\(rq.
+This directory must be in \(lqhash format\(rq, see \fBverify\fR(1ssl)
+for more information.
+
+.TP
+.I SSL_CAfile
+File containing trusted certificates to use during server certificate
+authentication if \(lq\fISSL_verify\fR=YES\(rq.
+
 .SH SUPPORTED EXTENSIONS
 
 Performance is better for servers supporting the following extensions to
diff --git a/interimap.sample b/interimap.sample
index b0f619a..bbf8c42 100644
--- a/interimap.sample
+++ b/interimap.sample
@@ -18,9 +18,9 @@ password = xxxxxxxxxxxxxxxx
 #compress = YES
 
 # SSL options
-#SSL_cipher_list = EECDH+AES:EDH+AES:!MEDIUM:!LOW:!EXP:!aNULL:!eNULL:!SSLv2:!SSLv3:!TLSv1:!TLSv1.1
+SSL_CApath = /etc/ssl/certs
+#SSL_verify = YES
+#SSL_cipherlist = EECDH+AES:EDH+AES:!MEDIUM:!LOW:!EXP:!aNULL:!eNULL:!SSLv2:!SSLv3:!TLSv1:!TLSv1.1
 #SSL_fingerprint = sha256$62E436BB329C46A628314C49BDA7C2A2E86C57B2021B9A964B8FABB6540D3605
-#SSL_verify_trusted_peer = YES
-SSL_ca_path = /etc/ssl/certs
 
 # vim:ft=dosini
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 678e09d..c26d102 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -20,16 +20,20 @@ package Net::IMAP::InterIMAP v0.0.2;
 use warnings;
 use strict;
 
-use Compress::Zlib qw/Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
+use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
-use Errno 'EWOULDBLOCK';
 use IO::Select ();
+use Net::SSLeay ();
 use List::Util 'first';
 use POSIX ':signal_h';
-use Socket 'SO_KEEPALIVE';
+use Socket qw/SO_KEEPALIVE SOL_SOCKET/;
 
 use Exporter 'import';
 BEGIN {
+    Net::SSLeay::load_error_strings();
+    Net::SSLeay::SSLeay_add_ssl_algorithms();
+    Net::SSLeay::randomize();
+
     our @EXPORT_OK = qw/read_config compact_set $IMAP_text $IMAP_cond/;
 }
 
@@ -51,12 +55,16 @@ my %OPTIONS = (
     command => qr/\A(\/\P{Control}+)\z/,
     'null-stderr' => qr/\A(YES|NO)\z/i,
     compress => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/,
-    SSL_fingerprint => qr/\A([A-Za-z0-9]+\$\p{AHex}+)\z/,
-    SSL_cipher_list => qr/\A(\P{Control}+)\z/,
-    SSL_verify_trusted_peer => qr/\A(YES|NO)\z/i,
-    SSL_ca_path => qr/\A(\P{Control}+)\z/,
+    SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+)\z/,
+    SSL_cipherlist => qr/\A(\P{Control}+)\z/,
+    SSL_verify => qr/\A(YES|NO)\z/i,
+    SSL_CApath => qr/\A(\P{Control}+)\z/,
+    SSL_CAfile => qr/\A(\P{Control}+)\z/,
 );
 
+# Use the same buffer size as Net::SSLeay::read(), to ensure there is
+# never any pending data left in the current TLS record
+my $BUFSIZE = 32768;
 
 #############################################################################
 # Utilities
@@ -228,7 +236,7 @@ sub new($%) {
     # in/out buffer counts and output stream
     $self->{_INCOUNT}  = $self->{_INRAWCOUNT}  = 0;
     $self->{_OUTCOUNT} = $self->{_OUTRAWCOUNT} = 0;
-    $self->{_OUTBUF} = '';
+    $self->{_OUTBUF} = undef;
 
     if ($self->{type} eq 'tunnel') {
         my $command = $self->{command} // $self->fail("Missing tunnel command");
@@ -277,12 +285,10 @@ sub new($%) {
         $args{PeerPort} = $self->{port} // $self->fail("Missing option port");
 
         my $socket = IO::Socket::INET->new(%args) or $self->fail("Cannot bind: $@");
+        $socket->setsockopt(SOL_SOCKET,  SO_KEEPALIVE, 1) or $self->fail("Can't setsockopt SO_KEEPALIVE: $!");
         $self->_start_ssl($socket) if $self->{type} eq 'imaps';
-
-        $socket->sockopt(SO_KEEPALIVE, 1);
         $self->{$_} = $socket for qw/STDOUT STDIN/;
     }
-    $self->{STDIN}->autoflush(0) // $self->panic("Can't turn off autoflush: $!");
     binmode $self->{$_} foreach qw/STDIN STDOUT/;
 
     # command counter
@@ -396,10 +402,10 @@ sub new($%) {
                 $self->panic($IMAP_text) unless $r eq 'OK';
 
                 if ($algo eq 'DEFLATE') {
-                    my %args = ( -WindowBits => 0 - MAX_WBITS );
-                    $self->{_Z_DEFLATE} = Compress::Zlib::deflateInit(%args) //
+                    my %args = ( -WindowBits => 0 - MAX_WBITS, -Bufsize => $BUFSIZE );
+                    $self->{_Z_DEFLATE} = Compress::Raw::Zlib::Deflate::->new(%args, -AppendOutput => 1) //
                         $self->panic("Can't create deflation stream");
-                    $self->{_Z_INFLATE} = Compress::Zlib::inflateInit(%args) //
+                    $self->{_Z_INFLATE} = Compress::Raw::Zlib::Inflate::->new(%args) //
                         $self->panic("Can't create inflation stream");
                 }
                 else {
@@ -445,6 +451,9 @@ sub DESTROY($) {
     my $self = shift;
     $self->{_STATE} = 'LOGOUT';
 
+    Net::SSLeay::free($self->{_SSL}) if defined $self->{_SSL};
+    Net::SSLeay::CTX_free($self->{_SSL_CTX}) if defined $self->{_SSL_CTX};
+
     foreach (qw/STDIN STDOUT/) {
         $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
     }
@@ -871,18 +880,17 @@ sub notify($@) {
 sub slurp($) {
     my $self = shift;
 
-    my $stdout = $self->{STDOUT};
+    my $ssl = $self->{_SSL};
     my $read = 0;
 
     while (1) {
-        # Unprocessed data within the current SSL frame would cause
+        # Unprocessed data within the current TLS record would cause
         # select(2) to block/timeout due to the raw socket not being
         # ready.
-        unless (ref $stdout eq 'IO::Socket::SSL' and $stdout->pending() > 0) {
+        unless (defined $ssl and Net::SSLeay::pending($ssl) > 0) {
             my ($ok) = $self->{_SEL_OUT}->can_read(0);
             return $read unless defined $ok;
         }
-
         $self->_resp( $self->_getline() );
         $read++;
     }
@@ -1180,52 +1188,80 @@ sub push_flag_updates($$@) {
 #############################################################################
 # Private methods
 
+# $self->_ssl_error($error, [...])
+#   Log an SSL $error and exit with return value 1.
+sub _ssl_error($$) {
+    my $self = shift;
+    $self->log('SSL ERROR: ', @_);
+    if ($self->{debug}) {
+        while (my $err = Net::SSLeay::ERR_get_error()) {
+            $self->log(Net::SSLeay::ERR_error_string($err));
+        }
+    }
+    exit 1;
+}
+
 
 # $self->_start_ssl($socket)
-#   Upgrade the $socket to IO::Socket::SSL.
+#   Upgrade the $socket to SSL/TLS.
 sub _start_ssl($$) {
     my ($self, $socket) = @_;
-    require 'IO/Socket/SSL.pm';
-    require 'Net/SSLeay.pm';
-
-    my %sslargs = (SSL_create_ctx_callback => sub($) {
-        my $ctx = shift;
-        my $rv;
-
-        # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_options.html
-        $rv = Net::SSLeay::CTX_get_options($ctx)
-            | Net::SSLeay::OP_SINGLE_ECDH_USE()
-            | Net::SSLeay::OP_SINGLE_DH_USE()
-            | Net::SSLeay::OP_NO_SSLv2()
-            | Net::SSLeay::OP_NO_SSLv3()
-            | Net::SSLeay::OP_NO_COMPRESSION();
-        Net::SSLeay::CTX_set_options($ctx, $rv);
-
-        # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_mode.html
-        $rv = Net::SSLeay::CTX_get_mode($ctx)
-            | Net::SSLeay::MODE_AUTO_RETRY() # don't fail SSL_read on renegociation
-            | Net::SSLeay::MODE_RELEASE_BUFFERS();
-        Net::SSLeay::CTX_set_mode($ctx, $rv);
-    });
-
-    my $fpr = delete $self->{SSL_fingerprint};
-    my $vrfy = delete $self->{SSL_verify_trusted_peer};
-    $sslargs{SSL_verify_mode} = ($vrfy // 1) ? Net::SSLeay::VERIFY_PEER() : Net::SSLeay::VERIFY_NONE();
-    $sslargs{$_} = $self->{$_} foreach grep /^SSL_/, keys %$self;
-
-    IO::Socket::SSL->start_SSL($socket, %sslargs)
-        or $self->fail("Failed SSL handshake: $!\n$IO::Socket::SSL::SSL_ERROR");
-
-    # ensure we're talking to the right server
-    if (defined $fpr) {
-        my $algo = $fpr =~ /^([^\$]+)\$/ ? $1 : 'sha256';
-        my $fpr2 = $socket->get_fingerprint($algo);
-        $fpr =~ s/.*\$//;
-        $fpr2 =~ s/.*\$//;
-        $self->fail("Fingerprint don't match!  MiTM in action?")
-                unless uc $fpr eq uc $fpr2;
+    my $ctx = Net::SSLeay::CTX_new() or $self->panic("Failed to create SSL_CTX $!");
+
+    # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_options.html
+    Net::SSLeay::CTX_set_options($ctx,
+        Net::SSLeay::OP_SINGLE_ECDH_USE() |
+        Net::SSLeay::OP_SINGLE_DH_USE() |
+        Net::SSLeay::OP_NO_SSLv2() |
+        Net::SSLeay::OP_NO_SSLv3() |
+        Net::SSLeay::OP_NO_COMPRESSION() );
+
+    # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_mode.html
+    Net::SSLeay::CTX_set_mode($ctx,
+        Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE() |
+        Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER() |
+        Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegociation
+        Net::SSLeay::MODE_RELEASE_BUFFERS() );
+
+    if (defined (my $ciphers = $self->{SSL_cipherlist})) {
+        Net::SSLeay::CTX_set_cipher_list($ctx, $ciphers)
+            or $self->_ssl_error("Can't set cipher list");
+    }
+
+    if ($self->{SSL_verify} // 1) {
+        # verify the certificate chain
+        my ($file, $path) = ($self->{SSL_CAfile} // '', $self->{SSL_CApath} // '');
+        if ($file ne '' or $path ne '') {
+            Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path)
+                or $self->_ssl_error("Can't load verify locations");
+        }
+        Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_PEER());
+    }
+    else {
+        Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_NONE());
     }
 
+    my $ssl = Net::SSLeay::new($ctx) or $self->fail("Can't create new SSL structure");
+    Net::SSLeay::set_fd($ssl, $socket->fileno()) or $self->fail("SSL filehandle association failed");
+    $self->_ssl_error("Can't initiate TLS/SSL handshake") unless Net::SSLeay::connect($ssl) == 1;
+
+    if (defined (my $fpr = $self->{SSL_fingerprint})) {
+        # ensure we're talking to the right server
+        (my $algo, $fpr) = $fpr =~ /^([^\$]+)\$(.*)/ ? ($1, $2) : ('sha256', $fpr);
+        my $digest = pack 'H*', ($fpr =~ tr/://rd);
+
+        my $type = Net::SSLeay::EVP_get_digestbyname($algo)
+            or $self->_ssl_error("Can't find MD value for name '$algo'");
+
+        my $cert = Net::SSLeay::get_peer_certificate($ssl)
+            or $self->_ssl_error("Can't get peer certificate");
+
+        $self->fail("Fingerprint doesn't match!  MiTM in action?")
+            if Net::SSLeay::X509_digest($cert, $type) ne $digest and
+               Net::SSLeay::X509_pubkey_digest($cert, $type) ne $digest;
+    }
+
+    @$self{qw/_SSL _SSL_CTX/} = ($ssl, $ctx);
 }
 
 
@@ -1239,24 +1275,31 @@ sub _getline($;$) {
     my $self = shift;
     my $len = shift // 0;
 
-    my $stdout = $self->{STDOUT};
+    my ($stdout, $ssl) = @$self{qw/STDOUT _SSL/};
     $self->fail("Lost connection") unless $stdout->opened();
 
     my (@lit, @line);
     while(1) {
-        if ($self->{_OUTBUF} eq '') {
+        unless (defined $self->{_OUTBUF}) {
+            my ($buf, $n);
             # nothing cached: read some more
-            # (read at most 2^14 bytes, the maximum length of an SSL
-            # frame, to ensure to guaranty that there is no pending data)
-            my $n = $stdout->sysread(my $buf,16384,0);
+            if (defined $ssl) {
+                ($buf, $n) = Net::SSLeay::read($ssl, $BUFSIZE);
+            } else {
+                $n = $stdout->sysread($buf, $BUFSIZE, 0);
+            }
+
             $self->panic("Can't read: $!") unless defined $n;
             $self->fail("0 bytes read (got EOF)") unless $n > 0; # EOF
             $self->{_OUTRAWCOUNT} += $n;
 
             if (defined (my $i = $self->{_Z_INFLATE})) {
-                $buf = $i->inflate($buf) // $self->panic("Inflation failed: ", $i->msg());
+                $i->inflate($buf, $self->{_OUTBUF}) == Z_OK or
+                    $self->panic("Inflation failed: ", $i->msg());
+            }
+            else {
+                $self->{_OUTBUF} = $buf;
             }
-            $self->{_OUTBUF} = $buf;
         }
         if ($len == 0) { # read a regular line: stop after the first \r\n
             if ((my $idx = 1 + index($self->{_OUTBUF}, "\n")) > 0) {
@@ -1273,20 +1316,19 @@ sub _getline($;$) {
             }
             else {
                 push @line, $self->{_OUTBUF};
-                $self->{_OUTBUF} = '';
+                undef $self->{_OUTBUF};
             }
         }
         elsif ($len > 0) { # $len bytes of literal bytes to read
-            if ($len <= length($self->{_OUTBUF})) {
+            if ($len < length($self->{_OUTBUF})) {
                 push @lit, substr($self->{_OUTBUF}, 0, $len, '');
                 $len = 0;
             }
             else {
                 push @lit, $self->{_OUTBUF};
                 $len -= length($self->{_OUTBUF});
-                $self->{_OUTBUF} = '';
+                undef $self->{_OUTBUF};
             }
-            next;
         }
     }
 }
@@ -1314,7 +1356,7 @@ sub _update_cache_for($$%) {
         if ($k eq 'UIDVALIDITY') {
             # try to detect UIDVALIDITY changes early (before starting the sync)
             $self->fail("UIDVALIDITY changed! ($cache->{UIDVALIDITY} != $v)  ",
-                         "Need to invalidate the UID cache.")
+                        "Need to invalidate the UID cache.")
                 if defined $cache->{UIDVALIDITY} and $cache->{UIDVALIDITY} != $v;
             $self->{_PCACHE}->{$mailbox}->{UIDVALIDITY} //= $v;
         }
@@ -1327,12 +1369,18 @@ sub _update_cache_for($$%) {
 #   Send the given @data to the IMAP server.
 #   Update the interal raw byte count, but the regular byte count must
 #   have been updated earlier (eg, by _send_cmd).
-sub _write($@) {
-    my $self = shift;
-    foreach (@_) {
-        next if $_ eq '';
-        $self->{STDIN}->write($_) // $self->panic("Can't write: $!");
-        $self->{_INRAWCOUNT} += length($_);
+sub _write($$) {
+    my ($self, $data) = @_;
+    my ($stdin, $ssl) = @$self{qw/STDIN _SSL/};
+
+    my ($offset, $length) = (0, length($$data));
+    while ($length > 0) {
+        my $written = defined $ssl ?
+            Net::SSLeay::write_partial($ssl, $offset, $length, $$data) :
+            $stdin->syswrite($$data, $length, $offset);
+        $offset += $written;
+        $length -= $written;
+        $self->{_INRAWCOUNT} += $written;
     }
 }
 
@@ -1340,10 +1388,11 @@ sub _write($@) {
 # $self->_z_flush([$type])
 #   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,$t) = @_;
-    my $d = $self->{_Z_DEFLATE} // return;
-    $self->_write( $d->flush($t) // $self->panic("Can't flush deflation stream: ", $d->msg()) );
+sub _z_flush($$;$) {
+    my ($self, $buf, $t) = @_;
+    my $d = $self->{_Z_DEFLATE};
+    $d->flush($buf, $t) == Z_OK or
+        $self->panic("Can't flush deflation stream: ", $d->msg());
 }
 
 
@@ -1361,6 +1410,7 @@ sub _send_cmd($) {
     my ($offset, $litlen) = (0, 0);
     my $z_flush = 0; # whether to flush the dictionary after processing the next literal
 
+    my $buf;
     while(1) {
         my $lit = substr($command, $offset, $litlen) if $litlen > 0;
         $offset += $litlen;
@@ -1383,20 +1433,21 @@ sub _send_cmd($) {
         my @data = (($offset == 0 ? "$tag " : $lit), $line, "\r\n");
         $self->{_INCOUNT} += length($_) foreach @data;
         if (!defined $d) {
-            $self->_write(@data);
+            $buf .= join '', @data;
         }
         else {
             for (my $i = 0; $i <= $#data; $i++) {
-                $self->_z_flush(Z_FULL_FLUSH) if $i == 0 and $z_flush;
-                $self->_write( $d->deflate($data[$i]) // $self->panic("Deflation failed: ", $d->msg()) );
-                $self->_z_flush(Z_FULL_FLUSH) if $i == 0 and $z_flush;
+                $self->_z_flush(\$buf, Z_FULL_FLUSH) if $i == 0 and $z_flush;
+                $d->deflate($data[$i], \$buf) == Z_OK or $self->panic("Deflation failed: ", $d->msg());
+                $self->_z_flush(\$buf, Z_FULL_FLUSH) if $i == 0 and $z_flush;
             }
         }
 
         if (!$litplus or $idx < 0) {
-            $self->_z_flush(Z_SYNC_FLUSH) if defined $d;
+            $self->_z_flush(\$buf, Z_SYNC_FLUSH) if defined $d;
+            $self->_write(\$buf);
+            undef $buf;
 
-            $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
             last if $idx < 0;
             my $x = $self->_getline();
             $x =~ /\A\+ / or $self->panic($x);
@@ -1851,7 +1902,6 @@ sub _resp($$;$$$) {
             $x .= "\r\n";
             $self->{_INCOUNT} += length($x);
             $self->_write($x);
-            $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
         }
     }
     else {