qpsmtpd/lib/Qpsmtpd/SMTP/Prefork.pm
John Peacock 67dc86e255 New pre-forking qpsmtpd daemon, courtesy of Lars Roland at SoftScan.
Initial load with minor tweaks by John Peacock.

git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@639 958fd67b-6ff1-0310-b445-bb7760255be9
2006-05-31 20:54:03 +00:00

44 lines
1013 B
Perl

package Qpsmtpd::SMTP::Prefork;
use Qpsmtpd::SMTP;
@ISA = qw(Qpsmtpd::SMTP);
sub dispatch {
my $self = shift;
my ($cmd) = lc shift;
$self->{_counter}++;
if ($cmd !~ /^(\w{1,12})$/ or !exists $self->{_commands}->{$1}) {
my ($rc, @msg) = $self->run_hooks("unrecognized_command", $cmd, @_);
@msg = map { split /\n/ } @msg;
if ($rc == DENY_DISCONNECT) {
$self->respond(521, @msg);
$self->disconnect;
}
elsif ($rc == DENY) {
$self->respond(500, @msg);
}
elsif ($rc == DONE) {
1;
}
else {
$self->respond(500, "Unrecognized command");
}
return 1
}
$cmd = $1;
if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) {
my ($result) = eval { $self->$cmd(@_) };
if ($@ =~ /^disconnect_tcpserver/) {
die "disconnect_tcpserver";
} elsif ($@) {
$self->log(LOGERROR, "XX: $@") if $@;
}
return $result if defined $result;
return $self->fault("command '$cmd' failed unexpectedly");
}
return;
}