byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Revamp Qpsmtpd::Constants so it is possible to retrieve the text

Browse Source 
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:
John Peacock 2005-03-29 20:15:53 +00:00
parent 172fee0798
commit 89fd516d8e
6 changed files with 360 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
README.logging Normal file
View 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.

17
config.sample/loglevel
View File

@ -1,11 +1,10 @@
# Log levels # Log levels
# LOGDEBUG = 8 # LOGDEBUG = 7
# LOGINFO = 7 # LOGINFO = 6
# LOGNOTICE = 6 # LOGNOTICE = 5
# LOGWARN = 5 # LOGWARN = 4
# LOGERROR = 4 # LOGERROR = 3
# LOGCRIT = 3 # LOGCRIT = 2
# LOGALERT = 2 # LOGALERT = 1
# LOGEMERG = 1 # LOGEMERG = 0
# LOGRADAR = 0
4 4

28
lib/Qpsmtpd.pm
View File

@ -1,6 +1,6 @@
package Qpsmtpd; package Qpsmtpd;
use strict; use strict;
use vars qw($VERSION $Logger $LogLevel $Spool_dir); use vars qw($VERSION $Logger $TraceLevel $Spool_dir);
use Sys::Hostname; use Sys::Hostname;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
@ -9,7 +9,7 @@ $VERSION = "0.30-dev";
sub version { $VERSION }; sub version { $VERSION };
sub TRACE_LEVEL { log_level(); }; # leave for plugin compatibility sub TRACE_LEVEL { trace_level(); }; # leave for plugin compatibility
sub load_logging { sub load_logging {
# need to do this differently that other plugins so as to # need to do this differently that other plugins so as to
@ -30,24 +30,24 @@ sub load_logging {
return @loggers; return @loggers;
} }
sub log_level { sub trace_level {
my $self = shift; my $self = shift;
return $LogLevel if $LogLevel; return $TraceLevel if $TraceLevel;
my $configdir = $self->config_dir("loglevel"); my $configdir = $self->config_dir("loglevel");
my $configfile = "$configdir/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+$/) { if (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
$LogLevel = $loglevel; $TraceLevel = $TraceLevel;
} }
else { else {
$LogLevel = LOGWARN; # Default if no loglevel file found. $TraceLevel = LOGWARN; # Default if no loglevel file found.
} }
$self->log(LOGINFO, "Loaded default logger"); $self->log(LOGINFO, "Loaded default logger");
return $LogLevel; return $TraceLevel;
} }
sub log { sub log {
@ -78,7 +78,7 @@ sub varlog {
(defined $plugin ? " $plugin plugin:" : (defined $plugin ? " $plugin plugin:" :
defined $hook ? " running plugin ($hook):" : ""), defined $hook ? " running plugin ($hook):" : ""),
@log), "\n" @log), "\n"
if $trace <= $self->log_level(); if $trace <= $self->trace_level();
} }
} }
@ -171,7 +171,7 @@ sub _config_from_file {
sub load_plugins { sub load_plugins {
my $self = shift; my $self = shift;
$self->log(LOGERROR, "Plugins already loaded") if $self->{hooks}; $self->log(LOGWARN, "Plugins already loaded") if $self->{hooks};
$self->{hooks} = {}; $self->{hooks} = {};
my @plugins = $self->config('plugins'); my @plugins = $self->config('plugins');
@ -286,11 +286,13 @@ sub run_hooks {
$r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT) $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}.", 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"); $self->run_hooks("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}.", 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"); $self->run_hooks("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
} }

88
lib/Qpsmtpd/Constants.pm
View File

@ -2,39 +2,69 @@ package Qpsmtpd::Constants;
use strict; use strict;
require Exporter; 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 # log levels
use constant LOGDEBUG => 8; my %log_levels = (
use constant LOGINFO => 7; LOGDEBUG => 7,
use constant LOGNOTICE => 6; LOGINFO => 6,
use constant LOGWARN => 5; LOGNOTICE => 5,
use constant LOGERROR => 4; LOGWARN => 4,
use constant LOGCRIT => 3; LOGERROR => 3,
use constant LOGALERT => 2; LOGCRIT => 2,
use constant LOGEMERG => 1; LOGALERT => 1,
use constant LOGRADAR => 0; 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; 1;
=head1 NAME =head1 NAME
Qpsmtpd::Constants - Constants for plugins to use Qpsmtpd::Constants - Constants for plugins to use

160
plugins/logging/adaptive Normal file
View 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

45
plugins/logging/warn
View File

@ -8,8 +8,13 @@ sub register {
my ($self, $qp, $loglevel) = @_; my ($self, $qp, $loglevel) = @_;
$self->{_level} = LOGWARN; $self->{_level} = LOGWARN;
if (defined($loglevel) and ($loglevel =~ /^\d+$/)) { if ( defined($loglevel) ) {
$self->{_level} = $loglevel; if ($loglevel =~ /^\d+$/) {
$self->{_level} = $loglevel;
}
else {
$self->{_level} = log_level($loglevel);
}
} }
$self->register_hook('logging', 'wlog'); $self->register_hook('logging', 'wlog');
@ -36,3 +41,39 @@ sub wlog {
return DECLINED; 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