pullimap: add sendmail feature (SMTP/LMTP client).

diff --git a/pullimap b/pullimap
index e79e64470c1c60018f03676fffbdfd4428bcb175..ba48f197065d8ec98b0a2e8742ef08b4ff90f29b 100755 (executable)
--- a/pullimap
+++ b/pullimap
@@ -24,9 +24,11 @@ use warnings;
 our $VERSION = '0.3';
 my $NAME = 'pullimap';
 
+use Errno 'EINTR';
 use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET/;
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
 use List::Util 'first';
+use Socket qw/PF_INET PF_INET6 SOCK_STREAM/;
 
 use lib 'lib';
 use Net::IMAP::InterIMAP qw/read_config compact_set/;
@@ -57,6 +59,9 @@ my $CONF = read_config( delete $CONFIG{config} // $NAME,
                       , [$ARGV[0]]
                       , statefile => qr/\A(\P{Control}+)\z/
                       , mailbox => qr/\A([\x01-\x7F]+)\z/
+                      , 'deliver-method' => qr/\A((?:[ls]mtp:)?\[.*\](?::\d+)?)\z/
+                      , 'deliver-ehlo' => qr/\A(\P{Control}+)\z/
+                      , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/
                       )->{$ARGV[0]};
 
 my ($MAILBOX, $STATE, $LOGGER_FD);
@@ -115,6 +120,90 @@ sub writeUID($) {
 }
 
 
+#######################################################################
+# SMTP/LMTP part
+#
+my $SMTP;
+sub sendmail($$) {
+    my ($from, $rfc822) = @_;
+    unless (defined $SMTP) {
+        # XXX we can be logged out while connected, so we need to be able to reconnect
+        my ($fam, $addr, $port) = (PF_INET, $CONF->{'deliver-method'}, 25);
+        $addr =~ s/^([ls]mtp):// or die;
+        my $ehlo = $1 eq 'lmtp' ? 'LHO' : $1 eq 'smtp' ? 'EHLO' : die;
+        $ehlo .= ' '. ($CONF->{'deliver-ehlo'} // 'localhost.localdomain');
+
+        $port = $1 if $addr =~ s/:(\d+)$//;
+        $addr =~ s/^\[(.*)\]$/$1/ or die;
+        $fam = PF_INET6 if $addr =~ /:/;
+        $addr = Socket::inet_pton($fam, $addr) // die "Invalid address $addr\n";
+        my $sockaddr = $fam == PF_INET  ? Socket::pack_sockaddr_in($port,  $addr)
+                     : $fam == PF_INET6 ? Socket::pack_sockaddr_in6($port, $addr)
+                     : die;
+
+        my $proto = getprotobyname("tcp") // die;
+        socket($SMTP, $fam, SOCK_STREAM, $proto) or die "socket: $!";
+        until (connect($SMTP, $sockaddr)) {
+            next if $! == EINTR; # try again if connect(2) was interrupted by a signal
+            die "connect: $!";
+        }
+
+        smtp_resp('220');
+        smtp_send1($ehlo, '250');
+    }
+    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};
+
+    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
+        $SMTP->printflush("\r\n.\r\n");
+    } else {
+        my $offset = 0;
+        my $length = length($$rfc822);
+        while ((my $end = index($$rfc822, "\r\n", $offset) + 2) != 1) {
+            my $line = substr($$rfc822, $offset, $end-$offset);
+            # RFC 5321 section 4.5.2: the character sequence "\r\n.\r\n"
+            # ends the mail text and cannot be sent by the user
+            $SMTP->print($line eq ".\r\n" ? "..\r\n" : $line);
+            $offset = $end;
+        }
+        if ($offset < $length) {
+            # the last line did not end with "\r\n"; add it in order to
+            # have the receiving SMTP server recognize the "end of data"
+            # condition.  See RFC 5321 section 4.1.1.4
+            my $line = substr($$rfc822, $offset);
+            $SMTP->print(($line eq "." ? ".." : $line), "\r\n");
+        }
+        $SMTP->printflush(".\r\n");
+    }
+    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;
+    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 ' ';
+    }
+}
+
+
 #######################################################################
 # Initialize the cache from the statefile, then pull new messages from
 # the remote mailbox
@@ -163,7 +252,8 @@ do {
         $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
         print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
 
-        # TODO sendmail
+        sendmail($from, $mail->{RFC822});
+
         push @uid, $uid;
         writeUID($uid);
     }, @ignore);