update tcpenv and lrpip calls to use -> syntax

don't load plugins twice.

Not exactly sure where that feature crept in some time ago. It was suppressed by checking to see if a queue plugin was already registered, and then bailing out on subsequent register_hook runs. I noticed it in testing, b/c I didn't have a queue plugin loaded. This removes the duplicate calls to register_hook.

* adds caching of the AUTH methods. You can't add new plugins or register new
  hooks w/o restarting QP, so cache the list and avoid having to generate it on every connection.

* other PBP changes (early exits, less indention, fewer unnecessary parens, etc.)
This commit is contained in:
Matt Simerson 2014-11-10 16:26:46 -08:00
parent f5b58d08e8
commit be9f4aef0c
7 changed files with 115 additions and 150 deletions

View File

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

View File

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

View File

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

View File

@ -99,21 +99,19 @@ sub init {
or die "Could not create SSL context: $!";
# now extract the password...
$self->ssl_context($ssl_ctx);
# Check for possible AUTH mechanisms
HOOK: foreach my $hook (keys %{$qp->hooks}) {
foreach my $hook (keys %{$qp->hooks}) {
no strict 'refs';
if ($hook =~ m/^auth-?(.+)?$/) {
if (defined $1) {
my $hooksub = "hook_$hook";
$hooksub =~ s/\W/_/g;
*$hooksub = \&bad_ssl_hook;
}
else { # at least one polymorphous auth provider
*hook_auth = \&bad_ssl_hook;
}
next if $hook !~ m/^auth-?(.+)?$/;
if (defined $1) {
my $hooksub = "hook_$hook";
$hooksub =~ s/\W/_/g;
*$hooksub = \&bad_ssl_hook;
}
else { # at least one polymorphous auth provider
*hook_auth = \&bad_ssl_hook;
}
}
}
@ -135,7 +133,7 @@ sub hook_unrecognized_command {
my ($self, $transaction, $cmd, @args) = @_;
return DECLINED unless lc $cmd eq 'starttls';
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
$self->qp->respond(220, "Go ahead with TLS");
@ -143,12 +141,12 @@ sub hook_unrecognized_command {
unless (_convert_to_ssl($self)) {
# 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);
return DENY, "TLS Negotiation Failed";
return DENY, 'TLS Negotiation Failed';
}
$self->log(LOGINFO, "TLS setup returning");
$self->log(LOGINFO, 'TLS setup returning');
return DONE;
}
@ -173,12 +171,12 @@ sub hook_post_connection {
my ($self, $transaction) = @_;
my $tls_socket = $self->connection->notes('tls_socket');
if (defined $tls_socket && $self->connection->notes('tls_socket_is_duped'))
{
$tls_socket->close;
$self->connection->notes('tls_socket', undef);
$self->connection->notes('tls_socked_is_duped', 0);
}
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);
$self->connection->notes('tls_socked_is_duped', 0);
return DECLINED;
}
@ -280,26 +278,27 @@ sub new {
sub upgrade_socket {
my UpgradeClientSSL $self = shift;
unless ($self->{_ssl_started}) {
$self->{_stashed_qp}->clear_data();
IO::Socket::SSL->start_SSL(
$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;
if (!$self->{_ssl_started}) {
$self->event_read($self->{_stashed_qp});
return;
}
$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 {

View File

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

View File

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

View File

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