qpsmtpd/lib/Qpsmtpd/TcpServer.pm
John Peacock c0920346e5 the pre-connection and post-connection hooks are not working in
qpsmtpd-forkserver. This patch merges Peter's patch (with the possibilty
to DENY/DENSOFT the connection) and my first attempt. The --max-from-ip
check was moved from core to the hosts_allow plugin. 

Patch by: Hanno Hecker <hah@uu-x.de>

git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@599 958fd67b-6ff1-0310-b445-bb7760255be9
2006-01-11 16:21:08 +00:00

92 lines
2.4 KiB
Perl

package Qpsmtpd::TcpServer;
use Qpsmtpd::SMTP;
use Qpsmtpd::Constants;
@ISA = qw(Qpsmtpd::SMTP);
use strict;
use POSIX ();
my $first_0;
sub start_connection {
my $self = shift;
die "Qpsmtpd::TcpServer must be started by tcpserver\n"
unless $ENV{TCPREMOTEIP};
my $remote_host = $ENV{TCPREMOTEHOST} || ( $ENV{TCPREMOTEIP} ? "[$ENV{TCPREMOTEIP}]" : "[noip!]");
my $remote_info = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host;
my $remote_ip = $ENV{TCPREMOTEIP};
$self->log(LOGNOTICE, "Connection from $remote_info [$remote_ip]");
# if the local dns resolver doesn't filter it out we might get
# ansi escape characters that could make a ps axw do "funny"
# things. So to be safe, cut them out.
$remote_host =~ tr/a-zA-Z\.\-0-9//cd;
$first_0 = $0 unless $first_0;
my $now = POSIX::strftime("%H:%M:%S %Y-%m-%d", localtime);
$0 = "$first_0 [$remote_ip : $remote_host : $now]";
$self->SUPER::connection->start(remote_info => $remote_info,
remote_ip => $remote_ip,
remote_host => $remote_host,
@_);
}
sub run {
my $self = shift;
# should be somewhere in Qpsmtpd.pm and not here...
$self->load_plugins unless $self->{hooks};
my $rc = $self->start_conversation;
return if $rc != DONE;
# this should really be the loop and read_input should just get one line; I think
$self->read_input;
}
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;
while (<STDIN>) {
alarm 0;
$_ =~ s/\r?\n$//s; # advanced chomp
$self->log(LOGDEBUG, "dispatching $_");
$self->connection->notes('original_string', $_);
defined $self->dispatch(split / +/, $_)
or $self->respond(502, "command unrecognized: '$_'");
alarm $timeout;
}
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");
exit;
}
1;