diff options
Diffstat (limited to 'pullimap')
| -rwxr-xr-x | pullimap | 92 |
1 files changed, 91 insertions, 1 deletions
@@ -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); |