qpsmtpd/lib/Qpsmtpd/TcpServer/Prefork.pm
Matt Simerson be9f4aef0c update tcpenv and lrpip calls to use -> syntax
don't load plugins twice.

Not exactly sure where that feature crept in some time ago. It was suppressed by checking to see if a queue plugin was already registered, and then bailing out on subsequent register_hook runs. I noticed it in testing, b/c I didn't have a queue plugin loaded. This removes the duplicate calls to register_hook.

* adds caching of the AUTH methods. You can't add new plugins or register new
  hooks w/o restarting QP, so cache the list and avoid having to generate it on every connection.

* other PBP changes (early exits, less indention, fewer unnecessary parens, etc.)
2015-01-28 19:58:58 -08:00

84 lines
2.2 KiB
Perl

package Qpsmtpd::TcpServer::Prefork;
use strict;
use lib 'lib';
use Qpsmtpd::Constants;
use parent 'Qpsmtpd::SMTP::Prefork';
use parent 'Qpsmtpd::TcpServer';
my $first_0;
sub start_connection {
my $self = shift;
#reset info
$self->{_connection} = Qpsmtpd::Connection->new(); #reset connection
$self->reset_transaction;
$self->SUPER::start_connection(@_);
}
sub read_input {
my $self = shift;
my $timeout = $self->config('timeoutsmtpd') # qmail smtpd control file
|| $self->config('timeout') # qpsmtpd control file
|| 1200; # default value
alarm $timeout;
eval {
while (<STDIN>) {
alarm 0;
$_ =~ s/\r?\n$//s; # advanced chomp
$self->log(LOGINFO, "dispatching $_");
$self->connection->notes('original_string', $_);
defined $self->dispatch(split / +/, $_, 2)
or $self->respond(502, "command unrecognized: '$_'");
alarm $timeout;
}
unless ($self->connection->notes('disconnected')) {
$self->reset_transaction;
$self->run_hooks('disconnect');
$self->connection->notes(disconnected => 1);
}
};
if ($@ =~ /^disconnect_tcpserver/) {
die "disconnect_tcpserver";
}
else {
$self->run_hooks("post-connection");
$self->connection->reset;
die "died while reading from STDIN (probably broken sender) - $@";
}
alarm(0);
}
sub respond {
my ($self, $code, @messages) = @_;
if (!$self->check_socket()) {
$self->log(LOGERROR,
"Lost connection to client, cannot send response.");
return 0;
}
while (my $msg = shift @messages) {
my $line = $code . (@messages ? "-" : " ") . $msg;
$self->log(LOGINFO, $line);
print "$line\r\n"
or ($self->log(LOGERROR, "Could not print [$line]: $!"), return 0);
}
return 1;
}
sub disconnect {
my $self = shift;
$self->log(LOGINFO, "click, disconnecting");
$self->SUPER::disconnect(@_);
$self->run_hooks("post-connection");
$self->connection->reset;
die "disconnect_tcpserver";
}
1;