aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xpullimap92
1 files changed, 91 insertions, 1 deletions
diff --git a/pullimap b/pullimap
index e79e644..ba48f19 100755
--- 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);
@@ -116,6 +121,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);