From 90d926f6f32dd3ff06e5c49e6a982777ead9f691 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Tue, 15 Sep 2015 16:48:29 +0200
Subject: Remove support for the Binary Content extension [RFC3516].
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

“If the server does not know how to decode the section's CTE, it MUST
fail the request and issue a "NO" response that contains the
"UNKNOWN-CTE" extended response code.” — [RFC3516 section 4.3]

Unfortunately the client doesn't know which message couldn't be decoded,
so it can't fallback and use BODY instead.

This made ‘use-binary=NO’ pretty much mandatory.  Hence we remove
support for BINARY [RFC3516].  Instead, we increase the thresold for
when to add Zlib full flush points from 4096 to the buffer size (32768).
---
 lib/Net/IMAP/InterIMAP.pm | 39 +++++++++++----------------------------
 1 file changed, 11 insertions(+), 28 deletions(-)

(limited to 'lib')

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 6f44879..a761614 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -772,9 +772,7 @@ sub remove_message($@) {
 #   Issue an APPEND command with the given mails.  Croak if the server
 #   did not advertise "UIDPLUS" (RFC 4315) in its CAPABILITY list.
 #   Each $mail is a hash reference with key 'RFC822' and optionally
-#   'FLAGS' and 'INTERNALDATE'.  If the server supports the "BINARY"
-#   extension (RFC 3516), the key 'RFC822' can be replaced with 'BINARY'
-#   to send the mail body as a binary literal.
+#   'FLAGS' and 'INTERNALDATE'.
 #   Providing multiple mails is only allowed for servers supporting
 #   "MULTIAPPEND" (RFC 3502).
 #   Return the list of UIDs allocated for the new messages.
@@ -801,11 +799,8 @@ sub append($$@) {
         my $str = ' ';
         $str .= '('.join(' ', grep {lc $_ ne '\recent'} @{$mail->{FLAGS}}).') ' if defined $mail->{FLAGS};
         $str .= '"'.$mail->{INTERNALDATE}.'" ' if defined $mail->{INTERNALDATE};
-        my ($body, $t) = defined $mail->{RFC822} ? ($mail->{RFC822}, 0)
-                       : defined $mail->{BINARY} ? ($mail->{BINARY}, 1)
-                       : $self->panic("Missing message body in APPEND");
         $self->_cmd_extend(\$str);
-        $self->_cmd_extend_lit($body, $t);
+        $self->_cmd_extend_lit($mail->{RFC822} // $self->panic("Missing message body in APPEND"));
     }
 
     $self->_cmd_flush();
@@ -1075,8 +1070,7 @@ sub pull_updates($;$) {
 #   FETCH new messages since the UIDNEXT found in the persistent cache
 #   (or 1 in no such UIDNEXT is found), and process each response on the
 #   fly with the callback.
-#   The list of attributes to FETCH, $attr, much contain either BODY or
-#   BINARY.
+#   The list of attributes to FETCH, $attr, must contain BODY[].
 #   If an @ignore list is supplied, then these messages are ignored from
 #   the UID FETCH range.
 #   Finally, update the UIDNEXT from the persistent cache to the value
@@ -1582,20 +1576,17 @@ sub _cmd_extend($$) {
 }
 
 
-# $self->_cmd_extend_lit($lit, [$lit8])
+# $self->_cmd_extend_lit($lit)
 #   Append the literal $lit to the command buffer.  $lit must be a
-#   scalar reference.  If $lit8 is true, a literal8 is sent instead [RFC
-#   3516].
-sub _cmd_extend_lit($$;$) {
-    my ($self, $lit, $lit8) = @_;
+#   scalar reference.
+sub _cmd_extend_lit($$) {
+    my ($self, $lit) = @_;
     my $len = length($$lit);
     my $d = $self->{_Z_DEFLATE};
 
-    # create a full flush point for long binary literals
-    my $z_flush = ($len > 4096 and !($self->{'use-binary'} // 1 and !$lit8)) ? 1 : 0;
-    $lit8 = $lit8 ? '~' : ''; # literal8, RFC 3516 BINARY
-
-    my $strlen = $lit8.'{'.$len.$self->{_LITPLUS}.'}'.$CRLF;
+    # create a full flush point for long literals, cf. RFC 4978 section 4
+    my $z_flush = $len > $BUFSIZE ? 1 : 0;
+    my $strlen = "{$len$self->{_LITPLUS}}$CRLF";
 
     if ($self->{_LITPLUS} ne '') {
         $self->_cmd_extend_(\$strlen);
@@ -2086,14 +2077,6 @@ sub _resp($$;$$$) {
                 elsif (s/\A(?:RFC822|BODY\[\]) //) {
                     $mail{RFC822} = \$self->_nstring(\$_);
                 }
-                elsif (s/\ABINARY\[\] //) {
-                    if (s/\A~\{([0-9]+)\}\z//) { # literal8, RFC 3516 BINARY
-                        (my $lit, $_) = $self->_getline($1);
-                        $mail{BINARY} = $lit;
-                    } else {
-                        $mail{RFC822} = \$self->_nstring(\$_);
-                    }
-                }
                 elsif (s/\AFLAGS \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\)//) {
                     $mail{FLAGS} = defined $1 ? [ split / /, $1 ] : [];
                 }
@@ -2103,7 +2086,7 @@ sub _resp($$;$$$) {
             my $uid = $mail{UID} // $self->panic(); # sanity check
             $self->panic() unless defined $mail{MODSEQ} or !$self->_enabled('QRESYNC'); # sanity check
 
-            if (!exists $mail{RFC822} and !exists $mail{BINARY} and !exists $mail{ENVELOPE} and # ignore new mails
+            if (!exists $mail{RFC822} and !exists $mail{ENVELOPE} and # ignore new mails
                 (!exists $self->{_MODIFIED}->{$uid} or $self->{_MODIFIED}->{$uid}->[0] < $mail{MODSEQ} or
                     ($self->{_MODIFIED}->{$uid}->[0] == $mail{MODSEQ} and !defined $self->{_MODIFIED}->{$uid}->[1]))) {
                 my $flags = join ' ', sort(grep {lc $_ ne '\recent'} @{$mail{FLAGS}}) if defined $mail{FLAGS};
-- 
cgit v1.2.3