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;