More crazy performance stuff
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@845 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
parent
367c9a31a9
commit
214e7e0ec0
@ -15,7 +15,6 @@ my %defaults = (
|
||||
timeout => 1200,
|
||||
);
|
||||
my $_config_cache = {};
|
||||
clear_config_cache();
|
||||
|
||||
#DashProfiler->add_profile("qpsmtpd");
|
||||
#my $SAMPLER = DashProfiler->prepare("qpsmtpd");
|
||||
@ -57,6 +56,14 @@ sub load_logging {
|
||||
$self->log(LOGINFO, "Loaded $logger");
|
||||
}
|
||||
|
||||
$configdir = $self->config_dir("loglevel");
|
||||
$configfile = "$configdir/loglevel";
|
||||
$TraceLevel = $self->_config_from_file($configfile,'loglevel');
|
||||
|
||||
unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
|
||||
$TraceLevel = LOGWARN; # Default if no loglevel file found.
|
||||
}
|
||||
|
||||
$LOGGING_LOADED = 1;
|
||||
|
||||
return @loggers;
|
||||
@ -64,16 +71,6 @@ sub load_logging {
|
||||
|
||||
sub trace_level {
|
||||
my $self = shift;
|
||||
return $TraceLevel if $TraceLevel;
|
||||
|
||||
my $configdir = $self->config_dir("loglevel");
|
||||
my $configfile = "$configdir/loglevel";
|
||||
$TraceLevel = $self->_config_from_file($configfile,'loglevel');
|
||||
|
||||
unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
|
||||
$TraceLevel = LOGWARN; # Default if no loglevel file found.
|
||||
}
|
||||
|
||||
return $TraceLevel;
|
||||
}
|
||||
|
||||
@ -106,18 +103,15 @@ sub varlog {
|
||||
unless ( $rc and $rc == DECLINED or $rc == OK ) {
|
||||
# no logging plugins registered so fall back to STDERR
|
||||
warn join(" ", $$ .
|
||||
(defined $plugin ? " $plugin plugin:" :
|
||||
(defined $plugin ? " $plugin plugin ($hook):" :
|
||||
defined $hook ? " running plugin ($hook):" : ""),
|
||||
@log), "\n"
|
||||
if $trace <= $self->trace_level();
|
||||
if $trace <= $TraceLevel;
|
||||
}
|
||||
}
|
||||
|
||||
sub clear_config_cache {
|
||||
$_config_cache = {};
|
||||
for (keys %defaults) {
|
||||
$_config_cache->{$_} = [$defaults{$_}];
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
@ -133,6 +127,8 @@ sub config {
|
||||
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
|
||||
}
|
||||
|
||||
$_config_cache->{$c} = [$defaults{$c}] if exists($defaults{$c});
|
||||
|
||||
#warn "SELF->config($c) ", ref $self;
|
||||
|
||||
my ($rc, @config) = $self->run_hooks_no_respond("config", $c);
|
||||
|
@ -60,8 +60,8 @@ sub qp {
|
||||
|
||||
sub log {
|
||||
my $self = shift;
|
||||
$self->qp->varlog(shift, $self->hook_name, $self->plugin_name, @_)
|
||||
unless defined $self->hook_name and $self->hook_name eq 'logging';
|
||||
$self->{_qp}->varlog(shift, $self->{_hook}, $self->plugin_name, @_)
|
||||
unless defined $self->{_hook} and $self->{_hook} eq 'logging';
|
||||
}
|
||||
|
||||
sub transaction {
|
||||
|
@ -103,59 +103,43 @@ sub fault {
|
||||
return;
|
||||
}
|
||||
|
||||
my %cmd_cache;
|
||||
|
||||
sub process_line {
|
||||
my Qpsmtpd::PollServer $self = shift;
|
||||
my $line = shift || return;
|
||||
if ($::DEBUG > 1) { print "$$:".($self+0)."C($self->{mode}): $line"; }
|
||||
eval { $self->_process_line($line) };
|
||||
if ($@) {
|
||||
print STDERR "Error: $@\n";
|
||||
return $self->fault("command failed unexpectedly") if $self->{mode} eq 'cmd';
|
||||
return $self->fault("unknown error");
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub _process_line {
|
||||
my Qpsmtpd::PollServer $self = shift;
|
||||
my $line = shift;
|
||||
|
||||
if ($self->{mode} eq 'connect') {
|
||||
$self->{mode} = 'cmd';
|
||||
my $rc = $self->start_conversation;
|
||||
return;
|
||||
}
|
||||
elsif ($self->{mode} eq 'cmd') {
|
||||
if ($self->{mode} eq 'cmd') {
|
||||
$line =~ s/\r?\n//;
|
||||
return $self->process_cmd($line);
|
||||
my ($cmd, @params) = split(/ +/, $line, 2);
|
||||
my $meth = lc($cmd);
|
||||
if (my $lookup = $cmd_cache{$meth} || $self->{_commands}->{$meth} && $self->can($meth)) {
|
||||
$cmd_cache{$meth} = $lookup;
|
||||
eval {
|
||||
$lookup->($self, @params);
|
||||
};
|
||||
if ($@) {
|
||||
my $error = $@;
|
||||
chomp($error);
|
||||
$self->log(LOGERROR, "Command Error: $error");
|
||||
$self->fault("command '$cmd' failed unexpectedly");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# No such method - i.e. unrecognized command
|
||||
my ($rc, $msg) = $self->run_hooks("unrecognized_command", $meth, @params);
|
||||
}
|
||||
}
|
||||
elsif ($self->{mode} eq 'connect') {
|
||||
$self->{mode} = 'cmd';
|
||||
# I've removed an eval{} from around this. It shouldn't ever die()
|
||||
# but if it does we're a bit screwed... Ah well :-)
|
||||
$self->start_conversation;
|
||||
}
|
||||
else {
|
||||
die "Unknown mode";
|
||||
}
|
||||
}
|
||||
|
||||
sub process_cmd {
|
||||
my Qpsmtpd::PollServer $self = shift;
|
||||
my $line = shift;
|
||||
my ($cmd, @params) = split(/ +/, $line, 2);
|
||||
my $meth = lc($cmd);
|
||||
if (my $lookup = $self->{_commands}->{$meth} && $self->can($meth)) {
|
||||
my $resp = eval {
|
||||
$lookup->($self, @params);
|
||||
};
|
||||
if ($@) {
|
||||
my $error = $@;
|
||||
chomp($error);
|
||||
$self->log(LOGERROR, "Command Error: $error");
|
||||
return $self->fault("command '$cmd' failed unexpectedly");
|
||||
}
|
||||
return $resp;
|
||||
}
|
||||
else {
|
||||
# No such method - i.e. unrecognized command
|
||||
my ($rc, $msg) = $self->run_hooks("unrecognized_command", $meth, @params);
|
||||
return 1;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub disconnect {
|
||||
|
Loading…
Reference in New Issue
Block a user