qpsmtpd/lib/Qpsmtpd/TcpServer.pm
2015-01-29 00:04:13 -08:00

209 lines
5.5 KiB
Perl

package Qpsmtpd::TcpServer;
use strict;
use POSIX ();
use Socket;
use lib 'lib';
use Qpsmtpd::Constants;
use parent 'Qpsmtpd::Base';
use parent 'Qpsmtpd::SMTP';
my $has_ipv6 = 0;
if (
eval { require Socket6; } &&
eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION('2.51'); }
)
{
Socket6->import('inet_ntop');
$has_ipv6 = 1;
}
sub has_ipv6 {
return $has_ipv6;
}
my $first_0;
sub conn_info_tcpserver {
# started from tcpserver (or some other superserver which
# exports the TCPREMOTE* variables.
my $r_host = $ENV{TCPREMOTEHOST} || '[' . $ENV{TCPREMOTEIP} . ']';
return (
local_ip => $ENV{TCPLOCALIP},
local_host => $ENV{TCPLOCALHOST},
local_port => $ENV{TCPLOCALPORT},
remote_ip => $ENV{TCPREMOTEIP},
remote_host => $r_host,
remote_info => $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$r_host" : $r_host,
remote_port => $ENV{TCPREMOTEPORT},
)
}
sub conn_info_inetd {
my $self = shift;
# Started from inetd or similar.
# get info on the remote host from the socket.
# ignore ident/tap/...
my $hersockaddr = getpeername(STDIN) or die "getpeername failed:" .
" $0 must be called from tcpserver, (x)inetd or" .
" a similar program which passes a socket to stdin";
my ($r_port, $iaddr) = sockaddr_in($hersockaddr);
my $r_ip = inet_ntoa($iaddr);
my ($r_host) = $self->resolve_ptr($r_ip) || "[$r_ip]";
return (
local_ip => '',
local_host => '',
local_port => '',
remote_ip => $r_ip,
remote_host => $r_host,
remote_info => $r_host,
remote_port => $r_port,
)
}
sub start_connection {
my $self = shift;
my %info;
if ($ENV{TCPREMOTEIP}) {
%info = $self->conn_info_tcpserver();
}
else {
%info = $self->conn_info_inetd();
}
$self->log(LOGNOTICE, "Connection from $info{remote_info} [$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.
$info{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 [$info{remote_ip} : $info{remote_host} : $now]";
$self->SUPER::connection->start(%info, @_);
}
sub run {
my ($self, $client) = @_;
# Set local client_socket to passed client object for testing socket state on writes
$self->{__client_socket} = $client;
$self->load_plugins if !$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(LOGINFO, "dispatching $_");
$self->connection->notes('original_string', $_);
defined $self->dispatch(split / +/, $_, 2)
or $self->respond(502, "command unrecognized: '$_'");
alarm $timeout;
}
alarm(0);
return if $self->connection->notes('disconnected');
$self->reset_transaction;
$self->run_hooks('disconnect');
$self->connection->notes(disconnected => 1);
}
sub respond {
my ($self, $code, @messages) = @_;
my $buf = '';
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);
$buf .= "$line\r\n";
}
print $buf
or ($self->log(LOGERROR, "Could not print [$buf]: $!"), 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;
exit;
}
# local/remote port and ip address
sub lrpip {
my ($self, $server, $client, $hisaddr) = @_;
my $localsockaddr = getsockname($client);
my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr);
if ($server->sockdomain == AF_INET6) { # IPv6
($port, $iaddr) = sockaddr_in6($hisaddr);
($lport, $laddr) = sockaddr_in6($localsockaddr);
$nto_iaddr = inet_ntop(AF_INET6(), $iaddr);
$nto_laddr = inet_ntop(AF_INET6(), $laddr);
}
else { # IPv4
($port, $iaddr) = sockaddr_in($hisaddr);
($lport, $laddr) = sockaddr_in($localsockaddr);
$nto_iaddr = inet_ntoa($iaddr);
$nto_laddr = inet_ntoa($laddr);
}
$nto_iaddr =~ s/::ffff://;
$nto_laddr =~ s/::ffff://;
return $port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr;
}
sub tcpenv {
my ($self, $TCPLOCALIP, $TCPREMOTEIP, $no_rdns) = @_;
if ($no_rdns) {
return $TCPLOCALIP, $TCPREMOTEIP,
$TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]";
}
my ($TCPREMOTEHOST) = $self->resolve_ptr($TCPREMOTEIP) || 'Unknown';
return $TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEHOST;
}
sub check_socket() {
my $self = shift;
return 1 if ($self->{__client_socket}->connected);
return 0;
}
1;