qpsmtpd/lib/Qpsmtpd/TcpServer/Prefork.pm
John Peacock b7f468404b Fixup qpsmtpd-prefork, et al, to correctly load Constants.
Make child process pretty name optional for qpsmtpd-prefork.
Ignore rather than crash for uninstalled plugins.

git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@675 958fd67b-6ff1-0310-b445-bb7760255be9
2006-11-22 16:30:37 +00:00

66 lines
1.6 KiB
Perl

package Qpsmtpd::TcpServer::Prefork;
use Qpsmtpd::TcpServer;
use Qpsmtpd::SMTP::Prefork;
use Qpsmtpd::Constants;
@ISA = qw(Qpsmtpd::SMTP::Prefork Qpsmtpd::TcpServer);
my $first_0;
sub start_connection {
my $self = shift;
#reset info
$self->{_connection} = Qpsmtpd::Connection->new(); #reset connection
$self->{_transaction} = Qpsmtpd::Transaction->new(); #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(LOGDEBUG, "dispatching $_");
$self->connection->notes('original_string', $_);
defined $self->dispatch(split / +/, $_, 2)
or $self->respond(502, "command unrecognized: '$_'");
alarm $timeout;
}
};
if ($@ =~ /^disconnect_tcpserver/) {
die "disconnect_tcpserver";
} else {
die "died while reading from STDIN (probably broken sender) - $@";
}
alarm(0);
}
sub respond {
my ($self, $code, @messages) = @_;
while (my $msg = shift @messages) {
my $line = $code . (@messages?"-":" ").$msg;
$self->log(LOGDEBUG, $line);
print "$line\r\n" or ($self->log(LOGERROR, "Could not print [$line]: $!"), return 0);
}
return 1;
}
sub disconnect {
my $self = shift;
$self->log(LOGDEBUG,"click, disconnecting");
$self->SUPER::disconnect(@_);
$self->run_hooks("post-connection");
die "disconnect_tcpserver";
}
1;