368 lines
9.9 KiB
Perl
368 lines
9.9 KiB
Perl
package Qpsmtpd::PollServer;
|
|
|
|
use base ('Danga::Client', 'Qpsmtpd::SMTP');
|
|
|
|
# use fields required to be a subclass of Danga::Client. Have to include
|
|
# all fields used by Qpsmtpd.pm here too.
|
|
use fields qw(
|
|
input_sock
|
|
mode
|
|
header_lines
|
|
in_header
|
|
data_size
|
|
max_size
|
|
hooks
|
|
start_time
|
|
cmd_timeout
|
|
conn
|
|
_auth
|
|
_auth_mechanism
|
|
_auth_state
|
|
_auth_ticket
|
|
_auth_user
|
|
_commands
|
|
_config_cache
|
|
_connection
|
|
_continuation
|
|
_extras
|
|
_test_mode
|
|
_transaction
|
|
);
|
|
use Qpsmtpd::Constants;
|
|
use Qpsmtpd::Address;
|
|
use ParaDNS;
|
|
use Mail::Header;
|
|
use POSIX qw(strftime);
|
|
use Socket qw(inet_aton AF_INET CRLF);
|
|
use Time::HiRes qw(time);
|
|
use strict;
|
|
|
|
sub max_idle_time { 60 }
|
|
sub max_connect_time { 1200 }
|
|
|
|
sub input_sock {
|
|
my $self = shift;
|
|
@_ and $self->{input_sock} = shift;
|
|
$self->{input_sock} || $self;
|
|
}
|
|
|
|
sub new {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
|
|
$self = fields::new($self) unless ref $self;
|
|
$self->SUPER::new(@_);
|
|
$self->{cmd_timeout} = 5;
|
|
$self->{start_time} = time;
|
|
$self->{mode} = 'connect';
|
|
$self->load_plugins;
|
|
$self->load_logging;
|
|
|
|
my ($rc, @msg) = $self->run_hooks_no_respond("pre-connection");
|
|
if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) {
|
|
@msg = ("Sorry, try again later")
|
|
unless @msg;
|
|
$self->respond(451, @msg);
|
|
$self->disconnect;
|
|
}
|
|
elsif ($rc == DENY || $rc == DENY_DISCONNECT) {
|
|
@msg = ("Sorry, service not available for you")
|
|
unless @msg;
|
|
$self->respond(550, @msg);
|
|
$self->disconnect;
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub uptime {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
|
|
return (time() - $self->{start_time});
|
|
}
|
|
|
|
sub reset_for_next_message {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
$self->SUPER::reset_for_next_message(@_);
|
|
|
|
$self->{_commands} = {
|
|
ehlo => 1,
|
|
helo => 1,
|
|
rset => 1,
|
|
mail => 1,
|
|
rcpt => 1,
|
|
data => 1,
|
|
help => 1,
|
|
vrfy => 1,
|
|
noop => 1,
|
|
quit => 1,
|
|
auth => 0, # disabled by default
|
|
};
|
|
$self->{mode} = 'cmd';
|
|
$self->{_extras} = {};
|
|
}
|
|
|
|
sub respond {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
my ($code, @messages) = @_;
|
|
while (my $msg = shift @messages) {
|
|
my $line = $code . (@messages ? "-" : " ") . $msg;
|
|
$self->write("$line\r\n");
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub fault {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
$self->SUPER::fault(@_);
|
|
return;
|
|
}
|
|
|
|
my %cmd_cache;
|
|
|
|
sub process_line {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
my $line = shift || return;
|
|
if ($::DEBUG > 1) { print "$$:" . ($self + 0) . "C($self->{mode}): $line"; }
|
|
if ($self->{mode} eq 'cmd') {
|
|
$line =~ s/\r?\n$//s;
|
|
$self->connection->notes('original_string', $line);
|
|
my ($cmd, @params) = split(/ +/, $line, 2);
|
|
my $meth = lc($cmd);
|
|
if (my $lookup =
|
|
$cmd_cache{$meth}
|
|
|| $self->{_commands}->{$meth} && $self->can($meth))
|
|
{
|
|
$cmd_cache{$meth} = $lookup;
|
|
eval { $lookup->($self, @params); };
|
|
if ($@) {
|
|
my $error = $@;
|
|
chomp($error);
|
|
$self->log(LOGERROR, "Command Error: $error");
|
|
$self->fault("command '$cmd' failed unexpectedly");
|
|
}
|
|
}
|
|
else {
|
|
# No such method - i.e. unrecognized command
|
|
my ($rc, $msg) =
|
|
$self->run_hooks("unrecognized_command", $meth, @params);
|
|
}
|
|
}
|
|
elsif ($self->{mode} eq 'connect') {
|
|
$self->{mode} = 'cmd';
|
|
|
|
# I've removed an eval{} from around this. It shouldn't ever die()
|
|
# but if it does we're a bit screwed... Ah well :-)
|
|
$self->start_conversation;
|
|
}
|
|
else {
|
|
die "Unknown mode";
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub disconnect {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
$self->SUPER::disconnect(@_);
|
|
$self->close;
|
|
}
|
|
|
|
sub close {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
$self->run_hooks_no_respond("post-connection");
|
|
$self->connection->reset;
|
|
$self->SUPER::close;
|
|
}
|
|
|
|
sub start_conversation {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
|
|
my $conn = $self->connection;
|
|
|
|
# set remote_host, remote_ip and remote_port
|
|
my ($ip, $port) = split(/:/, $self->peer_addr_string);
|
|
return $self->close() unless $ip;
|
|
$conn->remote_ip($ip);
|
|
$conn->remote_port($port);
|
|
$conn->remote_info("[$ip]");
|
|
my ($lip, $lport) = split(/:/, $self->local_addr_string);
|
|
$conn->local_ip($lip);
|
|
$conn->local_port($lport);
|
|
|
|
ParaDNS->new(
|
|
finished => sub { $self->continue_read(); $self->run_hooks("connect") },
|
|
|
|
# NB: Setting remote_info to the same as remote_host
|
|
callback => sub { $conn->remote_info($conn->remote_host($_[0])) },
|
|
host => $ip,
|
|
);
|
|
|
|
return;
|
|
}
|
|
|
|
sub data {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
|
|
my ($rc, $msg) = $self->run_hooks("data");
|
|
return 1;
|
|
}
|
|
|
|
sub data_respond {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
my ($rc, $msg) = @_;
|
|
if ($rc == DONE) {
|
|
return;
|
|
}
|
|
elsif ($rc == DENY) {
|
|
$msg->[0] ||= "Message denied";
|
|
$self->respond(554, @$msg);
|
|
$self->reset_transaction();
|
|
return;
|
|
}
|
|
elsif ($rc == DENYSOFT) {
|
|
$msg->[0] ||= "Message denied temporarily";
|
|
$self->respond(451, @$msg);
|
|
$self->reset_transaction();
|
|
return;
|
|
}
|
|
elsif ($rc == DENY_DISCONNECT) {
|
|
$msg->[0] ||= "Message denied";
|
|
$self->respond(554, @$msg);
|
|
$self->disconnect;
|
|
return;
|
|
}
|
|
elsif ($rc == DENYSOFT_DISCONNECT) {
|
|
$msg->[0] ||= "Message denied temporarily";
|
|
$self->respond(451, @$msg);
|
|
$self->disconnect;
|
|
return;
|
|
}
|
|
return $self->respond(503, "MAIL first") unless $self->transaction->sender;
|
|
return $self->respond(503, "RCPT first")
|
|
unless $self->transaction->recipients;
|
|
|
|
$self->{header_lines} = '';
|
|
$self->{data_size} = 0;
|
|
$self->{in_header} = 1;
|
|
$self->{max_size} = ($self->config('databytes'))[0] || 0;
|
|
|
|
$self->log(LOGDEBUG,
|
|
"max_size: $self->{max_size} / size: $self->{data_size}");
|
|
|
|
$self->respond(354, "go ahead");
|
|
|
|
my $max_get = $self->{max_size} || 1048576;
|
|
$self->get_chunks($max_get, sub { $self->got_data($_[0]) });
|
|
return 1;
|
|
}
|
|
|
|
sub got_data {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
my $data = shift;
|
|
|
|
my $done = 0;
|
|
my $remainder;
|
|
if ($data =~ s/^\.\r\n(.*)\z//ms) {
|
|
$remainder = $1;
|
|
$done = 1;
|
|
}
|
|
|
|
# add a transaction->blocked check back here when we have line by line plugin access...
|
|
unless (($self->{max_size} and $self->{data_size} > $self->{max_size})) {
|
|
$data =~ s/\r\n/\n/mg;
|
|
$data =~ s/^\.\./\./mg;
|
|
|
|
if ($self->{in_header}) {
|
|
$self->{header_lines} .= $data;
|
|
|
|
if ($self->{header_lines} =~ s/\n(\n.*)\z/\n/ms) {
|
|
$data = $1;
|
|
|
|
# end of headers
|
|
$self->{in_header} = 0;
|
|
|
|
# ... need to check that we don't reformat any of the received lines.
|
|
#
|
|
# 3.8.2 Received Lines in Gatewaying
|
|
# When forwarding a message into or out of the Internet environment, a
|
|
# gateway MUST prepend a Received: line, but it MUST NOT alter in any
|
|
# way a Received: line that is already in the header.
|
|
my @header_lines = split(/^/m, $self->{header_lines});
|
|
|
|
my $header =
|
|
Mail::Header->new(
|
|
\@header_lines,
|
|
Modify => 0,
|
|
MailFrom => "COERCE"
|
|
);
|
|
$self->transaction->header($header);
|
|
$self->transaction->body_write($self->{header_lines});
|
|
$self->{header_lines} = '';
|
|
|
|
#$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
|
|
|
|
# FIXME - call plugins to work on just the header here; can
|
|
# save us buffering the mail content.
|
|
|
|
# Save the start of just the body itself
|
|
$self->transaction->set_body_start();
|
|
}
|
|
}
|
|
|
|
$self->transaction->body_write(\$data);
|
|
$self->{data_size} += length $data;
|
|
}
|
|
|
|
if ($done) {
|
|
$self->end_of_data;
|
|
$self->end_get_chunks($remainder);
|
|
}
|
|
|
|
}
|
|
|
|
sub end_of_data {
|
|
my Qpsmtpd::PollServer $self = shift;
|
|
|
|
#$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
|
|
|
|
$self->log(LOGDEBUG,
|
|
"max_size: $self->{max_size} / size: $self->{data_size}");
|
|
|
|
my $header = $self->transaction->header;
|
|
if (!$header) {
|
|
$header = Mail::Header->new(Modify => 0, MailFrom => "COERCE");
|
|
$self->transaction->header($header);
|
|
}
|
|
|
|
my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
|
|
my $esmtp = substr($smtp, 0, 1) eq "E";
|
|
my $authheader;
|
|
my $sslheader;
|
|
|
|
if (defined $self->connection->notes('tls_enabled')
|
|
and $self->connection->notes('tls_enabled'))
|
|
{
|
|
$smtp .= "S" if $esmtp; # RFC3848
|
|
$sslheader = "("
|
|
. $self->connection->notes('tls_socket')->get_cipher()
|
|
. " encrypted) ";
|
|
}
|
|
|
|
if (defined $self->{_auth} and $self->{_auth} == OK) {
|
|
$smtp .= "A" if $esmtp; # RFC3848
|
|
$authheader =
|
|
"(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n";
|
|
}
|
|
|
|
$header->add("Received",
|
|
$self->received_line($smtp, $authheader, $sslheader), 0);
|
|
|
|
return $self->respond(552, "Message too big!")
|
|
if $self->{max_size} and $self->{data_size} > $self->{max_size};
|
|
|
|
my ($rc, $msg) = $self->run_hooks("data_post");
|
|
return 1;
|
|
}
|
|
|
|
1;
|
|
|