Merge pull request #147 from msimerson/tcpserver

update tcpenv and lrpip calls to use -> syntax
This commit is contained in:
Matt Simerson 2015-01-28 20:08:53 -08:00
commit d81b2d4331
7 changed files with 115 additions and 150 deletions

View File

@ -1,23 +1,20 @@
package Qpsmtpd::TcpServer; package Qpsmtpd::TcpServer;
use Qpsmtpd::SMTP;
use Qpsmtpd::Constants;
use Socket;
@ISA = qw(Qpsmtpd::SMTP);
use strict; use strict;
use POSIX (); use POSIX ();
use Socket;
use lib 'lib';
use Qpsmtpd::Constants;
use parent 'Qpsmtpd::SMTP';
my $has_ipv6 = 0; my $has_ipv6 = 0;
if ( if (
eval { require Socket6; } eval { require Socket6; } &&
&& eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION('2.51'); }
# INET6 prior to 2.01 will not work; sorry.
eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION("2.00"); }
) )
{ {
Socket6->import(qw(inet_ntop)); Socket6->import('inet_ntop');
$has_ipv6 = 1; $has_ipv6 = 1;
} }
@ -91,7 +88,7 @@ sub run {
# Set local client_socket to passed client object for testing socket state on writes # Set local client_socket to passed client object for testing socket state on writes
$self->{__client_socket} = $client; $self->{__client_socket} = $client;
$self->load_plugins unless $self->{hooks}; $self->load_plugins if !$self->{hooks};
my $rc = $self->start_conversation; my $rc = $self->start_conversation;
return if $rc != DONE; return if $rc != DONE;
@ -155,26 +152,24 @@ sub disconnect {
# local/remote port and ip address # local/remote port and ip address
sub lrpip { sub lrpip {
my ($server, $client, $hisaddr) = @_; my ($self, $server, $client, $hisaddr) = @_;
my ($port, $iaddr) =
($server->sockdomain == AF_INET)
? (sockaddr_in($hisaddr))
: (sockaddr_in6($hisaddr));
my $localsockaddr = getsockname($client); my $localsockaddr = getsockname($client);
my ($lport, $laddr) = my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr);
($server->sockdomain == AF_INET)
? (sockaddr_in($localsockaddr)) if ($server->sockdomain == AF_INET6) { # IPv6
: (sockaddr_in6($localsockaddr)); ($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);
}
my $nto_iaddr =
($server->sockdomain == AF_INET)
? (inet_ntoa($iaddr))
: (inet_ntop(AF_INET6(), $iaddr));
my $nto_laddr =
($server->sockdomain == AF_INET)
? (inet_ntoa($laddr))
: (inet_ntop(AF_INET6(), $laddr));
$nto_iaddr =~ s/::ffff://; $nto_iaddr =~ s/::ffff://;
$nto_laddr =~ s/::ffff://; $nto_laddr =~ s/::ffff://;
@ -182,27 +177,14 @@ sub lrpip {
} }
sub tcpenv { sub tcpenv {
my ($nto_laddr, $nto_iaddr, $no_rdns) = @_; my ($self, $TCPLOCALIP, $TCPREMOTEIP, $no_rdns) = @_;
my $TCPLOCALIP = $nto_laddr;
my $TCPREMOTEIP = $nto_iaddr;
if ($no_rdns) { if ($no_rdns) {
return $TCPLOCALIP, $TCPREMOTEIP, return $TCPLOCALIP, $TCPREMOTEIP,
$TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]"; $TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]";
} }
my $res = Net::DNS::Resolver->new( dnsrch => 0 ); my ($TCPREMOTEHOST) = $self->resolve_ptr($TCPREMOTEIP) || 'Unknown';
$res->tcp_timeout(3); return $TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEHOST;
$res->udp_timeout(3);
my $query = $res->query($nto_iaddr, 'PTR');
my $TCPREMOTEHOST;
if ($query) {
foreach my $rr ($query->answer) {
next if $rr->type ne 'PTR';
$TCPREMOTEHOST = $rr->ptrdname;
}
}
return $TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEHOST || 'Unknown';
} }
sub check_socket() { sub check_socket() {

View File

@ -1,9 +1,11 @@
package Qpsmtpd::TcpServer::Prefork; package Qpsmtpd::TcpServer::Prefork;
use Qpsmtpd::TcpServer; use strict;
use Qpsmtpd::SMTP::Prefork;
use lib 'lib';
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
@ISA = qw(Qpsmtpd::SMTP::Prefork Qpsmtpd::TcpServer); use parent 'Qpsmtpd::SMTP::Prefork';
use parent 'Qpsmtpd::TcpServer';
my $first_0; my $first_0;

View File

@ -181,4 +181,3 @@ sub check_dmarc {
# at what point do we reject? # at what point do we reject?
return $self->get_reject("failed DMARC policy"); return $self->get_reject("failed DMARC policy");
} }

View File

@ -99,21 +99,19 @@ sub init {
or die "Could not create SSL context: $!"; or die "Could not create SSL context: $!";
# now extract the password... # now extract the password...
$self->ssl_context($ssl_ctx); $self->ssl_context($ssl_ctx);
# Check for possible AUTH mechanisms # Check for possible AUTH mechanisms
HOOK: foreach my $hook (keys %{$qp->hooks}) { foreach my $hook (keys %{$qp->hooks}) {
no strict 'refs'; no strict 'refs';
if ($hook =~ m/^auth-?(.+)?$/) { next if $hook !~ m/^auth-?(.+)?$/;
if (defined $1) { if (defined $1) {
my $hooksub = "hook_$hook"; my $hooksub = "hook_$hook";
$hooksub =~ s/\W/_/g; $hooksub =~ s/\W/_/g;
*$hooksub = \&bad_ssl_hook; *$hooksub = \&bad_ssl_hook;
} }
else { # at least one polymorphous auth provider else { # at least one polymorphous auth provider
*hook_auth = \&bad_ssl_hook; *hook_auth = \&bad_ssl_hook;
}
} }
} }
} }
@ -135,7 +133,7 @@ sub hook_unrecognized_command {
my ($self, $transaction, $cmd, @args) = @_; my ($self, $transaction, $cmd, @args) = @_;
return DECLINED unless lc $cmd eq 'starttls'; return DECLINED unless lc $cmd eq 'starttls';
return DECLINED unless $transaction->notes('tls_enabled'); return DECLINED unless $transaction->notes('tls_enabled');
return DENY, "Syntax error (no parameters allowed)" if @args; return DENY, 'Syntax error (no parameters allowed)' if @args;
# OK, now we setup TLS # OK, now we setup TLS
$self->qp->respond(220, "Go ahead with TLS"); $self->qp->respond(220, "Go ahead with TLS");
@ -143,12 +141,12 @@ sub hook_unrecognized_command {
unless (_convert_to_ssl($self)) { unless (_convert_to_ssl($self)) {
# SSL setup failed. Now we must respond to every command with 5XX # SSL setup failed. Now we must respond to every command with 5XX
warn("TLS failed: $@\n"); warn "TLS failed: $@\n";
$transaction->notes('ssl_failed', 1); $transaction->notes('ssl_failed', 1);
return DENY, "TLS Negotiation Failed"; return DENY, 'TLS Negotiation Failed';
} }
$self->log(LOGINFO, "TLS setup returning"); $self->log(LOGINFO, 'TLS setup returning');
return DONE; return DONE;
} }
@ -173,12 +171,12 @@ sub hook_post_connection {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $tls_socket = $self->connection->notes('tls_socket'); my $tls_socket = $self->connection->notes('tls_socket');
if (defined $tls_socket && $self->connection->notes('tls_socket_is_duped')) return DECLINED if !defined $tls_socket;
{ return DECLINED if !$self->connection->notes('tls_socket_is_duped');
$tls_socket->close;
$self->connection->notes('tls_socket', undef); $tls_socket->close;
$self->connection->notes('tls_socked_is_duped', 0); $self->connection->notes('tls_socket', undef);
} $self->connection->notes('tls_socked_is_duped', 0);
return DECLINED; return DECLINED;
} }
@ -280,26 +278,27 @@ sub new {
sub upgrade_socket { sub upgrade_socket {
my UpgradeClientSSL $self = shift; my UpgradeClientSSL $self = shift;
unless ($self->{_ssl_started}) { if (!$self->{_ssl_started}) {
$self->{_stashed_qp}->clear_data(); $self->event_read($self->{_stashed_qp});
IO::Socket::SSL->start_SSL( return;
$self->{_stashed_qp}->{sock},
{
SSL_use_cert => 1,
SSL_cert_file => $self->{_stashed_plugin}->tls_cert,
SSL_key_file => $self->{_stashed_plugin}->tls_key,
SSL_ca_file => $self->{_stashed_plugin}->tls_ca,
SSL_cipher_list => $self->{_stashed_plugin}->tls_ciphers,
SSL_startHandshake => 0,
SSL_server => 1,
SSL_reuse_ctx => $self->{_stashed_plugin}->ssl_context,
}
)
or die "Could not upgrade socket to SSL: $!";
$self->{_ssl_started} = 1;
} }
$self->event_read($self->{_stashed_qp}); $self->{_stashed_qp}->clear_data();
my $sp = $self->{_stashed_plugin};
IO::Socket::SSL->start_SSL(
$self->{_stashed_qp}->{sock}, {
SSL_use_cert => 1,
SSL_cert_file => $sp->tls_cert,
SSL_key_file => $sp->tls_key,
SSL_ca_file => $sp->tls_ca,
SSL_cipher_list => $sp->tls_ciphers,
SSL_startHandshake => 0,
SSL_server => 1,
SSL_reuse_ctx => $sp->ssl_context,
}
)
or die "Could not upgrade socket to SSL: $!";
$self->{_ssl_started} = 1;
} }
sub event_read { sub event_read {

View File

@ -39,7 +39,7 @@ foreach my $key ( keys %defaults ) {
} }
$opts{emailAddress} = 'postmaster@'.$opts{CN}; $opts{emailAddress} = 'postmaster@'.$opts{CN};
mkdir('ssl') unless -d 'ssl'; mkdir 'ssl' if ! -d 'ssl';
my $CA_key = 'ssl/qpsmtpd-ca.key'; my $CA_key = 'ssl/qpsmtpd-ca.key';
my $CA_crt = 'ssl/qpsmtpd-ca.crt'; my $CA_crt = 'ssl/qpsmtpd-ca.crt';

View File

@ -1,4 +1,5 @@
#!/usr/bin/perl -Tw #!/usr/bin/perl -Tw
use strict;
# Copyright (c) 2001-2010 Ask Bjoern Hansen. See the LICENSE file for details. # Copyright (c) 2001-2010 Ask Bjoern Hansen. See the LICENSE file for details.
# The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/ # The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/
# #
@ -6,15 +7,13 @@
# #
use lib 'lib'; use lib 'lib';
use Qpsmtpd::TcpServer;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
use Qpsmtpd::TcpServer;
use IO::Socket; use IO::Socket;
use IO::Select; use IO::Select;
use Socket; use Socket;
use Getopt::Long qw(:config no_ignore_case); use Getopt::Long qw(:config no_ignore_case);
use POSIX qw(:sys_wait_h :errno_h :signal_h); use POSIX qw(:sys_wait_h :errno_h :signal_h);
use Net::DNS::Header;
use strict;
$| = 1; $| = 1;
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6; my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6;
@ -29,7 +28,7 @@ my $DETACH; # daemonize on startup
my $NORDNS; my $NORDNS;
my $USER = (getpwuid $>)[0]; # user to suid to my $USER = (getpwuid $>)[0]; # user to suid to
$USER = "smtpd" if $USER eq "root"; $USER = 'smtpd' if $USER eq 'root';
sub usage { sub usage {
print <<"EOT"; print <<"EOT";
@ -71,35 +70,31 @@ if ($has_ipv6) {
else { else {
@LOCALADDR = ('0.0.0.0') if !@LOCALADDR; @LOCALADDR = ('0.0.0.0') if !@LOCALADDR;
} }
@PORT = (2525) if !@PORT; @PORT = 2525 if !@PORT;
my @LISTENADDR; my @LISTENADDR;
for (0 .. $#LOCALADDR) { for (0 .. $#LOCALADDR) {
if ($LOCALADDR[$_] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) { if ($LOCALADDR[$_] !~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) {
if (defined $2) {
push @LISTENADDR, {'addr' => $1, 'port' => $2};
}
else {
my $addr = $1;
for (0 .. $#PORT) {
if ($PORT[$_] =~ /^(\d+)$/) {
push @LISTENADDR, {'addr' => $addr, 'port' => $1};
}
else {
&usage;
}
}
}
}
else {
&usage; &usage;
} }
if (defined $2) {
push @LISTENADDR, {'addr' => $1, 'port' => $2};
next;
}
my $addr = $1;
for (0 .. $#PORT) {
if ($PORT[$_] !~ /^(\d+)$/) {
&usage;
}
push @LISTENADDR, {'addr' => $addr, 'port' => $1};
}
} }
if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } if ($USER !~ /^([\w\-]+)$/) { &usage; }
else { &usage } $USER = $1;
if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } if ($MAXCONN !~ /^(\d+)$/) { &usage; }
else { &usage } $MAXCONN = $1;
delete $ENV{ENV}; delete $ENV{ENV};
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin'; $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
@ -139,6 +134,7 @@ for my $listen_addr (@LISTENADDR) {
Blocking => 0, Blocking => 0,
Listen => SOMAXCONN Listen => SOMAXCONN
); );
if ($has_ipv6) { if ($has_ipv6) {
$server = IO::Socket::INET6->new(@Socket_opts) $server = IO::Socket::INET6->new(@Socket_opts)
or die or die
@ -186,24 +182,21 @@ my (undef, undef, $quid, $qgid) = getpwnam $USER
or die "unable to determine uid/gid for $USER\n"; or die "unable to determine uid/gid for $USER\n";
my $groups = "$qgid $qgid"; my $groups = "$qgid $qgid";
while (my ($name, $passwd, $gid, $members) = getgrent()) { while (my ($name, $passwd, $gid, $members) = getgrent()) {
my @m = split(/ /, $members); my @m = split / /, $members;
if (grep { $_ eq $USER } @m) { if (grep { $_ eq $USER } @m) {
$groups .= " $gid"; $groups .= " $gid";
} }
} }
endgrent; endgrent;
$) = $groups; $) = $groups;
POSIX::setgid($qgid) POSIX::setgid($qgid) or die "unable to change gid: $!\n";
or die "unable to change gid: $!\n"; POSIX::setuid($quid) or die "unable to change uid: $!\n";
POSIX::setuid($quid)
or die "unable to change uid: $!\n";
$> = $quid; $> = $quid;
$qpsmtpd->load_plugins; #$qpsmtpd->load_plugins;
foreach my $listen_addr (@LISTENADDR) { foreach my $addr (@LISTENADDR) {
::log(LOGINFO, ::log(LOGINFO, "Listening on $addr->{addr}:$addr->{port}");
"Listening on $listen_addr->{'addr'}:$listen_addr->{'port'}");
} }
::log(LOGINFO, ::log(LOGINFO,
'Running as user ' 'Running as user '
@ -244,7 +237,7 @@ while (1) {
::log(LOGINFO, ::log(LOGINFO,
"Too many connections: $running >= $MAXCONN. Waiting one second." "Too many connections: $running >= $MAXCONN. Waiting one second."
); );
sleep(1); sleep 1;
next; next;
} }
my @ready = $select->can_read(1); my @ready = $select->can_read(1);
@ -252,20 +245,16 @@ while (1) {
while (my $server = shift @ready) { while (my $server = shift @ready) {
my ($client, $hisaddr) = $server->accept; my ($client, $hisaddr) = $server->accept;
if (!$hisaddr) { next if !$hisaddr;
# possible something condition...
next;
}
IO::Handle::blocking($client, 1); IO::Handle::blocking($client, 1);
# get local/remote hostname, port and ip address # get local/remote hostname, port and ip address
my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) = my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) =
Qpsmtpd::TcpServer::lrpip($server, $client, $hisaddr); $qpsmtpd->lrpip($server, $client, $hisaddr);
my ($rc, @msg) = my ($rc, @msg) =
$qpsmtpd->run_hooks( $qpsmtpd->run_hooks(
"pre-connection", 'pre-connection',
remote_ip => $nto_iaddr, remote_ip => $nto_iaddr,
remote_port => $port, remote_port => $port,
local_ip => $nto_laddr, local_ip => $nto_laddr,
@ -281,7 +270,7 @@ while (1) {
close $client; close $client;
next; next;
} }
elsif ($rc == DENY || $rc == DENY_DISCONNECT) { if ($rc == DENY || $rc == DENY_DISCONNECT) {
unless ($msg[0]) { unless ($msg[0]) {
@msg = ("Sorry, service not available for you"); @msg = ("Sorry, service not available for you");
} }
@ -295,13 +284,12 @@ while (1) {
# parent # parent
$childstatus{$pid} = $iaddr; # add to table $childstatus{$pid} = $iaddr; # add to table
# $childstatus{$pid} = 1; # add to table
$running++; $running++;
close($client); close $client;
next; next;
} }
# otherwise child # child
close $_ for $select->handles; close $_ for $select->handles;
@ -314,7 +302,7 @@ while (1) {
# set enviroment variables # set enviroment variables
($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) = ($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) =
Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr); $qpsmtpd->tcpenv($nto_laddr, $nto_iaddr);
# don't do this! # don't do this!
#$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}"; #$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}";
@ -334,11 +322,10 @@ while (1) {
remote_port => $port, remote_port => $port,
); );
$qpsmtpd->run($client); $qpsmtpd->run($client);
$qpsmtpd->run_hooks('post-connection');
$qpsmtpd->run_hooks("post-connection");
$qpsmtpd->connection->reset; $qpsmtpd->connection->reset;
close $client; close $client;
exit; # child leaves exit; # child
} }
} }

