pullimap: add support for SMTP pipelining (RFC 2920)

diff --git a/pullimap b/pullimap
index ba48f197065d8ec98b0a2e8742ef08b4ff90f29b..f9b9d0d5ce52a8f717b8509632735f6b32008c5f 100755 (executable)
--- a/pullimap
+++ b/pullimap
@@ -123,7 +123,7 @@ sub writeUID($) {
 #######################################################################
 # SMTP/LMTP part
 #
-my $SMTP;
+my ($SMTP, $SMTP_PIPELINING);
 sub sendmail($$) {
     my ($from, $rfc822) = @_;
     unless (defined $SMTP) {
@@ -149,18 +149,18 @@ sub sendmail($$) {
         }
 
         smtp_resp('220');
-        smtp_send1($ehlo, '250');
+        my @r = smtp_send($ehlo => '250');
+        $SMTP_PIPELINING = grep {$_ eq 'PIPELINING'} @r; # SMTP pipelining (RFC 2920)
     }
     my $rcpt = $CONF->{'deliver-rcpt'} // getpwuid($>) // die;
 
-    # TODO SMTP pipelining (RFC 2920)
-
     # return codes are from RFC 5321 section 4.3.2
-    smtp_send1("MAIL FROM:<$from>", '250');
-    smtp_send1("RCPT TO:<$rcpt>", '250');
-    smtp_send1("DATA", '354');
-    print STDERR "C: [...]\n" if $CONFIG{debug};
+    smtp_send( "MAIL FROM:<$from>" => '250'
+             , "RCPT TO:<$rcpt>"   => '250'
+             , "DATA"              => '354'
+             );
 
+    print STDERR "C: [...]\n" if $CONFIG{debug};
     if ($$rfc822 eq '') {
         # RFC 5321 section 4.1.1.4: if there was no mail data, the first
         # "\r\n" ends the DATA command itself
@@ -186,21 +186,37 @@ sub sendmail($$) {
     }
     smtp_resp('250');
 }
-sub smtp_send1($$) {
-    my ($cmd, $code) = @_;
-    print STDERR "C: $cmd\n" if $CONFIG{debug};
-    $SMTP->printflush($cmd, "\r\n");
-    smtp_resp($code);
-}
 sub smtp_resp($) {
     my $code = shift;
+    my @resp;
     while(1) {
         local $_ = $SMTP->getline() // die;
         s/\r\n\z// or die "Invalid SMTP reply: $_";
         print STDERR "S: $_\n" if $CONFIG{debug};
-        /\A\Q$code\E([ -])/ or die "SMTP error: Expected $code, got: $_\n";
-        return if $1 eq ' ';
+        s/\A\Q$code\E([ -])// or die "SMTP error: Expected $code, got: $_\n";
+        push @resp, $_;
+        return @resp if $1 eq ' ';
+    }
+}
+sub smtp_send(@) {
+    my (@cmd, @code, @r);
+    while (@_) {
+        push @cmd,  shift // die;
+        push @code, shift // die;
+    }
+    if ($SMTP_PIPELINING) { # SMTP pipelining (RFC 2920)
+        print STDERR join('', map {"C: $_\n"} @cmd) if $CONFIG{debug};
+        $SMTP->printflush(join('', map {"$_\r\n"} @cmd));
+        @r = smtp_resp($_) foreach @code;
+    }
+    else {
+        foreach (@cmd) {
+            print STDERR "C: $_\n" if $CONFIG{debug};
+            $SMTP->printflush("$_\r\n");
+            @r = smtp_resp(shift(@code));
+        }
     }
+    return @r;
 }