Revamp Qpsmtpd::Constants so it is possible to retrieve the text
representation from the numeric (for logging purposes). Add new logging plugin, logging/adaptive, which logs at different levels depending on whether the message was accepted/rejected. * lib/Qpsmtpd/Constants.pm use hashes for storing return_codes and log_levels export accessor methods to retrieve the text representations * lib/Qpsmtpd.pm Rename log_level() to trace_level() so as to not conflict with the same name in Qpsmtpd::Constants. Call return_code() to display the text form when logging * plugins/logging/adaptive Better documentation Support named parameters and prefix Call return_code() to display the text form when logging * plugins/logging/warn Include POD * README.logging First pass at documenting the logging plugin API * config.sample/loglevel New numbering scheme to map directly to syslog levels git-svn-id: https://svn.perl.org/qpsmtpd/trunk@401 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
parent
172fee0798
commit
89fd516d8e
74
README.logging
Normal file
74
README.logging
Normal file
@ -0,0 +1,74 @@
|
||||
#
|
||||
# read this with 'perldoc README.logging' ...
|
||||
#
|
||||
|
||||
=head1 qpsmtpd logging system; developer documentation
|
||||
|
||||
Qpsmtpd now (as of 0.30-dev) supports a plugable logging architecture, so
|
||||
that different logging plugins can be supported. See the example logging
|
||||
plugins in plugins/logging, specifically the L<plugins/logging/warn> and
|
||||
L<plugins/logging/adaptive> files for examples of how to write your own
|
||||
logging plugins.
|
||||
|
||||
=head1 Internal support for pluggable logging
|
||||
|
||||
Any code in the core can call C<$self->log()> and those log lines will be
|
||||
dispatched to each of the registered logging plugins. When C<log()> is
|
||||
called from a plugin, the plugin and hook names are automatically included
|
||||
in the parameters passed the logging hooks. All plugins which register for
|
||||
the logging hook should expect the following parameters to be passed:
|
||||
|
||||
$self, $transaction, $trace, $hook, $plugin, @log
|
||||
|
||||
where those terms are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item C<$self>
|
||||
|
||||
The object which was used to call the log() method; this can be any object
|
||||
within the system, since the core code will automatically load logging
|
||||
plugins on behalf of any object.
|
||||
|
||||
=item C<$transaction>
|
||||
|
||||
This is the current SMTP transaction (defined as everything that happens
|
||||
between HELO/EHLO and QUIT/RSET). If you want to defer outputting certain
|
||||
log lines, you can store them in the transaction object, but you will need
|
||||
to bind the C<reset_transaction> hook in order to retrieve that information
|
||||
before it is discarded when the transaction is closed (see the
|
||||
L<logging/adaptive> plugin for an example of doing this).
|
||||
|
||||
=item C<$trace>
|
||||
|
||||
This is the log level (as shown in config.sample/loglevel) that the caller
|
||||
asserted when calling log(). If you want to output the textural
|
||||
representation (e.g. C<LOGERROR>) of this in your log messages, you can use
|
||||
the log_level() function exported by Qpsmtpd::Constants (which is
|
||||
automatically available to all plugins).
|
||||
|
||||
=item C<$hook>
|
||||
|
||||
This is the hook that is currently being executed. If log() is called by
|
||||
any core code (i.e. not as part of a hook), this term will be C<undef>.
|
||||
|
||||
=item C<$plugin>
|
||||
|
||||
This is the plugin name that executed the log(). Like C<$hook>, if part of
|
||||
the core code calls log(), this wil be C<undef>. See L<logging/warn> for a
|
||||
way to prevent logging your own plugin's log entries from within that
|
||||
plugin (the system will not infinitely recurse in any case).
|
||||
|
||||
=item C<@log>
|
||||
|
||||
The remaining arguments are as passed by the caller, which may be a single
|
||||
term or may be a list of values. It is usually sufficient to call
|
||||
C<join(" ",@log)> to deal with these terms, but it is possible that some
|
||||
plugin might pass additional arguments with signficance.
|
||||
|
||||
=back
|
||||
|
||||
Note: if you register a handler for certain hooks, e.g. C<deny>, there may
|
||||
be additional terms passed between C<$self> and C<$transaction>. See
|
||||
L<logging/adaptive> for and example.
|
||||
|
@ -1,11 +1,10 @@
|
||||
# Log levels
|
||||
# LOGDEBUG = 8
|
||||
# LOGINFO = 7
|
||||
# LOGNOTICE = 6
|
||||
# LOGWARN = 5
|
||||
# LOGERROR = 4
|
||||
# LOGCRIT = 3
|
||||
# LOGALERT = 2
|
||||
# LOGEMERG = 1
|
||||
# LOGRADAR = 0
|
||||
# LOGDEBUG = 7
|
||||
# LOGINFO = 6
|
||||
# LOGNOTICE = 5
|
||||
# LOGWARN = 4
|
||||
# LOGERROR = 3
|
||||
# LOGCRIT = 2
|
||||
# LOGALERT = 1
|
||||
# LOGEMERG = 0
|
||||
4
|
@ -1,6 +1,6 @@
|
||||
package Qpsmtpd;
|
||||
use strict;
|
||||
use vars qw($VERSION $Logger $LogLevel $Spool_dir);
|
||||
use vars qw($VERSION $Logger $TraceLevel $Spool_dir);
|
||||
|
||||
use Sys::Hostname;
|
||||
use Qpsmtpd::Constants;
|
||||
@ -9,7 +9,7 @@ $VERSION = "0.30-dev";
|
||||
|
||||
sub version { $VERSION };
|
||||
|
||||
sub TRACE_LEVEL { log_level(); }; # leave for plugin compatibility
|
||||
sub TRACE_LEVEL { trace_level(); }; # leave for plugin compatibility
|
||||
|
||||
sub load_logging {
|
||||
# need to do this differently that other plugins so as to
|
||||
@ -30,24 +30,24 @@ sub load_logging {
|
||||
return @loggers;
|
||||
}
|
||||
|
||||
sub log_level {
|
||||
sub trace_level {
|
||||
my $self = shift;
|
||||
return $LogLevel if $LogLevel;
|
||||
return $TraceLevel if $TraceLevel;
|
||||
|
||||
my $configdir = $self->config_dir("loglevel");
|
||||
my $configfile = "$configdir/loglevel";
|
||||
my ($loglevel) = $self->_config_from_file($configfile,'loglevel');
|
||||
my ($TraceLevel) = $self->_config_from_file($configfile,'loglevel');
|
||||
|
||||
if (defined($loglevel) and $loglevel =~ /^\d+$/) {
|
||||
$LogLevel = $loglevel;
|
||||
if (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
|
||||
$TraceLevel = $TraceLevel;
|
||||
}
|
||||
else {
|
||||
$LogLevel = LOGWARN; # Default if no loglevel file found.
|
||||
$TraceLevel = LOGWARN; # Default if no loglevel file found.
|
||||
}
|
||||
|
||||
$self->log(LOGINFO, "Loaded default logger");
|
||||
|
||||
return $LogLevel;
|
||||
return $TraceLevel;
|
||||
}
|
||||
|
||||
sub log {
|
||||
@ -78,7 +78,7 @@ sub varlog {
|
||||
(defined $plugin ? " $plugin plugin:" :
|
||||
defined $hook ? " running plugin ($hook):" : ""),
|
||||
@log), "\n"
|
||||
if $trace <= $self->log_level();
|
||||
if $trace <= $self->trace_level();
|
||||
}
|
||||
}
|
||||
|
||||
@ -171,7 +171,7 @@ sub _config_from_file {
|
||||
sub load_plugins {
|
||||
my $self = shift;
|
||||
|
||||
$self->log(LOGERROR, "Plugins already loaded") if $self->{hooks};
|
||||
$self->log(LOGWARN, "Plugins already loaded") if $self->{hooks};
|
||||
$self->{hooks} = {};
|
||||
|
||||
my @plugins = $self->config('plugins');
|
||||
@ -286,11 +286,13 @@ sub run_hooks {
|
||||
$r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT)
|
||||
{
|
||||
$r[1] = "" if not defined $r[1];
|
||||
$self->log(LOGDEBUG, "Plugin ".$code->{name}.", hook $hook returned $r[0], $r[1]");
|
||||
$self->log(LOGDEBUG, "Plugin ".$code->{name}.
|
||||
", hook $hook returned ".return_code($r[0]).", $r[1]");
|
||||
$self->run_hooks("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny");
|
||||
} else {
|
||||
$r[1] = "" if not defined $r[1];
|
||||
$self->log(LOGDEBUG, "Plugin ".$code->{name}.", hook $hook returned $r[0], $r[1]");
|
||||
$self->log(LOGDEBUG, "Plugin ".$code->{name}.
|
||||
", hook $hook returned ".return_code($r[0]).", $r[1]");
|
||||
$self->run_hooks("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
|
||||
}
|
||||
|
||||
|
@ -2,39 +2,69 @@ package Qpsmtpd::Constants;
|
||||
use strict;
|
||||
require Exporter;
|
||||
|
||||
my (@common) = qw(OK DECLINED DONE DENY DENYSOFT DENYHARD
|
||||
DENY_DISCONNECT DENYSOFT_DISCONNECT
|
||||
);
|
||||
my (@loglevels) = qw(LOGDEBUG LOGINFO LOGNOTICE LOGWARN LOGERROR LOGCRIT LOGALERT LOGEMERG LOGRADAR);
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT);
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = (@common, @loglevels);
|
||||
|
||||
use constant OK => 900;
|
||||
use constant DENY => 901; # 550
|
||||
use constant DENYSOFT => 902; # 450
|
||||
use constant DENYHARD => 903; # 550 + disconnect (deprecated in 0.29)
|
||||
use constant DENY_DISCONNECT => 903; # 550 + disconnect
|
||||
use constant DENYSOFT_DISCONNECT => 904; # 450 + disconnect
|
||||
use constant DECLINED => 909;
|
||||
use constant DONE => 910;
|
||||
|
||||
|
||||
# log levels
|
||||
use constant LOGDEBUG => 8;
|
||||
use constant LOGINFO => 7;
|
||||
use constant LOGNOTICE => 6;
|
||||
use constant LOGWARN => 5;
|
||||
use constant LOGERROR => 4;
|
||||
use constant LOGCRIT => 3;
|
||||
use constant LOGALERT => 2;
|
||||
use constant LOGEMERG => 1;
|
||||
use constant LOGRADAR => 0;
|
||||
my %log_levels = (
|
||||
LOGDEBUG => 7,
|
||||
LOGINFO => 6,
|
||||
LOGNOTICE => 5,
|
||||
LOGWARN => 4,
|
||||
LOGERROR => 3,
|
||||
LOGCRIT => 2,
|
||||
LOGALERT => 1,
|
||||
LOGEMERG => 0,
|
||||
LOGRADAR => 0,
|
||||
);
|
||||
|
||||
# return codes
|
||||
my %return_codes = (
|
||||
OK => 900,
|
||||
DENY => 901, # 550
|
||||
DENYSOFT => 902, # 450
|
||||
DENYHARD => 903, # 550 + disconnect (deprecated in 0.29)
|
||||
DENY_DISCONNECT => 903, # 550 + disconnect
|
||||
DENYSOFT_DISCONNECT => 904, # 450 + disconnect
|
||||
DECLINED => 909,
|
||||
DONE => 910,
|
||||
);
|
||||
|
||||
use vars qw(@ISA @EXPORT);
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = (keys(%return_codes), keys(%log_levels), "return_code", "log_level");
|
||||
|
||||
foreach (keys %return_codes ) {
|
||||
eval "use constant $_ => ".$return_codes{$_};
|
||||
}
|
||||
|
||||
foreach (keys %log_levels ) {
|
||||
eval "use constant $_ => ".$log_levels{$_};
|
||||
}
|
||||
|
||||
sub return_code {
|
||||
my $test = shift;
|
||||
if ( $test =~ /^\d+$/ ) { # need to return the textural form
|
||||
foreach ( keys %return_codes ) {
|
||||
return $_ if $return_codes{$_} =~ /$test/;
|
||||
}
|
||||
}
|
||||
else { # just return the numeric value
|
||||
return $return_codes{$test};
|
||||
}
|
||||
}
|
||||
|
||||
sub log_level {
|
||||
my $test = shift;
|
||||
if ( $test =~ /^\d+$/ ) { # need to return the textural form
|
||||
foreach ( keys %log_levels ) {
|
||||
return $_ if $log_levels{$_} =~ /$test/;
|
||||
}
|
||||
}
|
||||
else { # just return the numeric value
|
||||
return $log_levels{$test};
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Qpsmtpd::Constants - Constants for plugins to use
|
||||
|
160
plugins/logging/adaptive
Normal file
160
plugins/logging/adaptive
Normal file
@ -0,0 +1,160 @@
|
||||
#!/usr/bin/perl
|
||||
# Adaptive logging plugin - logs at one level for successful messages and
|
||||
# one level for DENY'd messages
|
||||
|
||||
sub register {
|
||||
my ($self, $qp, %args) = @_;
|
||||
|
||||
$self->{_minlevel} = LOGERROR;
|
||||
if ( defined( $args{accept} ) ) {
|
||||
if ( $args{accept} =~ /^\d+$/ ) {
|
||||
$self->{_minlevel} = $args{accept};
|
||||
}
|
||||
else {
|
||||
$self->{_minlevel} = log_level( $args{accept} );
|
||||
}
|
||||
}
|
||||
|
||||
$self->{_maxlevel} = LOGWARN;
|
||||
if ( defined( $args{reject} ) ) {
|
||||
if ( $args{reject} =~ /^\d+$/ ) {
|
||||
$self->{_maxlevel} = $args{reject};
|
||||
}
|
||||
else {
|
||||
$self->{_maxlevel} = log_level( $args{reject} );
|
||||
}
|
||||
}
|
||||
|
||||
$self->{_prefix} = '!';
|
||||
if ( defined $args{prefix} and $args{prefix} =~ /^(.+)$/ ) {
|
||||
$self->{_prefix} = $1;
|
||||
}
|
||||
|
||||
$self->register_hook('logging', 'wlog');
|
||||
$self->register_hook('deny', 'dlog');
|
||||
$self->register_hook('reset_transaction', 'slog');
|
||||
|
||||
# If you want to capture this log entry with this plugin, you need to
|
||||
# wait until after you register the plugin
|
||||
$self->log(LOGINFO,'Initializing logging::adaptive plugin');
|
||||
}
|
||||
|
||||
sub wlog {
|
||||
my ($self, $transaction, $trace, $hook, $plugin, @log) = @_;
|
||||
|
||||
# Don't log your own log entries! If this is the only logging plugin
|
||||
# then these lines will not be logged at all. You can safely comment
|
||||
# out this line and it will not cause an infinite loop.
|
||||
return DECLINED if defined $plugin and $plugin eq $self->plugin_name;
|
||||
|
||||
push @{$transaction->{_log}}, [$trace, $hook, $plugin, @log];
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub dlog {
|
||||
# fires when a message is denied
|
||||
my ($self, $transaction, $prev_hook, $return, $return_text) = @_;
|
||||
warn join(" ", $$, $self->{_prefix},
|
||||
"Plugin $prev_hook returned",
|
||||
return_code($return).
|
||||
": '$return_text'"), "\n";
|
||||
|
||||
foreach my $row ( @{$transaction->{_log}} ) {
|
||||
my ($trace, $hook, $plugin, @log) = @$row;
|
||||
if ($trace <= $self->{_maxlevel}) {
|
||||
warn
|
||||
join(" ", $$, $self->{_prefix}.
|
||||
(defined $plugin ? " $plugin plugin:" :
|
||||
defined $hook ? " running plugin ($hook):" : ""),
|
||||
@log), "\n"
|
||||
unless $log[0] =~ /logging::adaptive/;
|
||||
# consume any lines you print so that they don't also
|
||||
# show up as OK lines
|
||||
$row = [];
|
||||
}
|
||||
}
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub slog {
|
||||
# fires when a message is accepted
|
||||
my ($self, $transaction, @args) = @_;
|
||||
|
||||
foreach my $row ( @{$transaction->{_log}} ) {
|
||||
next unless scalar @$row;
|
||||
my ($trace, $hook, $plugin, @log) = @$row;
|
||||
warn
|
||||
join(" ", $$ .
|
||||
(defined $plugin ? " $plugin plugin:" :
|
||||
defined $hook ? " running plugin ($hook):" : ""),
|
||||
@log), "\n"
|
||||
if ($trace <= $self->{_minlevel});
|
||||
}
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
=cut
|
||||
|
||||
=head1 NAME
|
||||
|
||||
adaptive - An adaptive logging plugin for qpsmtpd
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A qpsmtpd plugin for logging at different levels depending on success or
|
||||
failure of any given message.
|
||||
|
||||
=head1 INSTALL AND CONFIG
|
||||
|
||||
Place this plugin in the plugin/logging directory beneath the standard
|
||||
qpsmtpd installation. Edit the config/logging file and add a line like
|
||||
this:
|
||||
|
||||
logging/adaptive [accept minlevel] [reject maxlevel] [prefix char]
|
||||
|
||||
where the optional parameters are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<accept>
|
||||
|
||||
This is the level at which messages which are accepted will be logged. You
|
||||
can use either the loglevel number (as shown in config.sample/loglevels) or
|
||||
you can use the text form (from the same file). Typically, you would set
|
||||
this to LOGERROR (4) so that the FROM and TO lines would be logged (with the
|
||||
default installation). If absent, it will be set to LOGERROR (4).
|
||||
|
||||
=item B<reject>
|
||||
|
||||
This is the level which messages which are rejected for any reason will be
|
||||
logged. This would typically be set as high as reasonable, to document why a
|
||||
message may have been rejected. If absent, it defaults to LOGWARN (5), which
|
||||
is probably not high enough for most sites.
|
||||
|
||||
=item B<prefix>
|
||||
|
||||
In order to visually distinguish the accepted from rejected lines, all
|
||||
log lines from a rejected message will be prefixed with the character
|
||||
listed here (directly after the PID). You can use anything you want as
|
||||
a prefix, but it is recommended that it be short (preferably just a single
|
||||
character) to minimize the amount of bloat in the log file. If absent, the
|
||||
prefix defaults to the exclamation point (!).
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
John Peacock <jpeacock@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (c) 2005 John Peacock
|
||||
|
||||
This plugin is licensed under the same terms as the qpsmtpd package itself.
|
||||
Please see the LICENSE file included with qpsmtpd for details.
|
||||
|
||||
=cut
|
||||
|
@ -8,9 +8,14 @@ sub register {
|
||||
my ($self, $qp, $loglevel) = @_;
|
||||
|
||||
$self->{_level} = LOGWARN;
|
||||
if (defined($loglevel) and ($loglevel =~ /^\d+$/)) {
|
||||
if ( defined($loglevel) ) {
|
||||
if ($loglevel =~ /^\d+$/) {
|
||||
$self->{_level} = $loglevel;
|
||||
}
|
||||
else {
|
||||
$self->{_level} = log_level($loglevel);
|
||||
}
|
||||
}
|
||||
$self->register_hook('logging', 'wlog');
|
||||
|
||||
# If you want to capture this log entry with this plugin, you need to
|
||||
@ -36,3 +41,39 @@ sub wlog {
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
=cut
|
||||
|
||||
=head1 NAME
|
||||
|
||||
warn - Default logging plugin for qpsmtpd
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A qpsmtpd plugin which replicates the built in logging functionality, which
|
||||
is to send all logging messages to STDERR below a specific log level.
|
||||
|
||||
=head1 INSTALL AND CONFIG
|
||||
|
||||
Place this plugin in the plugin/logging directory beneath the standard
|
||||
qpsmtpd installation. Edit the config/logging file and add a line like
|
||||
this:
|
||||
|
||||
logging/warn [loglevel]
|
||||
|
||||
where the optional parameters C<loglevel> is either the numeric or text
|
||||
representation of the maximum log level, as shown in the
|
||||
L<config.sample/loglevel> file.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
John Peacock <jpeacock@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (c) 2005 John Peacock
|
||||
|
||||
This plugin is licensed under the same terms as the qpsmtpd package itself.
|
||||
Please see the LICENSE file included with qpsmtpd for details.
|
||||
|
||||
=cut
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user