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
parent
f5b58d08e8
commit
be9f4aef0c
|
|
@ -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() {
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -181,4 +181,3 @@ sub check_dmarc {
|
|||
# at what point do we reject?
|
||||
return $self->get_reject("failed DMARC policy");
|
||||
}
|
||||
|
||||
|
|
|
|||
77
plugins/tls
77
plugins/tls
|
|
@ -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 {
|
||||
|
|
|
|||
|
|
@ -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';
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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';
|
||||
|
|
|
|||
Loading…
Reference in New Issue