View File

@ -63,7 +63,7 @@ my $select = new IO::Select; # socket(s)
# default settings # default settings
my $pid_file; my $pid_file;
my $d_port = 25; my $d_port = 25;
my @d_addr; # default applied after getopt call my @d_addr; # default applied after getopt call
my $debug = 0; my $debug = 0;
my $max_children = 15; # max number of child processes to spawn my $max_children = 15; # max number of child processes to spawn
@ -129,13 +129,11 @@ else { &usage }
if (@d_addr) { if (@d_addr) {
for my $i (0 .. $#d_addr) { for my $i (0 .. $#d_addr) {
if ($d_addr[$i] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) { if ($d_addr[$i] !~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) {
$d_addr[$i] = {'addr' => $1, 'port' => $2 || $d_port};
}
else {
print STDERR "Malformed listen address '$d_addr[$i]'\n"; print STDERR "Malformed listen address '$d_addr[$i]'\n";
&usage; &usage;
} }
$d_addr[$i] = {'addr' => $1, 'port' => $2 || $d_port};
} }
} }
else { else {
@ -283,7 +281,6 @@ sub run {
# reload qpmstpd plugins # reload qpmstpd plugins
$qpsmtpd = qpsmtpd_instance('restart' => 1); # reload plugins... $qpsmtpd = qpsmtpd_instance('restart' => 1); # reload plugins...
$qpsmtpd->load_plugins;
kill 'HUP' => keys %children; kill 'HUP' => keys %children;
info("reload daemon requested"); info("reload daemon requested");
}; };
@ -527,7 +524,6 @@ sub respond_client {
sub qpsmtpd_instance { sub qpsmtpd_instance {
my %args = @_; my %args = @_;
my $qpsmtpd = Qpsmtpd::TcpServer::Prefork->new(%args); my $qpsmtpd = Qpsmtpd::TcpServer::Prefork->new(%args);
$qpsmtpd->load_plugins;
$qpsmtpd->spool_dir; $qpsmtpd->spool_dir;
$qpsmtpd->size_threshold; $qpsmtpd->size_threshold;
@ -679,7 +675,7 @@ sub qpsmtpd_session {
# get local/remote hostname, port and ip address # get local/remote hostname, port and ip address
my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) = my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) =
Qpsmtpd::TcpServer::lrpip($socket, $client, $iinfo); $qpsmtpd->lrpip($socket, $client, $iinfo);
# get current connected ip addresses (from shared memory) # get current connected ip addresses (from shared memory)
my %children; my %children;
@ -734,7 +730,7 @@ sub qpsmtpd_session {
# set enviroment variables # set enviroment variables
($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) = ($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) =
Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr); $qpsmtpd->tcpenv($nto_laddr, $nto_iaddr);
# run qpmsptd functions # run qpmsptd functions
$SIG{__DIE__} = 'DEFAULT'; $SIG{__DIE__} = 'DEFAULT';