find . -name '*.pm' -exec perltidy -b {} \;
This commit is contained in:
parent
8536a99379
commit
73c988ac05
@ -56,7 +56,8 @@ sub config_dir {
|
|||||||
$cdir =~ /^(.*)$/; # detaint
|
$cdir =~ /^(.*)$/; # detaint
|
||||||
my $configdir = $1 if -e "$1/$config";
|
my $configdir = $1 if -e "$1/$config";
|
||||||
$cdir_memo{$config} = $configdir;
|
$cdir_memo{$config} = $configdir;
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
$cdir_memo{$config} = $self->SUPER::config_dir(@_);
|
$cdir_memo{$config} = $self->SUPER::config_dir(@_);
|
||||||
}
|
}
|
||||||
return $cdir_memo{$config};
|
return $cdir_memo{$config};
|
||||||
@ -67,9 +68,12 @@ sub start_connection {
|
|||||||
my %opts = @_;
|
my %opts = @_;
|
||||||
|
|
||||||
$self->{conn} = $opts{conn};
|
$self->{conn} = $opts{conn};
|
||||||
$self->{conn}->client_socket->timeout_set($self->config('timeout') * 1_000_000);
|
$self->{conn}
|
||||||
$self->{bb_in} = APR::Brigade->new($self->{conn}->pool, $self->{conn}->bucket_alloc);
|
->client_socket->timeout_set($self->config('timeout') * 1_000_000);
|
||||||
$self->{bb_out} = APR::Brigade->new($self->{conn}->pool, $self->{conn}->bucket_alloc);
|
$self->{bb_in} =
|
||||||
|
APR::Brigade->new($self->{conn}->pool, $self->{conn}->bucket_alloc);
|
||||||
|
$self->{bb_out} =
|
||||||
|
APR::Brigade->new($self->{conn}->pool, $self->{conn}->bucket_alloc);
|
||||||
|
|
||||||
my $remote_host = $opts{host} || ($opts{ip} ? "[$opts{ip}]" : "[noip!]");
|
my $remote_host = $opts{host} || ($opts{ip} ? "[$opts{ip}]" : "[noip!]");
|
||||||
my $remote_info = $opts{info} ? "$opts{info}\@$remote_host" : $remote_host;
|
my $remote_info = $opts{info} ? "$opts{info}\@$remote_host" : $remote_host;
|
||||||
@ -119,7 +123,8 @@ sub getline {
|
|||||||
my $bb = $self->{bb_in};
|
my $bb = $self->{bb_in};
|
||||||
|
|
||||||
while (1) {
|
while (1) {
|
||||||
my $rc = $c->input_filters->get_brigade($bb, Apache2::Const::MODE_GETLINE);
|
my $rc =
|
||||||
|
$c->input_filters->get_brigade($bb, Apache2::Const::MODE_GETLINE);
|
||||||
return if $rc == APR::Const::EOF;
|
return if $rc == APR::Const::EOF;
|
||||||
die APR::Error::strerror($rc) unless $rc == APR::Const::SUCCESS;
|
die APR::Error::strerror($rc) unless $rc == APR::Const::SUCCESS;
|
||||||
|
|
||||||
@ -156,6 +161,7 @@ sub respond {
|
|||||||
my $bucket = APR::Bucket->new(($c->bucket_alloc), "$line\r\n");
|
my $bucket = APR::Bucket->new(($c->bucket_alloc), "$line\r\n");
|
||||||
$bb->insert_tail($bucket);
|
$bb->insert_tail($bucket);
|
||||||
$c->output_filters->fflush($bb);
|
$c->output_filters->fflush($bb);
|
||||||
|
|
||||||
# $bucket->remove;
|
# $bucket->remove;
|
||||||
$bb->cleanup;
|
$bb->cleanup;
|
||||||
}
|
}
|
||||||
|
@ -52,10 +52,12 @@ sub get_bytes {
|
|||||||
$self->{line} = '';
|
$self->{line} = '';
|
||||||
if ($self->{read_bytes} <= 0) {
|
if ($self->{read_bytes} <= 0) {
|
||||||
if ($self->{read_bytes} < 0) {
|
if ($self->{read_bytes} < 0) {
|
||||||
$self->{line} = substr($self->{data_bytes},
|
$self->{line} = substr(
|
||||||
|
$self->{data_bytes},
|
||||||
$self->{read_bytes}, # negative offset
|
$self->{read_bytes}, # negative offset
|
||||||
0 - $self->{read_bytes}, # to end of str
|
0 - $self->{read_bytes}, # to end of str
|
||||||
""); # truncate that substr
|
""
|
||||||
|
); # truncate that substr
|
||||||
}
|
}
|
||||||
$callback->($self->{data_bytes});
|
$callback->($self->{data_bytes});
|
||||||
return;
|
return;
|
||||||
@ -132,6 +134,7 @@ sub event_read {
|
|||||||
$self->{data_bytes} .= $$bref;
|
$self->{data_bytes} .= $$bref;
|
||||||
}
|
}
|
||||||
if ($self->{read_bytes} <= 0) {
|
if ($self->{read_bytes} <= 0) {
|
||||||
|
|
||||||
# print "Erk, read too much!\n" if $self->{read_bytes} < 0;
|
# print "Erk, read too much!\n" if $self->{read_bytes} < 0;
|
||||||
my $cb = $self->{callback};
|
my $cb = $self->{callback};
|
||||||
$self->{callback} = undef;
|
$self->{callback} = undef;
|
||||||
@ -155,16 +158,24 @@ sub process_read_buf {
|
|||||||
my $line = $1;
|
my $line = $1;
|
||||||
$self->{alive_time} = time;
|
$self->{alive_time} = time;
|
||||||
my $resp = $self->process_line($line);
|
my $resp = $self->process_line($line);
|
||||||
if ($::DEBUG > 1 and $resp) { print "$$:".($self+0)."S: $_\n" for split(/\n/, $resp) }
|
if ($::DEBUG > 1 and $resp) {
|
||||||
|
print "$$:" . ($self + 0) . "S: $_\n" for split(/\n/, $resp);
|
||||||
|
}
|
||||||
$self->write($resp) if $resp;
|
$self->write($resp) if $resp;
|
||||||
|
|
||||||
# $self->watch_read(0) if $self->{pause_count};
|
# $self->watch_read(0) if $self->{pause_count};
|
||||||
return if $self->{pause_count} || $self->{closed};
|
return if $self->{pause_count} || $self->{closed};
|
||||||
|
|
||||||
# read more in a timer, to give other clients a look in
|
# read more in a timer, to give other clients a look in
|
||||||
$self->AddTimer(0, sub {
|
$self->AddTimer(
|
||||||
|
0,
|
||||||
|
sub {
|
||||||
if (length($self->{line}) && !$self->paused) {
|
if (length($self->{line}) && !$self->paused) {
|
||||||
$self->process_read_buf(\""); # " for bad syntax highlighters
|
$self->process_read_buf(\"")
|
||||||
|
; # " for bad syntax highlighters
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -188,6 +199,7 @@ sub paused {
|
|||||||
sub pause_read {
|
sub pause_read {
|
||||||
my Danga::Client $self = shift;
|
my Danga::Client $self = shift;
|
||||||
$self->{pause_count}++;
|
$self->{pause_count}++;
|
||||||
|
|
||||||
# $self->watch_read(0);
|
# $self->watch_read(0);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -196,11 +208,15 @@ sub continue_read {
|
|||||||
$self->{pause_count}--;
|
$self->{pause_count}--;
|
||||||
if ($self->{pause_count} <= 0) {
|
if ($self->{pause_count} <= 0) {
|
||||||
$self->{pause_count} = 0;
|
$self->{pause_count} = 0;
|
||||||
$self->AddTimer(0, sub {
|
$self->AddTimer(
|
||||||
|
0,
|
||||||
|
sub {
|
||||||
if (length($self->{line}) && !$self->paused) {
|
if (length($self->{line}) && !$self->paused) {
|
||||||
$self->process_read_buf(\""); # " for bad syntax highlighters
|
$self->process_read_buf(\"")
|
||||||
|
; # " for bad syntax highlighters
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -216,6 +232,10 @@ sub close {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub event_err { my Danga::Client $self = shift; $self->close("Error") }
|
sub event_err { my Danga::Client $self = shift; $self->close("Error") }
|
||||||
sub event_hup { my Danga::Client $self = shift; $self->close("Disconnect (HUP)") }
|
|
||||||
|
sub event_hup {
|
||||||
|
my Danga::Client $self = shift;
|
||||||
|
$self->close("Disconnect (HUP)");
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
130
lib/Qpsmtpd.pm
130
lib/Qpsmtpd.pm
@ -33,6 +33,7 @@ sub _restart {
|
|||||||
my $self = shift;
|
my $self = shift;
|
||||||
my %args = @_;
|
my %args = @_;
|
||||||
if ($args{restart}) {
|
if ($args{restart}) {
|
||||||
|
|
||||||
# reset all global vars to defaults
|
# reset all global vars to defaults
|
||||||
$self->clear_config_cache;
|
$self->clear_config_cache;
|
||||||
$hooks = {};
|
$hooks = {};
|
||||||
@ -44,19 +45,19 @@ sub _restart {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
sub DESTROY {
|
sub DESTROY {
|
||||||
|
|
||||||
#warn $_ for DashProfiler->profile_as_text("qpsmtpd");
|
#warn $_ for DashProfiler->profile_as_text("qpsmtpd");
|
||||||
}
|
}
|
||||||
|
|
||||||
sub version { $VERSION . ($git ? "/$git" : "") };
|
sub version { $VERSION . ($git ? "/$git" : "") }
|
||||||
|
|
||||||
sub TRACE_LEVEL { $TraceLevel }; # leave for plugin compatibility
|
sub TRACE_LEVEL { $TraceLevel }; # leave for plugin compatibility
|
||||||
|
|
||||||
|
|
||||||
sub hooks { $hooks; }
|
sub hooks { $hooks; }
|
||||||
|
|
||||||
sub load_logging {
|
sub load_logging {
|
||||||
|
|
||||||
# need to do this differently than other plugins so as to
|
# need to do this differently than other plugins so as to
|
||||||
# not trigger logging activity
|
# not trigger logging activity
|
||||||
return if $LOGGING_LOADED;
|
return if $LOGGING_LOADED;
|
||||||
@ -125,16 +126,19 @@ sub varlog {
|
|||||||
|
|
||||||
$self->load_logging; # in case we don't have this loaded yet
|
$self->load_logging; # in case we don't have this loaded yet
|
||||||
|
|
||||||
my ($rc) = $self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log)
|
my ($rc) =
|
||||||
|
$self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log)
|
||||||
or return;
|
or return;
|
||||||
|
|
||||||
return if $rc == DECLINED || $rc == OK; # plugin success
|
return if $rc == DECLINED || $rc == OK; # plugin success
|
||||||
return if $trace > $TraceLevel;
|
return if $trace > $TraceLevel;
|
||||||
|
|
||||||
# no logging plugins registered, fall back to STDERR
|
# no logging plugins registered, fall back to STDERR
|
||||||
my $prefix = defined $plugin && defined $hook ? " ($hook) $plugin:" :
|
my $prefix =
|
||||||
defined $plugin ? " $plugin:" :
|
defined $plugin && defined $hook ? " ($hook) $plugin:"
|
||||||
defined $hook ? " ($hook) running plugin:" : '';
|
: defined $plugin ? " $plugin:"
|
||||||
|
: defined $hook ? " ($hook) running plugin:"
|
||||||
|
: '';
|
||||||
|
|
||||||
warn join(' ', $$ . $prefix, @log), "\n";
|
warn join(' ', $$ . $prefix, @log), "\n";
|
||||||
}
|
}
|
||||||
@ -157,7 +161,8 @@ sub config {
|
|||||||
# XXX - is this always the right thing to do? what if a config hook
|
# XXX - is this always the right thing to do? what if a config hook
|
||||||
# can return different values on subsequent calls?
|
# can return different values on subsequent calls?
|
||||||
if ($_config_cache->{$c}) {
|
if ($_config_cache->{$c}) {
|
||||||
$self->log(LOGDEBUG, "config($c) returning (@{$_config_cache->{$c}}) from cache");
|
$self->log(LOGDEBUG,
|
||||||
|
"config($c) returning (@{$_config_cache->{$c}}) from cache");
|
||||||
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -165,7 +170,9 @@ sub config {
|
|||||||
my ($rc, @config) = $self->run_hooks_no_respond("config", $c);
|
my ($rc, @config) = $self->run_hooks_no_respond("config", $c);
|
||||||
$self->log(LOGDEBUG, "config($c): hook returned ($rc, @config) ");
|
$self->log(LOGDEBUG, "config($c): hook returned ($rc, @config) ");
|
||||||
if ($rc == OK) {
|
if ($rc == OK) {
|
||||||
$self->log(LOGDEBUG, "setting _config_cache for $c to [@config] from hooks and returning it");
|
$self->log(LOGDEBUG,
|
||||||
|
"setting _config_cache for $c to [@config] from hooks and returning it"
|
||||||
|
);
|
||||||
$_config_cache->{$c} = \@config;
|
$_config_cache->{$c} = \@config;
|
||||||
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
||||||
}
|
}
|
||||||
@ -173,14 +180,18 @@ sub config {
|
|||||||
# and then get_qmail_config
|
# and then get_qmail_config
|
||||||
@config = $self->get_qmail_config($c, $type);
|
@config = $self->get_qmail_config($c, $type);
|
||||||
if (@config) {
|
if (@config) {
|
||||||
$self->log(LOGDEBUG, "setting _config_cache for $c to [@config] from get_qmail_config and returning it");
|
$self->log(LOGDEBUG,
|
||||||
|
"setting _config_cache for $c to [@config] from get_qmail_config and returning it"
|
||||||
|
);
|
||||||
$_config_cache->{$c} = \@config;
|
$_config_cache->{$c} = \@config;
|
||||||
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
# finally we use the default if there is any:
|
# finally we use the default if there is any:
|
||||||
if (exists($defaults{$c})) {
|
if (exists($defaults{$c})) {
|
||||||
$self->log(LOGDEBUG, "setting _config_cache for $c to @{[$defaults{$c}]} from defaults and returning it");
|
$self->log(LOGDEBUG,
|
||||||
|
"setting _config_cache for $c to @{[$defaults{$c}]} from defaults and returning it"
|
||||||
|
);
|
||||||
$_config_cache->{$c} = [$defaults{$c}];
|
$_config_cache->{$c} = [$defaults{$c}];
|
||||||
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
||||||
}
|
}
|
||||||
@ -229,7 +240,9 @@ sub get_qmail_config {
|
|||||||
eval { require CDB_File };
|
eval { require CDB_File };
|
||||||
|
|
||||||
if ($@) {
|
if ($@) {
|
||||||
$self->log(LOGERROR, "No CDB Support! Did NOT read $configfile.cdb, could not load CDB_File module: $@");
|
$self->log(LOGERROR,
|
||||||
|
"No CDB Support! Did NOT read $configfile.cdb, could not load CDB_File module: $@"
|
||||||
|
);
|
||||||
return +{};
|
return +{};
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -238,6 +251,7 @@ sub get_qmail_config {
|
|||||||
$self->log(LOGERROR, "tie of $configfile.cdb failed: $!");
|
$self->log(LOGERROR, "tie of $configfile.cdb failed: $!");
|
||||||
return +{};
|
return +{};
|
||||||
}
|
}
|
||||||
|
|
||||||
# We explicitly don't cache cdb entries. The assumption is that
|
# We explicitly don't cache cdb entries. The assumption is that
|
||||||
# the data is in a CDB file in the first place because there's
|
# the data is in a CDB file in the first place because there's
|
||||||
# lots of data and the cache hit ratio would be low.
|
# lots of data and the cache hit ratio would be low.
|
||||||
@ -257,7 +271,8 @@ sub _config_from_file {
|
|||||||
$visited ||= [];
|
$visited ||= [];
|
||||||
push @{$visited}, $configfile;
|
push @{$visited}, $configfile;
|
||||||
|
|
||||||
open CF, "<$configfile" or warn "$$ could not open configfile $configfile: $!" and return;
|
open CF, "<$configfile"
|
||||||
|
or warn "$$ could not open configfile $configfile: $!" and return;
|
||||||
my @config = <CF>;
|
my @config = <CF>;
|
||||||
chomp @config;
|
chomp @config;
|
||||||
@config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/ }
|
@config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/ }
|
||||||
@ -267,6 +282,7 @@ sub _config_from_file {
|
|||||||
|
|
||||||
my $pos = 0;
|
my $pos = 0;
|
||||||
while ($pos < @config) {
|
while ($pos < @config) {
|
||||||
|
|
||||||
# recursively pursue an $include reference, if found. An inclusion which
|
# recursively pursue an $include reference, if found. An inclusion which
|
||||||
# begins with a leading slash is interpreted as a path to a file and will
|
# begins with a leading slash is interpreted as a path to a file and will
|
||||||
# supercede the usual config path resolution. Otherwise, the normal
|
# supercede the usual config path resolution. Otherwise, the normal
|
||||||
@ -283,7 +299,8 @@ sub _config_from_file {
|
|||||||
}
|
}
|
||||||
|
|
||||||
if (grep($_ eq $inclusion, @{$visited})) {
|
if (grep($_ eq $inclusion, @{$visited})) {
|
||||||
$self->log(LOGERROR, "Circular \$include reference in config $config:");
|
$self->log(LOGERROR,
|
||||||
|
"Circular \$include reference in config $config:");
|
||||||
$self->log(LOGERROR, "From $visited->[0]:");
|
$self->log(LOGERROR, "From $visited->[0]:");
|
||||||
$self->log(LOGERROR, " includes $_")
|
$self->log(LOGERROR, " includes $_")
|
||||||
for (@{$visited}[1 .. $#{$visited}], $inclusion);
|
for (@{$visited}[1 .. $#{$visited}], $inclusion);
|
||||||
@ -292,11 +309,13 @@ sub _config_from_file {
|
|||||||
push @{$visited}, $inclusion;
|
push @{$visited}, $inclusion;
|
||||||
|
|
||||||
for my $inc ($self->expand_inclusion_($inclusion, $configfile)) {
|
for my $inc ($self->expand_inclusion_($inclusion, $configfile)) {
|
||||||
my @insertion = $self->_config_from_file($inc, $config, $visited);
|
my @insertion =
|
||||||
|
$self->_config_from_file($inc, $config, $visited);
|
||||||
splice @config, $pos, 0, @insertion; # insert the inclusion
|
splice @config, $pos, 0, @insertion; # insert the inclusion
|
||||||
$pos += @insertion;
|
$pos += @insertion;
|
||||||
}
|
}
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
$pos++;
|
$pos++;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -319,18 +338,21 @@ sub expand_inclusion_ {
|
|||||||
@includes = map { "$inclusion/$_" }
|
@includes = map { "$inclusion/$_" }
|
||||||
(grep { -f "$inclusion/$_" and !/^\./ } sort readdir INCD);
|
(grep { -f "$inclusion/$_" and !/^\./ } sort readdir INCD);
|
||||||
closedir INCD;
|
closedir INCD;
|
||||||
} else {
|
|
||||||
$self->log(LOGERROR, "Couldn't open directory $inclusion,".
|
|
||||||
" referenced from $context ($!)");
|
|
||||||
}
|
}
|
||||||
} else {
|
else {
|
||||||
|
$self->log(LOGERROR,
|
||||||
|
"Couldn't open directory $inclusion,"
|
||||||
|
. " referenced from $context ($!)"
|
||||||
|
);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
$self->log(LOGDEBUG, "inclusion of file $inclusion from $context");
|
$self->log(LOGDEBUG, "inclusion of file $inclusion from $context");
|
||||||
@includes = ($inclusion);
|
@includes = ($inclusion);
|
||||||
}
|
}
|
||||||
return @includes;
|
return @includes;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
sub load_plugins {
|
sub load_plugins {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
@ -338,6 +360,7 @@ sub load_plugins {
|
|||||||
my @loaded;
|
my @loaded;
|
||||||
|
|
||||||
if ($hooks->{queue}) {
|
if ($hooks->{queue}) {
|
||||||
|
|
||||||
#$self->log(LOGWARN, "Plugins already loaded");
|
#$self->log(LOGWARN, "Plugins already loaded");
|
||||||
return @plugins;
|
return @plugins;
|
||||||
}
|
}
|
||||||
@ -359,6 +382,7 @@ sub _load_plugin {
|
|||||||
my $package;
|
my $package;
|
||||||
|
|
||||||
if ($plugin =~ m/::/) {
|
if ($plugin =~ m/::/) {
|
||||||
|
|
||||||
# "full" package plugin (My::Plugin)
|
# "full" package plugin (My::Plugin)
|
||||||
$package = $plugin;
|
$package = $plugin;
|
||||||
$package =~ s/[^_a-z0-9:]+//gi;
|
$package =~ s/[^_a-z0-9:]+//gi;
|
||||||
@ -395,7 +419,8 @@ sub _load_plugin {
|
|||||||
if (-e "$dir/$plugin") {
|
if (-e "$dir/$plugin") {
|
||||||
Qpsmtpd::Plugin->compile($plugin_name, $package,
|
Qpsmtpd::Plugin->compile($plugin_name, $package,
|
||||||
"$dir/$plugin", $self->{_test_mode}, $plugin);
|
"$dir/$plugin", $self->{_test_mode}, $plugin);
|
||||||
$self->log(LOGDEBUG, "Loading $plugin_line from $dir/$plugin")
|
$self->log(LOGDEBUG,
|
||||||
|
"Loading $plugin_line from $dir/$plugin")
|
||||||
unless $plugin_line =~ /logging/;
|
unless $plugin_line =~ /logging/;
|
||||||
last PLUGIN_DIR;
|
last PLUGIN_DIR;
|
||||||
}
|
}
|
||||||
@ -431,7 +456,9 @@ sub run_hooks_no_respond {
|
|||||||
my @r;
|
my @r;
|
||||||
for my $code (@{$hooks->{$hook}}) {
|
for my $code (@{$hooks->{$hook}}) {
|
||||||
eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
|
eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
|
||||||
$@ and warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@) and next;
|
$@
|
||||||
|
and warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@)
|
||||||
|
and next;
|
||||||
if ($r[0] == YIELD) {
|
if ($r[0] == YIELD) {
|
||||||
die "YIELD not valid from $hook hook";
|
die "YIELD not valid from $hook hook";
|
||||||
}
|
}
|
||||||
@ -448,6 +475,7 @@ sub pause_read { die "Continuations only work in qpsmtpd-async" }
|
|||||||
|
|
||||||
sub run_continuation {
|
sub run_continuation {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
#my $t1 = $SAMPLER->("run_hooks", undef, 1);
|
#my $t1 = $SAMPLER->("run_hooks", undef, 1);
|
||||||
die "No continuation in progress" unless $self->{_continuation};
|
die "No continuation in progress" unless $self->{_continuation};
|
||||||
$self->continue_read();
|
$self->continue_read();
|
||||||
@ -456,18 +484,27 @@ sub run_continuation {
|
|||||||
my $hook = shift @$todo || die "No hook in the continuation";
|
my $hook = shift @$todo || die "No hook in the continuation";
|
||||||
my $args = shift @$todo || die "No hook args in the continuation";
|
my $args = shift @$todo || die "No hook args in the continuation";
|
||||||
my @r;
|
my @r;
|
||||||
|
|
||||||
while (@$todo) {
|
while (@$todo) {
|
||||||
my $code = shift @$todo;
|
my $code = shift @$todo;
|
||||||
|
|
||||||
#my $t2 = $SAMPLER->($hook . "_" . $code->{name}, undef, 1);
|
#my $t2 = $SAMPLER->($hook . "_" . $code->{name}, undef, 1);
|
||||||
#warn("Got sampler called: ${hook}_$code->{name}\n");
|
#warn("Got sampler called: ${hook}_$code->{name}\n");
|
||||||
$self->varlog(LOGDEBUG, $hook, $code->{name});
|
$self->varlog(LOGDEBUG, $hook, $code->{name});
|
||||||
my $tran = $self->transaction;
|
my $tran = $self->transaction;
|
||||||
eval { (@r) = $code->{code}->($self, $tran, @$args); };
|
eval { (@r) = $code->{code}->($self, $tran, @$args); };
|
||||||
$@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@) and next;
|
$@
|
||||||
|
and
|
||||||
|
$self->log(LOGCRIT, "FATAL PLUGIN ERROR [" . $code->{name} . "]: ",
|
||||||
|
$@)
|
||||||
|
and next;
|
||||||
|
|
||||||
!defined $r[0]
|
!defined $r[0]
|
||||||
and $self->log(LOGERROR, "plugin ".$code->{name}
|
and $self->log(LOGERROR,
|
||||||
." running the $hook hook returned undef!")
|
"plugin "
|
||||||
|
. $code->{name}
|
||||||
|
. " running the $hook hook returned undef!"
|
||||||
|
)
|
||||||
and next;
|
and next;
|
||||||
|
|
||||||
# note this is wrong as $tran is always true in the
|
# note this is wrong as $tran is always true in the
|
||||||
@ -488,24 +525,39 @@ sub run_continuation {
|
|||||||
$self->{_continuation} = [$hook, $args, @$todo];
|
$self->{_continuation} = [$hook, $args, @$todo];
|
||||||
return @r;
|
return @r;
|
||||||
}
|
}
|
||||||
elsif ($r[0] == DENY or $r[0] == DENYSOFT or
|
elsif ( $r[0] == DENY
|
||||||
$r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT)
|
or $r[0] == DENYSOFT
|
||||||
|
or $r[0] == DENY_DISCONNECT
|
||||||
|
or $r[0] == DENYSOFT_DISCONNECT)
|
||||||
{
|
{
|
||||||
$r[1] = "" if not defined $r[1];
|
$r[1] = "" if not defined $r[1];
|
||||||
$self->log(LOGDEBUG, "Plugin ".$code->{name}.
|
$self->log(LOGDEBUG,
|
||||||
", hook $hook returned ".return_code($r[0]).", $r[1]");
|
"Plugin "
|
||||||
$self->run_hooks_no_respond("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny");
|
. $code->{name}
|
||||||
|
. ", hook $hook returned "
|
||||||
|
. return_code($r[0])
|
||||||
|
. ", $r[1]"
|
||||||
|
);
|
||||||
|
$self->run_hooks_no_respond("deny", $code->{name}, $r[0], $r[1])
|
||||||
|
unless ($hook eq "deny");
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$r[1] = "" if not defined $r[1];
|
$r[1] = "" if not defined $r[1];
|
||||||
$self->log(LOGDEBUG, "Plugin ".$code->{name}.
|
$self->log(LOGDEBUG,
|
||||||
", hook $hook returned ".return_code($r[0]).", $r[1]");
|
"Plugin "
|
||||||
$self->run_hooks_no_respond("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
|
. $code->{name}
|
||||||
|
. ", hook $hook returned "
|
||||||
|
. return_code($r[0])
|
||||||
|
. ", $r[1]"
|
||||||
|
);
|
||||||
|
$self->run_hooks_no_respond("ok", $code->{name}, $r[0], $r[1])
|
||||||
|
unless ($hook eq "ok");
|
||||||
}
|
}
|
||||||
|
|
||||||
last unless $r[0] == DECLINED;
|
last unless $r[0] == DECLINED;
|
||||||
}
|
}
|
||||||
$r[0] = DECLINED if not defined $r[0];
|
$r[0] = DECLINED if not defined $r[0];
|
||||||
|
|
||||||
# hook_*_parse() may return a CODE ref..
|
# hook_*_parse() may return a CODE ref..
|
||||||
# ... which breaks when splitting as string:
|
# ... which breaks when splitting as string:
|
||||||
@r = map { split /\n/ } @r unless (ref($r[1]) eq "CODE");
|
@r = map { split /\n/ } @r unless (ref($r[1]) eq "CODE");
|
||||||
@ -554,7 +606,8 @@ sub spool_dir {
|
|||||||
if (!-d $Spool_dir) { # create it if it doesn't exist
|
if (!-d $Spool_dir) { # create it if it doesn't exist
|
||||||
mkdir($Spool_dir, oct($Spool_perms))
|
mkdir($Spool_dir, oct($Spool_perms))
|
||||||
or die "Could not create spool_dir $Spool_dir: $!";
|
or die "Could not create spool_dir $Spool_dir: $!";
|
||||||
};
|
}
|
||||||
|
|
||||||
# Make sure the spool dir has appropriate rights
|
# Make sure the spool dir has appropriate rights
|
||||||
$self->log(LOGWARN,
|
$self->log(LOGWARN,
|
||||||
"Permissions on spool_dir $Spool_dir are not $Spool_perms")
|
"Permissions on spool_dir $Spool_dir are not $Spool_perms")
|
||||||
@ -570,8 +623,8 @@ my $transaction_counter = 0;
|
|||||||
|
|
||||||
sub temp_file {
|
sub temp_file {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $filename = $self->spool_dir()
|
my $filename =
|
||||||
. join(":", time, $$, $transaction_counter++);
|
$self->spool_dir() . join(":", time, $$, $transaction_counter++);
|
||||||
return $filename;
|
return $filename;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -579,7 +632,8 @@ sub temp_dir {
|
|||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $mask = shift || 0700;
|
my $mask = shift || 0700;
|
||||||
my $dirname = $self->temp_file();
|
my $dirname = $self->temp_file();
|
||||||
-d $dirname or mkdir($dirname, $mask)
|
-d $dirname
|
||||||
|
or mkdir($dirname, $mask)
|
||||||
or die "Could not create temporary directory $dirname: $!";
|
or die "Could not create temporary directory $dirname: $!";
|
||||||
return $dirname;
|
return $dirname;
|
||||||
}
|
}
|
||||||
|
@ -196,8 +196,11 @@ sub canonify {
|
|||||||
return undef unless ($path =~ /^<(.*)>$/);
|
return undef unless ($path =~ /^<(.*)>$/);
|
||||||
$path = $1;
|
$path = $1;
|
||||||
|
|
||||||
my $domain = $domain_expr ? $domain_expr
|
my $domain =
|
||||||
|
$domain_expr
|
||||||
|
? $domain_expr
|
||||||
: "$subdomain_expr(?:\.$subdomain_expr)*";
|
: "$subdomain_expr(?:\.$subdomain_expr)*";
|
||||||
|
|
||||||
# it is possible for $address_literal_expr to be empty, if a site
|
# it is possible for $address_literal_expr to be empty, if a site
|
||||||
# doesn't want to allow them
|
# doesn't want to allow them
|
||||||
$domain = "(?:$address_literal_expr|$domain)"
|
$domain = "(?:$address_literal_expr|$domain)"
|
||||||
@ -216,6 +219,7 @@ sub canonify {
|
|||||||
return (undef) unless defined $localpart;
|
return (undef) unless defined $localpart;
|
||||||
|
|
||||||
if ($localpart =~ /^$atom_expr(\.$atom_expr)*/) {
|
if ($localpart =~ /^$atom_expr(\.$atom_expr)*/) {
|
||||||
|
|
||||||
# simple case, we are done
|
# simple case, we are done
|
||||||
return ($localpart, $domainpart);
|
return ($localpart, $domainpart);
|
||||||
}
|
}
|
||||||
@ -279,7 +283,8 @@ sub format {
|
|||||||
my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]';
|
my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]';
|
||||||
return '<>' unless defined $self->{_user};
|
return '<>' unless defined $self->{_user};
|
||||||
if ((my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) {
|
if ((my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) {
|
||||||
return qq(<"$user")
|
return
|
||||||
|
qq(<"$user")
|
||||||
. (defined $self->{_host} ? '@' . $self->{_host} : '') . ">";
|
. (defined $self->{_host} ? '@' . $self->{_host} : '') . ">";
|
||||||
}
|
}
|
||||||
return "<" . $self->address() . ">";
|
return "<" . $self->address() . ">";
|
||||||
@ -327,6 +332,7 @@ use this to pass data between plugins.
|
|||||||
|
|
||||||
sub notes {
|
sub notes {
|
||||||
my ($self, $key) = (shift, shift);
|
my ($self, $key) = (shift, shift);
|
||||||
|
|
||||||
# Check for any additional arguments passed by the caller -- including undef
|
# Check for any additional arguments passed by the caller -- including undef
|
||||||
return $self->{_notes}->{$key} unless @_;
|
return $self->{_notes}->{$key} unless @_;
|
||||||
return $self->{_notes}->{$key} = shift;
|
return $self->{_notes}->{$key} = shift;
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
package Qpsmtpd::Auth;
|
package Qpsmtpd::Auth;
|
||||||
|
|
||||||
# See the documentation in 'perldoc docs/authentication.pod'
|
# See the documentation in 'perldoc docs/authentication.pod'
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
@ -23,7 +24,8 @@ sub SASL {
|
|||||||
my ($user, $passClear, $passHash, $ticket, $loginas);
|
my ($user, $passClear, $passHash, $ticket, $loginas);
|
||||||
|
|
||||||
if ($mechanism eq 'plain') {
|
if ($mechanism eq 'plain') {
|
||||||
($loginas, $user, $passClear) = get_auth_details_plain($session,$prekey);
|
($loginas, $user, $passClear) =
|
||||||
|
get_auth_details_plain($session, $prekey);
|
||||||
return DECLINED if !$user || !$passClear;
|
return DECLINED if !$user || !$passClear;
|
||||||
}
|
}
|
||||||
elsif ($mechanism eq 'login') {
|
elsif ($mechanism eq 'login') {
|
||||||
@ -48,19 +50,21 @@ sub SASL {
|
|||||||
# try running the polymorphous hooks next
|
# try running the polymorphous hooks next
|
||||||
if (!$rc || $rc == DECLINED) {
|
if (!$rc || $rc == DECLINED) {
|
||||||
($rc, $msg) =
|
($rc, $msg) =
|
||||||
$session->run_hooks( "auth", $mechanism, $user, $passClear,
|
$session->run_hooks("auth", $mechanism, $user,
|
||||||
$passHash, $ticket );
|
$passClear, $passHash, $ticket);
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($rc == OK) {
|
if ($rc == OK) {
|
||||||
$msg = uc($mechanism) . " authentication successful for $user" .
|
$msg =
|
||||||
( $msg ? " - $msg" : '');
|
uc($mechanism)
|
||||||
|
. " authentication successful for $user"
|
||||||
|
. ($msg ? " - $msg" : '');
|
||||||
$session->respond(235, $msg);
|
$session->respond(235, $msg);
|
||||||
$session->connection->relay_client(1);
|
$session->connection->relay_client(1);
|
||||||
if ($session->connection->notes('naughty')) {
|
if ($session->connection->notes('naughty')) {
|
||||||
$session->log(LOGINFO, "auth success cleared naughty");
|
$session->log(LOGINFO, "auth success cleared naughty");
|
||||||
$session->connection->notes('naughty', 0);
|
$session->connection->notes('naughty', 0);
|
||||||
};
|
}
|
||||||
$session->log(LOGDEBUG, $msg); # already logged by $session->respond
|
$session->log(LOGDEBUG, $msg); # already logged by $session->respond
|
||||||
|
|
||||||
$session->{_auth_user} = $user;
|
$session->{_auth_user} = $user;
|
||||||
@ -70,8 +74,10 @@ sub SASL {
|
|||||||
return OK;
|
return OK;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$msg = uc($mechanism) . " authentication failed for $user" .
|
$msg =
|
||||||
( $msg ? " - $msg" : '');
|
uc($mechanism)
|
||||||
|
. " authentication failed for $user"
|
||||||
|
. ($msg ? " - $msg" : '');
|
||||||
$session->respond(535, $msg);
|
$session->respond(535, $msg);
|
||||||
$session->log(LOGDEBUG, $msg); # already logged by $session->respond
|
$session->log(LOGDEBUG, $msg); # already logged by $session->respond
|
||||||
return DENY;
|
return DENY;
|
||||||
@ -96,7 +102,7 @@ sub get_auth_details_plain {
|
|||||||
$session->respond(535, "Authentication invalid");
|
$session->respond(535, "Authentication invalid");
|
||||||
}
|
}
|
||||||
return;
|
return;
|
||||||
};
|
}
|
||||||
|
|
||||||
# Authorization ID must not be different from Authentication ID
|
# Authorization ID must not be different from Authentication ID
|
||||||
if ($loginas ne '' && $loginas ne $user) {
|
if ($loginas ne '' && $loginas ne $user) {
|
||||||
@ -105,7 +111,7 @@ sub get_auth_details_plain {
|
|||||||
}
|
}
|
||||||
|
|
||||||
return ($loginas, $user, $passClear);
|
return ($loginas, $user, $passClear);
|
||||||
};
|
}
|
||||||
|
|
||||||
sub get_auth_details_login {
|
sub get_auth_details_login {
|
||||||
my ($session, $prekey) = @_;
|
my ($session, $prekey) = @_;
|
||||||
@ -122,7 +128,7 @@ sub get_auth_details_login {
|
|||||||
my $passClear = get_base64_response($session, 'Password:') or return;
|
my $passClear = get_base64_response($session, 'Password:') or return;
|
||||||
|
|
||||||
return ($user, $passClear);
|
return ($user, $passClear);
|
||||||
};
|
}
|
||||||
|
|
||||||
sub get_auth_details_cram_md5 {
|
sub get_auth_details_cram_md5 {
|
||||||
my ($session, $ticket) = @_;
|
my ($session, $ticket) = @_;
|
||||||
@ -131,9 +137,9 @@ sub get_auth_details_cram_md5 {
|
|||||||
# rand() is not cryptographic, but we only need to generate a globally
|
# rand() is not cryptographic, but we only need to generate a globally
|
||||||
# unique number. The rand() is there in case the user logs in more than
|
# unique number. The rand() is there in case the user logs in more than
|
||||||
# once in the same second, or if the clock is skewed.
|
# once in the same second, or if the clock is skewed.
|
||||||
$ticket = sprintf( '<%x.%x@%s>',
|
$ticket =
|
||||||
rand(1000000), time(), $session->config('me') );
|
sprintf('<%x.%x@%s>', rand(1000000), time(), $session->config('me'));
|
||||||
};
|
}
|
||||||
|
|
||||||
# send the base64 encoded ticket
|
# send the base64 encoded ticket
|
||||||
$session->respond(334, encode_base64($ticket, ''));
|
$session->respond(334, encode_base64($ticket, ''));
|
||||||
@ -142,7 +148,7 @@ sub get_auth_details_cram_md5 {
|
|||||||
if ($line eq '*') {
|
if ($line eq '*') {
|
||||||
$session->respond(501, "Authentication canceled");
|
$session->respond(501, "Authentication canceled");
|
||||||
return;
|
return;
|
||||||
};
|
}
|
||||||
|
|
||||||
my ($user, $passHash) = split(/ /, decode_base64($line));
|
my ($user, $passHash) = split(/ /, decode_base64($line));
|
||||||
unless ($user && $passHash) {
|
unless ($user && $passHash) {
|
||||||
@ -152,7 +158,7 @@ sub get_auth_details_cram_md5 {
|
|||||||
|
|
||||||
$session->{auth}{ticket} = $ticket;
|
$session->{auth}{ticket} = $ticket;
|
||||||
return ($ticket, $user, $passHash);
|
return ($ticket, $user, $passHash);
|
||||||
};
|
}
|
||||||
|
|
||||||
sub get_base64_response {
|
sub get_base64_response {
|
||||||
my ($session, $question) = @_;
|
my ($session, $question) = @_;
|
||||||
@ -164,7 +170,7 @@ sub get_base64_response {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
return $answer;
|
return $answer;
|
||||||
};
|
}
|
||||||
|
|
||||||
sub validate_password {
|
sub validate_password {
|
||||||
my ($self, %a) = @_;
|
my ($self, %a) = @_;
|
||||||
@ -183,7 +189,7 @@ sub validate_password {
|
|||||||
if (!$src_crypt && !$src_clear) {
|
if (!$src_crypt && !$src_clear) {
|
||||||
$self->log(LOGINFO, "fail: missing password");
|
$self->log(LOGINFO, "fail: missing password");
|
||||||
return ($deny, "$file - no such user");
|
return ($deny, "$file - no such user");
|
||||||
};
|
}
|
||||||
|
|
||||||
if (!$src_clear && $method =~ /CRAM-MD5/i) {
|
if (!$src_clear && $method =~ /CRAM-MD5/i) {
|
||||||
$self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass");
|
$self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass");
|
||||||
@ -194,29 +200,29 @@ sub validate_password {
|
|||||||
if ($src_clear && $src_clear eq $attempt_clear) {
|
if ($src_clear && $src_clear eq $attempt_clear) {
|
||||||
$self->log(LOGINFO, "pass: clear match");
|
$self->log(LOGINFO, "pass: clear match");
|
||||||
return (OK, $file);
|
return (OK, $file);
|
||||||
};
|
}
|
||||||
|
|
||||||
if ($src_crypt && $src_crypt eq crypt($attempt_clear, $src_crypt)) {
|
if ($src_crypt && $src_crypt eq crypt($attempt_clear, $src_crypt)) {
|
||||||
$self->log(LOGINFO, "pass: crypt match");
|
$self->log(LOGINFO, "pass: crypt match");
|
||||||
return (OK, $file);
|
return (OK, $file);
|
||||||
}
|
}
|
||||||
};
|
}
|
||||||
|
|
||||||
if (defined $attempt_hash && $src_clear) {
|
if (defined $attempt_hash && $src_clear) {
|
||||||
if (!$ticket) {
|
if (!$ticket) {
|
||||||
$self->log(LOGERROR, "skip: missing ticket");
|
$self->log(LOGERROR, "skip: missing ticket");
|
||||||
return (DECLINED, $file);
|
return (DECLINED, $file);
|
||||||
};
|
}
|
||||||
|
|
||||||
if ($attempt_hash eq hmac_md5_hex($ticket, $src_clear)) {
|
if ($attempt_hash eq hmac_md5_hex($ticket, $src_clear)) {
|
||||||
$self->log(LOGINFO, "pass: hash match");
|
$self->log(LOGINFO, "pass: hash match");
|
||||||
return (OK, $file);
|
return (OK, $file);
|
||||||
};
|
}
|
||||||
};
|
}
|
||||||
|
|
||||||
$self->log(LOGINFO, "fail: wrong password");
|
$self->log(LOGINFO, "fail: wrong password");
|
||||||
return ($deny, "$file - wrong password");
|
return ($deny, "$file - wrong password");
|
||||||
};
|
}
|
||||||
|
|
||||||
# tag: qpsmtpd plugin that sets RELAYCLIENT when the user authenticates
|
# tag: qpsmtpd plugin that sets RELAYCLIENT when the user authenticates
|
||||||
|
|
||||||
|
@ -80,6 +80,7 @@ sub parse {
|
|||||||
}
|
}
|
||||||
my $parse = "parse_$cmd";
|
my $parse = "parse_$cmd";
|
||||||
if ($self->can($parse)) {
|
if ($self->can($parse)) {
|
||||||
|
|
||||||
# print "CMD=$cmd,line=$line\n";
|
# print "CMD=$cmd,line=$line\n";
|
||||||
my @out = eval { $self->$parse($cmd, $line); };
|
my @out = eval { $self->$parse($cmd, $line); };
|
||||||
if ($@) {
|
if ($@) {
|
||||||
@ -137,6 +138,7 @@ sub _get_mail_params {
|
|||||||
|
|
||||||
# let's see if $line contains nothing and use the first value as address:
|
# let's see if $line contains nothing and use the first value as address:
|
||||||
if ($line) {
|
if ($line) {
|
||||||
|
|
||||||
# parameter syntax error, i.e. not all of the arguments were
|
# parameter syntax error, i.e. not all of the arguments were
|
||||||
# stripped by the while() loop:
|
# stripped by the while() loop:
|
||||||
return (DENY, "Syntax error in parameters")
|
return (DENY, "Syntax error in parameters")
|
||||||
|
@ -71,9 +71,7 @@ sub _process_line {
|
|||||||
my ($cmd, @params) = split(/ +/, $line);
|
my ($cmd, @params) = split(/ +/, $line);
|
||||||
my $meth = "cmd_" . lc($cmd);
|
my $meth = "cmd_" . lc($cmd);
|
||||||
if (my $lookup = $self->can($meth)) {
|
if (my $lookup = $self->can($meth)) {
|
||||||
my $resp = eval {
|
my $resp = eval { $lookup->($self, @params); };
|
||||||
$lookup->($self, @params);
|
|
||||||
};
|
|
||||||
if ($@) {
|
if ($@) {
|
||||||
my $error = $@;
|
my $error = $@;
|
||||||
chomp($error);
|
chomp($error);
|
||||||
@ -91,8 +89,10 @@ sub _process_line {
|
|||||||
my %helptext = (
|
my %helptext = (
|
||||||
help => "HELP [CMD] - Get help on all commands or a specific command",
|
help => "HELP [CMD] - Get help on all commands or a specific command",
|
||||||
status => "STATUS - Returns status information about current connections",
|
status => "STATUS - Returns status information about current connections",
|
||||||
list => "LIST [LIMIT] - List the connections, specify limit or negative limit to shrink list",
|
list =>
|
||||||
kill => "KILL (\$IP | \$REF) - Disconnect all connections from \$IP or connection reference \$REF",
|
"LIST [LIMIT] - List the connections, specify limit or negative limit to shrink list",
|
||||||
|
kill =>
|
||||||
|
"KILL (\$IP | \$REF) - Disconnect all connections from \$IP or connection reference \$REF",
|
||||||
pause => "PAUSE - Stop accepting new connections",
|
pause => "PAUSE - Stop accepting new connections",
|
||||||
continue => "CONTINUE - Resume accepting connections",
|
continue => "CONTINUE - Resume accepting connections",
|
||||||
reload => "RELOAD - Reload all plugins and config",
|
reload => "RELOAD - Reload all plugins and config",
|
||||||
@ -107,10 +107,13 @@ sub cmd_help {
|
|||||||
$subcmd = lc($subcmd);
|
$subcmd = lc($subcmd);
|
||||||
|
|
||||||
if ($subcmd eq 'help') {
|
if ($subcmd eq 'help') {
|
||||||
my $txt = join("\n", map { substr($_, 0, index($_, "-")) } sort values(%helptext));
|
my $txt = join("\n",
|
||||||
|
map { substr($_, 0, index($_, "-")) }
|
||||||
|
sort values(%helptext));
|
||||||
return "Available Commands:\n\n$txt\n";
|
return "Available Commands:\n\n$txt\n";
|
||||||
}
|
}
|
||||||
my $txt = $helptext{$subcmd} || "Unrecognised help option. Try 'help' for a full list.";
|
my $txt = $helptext{$subcmd}
|
||||||
|
|| "Unrecognised help option. Try 'help' for a full list.";
|
||||||
return "$txt\n";
|
return "$txt\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -158,6 +161,7 @@ sub cmd_status {
|
|||||||
my $output = "Current Status as of " . gmtime() . " GMT\n\n";
|
my $output = "Current Status as of " . gmtime() . " GMT\n\n";
|
||||||
|
|
||||||
if (defined &Qpsmtpd::Plugin::stats::get_stats) {
|
if (defined &Qpsmtpd::Plugin::stats::get_stats) {
|
||||||
|
|
||||||
# Stats plugin is loaded
|
# Stats plugin is loaded
|
||||||
$output .= Qpsmtpd::Plugin::stats->get_stats;
|
$output .= Qpsmtpd::Plugin::stats->get_stats;
|
||||||
}
|
}
|
||||||
@ -176,8 +180,8 @@ sub cmd_status {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
$output .= "Curr Connections: $current_connections / $::MAXconn\n".
|
$output .= "Curr Connections: $current_connections / $::MAXconn\n"
|
||||||
"Curr DNS Queries: $current_dns";
|
. "Curr DNS Queries: $current_dns";
|
||||||
|
|
||||||
return $output;
|
return $output;
|
||||||
}
|
}
|
||||||
@ -188,14 +192,20 @@ sub cmd_list {
|
|||||||
|
|
||||||
my $descriptors = Danga::Socket->DescriptorMap;
|
my $descriptors = Danga::Socket->DescriptorMap;
|
||||||
|
|
||||||
my $list = "Current" . ($count ? (($count > 0) ? " Oldest $count" : " Newest ".-$count) : "") . " Connections: \n\n";
|
my $list =
|
||||||
|
"Current"
|
||||||
|
. ($count ? (($count > 0) ? " Oldest $count" : " Newest " . -$count) : "")
|
||||||
|
. " Connections: \n\n";
|
||||||
my @all;
|
my @all;
|
||||||
foreach my $fd (keys %$descriptors) {
|
foreach my $fd (keys %$descriptors) {
|
||||||
my $pob = $descriptors->{$fd};
|
my $pob = $descriptors->{$fd};
|
||||||
if ($pob->isa("Qpsmtpd::PollServer")) {
|
if ($pob->isa("Qpsmtpd::PollServer")) {
|
||||||
next unless $pob->connection->remote_ip; # haven't even started yet
|
next unless $pob->connection->remote_ip; # haven't even started yet
|
||||||
push @all, [$pob+0, $pob->connection->remote_ip,
|
push @all,
|
||||||
$pob->connection->remote_host, $pob->uptime];
|
[
|
||||||
|
$pob + 0, $pob->connection->remote_ip,
|
||||||
|
$pob->connection->remote_host, $pob->uptime
|
||||||
|
];
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -209,7 +219,8 @@ sub cmd_list {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
foreach my $item (@all) {
|
foreach my $item (@all) {
|
||||||
$list .= sprintf("%x : %s [%s] Connected %0.2fs\n", map { defined()?$_:'' } @$item);
|
$list .= sprintf("%x : %s [%s] Connected %0.2fs\n",
|
||||||
|
map { defined() ? $_ : '' } @$item);
|
||||||
}
|
}
|
||||||
|
|
||||||
return $list;
|
return $list;
|
||||||
@ -229,9 +240,11 @@ sub cmd_kill {
|
|||||||
my $pob = $descriptors->{$fd};
|
my $pob = $descriptors->{$fd};
|
||||||
if ($pob->isa("Qpsmtpd::PollServer")) {
|
if ($pob->isa("Qpsmtpd::PollServer")) {
|
||||||
if ($is_ip) {
|
if ($is_ip) {
|
||||||
next unless $pob->connection->remote_ip; # haven't even started yet
|
next
|
||||||
|
unless $pob->connection->remote_ip; # haven't even started yet
|
||||||
if ($pob->connection->remote_ip eq $match) {
|
if ($pob->connection->remote_ip eq $match) {
|
||||||
$pob->write("550 Your connection has been killed by an administrator\r\n");
|
$pob->write(
|
||||||
|
"550 Your connection has been killed by an administrator\r\n");
|
||||||
$pob->disconnect;
|
$pob->disconnect;
|
||||||
$killed++;
|
$killed++;
|
||||||
}
|
}
|
||||||
@ -239,7 +252,8 @@ sub cmd_kill {
|
|||||||
else {
|
else {
|
||||||
# match by ID
|
# match by ID
|
||||||
if ($pob + 0 == hex($match)) {
|
if ($pob + 0 == hex($match)) {
|
||||||
$pob->write("550 Your connection has been killed by an administrator\r\n");
|
$pob->write(
|
||||||
|
"550 Your connection has been killed by an administrator\r\n");
|
||||||
$pob->disconnect;
|
$pob->disconnect;
|
||||||
$killed++;
|
$killed++;
|
||||||
}
|
}
|
||||||
|
@ -15,7 +15,6 @@ my @parameters = qw(
|
|||||||
relay_client
|
relay_client
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $proto = shift;
|
my $proto = shift;
|
||||||
my $class = ref($proto) || $proto;
|
my $class = ref($proto) || $proto;
|
||||||
@ -44,10 +43,12 @@ sub clone {
|
|||||||
$new->$f($self->$f()) if $self->$f();
|
$new->$f($self->$f()) if $self->$f();
|
||||||
}
|
}
|
||||||
$new->{_notes} = $self->{_notes} if defined $self->{_notes};
|
$new->{_notes} = $self->{_notes} if defined $self->{_notes};
|
||||||
|
|
||||||
# reset the old connection object like it's done at the end of a connection
|
# reset the old connection object like it's done at the end of a connection
|
||||||
# to prevent leaks (like prefork/tls problem with the old SSL file handle
|
# to prevent leaks (like prefork/tls problem with the old SSL file handle
|
||||||
# still around)
|
# still around)
|
||||||
$self->reset unless $args{no_reset};
|
$self->reset unless $args{no_reset};
|
||||||
|
|
||||||
# should we generate a new id here?
|
# should we generate a new id here?
|
||||||
return $new;
|
return $new;
|
||||||
}
|
}
|
||||||
@ -82,7 +83,6 @@ sub local_port {
|
|||||||
$self->{_local_port};
|
$self->{_local_port};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
sub remote_info {
|
sub remote_info {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
@_ and $self->{_remote_info} = shift;
|
@_ and $self->{_remote_info} = shift;
|
||||||
@ -109,6 +109,7 @@ sub hello_host {
|
|||||||
|
|
||||||
sub notes {
|
sub notes {
|
||||||
my ($self, $key) = (shift, shift);
|
my ($self, $key) = (shift, shift);
|
||||||
|
|
||||||
# Check for any additional arguments passed by the caller -- including undef
|
# Check for any additional arguments passed by the caller -- including undef
|
||||||
return $self->{_notes}->{$key} unless @_;
|
return $self->{_notes}->{$key} unless @_;
|
||||||
return $self->{_notes}->{$key} = shift;
|
return $self->{_notes}->{$key} = shift;
|
||||||
|
@ -384,8 +384,7 @@ default: DENYSOFT
|
|||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub temp_resolver_failed {
|
sub temp_resolver_failed {
|
||||||
shift->_dsn(shift,
|
shift->_dsn(shift, (shift || "Temporary address resolution failure"),
|
||||||
(shift || "Temporary address resolution failure"),
|
|
||||||
DENYSOFT, 4, 3);
|
DENYSOFT, 4, 3);
|
||||||
}
|
}
|
||||||
sub net_directory_server_failed { shift->_dsn(shift, shift, DENYSOFT, 4, 3); }
|
sub net_directory_server_failed { shift->_dsn(shift, shift, DENYSOFT, 4, 3); }
|
||||||
@ -417,7 +416,10 @@ Why do we want to DENYSOFT something like this?
|
|||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub net_routing_loop { shift->_dsn(shift, shift, DENY, 4, 6); }
|
sub net_routing_loop { shift->_dsn(shift, shift, DENY, 4, 6); }
|
||||||
sub too_many_hops { shift->_dsn(shift,(shift || "Too many hops"),DENY,4,6,); }
|
sub too_many_hops {
|
||||||
|
shift->_dsn(shift, (shift || "Too many hops"), DENY, 4, 6,);
|
||||||
|
}
|
||||||
|
|
||||||
# not useful # sub delivery_time_expired { shift->_dsn(shift,shift,4,7); }
|
# not useful # sub delivery_time_expired { shift->_dsn(shift,shift,4,7); }
|
||||||
|
|
||||||
=head1 MAIL DELIVERY PROTOCOL STATUS
|
=head1 MAIL DELIVERY PROTOCOL STATUS
|
||||||
@ -553,9 +555,11 @@ default: DENY
|
|||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub sec_sender_unauthorized { shift->_dsn(shift, shift, DENY, 7, 1); }
|
sub sec_sender_unauthorized { shift->_dsn(shift, shift, DENY, 7, 1); }
|
||||||
|
|
||||||
sub bad_sender_ip {
|
sub bad_sender_ip {
|
||||||
shift->_dsn(shift, (shift || "Bad sender's IP"), DENY, 7, 1,);
|
shift->_dsn(shift, (shift || "Bad sender's IP"), DENY, 7, 1,);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub relaying_denied {
|
sub relaying_denied {
|
||||||
shift->_dsn(shift, (shift || "Relaying denied"), DENY, 7, 1);
|
shift->_dsn(shift, (shift || "Relaying denied"), DENY, 7, 1);
|
||||||
}
|
}
|
||||||
@ -603,7 +607,9 @@ default: DENYSOFT
|
|||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub sec_crypto_algorithm_unsupported { shift->_dsn(shift,shift,DENYSOFT,7,6); }
|
sub sec_crypto_algorithm_unsupported {
|
||||||
|
shift->_dsn(shift, shift, DENYSOFT, 7, 6);
|
||||||
|
}
|
||||||
|
|
||||||
=item sec_msg_integrity_failure
|
=item sec_msg_integrity_failure
|
||||||
|
|
||||||
|
@ -38,11 +38,13 @@ sub register_hook {
|
|||||||
|
|
||||||
# I can't quite decide if it's better to parse this code ref or if
|
# I can't quite decide if it's better to parse this code ref or if
|
||||||
# we should pass the plugin object and method name ... hmn.
|
# we should pass the plugin object and method name ... hmn.
|
||||||
$plugin->qp->_register_hook
|
$plugin->qp->_register_hook(
|
||||||
($hook,
|
$hook,
|
||||||
{ code => sub { local $plugin->{_qp} = shift;
|
{
|
||||||
|
code => sub {
|
||||||
|
local $plugin->{_qp} = shift;
|
||||||
local $plugin->{_hook} = $hook;
|
local $plugin->{_hook} = $hook;
|
||||||
$plugin->$method(@_)
|
$plugin->$method(@_);
|
||||||
},
|
},
|
||||||
name => $plugin->plugin_name,
|
name => $plugin->plugin_name,
|
||||||
},
|
},
|
||||||
@ -78,23 +80,26 @@ sub adjust_log_level {
|
|||||||
return $adj if $adj =~ m/^[01234567]$/; # a raw syslog numeral
|
return $adj if $adj =~ m/^[01234567]$/; # a raw syslog numeral
|
||||||
|
|
||||||
if ($adj !~ /^[\+\-][\d]$/) {
|
if ($adj !~ /^[\+\-][\d]$/) {
|
||||||
$self->log( LOGERROR, $self-"invalid $plugin_name loglevel setting ($adj)" );
|
$self->log(LOGERROR,
|
||||||
|
$self - "invalid $plugin_name loglevel setting ($adj)");
|
||||||
undef $self->{_args}{loglevel}; # only complain once per plugin
|
undef $self->{_args}{loglevel}; # only complain once per plugin
|
||||||
return $cur_level;
|
return $cur_level;
|
||||||
};
|
}
|
||||||
|
|
||||||
my $operator = substr($adj, 0, 1);
|
my $operator = substr($adj, 0, 1);
|
||||||
my $adjust = substr($adj, -1, 1);
|
my $adjust = substr($adj, -1, 1);
|
||||||
|
|
||||||
my $new_level = $operator eq '+' ? $cur_level + $adjust : $cur_level - $adjust;
|
my $new_level =
|
||||||
|
$operator eq '+' ? $cur_level + $adjust : $cur_level - $adjust;
|
||||||
|
|
||||||
$new_level = 7 if $new_level > 7;
|
$new_level = 7 if $new_level > 7;
|
||||||
$new_level = 0 if $new_level < 0;
|
$new_level = 0 if $new_level < 0;
|
||||||
|
|
||||||
return $new_level;
|
return $new_level;
|
||||||
};
|
}
|
||||||
|
|
||||||
sub transaction {
|
sub transaction {
|
||||||
|
|
||||||
# not sure if this will work in a non-forking or a threaded daemon
|
# not sure if this will work in a non-forking or a threaded daemon
|
||||||
shift->qp->transaction;
|
shift->qp->transaction;
|
||||||
}
|
}
|
||||||
@ -158,8 +163,7 @@ sub isa_plugin {
|
|||||||
die "cannot find plugin '$parent'" unless $parent_dir;
|
die "cannot find plugin '$parent'" unless $parent_dir;
|
||||||
|
|
||||||
$self->compile($self->plugin_name . "_isa_$cleanParent",
|
$self->compile($self->plugin_name . "_isa_$cleanParent",
|
||||||
$newPackage,
|
$newPackage, "$parent_dir/$parent");
|
||||||
"$parent_dir/$parent");
|
|
||||||
warn "---- $newPackage\n";
|
warn "---- $newPackage\n";
|
||||||
no strict 'refs';
|
no strict 'refs';
|
||||||
push @{"${currentPackage}::ISA"}, $newPackage;
|
push @{"${currentPackage}::ISA"}, $newPackage;
|
||||||
@ -222,30 +226,31 @@ sub get_reject {
|
|||||||
if (defined $reject && !$reject) {
|
if (defined $reject && !$reject) {
|
||||||
$self->log(LOGINFO, "fail, reject disabled" . $log_mess);
|
$self->log(LOGINFO, "fail, reject disabled" . $log_mess);
|
||||||
return DECLINED;
|
return DECLINED;
|
||||||
};
|
}
|
||||||
|
|
||||||
# the naughty plugin will reject later
|
# the naughty plugin will reject later
|
||||||
if ($reject eq 'naughty') {
|
if ($reject eq 'naughty') {
|
||||||
$self->log(LOGINFO, "fail, NAUGHTY" . $log_mess);
|
$self->log(LOGINFO, "fail, NAUGHTY" . $log_mess);
|
||||||
return $self->store_deferred_reject($smtp_mess);
|
return $self->store_deferred_reject($smtp_mess);
|
||||||
};
|
}
|
||||||
|
|
||||||
# they asked for reject, we give them reject
|
# they asked for reject, we give them reject
|
||||||
$self->log(LOGINFO, "fail" . $log_mess);
|
$self->log(LOGINFO, "fail" . $log_mess);
|
||||||
return ($self->get_reject_type(), $smtp_mess);
|
return ($self->get_reject_type(), $smtp_mess);
|
||||||
};
|
}
|
||||||
|
|
||||||
sub get_reject_type {
|
sub get_reject_type {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $default = shift || DENY;
|
my $default = shift || DENY;
|
||||||
my $deny = shift || $self->{_args}{reject_type} or return $default;
|
my $deny = shift || $self->{_args}{reject_type} or return $default;
|
||||||
|
|
||||||
return $deny =~ /^(temp|soft)$/i ? DENYSOFT
|
return
|
||||||
|
$deny =~ /^(temp|soft)$/i ? DENYSOFT
|
||||||
: $deny =~ /^(perm|hard)$/i ? DENY
|
: $deny =~ /^(perm|hard)$/i ? DENY
|
||||||
: $deny eq 'disconnect' ? DENY_DISCONNECT
|
: $deny eq 'disconnect' ? DENY_DISCONNECT
|
||||||
: $deny eq 'temp_disconnect' ? DENYSOFT_DISCONNECT
|
: $deny eq 'temp_disconnect' ? DENYSOFT_DISCONNECT
|
||||||
: $default;
|
: $default;
|
||||||
};
|
}
|
||||||
|
|
||||||
sub store_deferred_reject {
|
sub store_deferred_reject {
|
||||||
my ($self, $smtp_mess) = @_;
|
my ($self, $smtp_mess) = @_;
|
||||||
@ -258,12 +263,13 @@ sub store_deferred_reject {
|
|||||||
# append this reject message to the message
|
# append this reject message to the message
|
||||||
my $prev = $self->connection->notes('naughty');
|
my $prev = $self->connection->notes('naughty');
|
||||||
$self->connection->notes('naughty', "$prev\015\012$smtp_mess");
|
$self->connection->notes('naughty', "$prev\015\012$smtp_mess");
|
||||||
};
|
}
|
||||||
if (!$self->connection->notes('naughty_reject_type')) {
|
if (!$self->connection->notes('naughty_reject_type')) {
|
||||||
$self->connection->notes('naughty_reject_type', $self->{_args}{reject_type} );
|
$self->connection->notes('naughty_reject_type',
|
||||||
|
$self->{_args}{reject_type});
|
||||||
}
|
}
|
||||||
return (DECLINED);
|
return (DECLINED);
|
||||||
};
|
}
|
||||||
|
|
||||||
sub init_resolver {
|
sub init_resolver {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
@ -274,38 +280,43 @@ sub init_resolver {
|
|||||||
$self->{_resolver}->tcp_timeout($timeout);
|
$self->{_resolver}->tcp_timeout($timeout);
|
||||||
$self->{_resolver}->udp_timeout($timeout);
|
$self->{_resolver}->udp_timeout($timeout);
|
||||||
return $self->{_resolver};
|
return $self->{_resolver};
|
||||||
};
|
}
|
||||||
|
|
||||||
sub is_immune {
|
sub is_immune {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
if ($self->qp->connection->relay_client()) {
|
if ($self->qp->connection->relay_client()) {
|
||||||
|
|
||||||
# set by plugins/relay, or Qpsmtpd::Auth
|
# set by plugins/relay, or Qpsmtpd::Auth
|
||||||
$self->log(LOGINFO, "skip, relay client");
|
$self->log(LOGINFO, "skip, relay client");
|
||||||
return 1;
|
return 1;
|
||||||
};
|
}
|
||||||
if ($self->qp->connection->notes('whitelisthost')) {
|
if ($self->qp->connection->notes('whitelisthost')) {
|
||||||
|
|
||||||
# set by plugins/dns_whitelist_soft or plugins/whitelist
|
# set by plugins/dns_whitelist_soft or plugins/whitelist
|
||||||
$self->log(LOGINFO, "skip, whitelisted host");
|
$self->log(LOGINFO, "skip, whitelisted host");
|
||||||
return 1;
|
return 1;
|
||||||
};
|
}
|
||||||
if ($self->qp->transaction->notes('whitelistsender')) {
|
if ($self->qp->transaction->notes('whitelistsender')) {
|
||||||
|
|
||||||
# set by plugins/whitelist
|
# set by plugins/whitelist
|
||||||
$self->log(LOGINFO, "skip, whitelisted sender");
|
$self->log(LOGINFO, "skip, whitelisted sender");
|
||||||
return 1;
|
return 1;
|
||||||
};
|
}
|
||||||
if ($self->connection->notes('naughty')) {
|
if ($self->connection->notes('naughty')) {
|
||||||
|
|
||||||
# see plugins/naughty
|
# see plugins/naughty
|
||||||
$self->log(LOGINFO, "skip, naughty");
|
$self->log(LOGINFO, "skip, naughty");
|
||||||
return 1;
|
return 1;
|
||||||
};
|
}
|
||||||
if ($self->connection->notes('rejected')) {
|
if ($self->connection->notes('rejected')) {
|
||||||
|
|
||||||
# http://www.steve.org.uk/Software/ms-lite/
|
# http://www.steve.org.uk/Software/ms-lite/
|
||||||
$self->log(LOGINFO, "skip, already rejected");
|
$self->log(LOGINFO, "skip, already rejected");
|
||||||
return 1;
|
return 1;
|
||||||
};
|
}
|
||||||
return;
|
return;
|
||||||
};
|
}
|
||||||
|
|
||||||
sub adjust_karma {
|
sub adjust_karma {
|
||||||
my ($self, $value) = @_;
|
my ($self, $value) = @_;
|
||||||
@ -315,7 +326,7 @@ sub adjust_karma {
|
|||||||
$self->log(LOGDEBUG, "karma adjust: $value ($karma)");
|
$self->log(LOGDEBUG, "karma adjust: $value ($karma)");
|
||||||
$self->connection->notes('karma', $karma);
|
$self->connection->notes('karma', $karma);
|
||||||
return $value;
|
return $value;
|
||||||
};
|
}
|
||||||
|
|
||||||
sub _register_standard_hooks {
|
sub _register_standard_hooks {
|
||||||
my ($plugin, $qp) = @_;
|
my ($plugin, $qp) = @_;
|
||||||
@ -328,5 +339,4 @@ sub _register_standard_hooks {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
package Qpsmtpd::PollServer;
|
package Qpsmtpd::PollServer;
|
||||||
|
|
||||||
use base ('Danga::Client', 'Qpsmtpd::SMTP');
|
use base ('Danga::Client', 'Qpsmtpd::SMTP');
|
||||||
|
|
||||||
# use fields required to be a subclass of Danga::Client. Have to include
|
# use fields required to be a subclass of Danga::Client. Have to include
|
||||||
# all fields used by Qpsmtpd.pm here too.
|
# all fields used by Qpsmtpd.pm here too.
|
||||||
use fields qw(
|
use fields qw(
|
||||||
@ -127,11 +128,12 @@ sub process_line {
|
|||||||
$self->connection->notes('original_string', $line);
|
$self->connection->notes('original_string', $line);
|
||||||
my ($cmd, @params) = split(/ +/, $line, 2);
|
my ($cmd, @params) = split(/ +/, $line, 2);
|
||||||
my $meth = lc($cmd);
|
my $meth = lc($cmd);
|
||||||
if (my $lookup = $cmd_cache{$meth} || $self->{_commands}->{$meth} && $self->can($meth)) {
|
if (my $lookup =
|
||||||
|
$cmd_cache{$meth}
|
||||||
|
|| $self->{_commands}->{$meth} && $self->can($meth))
|
||||||
|
{
|
||||||
$cmd_cache{$meth} = $lookup;
|
$cmd_cache{$meth} = $lookup;
|
||||||
eval {
|
eval { $lookup->($self, @params); };
|
||||||
$lookup->($self, @params);
|
|
||||||
};
|
|
||||||
if ($@) {
|
if ($@) {
|
||||||
my $error = $@;
|
my $error = $@;
|
||||||
chomp($error);
|
chomp($error);
|
||||||
@ -141,11 +143,13 @@ sub process_line {
|
|||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# No such method - i.e. unrecognized command
|
# No such method - i.e. unrecognized command
|
||||||
my ($rc, $msg) = $self->run_hooks("unrecognized_command", $meth, @params);
|
my ($rc, $msg) =
|
||||||
|
$self->run_hooks("unrecognized_command", $meth, @params);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($self->{mode} eq 'connect') {
|
elsif ($self->{mode} eq 'connect') {
|
||||||
$self->{mode} = 'cmd';
|
$self->{mode} = 'cmd';
|
||||||
|
|
||||||
# I've removed an eval{} from around this. It shouldn't ever die()
|
# I've removed an eval{} from around this. It shouldn't ever die()
|
||||||
# but if it does we're a bit screwed... Ah well :-)
|
# but if it does we're a bit screwed... Ah well :-)
|
||||||
$self->start_conversation;
|
$self->start_conversation;
|
||||||
@ -173,6 +177,7 @@ sub start_conversation {
|
|||||||
my Qpsmtpd::PollServer $self = shift;
|
my Qpsmtpd::PollServer $self = shift;
|
||||||
|
|
||||||
my $conn = $self->connection;
|
my $conn = $self->connection;
|
||||||
|
|
||||||
# set remote_host, remote_ip and remote_port
|
# set remote_host, remote_ip and remote_port
|
||||||
my ($ip, $port) = split(/:/, $self->peer_addr_string);
|
my ($ip, $port) = split(/:/, $self->peer_addr_string);
|
||||||
return $self->close() unless $ip;
|
return $self->close() unless $ip;
|
||||||
@ -185,6 +190,7 @@ sub start_conversation {
|
|||||||
|
|
||||||
ParaDNS->new(
|
ParaDNS->new(
|
||||||
finished => sub { $self->continue_read(); $self->run_hooks("connect") },
|
finished => sub { $self->continue_read(); $self->run_hooks("connect") },
|
||||||
|
|
||||||
# NB: Setting remote_info to the same as remote_host
|
# NB: Setting remote_info to the same as remote_host
|
||||||
callback => sub { $conn->remote_info($conn->remote_host($_[0])) },
|
callback => sub { $conn->remote_info($conn->remote_host($_[0])) },
|
||||||
host => $ip,
|
host => $ip,
|
||||||
@ -231,14 +237,16 @@ sub data_respond {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
return $self->respond(503, "MAIL first") unless $self->transaction->sender;
|
return $self->respond(503, "MAIL first") unless $self->transaction->sender;
|
||||||
return $self->respond(503, "RCPT first") unless $self->transaction->recipients;
|
return $self->respond(503, "RCPT first")
|
||||||
|
unless $self->transaction->recipients;
|
||||||
|
|
||||||
$self->{header_lines} = '';
|
$self->{header_lines} = '';
|
||||||
$self->{data_size} = 0;
|
$self->{data_size} = 0;
|
||||||
$self->{in_header} = 1;
|
$self->{in_header} = 1;
|
||||||
$self->{max_size} = ($self->config('databytes'))[0] || 0;
|
$self->{max_size} = ($self->config('databytes'))[0] || 0;
|
||||||
|
|
||||||
$self->log(LOGDEBUG, "max_size: $self->{max_size} / size: $self->{data_size}");
|
$self->log(LOGDEBUG,
|
||||||
|
"max_size: $self->{max_size} / size: $self->{data_size}");
|
||||||
|
|
||||||
$self->respond(354, "go ahead");
|
$self->respond(354, "go ahead");
|
||||||
|
|
||||||
@ -268,6 +276,7 @@ sub got_data {
|
|||||||
|
|
||||||
if ($self->{header_lines} =~ s/\n(\n.*)\z/\n/ms) {
|
if ($self->{header_lines} =~ s/\n(\n.*)\z/\n/ms) {
|
||||||
$data = $1;
|
$data = $1;
|
||||||
|
|
||||||
# end of headers
|
# end of headers
|
||||||
$self->{in_header} = 0;
|
$self->{in_header} = 0;
|
||||||
|
|
||||||
@ -279,8 +288,12 @@ sub got_data {
|
|||||||
# way a Received: line that is already in the header.
|
# way a Received: line that is already in the header.
|
||||||
my @header_lines = split(/^/m, $self->{header_lines});
|
my @header_lines = split(/^/m, $self->{header_lines});
|
||||||
|
|
||||||
my $header = Mail::Header->new(\@header_lines,
|
my $header =
|
||||||
Modify => 0, MailFrom => "COERCE");
|
Mail::Header->new(
|
||||||
|
\@header_lines,
|
||||||
|
Modify => 0,
|
||||||
|
MailFrom => "COERCE"
|
||||||
|
);
|
||||||
$self->transaction->header($header);
|
$self->transaction->header($header);
|
||||||
$self->transaction->body_write($self->{header_lines});
|
$self->transaction->body_write($self->{header_lines});
|
||||||
$self->{header_lines} = '';
|
$self->{header_lines} = '';
|
||||||
@ -299,7 +312,6 @@ sub got_data {
|
|||||||
$self->{data_size} += length $data;
|
$self->{data_size} += length $data;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
if ($done) {
|
if ($done) {
|
||||||
$self->end_of_data;
|
$self->end_of_data;
|
||||||
$self->end_get_chunks($remainder);
|
$self->end_get_chunks($remainder);
|
||||||
@ -312,7 +324,8 @@ sub end_of_data {
|
|||||||
|
|
||||||
#$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
|
#$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
|
||||||
|
|
||||||
$self->log(LOGDEBUG, "max_size: $self->{max_size} / size: $self->{data_size}");
|
$self->log(LOGDEBUG,
|
||||||
|
"max_size: $self->{max_size} / size: $self->{data_size}");
|
||||||
|
|
||||||
my $header = $self->transaction->header;
|
my $header = $self->transaction->header;
|
||||||
if (!$header) {
|
if (!$header) {
|
||||||
@ -329,17 +342,22 @@ sub end_of_data {
|
|||||||
and $self->connection->notes('tls_enabled'))
|
and $self->connection->notes('tls_enabled'))
|
||||||
{
|
{
|
||||||
$smtp .= "S" if $esmtp; # RFC3848
|
$smtp .= "S" if $esmtp; # RFC3848
|
||||||
$sslheader = "(".$self->connection->notes('tls_socket')->get_cipher()." encrypted) ";
|
$sslheader = "("
|
||||||
|
. $self->connection->notes('tls_socket')->get_cipher()
|
||||||
|
. " encrypted) ";
|
||||||
}
|
}
|
||||||
|
|
||||||
if (defined $self->{_auth} and $self->{_auth} == OK) {
|
if (defined $self->{_auth} and $self->{_auth} == OK) {
|
||||||
$smtp .= "A" if $esmtp; # RFC3848
|
$smtp .= "A" if $esmtp; # RFC3848
|
||||||
$authheader = "(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n";
|
$authheader =
|
||||||
|
"(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
$header->add("Received", $self->received_line($smtp, $authheader, $sslheader), 0);
|
$header->add("Received",
|
||||||
|
$self->received_line($smtp, $authheader, $sslheader), 0);
|
||||||
|
|
||||||
return $self->respond(552, "Message too big!") if $self->{max_size} and $self->{data_size} > $self->{max_size};
|
return $self->respond(552, "Message too big!")
|
||||||
|
if $self->{max_size} and $self->{data_size} > $self->{max_size};
|
||||||
|
|
||||||
my ($rc, $msg) = $self->run_hooks("data_post");
|
my ($rc, $msg) = $self->run_hooks("data_post");
|
||||||
return 1;
|
return 1;
|
||||||
|
@ -77,7 +77,8 @@ sub print_rec {
|
|||||||
sub print_rec_size {
|
sub print_rec_size {
|
||||||
my ($self, $content_size, $data_offset, $rcpt_count) = @_;
|
my ($self, $content_size, $data_offset, $rcpt_count) = @_;
|
||||||
|
|
||||||
my $s = sprintf("%15ld %15ld %15ld", $content_size, $data_offset, $rcpt_count);
|
my $s =
|
||||||
|
sprintf("%15ld %15ld %15ld", $content_size, $data_offset, $rcpt_count);
|
||||||
$self->print_rec('REC_TYPE_SIZE', $s);
|
$self->print_rec('REC_TYPE_SIZE', $s);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -97,18 +98,24 @@ sub open_cleanup {
|
|||||||
if ($socket =~ m#^(/.+)#) {
|
if ($socket =~ m#^(/.+)#) {
|
||||||
$socket = $1; # un-taint socket path
|
$socket = $1; # un-taint socket path
|
||||||
$self = IO::Socket::UNIX->new(Type => SOCK_STREAM,
|
$self = IO::Socket::UNIX->new(Type => SOCK_STREAM,
|
||||||
Peer => $socket) if $socket;
|
Peer => $socket)
|
||||||
|
if $socket;
|
||||||
|
|
||||||
} elsif ($socket =~ /(.*):(\d+)/) {
|
}
|
||||||
|
elsif ($socket =~ /(.*):(\d+)/) {
|
||||||
my ($host, $port) = ($1, $2); # un-taint address and port
|
my ($host, $port) = ($1, $2); # un-taint address and port
|
||||||
$self = IO::Socket::INET->new(Proto => 'tcp',
|
$self = IO::Socket::INET->new(
|
||||||
PeerAddr => $host,PeerPort => $port)
|
Proto => 'tcp',
|
||||||
|
PeerAddr => $host,
|
||||||
|
PeerPort => $port
|
||||||
|
)
|
||||||
if $host and $port;
|
if $host and $port;
|
||||||
}
|
}
|
||||||
unless (ref $self) {
|
unless (ref $self) {
|
||||||
warn "Couldn't open \"$socket\": $!";
|
warn "Couldn't open \"$socket\": $!";
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# allow buffered writes
|
# allow buffered writes
|
||||||
$self->autoflush(0);
|
$self->autoflush(0);
|
||||||
bless($self, $class);
|
bless($self, $class);
|
||||||
@ -139,7 +146,6 @@ sub get_attr {
|
|||||||
return %kv;
|
return %kv;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
=head2 print_msg_line($line)
|
=head2 print_msg_line($line)
|
||||||
|
|
||||||
print one line of a message to cleanup.
|
print one line of a message to cleanup.
|
||||||
@ -189,6 +195,7 @@ sub inject_mail {
|
|||||||
for (map { $_->address } $transaction->recipients) {
|
for (map { $_->address } $transaction->recipients) {
|
||||||
$strm->print_rec('REC_TYPE_RCPT', $_);
|
$strm->print_rec('REC_TYPE_RCPT', $_);
|
||||||
}
|
}
|
||||||
|
|
||||||
# add an empty message length record.
|
# add an empty message length record.
|
||||||
# cleanup is supposed to understand that.
|
# cleanup is supposed to understand that.
|
||||||
# see src/pickup/pickup.c
|
# see src/pickup/pickup.c
|
||||||
@ -204,6 +211,7 @@ sub inject_mail {
|
|||||||
}
|
}
|
||||||
$transaction->body_resetpos;
|
$transaction->body_resetpos;
|
||||||
while (my $line = $transaction->body_getline) {
|
while (my $line = $transaction->body_getline) {
|
||||||
|
|
||||||
# print STDERR "body: $line\n";
|
# print STDERR "body: $line\n";
|
||||||
$strm->print_msg_line($line);
|
$strm->print_msg_line($line);
|
||||||
}
|
}
|
||||||
@ -220,4 +228,5 @@ sub inject_mail {
|
|||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
# vim:sw=2
|
# vim:sw=2
|
||||||
|
@ -51,13 +51,17 @@ use constant CLEANUP_FLAG_BOUNCE => (1<<0); # /* Bounce bad messages */
|
|||||||
use constant CLEANUP_FLAG_FILTER => (1 << 1); # /* Enable header/body checks */
|
use constant CLEANUP_FLAG_FILTER => (1 << 1); # /* Enable header/body checks */
|
||||||
use constant CLEANUP_FLAG_HOLD => (1 << 2); # /* Place message on hold */
|
use constant CLEANUP_FLAG_HOLD => (1 << 2); # /* Place message on hold */
|
||||||
use constant CLEANUP_FLAG_DISCARD => (1 << 3); # /* Discard message silently */
|
use constant CLEANUP_FLAG_DISCARD => (1 << 3); # /* Discard message silently */
|
||||||
use constant CLEANUP_FLAG_BCC_OK => (1<<4); # /* Ok to add auto-BCC addresses */
|
use constant CLEANUP_FLAG_BCC_OK => (1 << 4)
|
||||||
|
; # /* Ok to add auto-BCC addresses */
|
||||||
use constant CLEANUP_FLAG_MAP_OK => (1 << 5); # /* Ok to map addresses */
|
use constant CLEANUP_FLAG_MAP_OK => (1 << 5); # /* Ok to map addresses */
|
||||||
use constant CLEANUP_FLAG_MILTER => (1 << 6); # /* Enable Milter applications */
|
use constant CLEANUP_FLAG_MILTER => (1 << 6); # /* Enable Milter applications */
|
||||||
use constant CLEANUP_FLAG_FILTER_ALL => (CLEANUP_FLAG_FILTER | CLEANUP_FLAG_MILTER);
|
use constant CLEANUP_FLAG_FILTER_ALL =>
|
||||||
use constant CLEANUP_FLAG_MASK_EXTERNAL => (CLEANUP_FLAG_FILTER_ALL | CLEANUP_FLAG_BCC_OK | CLEANUP_FLAG_MAP_OK);
|
(CLEANUP_FLAG_FILTER | CLEANUP_FLAG_MILTER);
|
||||||
|
use constant CLEANUP_FLAG_MASK_EXTERNAL =>
|
||||||
|
(CLEANUP_FLAG_FILTER_ALL | CLEANUP_FLAG_BCC_OK | CLEANUP_FLAG_MAP_OK);
|
||||||
use constant CLEANUP_FLAG_MASK_INTERNAL => CLEANUP_FLAG_MAP_OK;
|
use constant CLEANUP_FLAG_MASK_INTERNAL => CLEANUP_FLAG_MAP_OK;
|
||||||
use constant CLEANUP_FLAG_MASK_EXTRA => (CLEANUP_FLAG_HOLD | CLEANUP_FLAG_DISCARD);
|
use constant CLEANUP_FLAG_MASK_EXTRA =>
|
||||||
|
(CLEANUP_FLAG_HOLD | CLEANUP_FLAG_DISCARD);
|
||||||
|
|
||||||
use constant CLEANUP_STAT_OK => 0; # /* Success. */
|
use constant CLEANUP_STAT_OK => 0; # /* Success. */
|
||||||
use constant CLEANUP_STAT_BAD => (1 << 0); # /* Internal protocol error */
|
use constant CLEANUP_STAT_BAD => (1 << 0); # /* Internal protocol error */
|
||||||
@ -68,8 +72,11 @@ use constant CLEANUP_STAT_HOPS => (1<<4); # /* Too many hops */
|
|||||||
use constant CLEANUP_STAT_RCPT => (1 << 6); # /* No recipients found */
|
use constant CLEANUP_STAT_RCPT => (1 << 6); # /* No recipients found */
|
||||||
use constant CLEANUP_STAT_PROXY => (1 << 7); # /* Proxy reject */
|
use constant CLEANUP_STAT_PROXY => (1 << 7); # /* Proxy reject */
|
||||||
use constant CLEANUP_STAT_DEFER => (1 << 8); # /* Temporary reject */
|
use constant CLEANUP_STAT_DEFER => (1 << 8); # /* Temporary reject */
|
||||||
use constant CLEANUP_STAT_MASK_CANT_BOUNCE => (CLEANUP_STAT_BAD | CLEANUP_STAT_WRITE | CLEANUP_STAT_DEFER);
|
use constant CLEANUP_STAT_MASK_CANT_BOUNCE =>
|
||||||
use constant CLEANUP_STAT_MASK_INCOMPLETE => (CLEANUP_STAT_BAD | CLEANUP_STAT_WRITE | CLEANUP_STAT_SIZE | CLEANUP_STAT_DEFER);
|
(CLEANUP_STAT_BAD | CLEANUP_STAT_WRITE | CLEANUP_STAT_DEFER);
|
||||||
|
use constant CLEANUP_STAT_MASK_INCOMPLETE =>
|
||||||
|
(CLEANUP_STAT_BAD | CLEANUP_STAT_WRITE | CLEANUP_STAT_SIZE |
|
||||||
|
CLEANUP_STAT_DEFER);
|
||||||
|
|
||||||
%cleanup_soft = (
|
%cleanup_soft = (
|
||||||
CLEANUP_STAT_DEFER => "service unavailable (#4.7.1)",
|
CLEANUP_STAT_DEFER => "service unavailable (#4.7.1)",
|
||||||
|
@ -16,6 +16,7 @@ use Qpsmtpd::Address ();
|
|||||||
use Qpsmtpd::Command;
|
use Qpsmtpd::Command;
|
||||||
|
|
||||||
use Mail::Header ();
|
use Mail::Header ();
|
||||||
|
|
||||||
#use Data::Dumper;
|
#use Data::Dumper;
|
||||||
use POSIX qw(strftime);
|
use POSIX qw(strftime);
|
||||||
use Net::DNS;
|
use Net::DNS;
|
||||||
@ -34,7 +35,9 @@ sub new {
|
|||||||
my $self = bless({args => \%args}, $class);
|
my $self = bless({args => \%args}, $class);
|
||||||
|
|
||||||
my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit);
|
my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit);
|
||||||
my (%commands); @commands{@commands} = ('') x @commands;
|
my (%commands);
|
||||||
|
@commands{@commands} = ('') x @commands;
|
||||||
|
|
||||||
# this list of valid commands should probably be a method or a set of methods
|
# this list of valid commands should probably be a method or a set of methods
|
||||||
$self->{_commands} = \%commands;
|
$self->{_commands} = \%commands;
|
||||||
$self->SUPER::_restart(%args) if $args{restart}; # calls Qpsmtpd::_restart()
|
$self->SUPER::_restart(%args) if $args{restart}; # calls Qpsmtpd::_restart()
|
||||||
@ -52,7 +55,7 @@ sub dispatch {
|
|||||||
if (!$cmd) {
|
if (!$cmd) {
|
||||||
$self->run_hooks("unrecognized_command", '', @_);
|
$self->run_hooks("unrecognized_command", '', @_);
|
||||||
return 1;
|
return 1;
|
||||||
};
|
}
|
||||||
$cmd = lc $cmd;
|
$cmd = lc $cmd;
|
||||||
|
|
||||||
$self->{_counter}++;
|
$self->{_counter}++;
|
||||||
@ -91,9 +94,9 @@ sub fault {
|
|||||||
return $self->respond(451, "Internal error - try again later - " . $msg);
|
return $self->respond(451, "Internal error - try again later - " . $msg);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
sub start_conversation {
|
sub start_conversation {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
# this should maybe be called something else than "connect", see
|
# this should maybe be called something else than "connect", see
|
||||||
# lib/Qpsmtpd/TcpServer.pm for more confusion.
|
# lib/Qpsmtpd/TcpServer.pm for more confusion.
|
||||||
$self->run_hooks("connect");
|
$self->run_hooks("connect");
|
||||||
@ -118,7 +121,8 @@ sub connect_respond {
|
|||||||
$greets .= " ESMTP" unless $greets =~ /(^|\W)ESMTP(\W|$)/;
|
$greets .= " ESMTP" unless $greets =~ /(^|\W)ESMTP(\W|$)/;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$greets = $self->config('me')
|
$greets =
|
||||||
|
$self->config('me')
|
||||||
. " ESMTP qpsmtpd "
|
. " ESMTP qpsmtpd "
|
||||||
. $self->version
|
. $self->version
|
||||||
. " ready; send us your mail, but not your spam.";
|
. " ready; send us your mail, but not your spam.";
|
||||||
@ -139,20 +143,22 @@ sub reset_transaction {
|
|||||||
return $self->{_transaction} = Qpsmtpd::Transaction->new();
|
return $self->{_transaction} = Qpsmtpd::Transaction->new();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
sub connection {
|
sub connection {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
@_ and $self->{_connection} = shift;
|
@_ and $self->{_connection} = shift;
|
||||||
return $self->{_connection} || ($self->{_connection} = Qpsmtpd::Connection->new());
|
return $self->{_connection}
|
||||||
|
|| ($self->{_connection} = Qpsmtpd::Connection->new());
|
||||||
}
|
}
|
||||||
|
|
||||||
sub helo {
|
sub helo {
|
||||||
my ($self, $line) = @_;
|
my ($self, $line) = @_;
|
||||||
my ($rc, @msg) = $self->run_hooks('helo_parse');
|
my ($rc, @msg) = $self->run_hooks('helo_parse');
|
||||||
my ($ok, $hello_host, @stuff) = Qpsmtpd::Command->parse('helo', $line, $msg[0]);
|
my ($ok, $hello_host, @stuff) =
|
||||||
|
Qpsmtpd::Command->parse('helo', $line, $msg[0]);
|
||||||
|
|
||||||
return $self->respond(501,
|
return $self->respond(501,
|
||||||
"helo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host;
|
"helo requires domain/address - see RFC-2821 4.1.1.1")
|
||||||
|
unless $hello_host;
|
||||||
my $conn = $self->connection;
|
my $conn = $self->connection;
|
||||||
return $self->respond(503, "but you already said HELO ...") if $conn->hello;
|
return $self->respond(503, "but you already said HELO ...") if $conn->hello;
|
||||||
|
|
||||||
@ -163,33 +169,47 @@ sub helo_respond {
|
|||||||
my ($self, $rc, $msg, $args) = @_;
|
my ($self, $rc, $msg, $args) = @_;
|
||||||
my ($hello_host) = @$args;
|
my ($hello_host) = @$args;
|
||||||
if ($rc == DONE) {
|
if ($rc == DONE) {
|
||||||
|
|
||||||
# do nothing:
|
# do nothing:
|
||||||
1;
|
1;
|
||||||
} elsif ($rc == DENY) {
|
}
|
||||||
|
elsif ($rc == DENY) {
|
||||||
$self->respond(550, @$msg);
|
$self->respond(550, @$msg);
|
||||||
} elsif ($rc == DENYSOFT) {
|
}
|
||||||
|
elsif ($rc == DENYSOFT) {
|
||||||
$self->respond(450, @$msg);
|
$self->respond(450, @$msg);
|
||||||
} elsif ($rc == DENY_DISCONNECT) {
|
}
|
||||||
|
elsif ($rc == DENY_DISCONNECT) {
|
||||||
$self->respond(550, @$msg);
|
$self->respond(550, @$msg);
|
||||||
$self->disconnect;
|
$self->disconnect;
|
||||||
} elsif ($rc == DENYSOFT_DISCONNECT) {
|
}
|
||||||
|
elsif ($rc == DENYSOFT_DISCONNECT) {
|
||||||
$self->respond(450, @$msg);
|
$self->respond(450, @$msg);
|
||||||
$self->disconnect;
|
$self->disconnect;
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
my $conn = $self->connection;
|
my $conn = $self->connection;
|
||||||
$conn->hello("helo");
|
$conn->hello("helo");
|
||||||
$conn->hello_host($hello_host);
|
$conn->hello_host($hello_host);
|
||||||
$self->transaction;
|
$self->transaction;
|
||||||
$self->respond(250, $self->config('me') ." Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]; I am so happy to meet you.");
|
$self->respond(
|
||||||
|
250,
|
||||||
|
$self->config('me') . " Hi "
|
||||||
|
. $conn->remote_info . " ["
|
||||||
|
. $conn->remote_ip
|
||||||
|
. "]; I am so happy to meet you."
|
||||||
|
);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub ehlo {
|
sub ehlo {
|
||||||
my ($self, $line) = @_;
|
my ($self, $line) = @_;
|
||||||
my ($rc, @msg) = $self->run_hooks('ehlo_parse');
|
my ($rc, @msg) = $self->run_hooks('ehlo_parse');
|
||||||
my ($ok, $hello_host, @stuff) = Qpsmtpd::Command->parse('ehlo', $line, $msg[0]);
|
my ($ok, $hello_host, @stuff) =
|
||||||
|
Qpsmtpd::Command->parse('ehlo', $line, $msg[0]);
|
||||||
return $self->respond(501,
|
return $self->respond(501,
|
||||||
"ehlo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host;
|
"ehlo requires domain/address - see RFC-2821 4.1.1.1")
|
||||||
|
unless $hello_host;
|
||||||
my $conn = $self->connection;
|
my $conn = $self->connection;
|
||||||
return $self->respond(503, "but you already said HELO ...") if $conn->hello;
|
return $self->respond(503, "but you already said HELO ...") if $conn->hello;
|
||||||
|
|
||||||
@ -200,25 +220,32 @@ sub ehlo_respond {
|
|||||||
my ($self, $rc, $msg, $args) = @_;
|
my ($self, $rc, $msg, $args) = @_;
|
||||||
my ($hello_host) = @$args;
|
my ($hello_host) = @$args;
|
||||||
if ($rc == DONE) {
|
if ($rc == DONE) {
|
||||||
|
|
||||||
# do nothing:
|
# do nothing:
|
||||||
1;
|
1;
|
||||||
} elsif ($rc == DENY) {
|
}
|
||||||
|
elsif ($rc == DENY) {
|
||||||
$self->respond(550, @$msg);
|
$self->respond(550, @$msg);
|
||||||
} elsif ($rc == DENYSOFT) {
|
}
|
||||||
|
elsif ($rc == DENYSOFT) {
|
||||||
$self->respond(450, @$msg);
|
$self->respond(450, @$msg);
|
||||||
} elsif ($rc == DENY_DISCONNECT) {
|
}
|
||||||
|
elsif ($rc == DENY_DISCONNECT) {
|
||||||
$self->respond(550, @$msg);
|
$self->respond(550, @$msg);
|
||||||
$self->disconnect;
|
$self->disconnect;
|
||||||
} elsif ($rc == DENYSOFT_DISCONNECT) {
|
}
|
||||||
|
elsif ($rc == DENYSOFT_DISCONNECT) {
|
||||||
$self->respond(450, @$msg);
|
$self->respond(450, @$msg);
|
||||||
$self->disconnect;
|
$self->disconnect;
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
my $conn = $self->connection;
|
my $conn = $self->connection;
|
||||||
$conn->hello("ehlo");
|
$conn->hello("ehlo");
|
||||||
$conn->hello_host($hello_host);
|
$conn->hello_host($hello_host);
|
||||||
$self->transaction;
|
$self->transaction;
|
||||||
|
|
||||||
my @capabilities = $self->transaction->notes('capabilities')
|
my @capabilities =
|
||||||
|
$self->transaction->notes('capabilities')
|
||||||
? @{$self->transaction->notes('capabilities')}
|
? @{$self->transaction->notes('capabilities')}
|
||||||
: ();
|
: ();
|
||||||
|
|
||||||
@ -236,17 +263,28 @@ HOOK: foreach my $hook ( keys %{$self->hooks} ) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Check if we should only offer AUTH after TLS is completed
|
# Check if we should only offer AUTH after TLS is completed
|
||||||
my $tls_before_auth = ($self->config('tls_before_auth') ? ($self->config('tls_before_auth'))[0] && $self->transaction->notes('tls_enabled') : 0);
|
my $tls_before_auth =
|
||||||
|
($self->config('tls_before_auth')
|
||||||
|
? ($self->config('tls_before_auth'))[0]
|
||||||
|
&& $self->transaction->notes('tls_enabled')
|
||||||
|
: 0);
|
||||||
if (%auth_mechanisms && !$tls_before_auth) {
|
if (%auth_mechanisms && !$tls_before_auth) {
|
||||||
push @capabilities, 'AUTH ' . join(" ", keys(%auth_mechanisms));
|
push @capabilities, 'AUTH ' . join(" ", keys(%auth_mechanisms));
|
||||||
$self->{_commands}->{'auth'} = "";
|
$self->{_commands}->{'auth'} = "";
|
||||||
}
|
}
|
||||||
|
|
||||||
$self->respond(250,
|
$self->respond(
|
||||||
$self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
|
250,
|
||||||
|
$self->config("me") . " Hi "
|
||||||
|
. $conn->remote_info . " ["
|
||||||
|
. $conn->remote_ip . "]",
|
||||||
"PIPELINING",
|
"PIPELINING",
|
||||||
"8BITMIME",
|
"8BITMIME",
|
||||||
($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()),
|
(
|
||||||
|
$self->config('databytes')
|
||||||
|
? "SIZE " . ($self->config('databytes'))[0]
|
||||||
|
: ()
|
||||||
|
),
|
||||||
@capabilities,
|
@capabilities,
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
@ -261,7 +299,8 @@ sub auth_parse_respond {
|
|||||||
my ($self, $rc, $msg, $args) = @_;
|
my ($self, $rc, $msg, $args) = @_;
|
||||||
my ($line) = @$args;
|
my ($line) = @$args;
|
||||||
|
|
||||||
my ($ok, $mechanism, @stuff) = Qpsmtpd::Command->parse('auth', $line, $msg->[0]);
|
my ($ok, $mechanism, @stuff) =
|
||||||
|
Qpsmtpd::Command->parse('auth', $line, $msg->[0]);
|
||||||
return $self->respond(501, $mechanism || "Syntax error in command")
|
return $self->respond(501, $mechanism || "Syntax error in command")
|
||||||
unless ($ok == OK);
|
unless ($ok == OK);
|
||||||
|
|
||||||
@ -281,7 +320,7 @@ sub auth_parse_respond {
|
|||||||
# we don't have a plugin implementing this auth mechanism, 504
|
# we don't have a plugin implementing this auth mechanism, 504
|
||||||
if (exists $auth_mechanisms{uc($mechanism)}) {
|
if (exists $auth_mechanisms{uc($mechanism)}) {
|
||||||
return $self->{_auth} = Qpsmtpd::Auth::SASL($self, $mechanism, @stuff);
|
return $self->{_auth} = Qpsmtpd::Auth::SASL($self, $mechanism, @stuff);
|
||||||
};
|
}
|
||||||
|
|
||||||
$self->respond(504, "Unimplemented authentification mechanism: $mechanism");
|
$self->respond(504, "Unimplemented authentification mechanism: $mechanism");
|
||||||
return DENY;
|
return DENY;
|
||||||
@ -289,6 +328,7 @@ sub auth_parse_respond {
|
|||||||
|
|
||||||
sub mail {
|
sub mail {
|
||||||
my ($self, $line) = @_;
|
my ($self, $line) = @_;
|
||||||
|
|
||||||
# -> from RFC2821
|
# -> from RFC2821
|
||||||
# The MAIL command (or the obsolete SEND, SOML, or SAML commands)
|
# The MAIL command (or the obsolete SEND, SOML, or SAML commands)
|
||||||
# begins a mail transaction. Once started, a mail transaction
|
# begins a mail transaction. Once started, a mail transaction
|
||||||
@ -311,7 +351,7 @@ sub mail {
|
|||||||
|
|
||||||
if (!$self->connection->hello) {
|
if (!$self->connection->hello) {
|
||||||
return $self->respond(503, "please say hello first ...");
|
return $self->respond(503, "please say hello first ...");
|
||||||
};
|
}
|
||||||
|
|
||||||
$self->log(LOGDEBUG, "full from_parameter: $line");
|
$self->log(LOGDEBUG, "full from_parameter: $line");
|
||||||
$self->run_hooks("mail_parse", $line);
|
$self->run_hooks("mail_parse", $line);
|
||||||
@ -320,7 +360,8 @@ sub mail {
|
|||||||
sub mail_parse_respond {
|
sub mail_parse_respond {
|
||||||
my ($self, $rc, $msg, $args) = @_;
|
my ($self, $rc, $msg, $args) = @_;
|
||||||
my ($line) = @$args;
|
my ($line) = @$args;
|
||||||
my ($ok, $from, @params) = Qpsmtpd::Command->parse('mail', $line, $msg->[0]);
|
my ($ok, $from, @params) =
|
||||||
|
Qpsmtpd::Command->parse('mail', $line, $msg->[0]);
|
||||||
return $self->respond(501, $from || "Syntax error in command")
|
return $self->respond(501, $from || "Syntax error in command")
|
||||||
unless ($ok == OK);
|
unless ($ok == OK);
|
||||||
my %param;
|
my %param;
|
||||||
@ -328,6 +369,7 @@ sub mail_parse_respond {
|
|||||||
my ($k, $v) = split /=/, $_, 2;
|
my ($k, $v) = split /=/, $_, 2;
|
||||||
$param{lc $k} = $v;
|
$param{lc $k} = $v;
|
||||||
}
|
}
|
||||||
|
|
||||||
# to support addresses without <> we now require a plugin
|
# to support addresses without <> we now require a plugin
|
||||||
# hooking "mail_pre" to
|
# hooking "mail_pre" to
|
||||||
# return (OK, "<$from>");
|
# return (OK, "<$from>");
|
||||||
@ -353,7 +395,8 @@ sub mail_pre_respond {
|
|||||||
else {
|
else {
|
||||||
$from = (Qpsmtpd::Address->parse($from))[0];
|
$from = (Qpsmtpd::Address->parse($from))[0];
|
||||||
}
|
}
|
||||||
return $self->respond(501, "could not parse your mail from command") unless $from;
|
return $self->respond(501, "could not parse your mail from command")
|
||||||
|
unless $from;
|
||||||
|
|
||||||
$self->run_hooks("mail", $from, %$param);
|
$self->run_hooks("mail", $from, %$param);
|
||||||
}
|
}
|
||||||
@ -388,7 +431,11 @@ sub mail_respond {
|
|||||||
}
|
}
|
||||||
else { # includes OK
|
else { # includes OK
|
||||||
$self->log(LOGDEBUG, "getting mail from " . $from->format);
|
$self->log(LOGDEBUG, "getting mail from " . $from->format);
|
||||||
$self->respond(250, $from->format . ", sender OK - how exciting to get mail from you!");
|
$self->respond(
|
||||||
|
250,
|
||||||
|
$from->format
|
||||||
|
. ", sender OK - how exciting to get mail from you!"
|
||||||
|
);
|
||||||
$self->transaction->sender($from);
|
$self->transaction->sender($from);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -404,13 +451,15 @@ sub rcpt_parse_respond {
|
|||||||
my ($ok, $rcpt, @param) = Qpsmtpd::Command->parse("rcpt", $line, $msg->[0]);
|
my ($ok, $rcpt, @param) = Qpsmtpd::Command->parse("rcpt", $line, $msg->[0]);
|
||||||
return $self->respond(501, $rcpt || "Syntax error in command")
|
return $self->respond(501, $rcpt || "Syntax error in command")
|
||||||
unless ($ok == OK);
|
unless ($ok == OK);
|
||||||
return $self->respond(503, "Use MAIL before RCPT") unless $self->transaction->sender;
|
return $self->respond(503, "Use MAIL before RCPT")
|
||||||
|
unless $self->transaction->sender;
|
||||||
|
|
||||||
my %param;
|
my %param;
|
||||||
foreach (@param) {
|
foreach (@param) {
|
||||||
my ($k, $v) = split /=/, $_, 2;
|
my ($k, $v) = split /=/, $_, 2;
|
||||||
$param{lc $k} = $v;
|
$param{lc $k} = $v;
|
||||||
}
|
}
|
||||||
|
|
||||||
# to support addresses without <> we now require a plugin
|
# to support addresses without <> we now require a plugin
|
||||||
# hooking "rcpt_pre" to
|
# hooking "rcpt_pre" to
|
||||||
# return (OK, "<$rcpt>");
|
# return (OK, "<$rcpt>");
|
||||||
@ -493,9 +542,11 @@ sub help_respond {
|
|||||||
else {
|
else {
|
||||||
unless ($msg->[0]) {
|
unless ($msg->[0]) {
|
||||||
@$msg = (
|
@$msg = (
|
||||||
"This is qpsmtpd " . ($self->config('smtpgreeting') ? '' : $self->version),
|
"This is qpsmtpd "
|
||||||
|
. ($self->config('smtpgreeting') ? '' : $self->version),
|
||||||
"See http://smtpd.develooper.com/",
|
"See http://smtpd.develooper.com/",
|
||||||
'To report bugs or send comments, mail to <ask@develooper.com>.');
|
'To report bugs or send comments, mail to <ask@develooper.com>.'
|
||||||
|
);
|
||||||
}
|
}
|
||||||
$self->respond(214, @$msg);
|
$self->respond(214, @$msg);
|
||||||
}
|
}
|
||||||
@ -549,7 +600,8 @@ sub vrfy_respond {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else { # $rc == DECLINED or anything else
|
else { # $rc == DECLINED or anything else
|
||||||
$self->respond(252, "Just try sending a mail and we'll see how it turns out ...");
|
$self->respond(252,
|
||||||
|
"Just try sending a mail and we'll see how it turns out ...");
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -568,7 +620,8 @@ sub quit {
|
|||||||
sub quit_respond {
|
sub quit_respond {
|
||||||
my ($self, $rc, $msg, $args) = @_;
|
my ($self, $rc, $msg, $args) = @_;
|
||||||
if ($rc != DONE) {
|
if ($rc != DONE) {
|
||||||
$msg->[0] ||= $self->config('me') . " closing connection. Have a wonderful day.";
|
$msg->[0] ||=
|
||||||
|
$self->config('me') . " closing connection. Have a wonderful day.";
|
||||||
$self->respond(221, @$msg);
|
$self->respond(221, @$msg);
|
||||||
}
|
}
|
||||||
$self->disconnect();
|
$self->disconnect();
|
||||||
@ -615,14 +668,17 @@ sub data_respond {
|
|||||||
$self->disconnect;
|
$self->disconnect;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
$self->respond(503, "MAIL first"), return 1 unless $self->transaction->sender;
|
$self->respond(503, "MAIL first"), return 1
|
||||||
$self->respond(503, "RCPT first"), return 1 unless $self->transaction->recipients;
|
unless $self->transaction->sender;
|
||||||
|
$self->respond(503, "RCPT first"), return 1
|
||||||
|
unless $self->transaction->recipients;
|
||||||
$self->respond(354, "go ahead");
|
$self->respond(354, "go ahead");
|
||||||
|
|
||||||
my $buffer = '';
|
my $buffer = '';
|
||||||
my $size = 0;
|
my $size = 0;
|
||||||
my $i = 0;
|
my $i = 0;
|
||||||
my $max_size = ($self->config('databytes'))[0] || 0; # this should work in scalar context
|
my $max_size =
|
||||||
|
($self->config('databytes'))[0] || 0; # this should work in scalar context
|
||||||
my $blocked = "";
|
my $blocked = "";
|
||||||
my %matches;
|
my %matches;
|
||||||
my $in_header = 1;
|
my $in_header = 1;
|
||||||
@ -637,7 +693,7 @@ sub data_respond {
|
|||||||
if ($_ eq ".\r\n") {
|
if ($_ eq ".\r\n") {
|
||||||
$complete++;
|
$complete++;
|
||||||
$_ = '';
|
$_ = '';
|
||||||
};
|
}
|
||||||
$i++;
|
$i++;
|
||||||
|
|
||||||
# should probably use \012 and \015 in these checks instead of \r and \n ...
|
# should probably use \012 and \015 in these checks instead of \r and \n ...
|
||||||
@ -665,6 +721,7 @@ sub data_respond {
|
|||||||
# way a Received: line that is already in the header.
|
# way a Received: line that is already in the header.
|
||||||
|
|
||||||
$header->extract(\@headers);
|
$header->extract(\@headers);
|
||||||
|
|
||||||
#$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
|
#$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
|
||||||
|
|
||||||
$buffer = "";
|
$buffer = "";
|
||||||
@ -678,7 +735,8 @@ sub data_respond {
|
|||||||
$self->respond(554, $msg || "Message denied");
|
$self->respond(554, $msg || "Message denied");
|
||||||
$self->disconnect;
|
$self->disconnect;
|
||||||
return 1;
|
return 1;
|
||||||
} elsif ($rc == DENYSOFT_DISCONNECT) {
|
}
|
||||||
|
elsif ($rc == DENYSOFT_DISCONNECT) {
|
||||||
$self->respond(421, $msg || "Message denied temporarily");
|
$self->respond(421, $msg || "Message denied temporarily");
|
||||||
$self->disconnect;
|
$self->disconnect;
|
||||||
return 1;
|
return 1;
|
||||||
@ -700,6 +758,7 @@ sub data_respond {
|
|||||||
$size += length $_;
|
$size += length $_;
|
||||||
}
|
}
|
||||||
last if $complete > 0;
|
last if $complete > 0;
|
||||||
|
|
||||||
#$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
|
#$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -711,17 +770,22 @@ sub data_respond {
|
|||||||
my $sslheader = '';
|
my $sslheader = '';
|
||||||
|
|
||||||
if (defined $self->connection->notes('tls_enabled')
|
if (defined $self->connection->notes('tls_enabled')
|
||||||
and $self->connection->notes('tls_enabled')) {
|
and $self->connection->notes('tls_enabled'))
|
||||||
|
{
|
||||||
$smtp .= "S" if $esmtp; # RFC3848
|
$smtp .= "S" if $esmtp; # RFC3848
|
||||||
$sslheader = "(".$self->connection->notes('tls_socket')->get_cipher()." encrypted) ";
|
$sslheader = "("
|
||||||
|
. $self->connection->notes('tls_socket')->get_cipher()
|
||||||
|
. " encrypted) ";
|
||||||
}
|
}
|
||||||
|
|
||||||
if (defined $self->{_auth} and $self->{_auth} == OK) {
|
if (defined $self->{_auth} and $self->{_auth} == OK) {
|
||||||
$smtp .= "A" if $esmtp; # RFC3848
|
$smtp .= "A" if $esmtp; # RFC3848
|
||||||
$authheader = "(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n";
|
$authheader =
|
||||||
|
"(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
$header->add("Received", $self->received_line($smtp, $authheader, $sslheader), 0);
|
$header->add("Received",
|
||||||
|
$self->received_line($smtp, $authheader, $sslheader), 0);
|
||||||
|
|
||||||
# if we get here without seeing a terminator, the connection is
|
# if we get here without seeing a terminator, the connection is
|
||||||
# probably dead.
|
# probably dead.
|
||||||
@ -733,7 +797,8 @@ sub data_respond {
|
|||||||
|
|
||||||
#$self->respond(550, $self->transaction->blocked),return 1 if ($self->transaction->blocked);
|
#$self->respond(550, $self->transaction->blocked),return 1 if ($self->transaction->blocked);
|
||||||
if ($max_size and $size > $max_size) {
|
if ($max_size and $size > $max_size) {
|
||||||
$self->log(LOGALERT, "Message too big: size: $size (max size: $max_size)");
|
$self->log(LOGALERT,
|
||||||
|
"Message too big: size: $size (max size: $max_size)");
|
||||||
$self->respond(552, "Message too big!");
|
$self->respond(552, "Message too big!");
|
||||||
$self->reset_transaction; # clean up after ourselves
|
$self->reset_transaction; # clean up after ourselves
|
||||||
return 1;
|
return 1;
|
||||||
@ -744,7 +809,8 @@ sub data_respond {
|
|||||||
|
|
||||||
sub received_line {
|
sub received_line {
|
||||||
my ($self, $smtp, $authheader, $sslheader) = @_;
|
my ($self, $smtp, $authheader, $sslheader) = @_;
|
||||||
my ($rc, @received) = $self->run_hooks("received_line", $smtp, $authheader, $sslheader);
|
my ($rc, @received) =
|
||||||
|
$self->run_hooks("received_line", $smtp, $authheader, $sslheader);
|
||||||
if ($rc == YIELD) {
|
if ($rc == YIELD) {
|
||||||
die "YIELD not supported for received_line hook";
|
die "YIELD not supported for received_line hook";
|
||||||
}
|
}
|
||||||
@ -752,10 +818,18 @@ sub received_line {
|
|||||||
return join("\n", @received);
|
return join("\n", @received);
|
||||||
}
|
}
|
||||||
else { # assume $rc == DECLINED
|
else { # assume $rc == DECLINED
|
||||||
return "from ".$self->connection->remote_info
|
return
|
||||||
." (HELO ".$self->connection->hello_host . ") (".$self->connection->remote_ip
|
"from "
|
||||||
. ")\n $authheader by ".$self->config('me')." (qpsmtpd/".$self->version
|
. $self->connection->remote_info
|
||||||
.") with $sslheader$smtp; ". (strftime('%a, %d %b %Y %H:%M:%S %z', localtime))
|
. " (HELO "
|
||||||
|
. $self->connection->hello_host . ") ("
|
||||||
|
. $self->connection->remote_ip
|
||||||
|
. ")\n $authheader by "
|
||||||
|
. $self->config('me')
|
||||||
|
. " (qpsmtpd/"
|
||||||
|
. $self->version
|
||||||
|
. ") with $sslheader$smtp; "
|
||||||
|
. (strftime('%a, %d %b %Y %H:%M:%S %z', localtime));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -767,12 +841,14 @@ sub data_post_respond {
|
|||||||
elsif ($rc == DENY) {
|
elsif ($rc == DENY) {
|
||||||
$msg->[0] ||= "Message denied";
|
$msg->[0] ||= "Message denied";
|
||||||
$self->respond(552, @$msg);
|
$self->respond(552, @$msg);
|
||||||
|
|
||||||
# DATA is always the end of a "transaction"
|
# DATA is always the end of a "transaction"
|
||||||
return $self->reset_transaction;
|
return $self->reset_transaction;
|
||||||
}
|
}
|
||||||
elsif ($rc == DENYSOFT) {
|
elsif ($rc == DENYSOFT) {
|
||||||
$msg->[0] ||= "Message denied temporarily";
|
$msg->[0] ||= "Message denied temporarily";
|
||||||
$self->respond(452, @$msg);
|
$self->respond(452, @$msg);
|
||||||
|
|
||||||
# DATA is always the end of a "transaction"
|
# DATA is always the end of a "transaction"
|
||||||
return $self->reset_transaction;
|
return $self->reset_transaction;
|
||||||
}
|
}
|
||||||
@ -858,5 +934,4 @@ sub queue_post_respond {
|
|||||||
$self->log(LOGERROR, @$msg) unless ($rc == OK or $rc == 0);
|
$self->log(LOGERROR, @$msg) unless ($rc == OK or $rc == 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
@ -19,7 +19,8 @@ sub dispatch {
|
|||||||
my ($result) = eval { $self->$cmd(@_) };
|
my ($result) = eval { $self->$cmd(@_) };
|
||||||
if ($@ =~ /^disconnect_tcpserver/) {
|
if ($@ =~ /^disconnect_tcpserver/) {
|
||||||
die "disconnect_tcpserver";
|
die "disconnect_tcpserver";
|
||||||
} elsif ($@) {
|
}
|
||||||
|
elsif ($@) {
|
||||||
$self->log(LOGERROR, "XX: $@") if $@;
|
$self->log(LOGERROR, "XX: $@") if $@;
|
||||||
}
|
}
|
||||||
return $result if defined $result;
|
return $result if defined $result;
|
||||||
|
@ -10,10 +10,13 @@ use POSIX ();
|
|||||||
|
|
||||||
my $has_ipv6 = 0;
|
my $has_ipv6 = 0;
|
||||||
if (
|
if (
|
||||||
eval {require Socket6;} &&
|
eval { require Socket6; }
|
||||||
|
&&
|
||||||
|
|
||||||
# INET6 prior to 2.01 will not work; sorry.
|
# INET6 prior to 2.01 will not work; sorry.
|
||||||
eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION("2.00"); }
|
eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION("2.00"); }
|
||||||
) {
|
)
|
||||||
|
{
|
||||||
Socket6->import(qw(inet_ntop));
|
Socket6->import(qw(inet_ntop));
|
||||||
$has_ipv6 = 1;
|
$has_ipv6 = 1;
|
||||||
}
|
}
|
||||||
@ -33,21 +36,27 @@ sub start_connection {
|
|||||||
);
|
);
|
||||||
|
|
||||||
if ($ENV{TCPREMOTEIP}) {
|
if ($ENV{TCPREMOTEIP}) {
|
||||||
|
|
||||||
# started from tcpserver (or some other superserver which
|
# started from tcpserver (or some other superserver which
|
||||||
# exports the TCPREMOTE* variables.
|
# exports the TCPREMOTE* variables.
|
||||||
$remote_ip = $ENV{TCPREMOTEIP};
|
$remote_ip = $ENV{TCPREMOTEIP};
|
||||||
$remote_host = $ENV{TCPREMOTEHOST} || "[$remote_ip]";
|
$remote_host = $ENV{TCPREMOTEHOST} || "[$remote_ip]";
|
||||||
$remote_info = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host;
|
$remote_info =
|
||||||
|
$ENV{TCPREMOTEINFO}
|
||||||
|
? "$ENV{TCPREMOTEINFO}\@$remote_host"
|
||||||
|
: $remote_host;
|
||||||
$remote_port = $ENV{TCPREMOTEPORT};
|
$remote_port = $ENV{TCPREMOTEPORT};
|
||||||
$local_ip = $ENV{TCPLOCALIP};
|
$local_ip = $ENV{TCPLOCALIP};
|
||||||
$local_port = $ENV{TCPLOCALPORT};
|
$local_port = $ENV{TCPLOCALPORT};
|
||||||
$local_host = $ENV{TCPLOCALHOST};
|
$local_host = $ENV{TCPLOCALHOST};
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
# Started from inetd or similar.
|
# Started from inetd or similar.
|
||||||
# get info on the remote host from the socket.
|
# get info on the remote host from the socket.
|
||||||
# ignore ident/tap/...
|
# ignore ident/tap/...
|
||||||
my $hersockaddr = getpeername(STDIN)
|
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";
|
or die
|
||||||
|
"getpeername failed: $0 must be called from tcpserver, (x)inetd or a similar program which passes a socket to stdin";
|
||||||
my ($port, $iaddr) = sockaddr_in($hersockaddr);
|
my ($port, $iaddr) = sockaddr_in($hersockaddr);
|
||||||
$remote_ip = inet_ntoa($iaddr);
|
$remote_ip = inet_ntoa($iaddr);
|
||||||
$remote_host = gethostbyaddr($iaddr, AF_INET) || "[$remote_ip]";
|
$remote_host = gethostbyaddr($iaddr, AF_INET) || "[$remote_ip]";
|
||||||
@ -64,14 +73,16 @@ sub start_connection {
|
|||||||
my $now = POSIX::strftime("%H:%M:%S %Y-%m-%d", localtime);
|
my $now = POSIX::strftime("%H:%M:%S %Y-%m-%d", localtime);
|
||||||
$0 = "$first_0 [$remote_ip : $remote_host : $now]";
|
$0 = "$first_0 [$remote_ip : $remote_host : $now]";
|
||||||
|
|
||||||
$self->SUPER::connection->start(remote_info => $remote_info,
|
$self->SUPER::connection->start(
|
||||||
|
remote_info => $remote_info,
|
||||||
remote_ip => $remote_ip,
|
remote_ip => $remote_ip,
|
||||||
remote_host => $remote_host,
|
remote_host => $remote_host,
|
||||||
remote_port => $remote_port,
|
remote_port => $remote_port,
|
||||||
local_ip => $local_ip,
|
local_ip => $local_ip,
|
||||||
local_port => $local_port,
|
local_port => $local_port,
|
||||||
local_host => $local_host,
|
local_host => $local_host,
|
||||||
@_);
|
@_
|
||||||
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub run {
|
sub run {
|
||||||
@ -92,8 +103,7 @@ sub run {
|
|||||||
sub read_input {
|
sub read_input {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
my $timeout =
|
my $timeout = $self->config('timeoutsmtpd') # qmail smtpd control file
|
||||||
$self->config('timeoutsmtpd') # qmail smtpd control file
|
|
||||||
|| $self->config('timeout') # qpsmtpd control file
|
|| $self->config('timeout') # qpsmtpd control file
|
||||||
|| 1200; # default value
|
|| 1200; # default value
|
||||||
|
|
||||||
@ -119,7 +129,8 @@ sub respond {
|
|||||||
my $buf = '';
|
my $buf = '';
|
||||||
|
|
||||||
if (!$self->check_socket()) {
|
if (!$self->check_socket()) {
|
||||||
$self->log(LOGERROR, "Lost connection to client, cannot send response.");
|
$self->log(LOGERROR,
|
||||||
|
"Lost connection to client, cannot send response.");
|
||||||
return (0);
|
return (0);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -128,7 +139,8 @@ sub respond {
|
|||||||
$self->log(LOGINFO, $line);
|
$self->log(LOGINFO, $line);
|
||||||
$buf .= "$line\r\n";
|
$buf .= "$line\r\n";
|
||||||
}
|
}
|
||||||
print $buf or ($self->log(LOGERROR, "Could not print [$buf]: $!"), return 0);
|
print $buf
|
||||||
|
or ($self->log(LOGERROR, "Could not print [$buf]: $!"), return 0);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -145,12 +157,24 @@ sub disconnect {
|
|||||||
sub lrpip {
|
sub lrpip {
|
||||||
my ($server, $client, $hisaddr) = @_;
|
my ($server, $client, $hisaddr) = @_;
|
||||||
|
|
||||||
my ($port, $iaddr) = ($server->sockdomain == AF_INET) ? (sockaddr_in($hisaddr)) : (sockaddr_in6($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) = ($server->sockdomain == AF_INET) ? (sockaddr_in($localsockaddr)) : (sockaddr_in6($localsockaddr));
|
my ($lport, $laddr) =
|
||||||
|
($server->sockdomain == AF_INET)
|
||||||
|
? (sockaddr_in($localsockaddr))
|
||||||
|
: (sockaddr_in6($localsockaddr));
|
||||||
|
|
||||||
my $nto_iaddr = ($server->sockdomain == AF_INET) ? (inet_ntoa($iaddr)) : (inet_ntop(AF_INET6(), $iaddr));
|
my $nto_iaddr =
|
||||||
my $nto_laddr = ($server->sockdomain == AF_INET) ? (inet_ntoa($laddr)) : (inet_ntop(AF_INET6(), $laddr));
|
($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://;
|
||||||
|
|
||||||
@ -164,7 +188,8 @@ sub tcpenv {
|
|||||||
my $TCPREMOTEIP = $nto_iaddr;
|
my $TCPREMOTEIP = $nto_iaddr;
|
||||||
|
|
||||||
if ($no_rdns) {
|
if ($no_rdns) {
|
||||||
return ($TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]");
|
return ($TCPLOCALIP, $TCPREMOTEIP,
|
||||||
|
$TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]");
|
||||||
}
|
}
|
||||||
my $res = new Net::DNS::Resolver;
|
my $res = new Net::DNS::Resolver;
|
||||||
$res->tcp_timeout(3);
|
$res->tcp_timeout(3);
|
||||||
|
@ -19,8 +19,7 @@ sub start_connection {
|
|||||||
sub read_input {
|
sub read_input {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
my $timeout =
|
my $timeout = $self->config('timeoutsmtpd') # qmail smtpd control file
|
||||||
$self->config('timeoutsmtpd') # qmail smtpd control file
|
|
||||||
|| $self->config('timeout') # qpsmtpd control file
|
|| $self->config('timeout') # qpsmtpd control file
|
||||||
|| 1200; # default value
|
|| 1200; # default value
|
||||||
|
|
||||||
@ -43,7 +42,8 @@ sub read_input {
|
|||||||
};
|
};
|
||||||
if ($@ =~ /^disconnect_tcpserver/) {
|
if ($@ =~ /^disconnect_tcpserver/) {
|
||||||
die "disconnect_tcpserver";
|
die "disconnect_tcpserver";
|
||||||
} else {
|
}
|
||||||
|
else {
|
||||||
$self->run_hooks("post-connection");
|
$self->run_hooks("post-connection");
|
||||||
$self->connection->reset;
|
$self->connection->reset;
|
||||||
die "died while reading from STDIN (probably broken sender) - $@";
|
die "died while reading from STDIN (probably broken sender) - $@";
|
||||||
@ -55,14 +55,16 @@ sub respond {
|
|||||||
my ($self, $code, @messages) = @_;
|
my ($self, $code, @messages) = @_;
|
||||||
|
|
||||||
if (!$self->check_socket()) {
|
if (!$self->check_socket()) {
|
||||||
$self->log(LOGERROR, "Lost connection to client, cannot send response.");
|
$self->log(LOGERROR,
|
||||||
|
"Lost connection to client, cannot send response.");
|
||||||
return (0);
|
return (0);
|
||||||
}
|
}
|
||||||
|
|
||||||
while (my $msg = shift @messages) {
|
while (my $msg = shift @messages) {
|
||||||
my $line = $code . (@messages ? "-" : " ") . $msg;
|
my $line = $code . (@messages ? "-" : " ") . $msg;
|
||||||
$self->log(LOGINFO, $line);
|
$self->log(LOGINFO, $line);
|
||||||
print "$line\r\n" or ($self->log(LOGERROR, "Could not print [$line]: $!"), return 0);
|
print "$line\r\n"
|
||||||
|
or ($self->log(LOGERROR, "Could not print [$line]: $!"), return 0);
|
||||||
}
|
}
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
@ -31,8 +31,9 @@ sub add_recipient {
|
|||||||
|
|
||||||
sub remove_recipient {
|
sub remove_recipient {
|
||||||
my ($self, $rcpt) = @_;
|
my ($self, $rcpt) = @_;
|
||||||
$self->{_recipients} = [grep {$_->address ne $rcpt->address}
|
$self->{_recipients} =
|
||||||
@{$self->{_recipients} || []}] if $rcpt;
|
[grep { $_->address ne $rcpt->address } @{$self->{_recipients} || []}]
|
||||||
|
if $rcpt;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub recipients {
|
sub recipients {
|
||||||
@ -64,6 +65,7 @@ sub header {
|
|||||||
|
|
||||||
sub notes {
|
sub notes {
|
||||||
my ($self, $key) = (shift, shift);
|
my ($self, $key) = (shift, shift);
|
||||||
|
|
||||||
# Check for any additional arguments passed by the caller -- including undef
|
# Check for any additional arguments passed by the caller -- including undef
|
||||||
return $self->{_notes}->{$key} unless @_;
|
return $self->{_notes}->{$key} unless @_;
|
||||||
return $self->{_notes}->{$key} = shift;
|
return $self->{_notes}->{$key} = shift;
|
||||||
@ -110,11 +112,14 @@ sub body_spool {
|
|||||||
my $self = shift;
|
my $self = shift;
|
||||||
$self->log(LOGINFO, "spooling message to disk");
|
$self->log(LOGINFO, "spooling message to disk");
|
||||||
$self->{_filename} = $self->temp_file();
|
$self->{_filename} = $self->temp_file();
|
||||||
$self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
|
$self->{_body_file} =
|
||||||
or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
|
IO::File->new($self->{_filename}, O_RDWR | O_CREAT, 0600)
|
||||||
|
or die "Could not open file $self->{_filename} - $! "
|
||||||
|
; # . $self->{_body_file}->error;
|
||||||
if ($self->{_body_array}) {
|
if ($self->{_body_array}) {
|
||||||
foreach my $line (@{$self->{_body_array}}) {
|
foreach my $line (@{$self->{_body_array}}) {
|
||||||
$self->{_body_file}->print($line) or die "Cannot print to temp file: $!";
|
$self->{_body_file}->print($line)
|
||||||
|
or die "Cannot print to temp file: $!";
|
||||||
}
|
}
|
||||||
$self->{_body_start} = $self->{_header_size};
|
$self->{_body_start} = $self->{_header_size};
|
||||||
}
|
}
|
||||||
@ -128,13 +133,15 @@ sub body_write {
|
|||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $data = shift;
|
my $data = shift;
|
||||||
if ($self->{_body_file}) {
|
if ($self->{_body_file}) {
|
||||||
|
|
||||||
#warn("body_write to file\n");
|
#warn("body_write to file\n");
|
||||||
# go to the end of the file
|
# go to the end of the file
|
||||||
seek($self->{_body_file}, 0, 2)
|
seek($self->{_body_file}, 0, 2)
|
||||||
unless $self->{_body_file_writing};
|
unless $self->{_body_file_writing};
|
||||||
$self->{_body_file_writing} = 1;
|
$self->{_body_file_writing} = 1;
|
||||||
$self->{_body_file}->print(ref $data eq "SCALAR" ? $$data : $data)
|
$self->{_body_file}->print(ref $data eq "SCALAR" ? $$data : $data)
|
||||||
and $self->{_body_size} += length (ref $data eq "SCALAR" ? $$data : $data);
|
and $self->{_body_size} +=
|
||||||
|
length(ref $data eq "SCALAR" ? $$data : $data);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
#warn("body_write to array\n");
|
#warn("body_write to array\n");
|
||||||
@ -157,7 +164,8 @@ sub body_write {
|
|||||||
|
|
||||||
sub body_size { # depreceated, use data_size() instead
|
sub body_size { # depreceated, use data_size() instead
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
$self->log(LOGWARN, "WARNING: body_size() is depreceated, use data_size() instead");
|
$self->log(LOGWARN,
|
||||||
|
"WARNING: body_size() is depreceated, use data_size() instead");
|
||||||
$self->{_body_size} || 0;
|
$self->{_body_size} || 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -229,6 +237,7 @@ sub dup_body_fh {
|
|||||||
|
|
||||||
sub DESTROY {
|
sub DESTROY {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
# would we save some disk flushing if we unlinked the file before
|
# would we save some disk flushing if we unlinked the file before
|
||||||
# closing it?
|
# closing it?
|
||||||
|
|
||||||
@ -236,14 +245,15 @@ sub DESTROY {
|
|||||||
|
|
||||||
if ($self->{_body_file}) {
|
if ($self->{_body_file}) {
|
||||||
undef $self->{_body_file};
|
undef $self->{_body_file};
|
||||||
};
|
}
|
||||||
|
|
||||||
if ($self->{_filename} and -e $self->{_filename}) {
|
if ($self->{_filename} and -e $self->{_filename}) {
|
||||||
if (unlink $self->{_filename}) {
|
if (unlink $self->{_filename}) {
|
||||||
$self->log(LOGDEBUG, "unlinked ", $self->{_filename});
|
$self->log(LOGDEBUG, "unlinked ", $self->{_filename});
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$self->log(LOGERROR, "Could not unlink ", $self->{_filename}, ": $!");
|
$self->log(LOGERROR, "Could not unlink ",
|
||||||
|
$self->{_filename}, ": $!");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -252,22 +262,24 @@ sub DESTROY {
|
|||||||
$self->log(LOGDEBUG, "Cleaning up temporary transaction files");
|
$self->log(LOGDEBUG, "Cleaning up temporary transaction files");
|
||||||
foreach my $file (@{$self->{_temp_files}}) {
|
foreach my $file (@{$self->{_temp_files}}) {
|
||||||
next unless -e $file;
|
next unless -e $file;
|
||||||
unlink $file or $self->log(LOGERROR,
|
unlink $file
|
||||||
"Could not unlink temporary file", $file, ": $!");
|
or $self->log(LOGERROR, "Could not unlink temporary file",
|
||||||
|
$file, ": $!");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Ditto
|
# Ditto
|
||||||
if ($self->{_temp_dirs}) {
|
if ($self->{_temp_dirs}) {
|
||||||
eval { use File::Path };
|
eval { use File::Path };
|
||||||
$self->log(LOGDEBUG, "Cleaning up temporary directories");
|
$self->log(LOGDEBUG, "Cleaning up temporary directories");
|
||||||
foreach my $dir (@{$self->{_temp_dirs}}) {
|
foreach my $dir (@{$self->{_temp_dirs}}) {
|
||||||
rmtree($dir) or $self->log(LOGERROR,
|
rmtree($dir)
|
||||||
"Could not unlink temporary dir", $dir, ": $!");
|
or $self->log(LOGERROR, "Could not unlink temporary dir",
|
||||||
|
$dir, ": $!");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
|
@ -11,5 +11,4 @@ sub tildeexp {
|
|||||||
return $path;
|
return $path;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
@ -10,8 +10,14 @@ use Test::Qpsmtpd::Plugin;
|
|||||||
|
|
||||||
sub new_conn {
|
sub new_conn {
|
||||||
ok(my $smtpd = __PACKAGE__->new(), "new");
|
ok(my $smtpd = __PACKAGE__->new(), "new");
|
||||||
ok(my $conn = $smtpd->start_connection(remote_host => 'localhost',
|
ok(
|
||||||
remote_ip => '127.0.0.1'), "start_connection");
|
my $conn =
|
||||||
|
$smtpd->start_connection(
|
||||||
|
remote_host => 'localhost',
|
||||||
|
remote_ip => '127.0.0.1'
|
||||||
|
),
|
||||||
|
"start_connection"
|
||||||
|
);
|
||||||
is(($smtpd->response)[0], "220", "greetings");
|
is(($smtpd->response)[0], "220", "greetings");
|
||||||
($smtpd, $conn);
|
($smtpd, $conn);
|
||||||
}
|
}
|
||||||
@ -24,11 +30,13 @@ sub start_connection {
|
|||||||
my $remote_info = "test\@$remote_host";
|
my $remote_info = "test\@$remote_host";
|
||||||
my $remote_ip = $args{remote_ip} or croak "no remote_ip parameter";
|
my $remote_ip = $args{remote_ip} or croak "no remote_ip parameter";
|
||||||
|
|
||||||
my $conn = $self->SUPER::connection->start(remote_info => $remote_info,
|
my $conn =
|
||||||
|
$self->SUPER::connection->start(
|
||||||
|
remote_info => $remote_info,
|
||||||
remote_ip => $remote_ip,
|
remote_ip => $remote_ip,
|
||||||
remote_host => $remote_host,
|
remote_host => $remote_host,
|
||||||
@_);
|
@_
|
||||||
|
);
|
||||||
|
|
||||||
$self->load_plugins;
|
$self->load_plugins;
|
||||||
|
|
||||||
@ -95,6 +103,7 @@ sub run_plugin_tests {
|
|||||||
my $self = shift;
|
my $self = shift;
|
||||||
$self->{_test_mode} = 1;
|
$self->{_test_mode} = 1;
|
||||||
my @plugins = $self->load_plugins();
|
my @plugins = $self->load_plugins();
|
||||||
|
|
||||||
# First count test number
|
# First count test number
|
||||||
my $num_tests = 0;
|
my $num_tests = 0;
|
||||||
foreach my $plugin (@plugins) {
|
foreach my $plugin (@plugins) {
|
||||||
|
@ -11,12 +11,14 @@ use Qpsmtpd::Constants;
|
|||||||
use Test::More;
|
use Test::More;
|
||||||
|
|
||||||
sub register_tests {
|
sub register_tests {
|
||||||
|
|
||||||
# Virtual base method - implement in plugin
|
# Virtual base method - implement in plugin
|
||||||
}
|
}
|
||||||
|
|
||||||
sub register_test {
|
sub register_test {
|
||||||
my ($plugin, $test, $num_tests) = @_;
|
my ($plugin, $test, $num_tests) = @_;
|
||||||
$num_tests = 1 unless defined($num_tests);
|
$num_tests = 1 unless defined($num_tests);
|
||||||
|
|
||||||
# print STDERR "Registering test $test ($num_tests)\n";
|
# print STDERR "Registering test $test ($num_tests)\n";
|
||||||
push @{$plugin->{_tests}}, {name => $test, num => $num_tests};
|
push @{$plugin->{_tests}}, {name => $test, num => $num_tests};
|
||||||
}
|
}
|
||||||
@ -34,7 +36,8 @@ sub run_tests {
|
|||||||
my ($plugin, $qp) = @_;
|
my ($plugin, $qp) = @_;
|
||||||
foreach my $t (@{$plugin->{_tests}}) {
|
foreach my $t (@{$plugin->{_tests}}) {
|
||||||
my $method = $t->{name};
|
my $method = $t->{name};
|
||||||
print "# Running $method tests for plugin " . $plugin->plugin_name . "\n";
|
print "# Running $method tests for plugin "
|
||||||
|
. $plugin->plugin_name . "\n";
|
||||||
local $plugin->{_qp} = $qp;
|
local $plugin->{_qp} = $qp;
|
||||||
$plugin->$method();
|
$plugin->$method();
|
||||||
}
|
}
|
||||||
@ -56,7 +59,7 @@ sub validate_password {
|
|||||||
if (!$src_crypt && !$src_clear) {
|
if (!$src_crypt && !$src_clear) {
|
||||||
$self->log(LOGINFO, "fail: missing password");
|
$self->log(LOGINFO, "fail: missing password");
|
||||||
return ($deny, "$file - no such user");
|
return ($deny, "$file - no such user");
|
||||||
};
|
}
|
||||||
|
|
||||||
if (!$src_clear && $method =~ /CRAM-MD5/i) {
|
if (!$src_clear && $method =~ /CRAM-MD5/i) {
|
||||||
$self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass");
|
$self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass");
|
||||||
@ -67,28 +70,28 @@ sub validate_password {
|
|||||||
if ($src_clear && $src_clear eq $attempt_clear) {
|
if ($src_clear && $src_clear eq $attempt_clear) {
|
||||||
$self->log(LOGINFO, "pass: clear match");
|
$self->log(LOGINFO, "pass: clear match");
|
||||||
return (OK, $file);
|
return (OK, $file);
|
||||||
};
|
}
|
||||||
|
|
||||||
if ($src_crypt && $src_crypt eq crypt($attempt_clear, $src_crypt)) {
|
if ($src_crypt && $src_crypt eq crypt($attempt_clear, $src_crypt)) {
|
||||||
$self->log(LOGINFO, "pass: crypt match");
|
$self->log(LOGINFO, "pass: crypt match");
|
||||||
return (OK, $file);
|
return (OK, $file);
|
||||||
}
|
}
|
||||||
};
|
}
|
||||||
|
|
||||||
if (defined $attempt_hash && $src_clear) {
|
if (defined $attempt_hash && $src_clear) {
|
||||||
if (!$ticket) {
|
if (!$ticket) {
|
||||||
$self->log(LOGERROR, "skip: missing ticket");
|
$self->log(LOGERROR, "skip: missing ticket");
|
||||||
return (DECLINED, $file);
|
return (DECLINED, $file);
|
||||||
};
|
}
|
||||||
|
|
||||||
if ($attempt_hash eq hmac_md5_hex($ticket, $src_clear)) {
|
if ($attempt_hash eq hmac_md5_hex($ticket, $src_clear)) {
|
||||||
$self->log(LOGINFO, "pass: hash match");
|
$self->log(LOGINFO, "pass: hash match");
|
||||||
return (OK, $file);
|
return (OK, $file);
|
||||||
};
|
}
|
||||||
};
|
}
|
||||||
|
|
||||||
$self->log(LOGINFO, "fail: wrong password");
|
$self->log(LOGINFO, "fail: wrong password");
|
||||||
return ($deny, "$file - wrong password");
|
return ($deny, "$file - wrong password");
|
||||||
};
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
Loading…
Reference in New Issue
Block a user