Add plugable logging support include sample plugin which replicates the

existing core code.  Add OK hook.

*  lib/Qpsmtpd.pm
   (init_logger): replaced with log_level()
   (load_logging): NEW - load logging plugins without calling log()
   (log_level): NEW - set/get global $LogLevel scalar
   (log): now just a wrapper for varlog(); called only by core code
   (varlog): initializes logging if not already done, calls logging plugins
     in turn and falls back to interal logging unless plugins OK or DECLINED
   (_load_plugins): only display "Loading plugin" when actually loading one
   (run_hooks): load logging plugins without calling log(); add OK hook as
     else of the DENY* case
   (spool_dir): use global $Spool_dir scalar to cache location

*  lib/Qpsmtpd/Plugin.pm
   (%hooks): add "logging" and "ok"
   (register_hook): add local _hook to object cache
   (log): call varlog() with additional parameters hook and plugin_name
     except for logging hook
   (compile): add accessor sub for local _hook scalar

*  lib/Qpsmtpd/SMTP.pm
   (mail, rcpt): change loglevel to LOGALERT instead of LOGWARN for from/to

*  qpsmtpd-forkserver
   (REAPER): use package ::log() instead of warn()
   (main): defer calling log until $plugin_loader has been initialized
   (log): call logging using the $plugin_loader object

*  plugins/logging/warn
   NEW: sample plugin which replicates the core logging functionality

*  plugins/logging/devnull
   NEW: sample plugin which logs nothing (for testing multiple logging
     plugin functionality)

*  config.sample/logging
   sample configuration file for logging plugins

*  plugins/virus/uvscan
   plugins/virus/clamav
   Increase loglevel for non-serious warnings to LOGWARN from LOGERROR


git-svn-id: https://svn.perl.org/qpsmtpd/trunk@398 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
John Peacock 2005-03-24 21:16:35 +00:00
parent aef508cb7b
commit e331f6b248
9 changed files with 189 additions and 77 deletions

1
config.sample/logging Normal file
View File

@ -0,0 +1 @@
logging/warn 9

View File

@ -1,37 +1,85 @@
package Qpsmtpd;
use strict;
use vars qw($VERSION $LogLevel);
use vars qw($VERSION $Logger $LogLevel $Spool_dir);
use Sys::Hostname;
use Qpsmtpd::Constants;
$VERSION = "0.30-dev";
sub TRACE_LEVEL { $LogLevel }
sub version { $VERSION };
sub init_logger {
my $self = shift;
# Get the loglevel - we localise loglevel to zero while we do this
my $loglevel = do {
local $LogLevel = 0;
$self->config("loglevel");
};
if (defined($loglevel) and $loglevel =~ /^\d+$/) {
$LogLevel = $loglevel;
}
else {
$LogLevel = LOGWARN; # Default if no loglevel file found.
}
return $LogLevel;
sub TRACE_LEVEL { log_level(); }; # leave for plugin compatibility
sub load_logging {
# need to do this differently that other plugins so as to
# not trigger logging activity
my $self = shift;
return if $self->{hooks}->{"logging"};
my $configdir = $self->config_dir("logging");
my $configfile = "$configdir/logging";
my @loggers = $self->_config_from_file($configfile,'logging');
my $dir = $self->plugin_dir;
$self->_load_plugins($dir, @loggers);
foreach my $logger (@loggers) {
$self->log(LOGINFO, "Loaded $logger");
}
return @loggers;
}
sub log_level {
my $self = shift;
return $LogLevel if $LogLevel;
my $configdir = $self->config_dir("loglevel");
my $configfile = "$configdir/loglevel";
my ($loglevel) = $self->_config_from_file($configfile,'loglevel');
if (defined($loglevel) and $loglevel =~ /^\d+$/) {
$LogLevel = $loglevel;
}
else {
$LogLevel = LOGWARN; # Default if no loglevel file found.
}
$self->log(LOGINFO, "Loaded default logger");
return $LogLevel;
}
sub log {
my ($self, $trace, @log) = @_;
my $level = TRACE_LEVEL();
$level = $self->init_logger unless defined $level;
warn join(" ", $$, @log), "\n"
if $trace <= $level;
$self->varlog($trace,join(" ",@log));
}
sub varlog {
my ($self, $trace) = (shift,shift);
my ($hook, $plugin, @log);
if ( $#_ == 0 ) { # log itself
(@log) = @_;
}
elsif ( $#_ == 1 ) { # plus the hook
($hook, @log) = @_;
}
else { # called from plugin
($hook, $plugin, @log) = @_;
}
$self->load_logging; # in case we already don't have this loaded yet
my ($rc) = $self->run_hooks("logging", $trace, $hook, $plugin, @log);
unless ( $rc and $rc == DECLINED or $rc == OK ) {
# no logging plugins registered so fall back to STDERR
warn join(" ", $$ .
(defined $plugin ? " $plugin plugin:" :
defined $hook ? " running plugin ($hook):" : ""),
@log), "\n"
if $trace <= $self->log_level();
}
}
#
@ -141,9 +189,8 @@ sub _load_plugins {
my ($dir, @plugins) = @_;
my @ret;
for my $plugin (@plugins) {
$self->log(LOGDEBUG, "Loading $plugin");
($plugin, my @args) = split /\s+/, $plugin;
for my $plugin_line (@plugins) {
my ($plugin, @args) = split /\s+/, $plugin_line;
if (lc($plugin) eq '$include') {
my $inc = shift @args;
@ -184,8 +231,12 @@ sub _load_plugins {
my $package = "Qpsmtpd::Plugin::$plugin_name";
# don't reload plugins if they are already loaded
Qpsmtpd::Plugin->compile($plugin_name, $package, "$dir/$plugin", $self->{_test_mode}) unless
defined &{"${package}::register"};
unless ( defined &{"${package}::register"} ) {
Qpsmtpd::Plugin->compile($plugin_name,
$package, "$dir/$plugin", $self->{_test_mode});
$self->log(LOGDEBUG, "Loading $plugin_line")
unless $plugin_line =~ /logging/;
}
my $plug = $package->new();
push @ret, $plug;
@ -206,32 +257,43 @@ sub run_hooks {
if ($hooks->{$hook}) {
my @r;
for my $code (@{$hooks->{$hook}}) {
$self->log(LOGINFO, "running plugin ($hook):", $code->{name});
eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
$@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
if ( $hook eq 'logging' ) { # without calling $self->log()
eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
$@ and warn("FATAL LOGGING PLUGIN ERROR: ", $@) and next;
}
else {
$self->varlog(LOGINFO, $hook, $code->{name});
eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
$@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
!defined $r[0]
and $self->log(LOGERROR, "plugin ".$code->{name}
."running the $hook hook returned undef!")
!defined $r[0]
and $self->log(LOGERROR, "plugin ".$code->{name}
." running the $hook hook returned undef!")
and next;
if ($self->transaction) {
my $tnotes = $self->transaction->notes( $code->{name} );
$tnotes->{"hook_$hook"}->{'return'} = $r[0]
if (!defined $tnotes || ref $tnotes eq "HASH");
} else {
my $cnotes = $self->connection->notes( $code->{name} );
$cnotes->{"hook_$hook"}->{'return'} = $r[0]
if (!defined $cnotes || ref $cnotes eq "HASH");
}
if ($self->transaction) {
my $tnotes = $self->transaction->notes( $code->{name} );
$tnotes->{"hook_$hook"}->{'return'} = $r[0]
if (!defined $tnotes || ref $tnotes eq "HASH");
} else {
my $cnotes = $self->connection->notes( $code->{name} );
$cnotes->{"hook_$hook"}->{'return'} = $r[0]
if (!defined $cnotes || ref $cnotes eq "HASH");
}
# should we have a hook for "OK" too?
if ($r[0] == DENY or $r[0] == DENYSOFT or
$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->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->run_hooks("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
}
# should we have a hook for "OK" too?
if ($r[0] == DENY or $r[0] == DENYSOFT or
$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->run_hooks("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny");
}
last unless $r[0] == DECLINED;
@ -255,35 +317,33 @@ sub _register_hook {
}
}
my $spool_dir = "";
sub spool_dir {
my $self = shift;
unless ( $spool_dir ) { # first time through
unless ( $Spool_dir ) { # first time through
$self->log(LOGINFO, "Initializing spool_dir");
$spool_dir = $self->config('spool_dir')
$Spool_dir = $self->config('spool_dir')
|| Qpsmtpd::Utils::tildeexp('~/tmp/');
$spool_dir .= "/" unless ($spool_dir =~ m!/$!);
$Spool_dir .= "/" unless ($Spool_dir =~ m!/$!);
$spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly";
$spool_dir = $1; # cleanse the taint
$Spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly";
$Spool_dir = $1; # cleanse the taint
# Make sure the spool dir has appropriate rights
if (-e $spool_dir) {
my $mode = (stat($spool_dir))[2];
if (-e $Spool_dir) {
my $mode = (stat($Spool_dir))[2];
$self->log(LOGWARN,
"Permissions on spool_dir $spool_dir are not 0700")
"Permissions on spool_dir $Spool_dir are not 0700")
if $mode & 07077;
}
# And finally, create it if it doesn't already exist
-d $spool_dir or mkdir($spool_dir, 0700)
or die "Could not create spool_dir $spool_dir: $!";
}
-d $Spool_dir or mkdir($Spool_dir, 0700)
or die "Could not create spool_dir $Spool_dir: $!";
}
return $spool_dir;
return $Spool_dir;
}
# For unique filenames. We write to a local tmp dir so we don't need

View File

@ -5,7 +5,7 @@ our %hooks = map { $_ => 1 } qw(
config queue data data_post quit rcpt mail ehlo helo
auth auth-plain auth-login auth-cram-md5
connect reset_transaction unrecognized_command disconnect
deny
deny logging ok
);
sub new {
@ -21,7 +21,7 @@ sub register_hook {
# 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.
$plugin->qp->_register_hook($hook, { code => sub { local $plugin->{_qp} = shift; $plugin->$method(@_) },
$plugin->qp->_register_hook($hook, { code => sub { local $plugin->{_qp} = shift; local $plugin->{_hook} = $hook; $plugin->$method(@_) },
name => $plugin->plugin_name,
},
$unshift,
@ -41,7 +41,8 @@ sub qp {
sub log {
my $self = shift;
$self->qp->log(shift, $self->plugin_name . " plugin: " . shift, @_);
$self->qp->varlog(shift, $self->hook_name, $self->plugin_name, @_)
unless defined $self->hook_name and $self->hook_name eq 'logging';
}
sub transaction {
@ -124,6 +125,7 @@ sub compile {
'@ISA = qw(Qpsmtpd::Plugin);',
($test_mode ? 'use Test::More;' : ''),
"sub plugin_name { qq[$plugin] }",
"sub hook_name { return shift->{_hook}; }",
$line,
$sub,
"\n", # last line comment without newline?

View File

@ -239,7 +239,7 @@ sub mail {
($from) = "<" . ($from_parameter =~ m/^from:\s*(\S+)/i)[0] . ">"
unless $from;
$self->log(LOGWARN, "from email address : [$from]");
$self->log(LOGALERT, "from email address : [$from]");
if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<#@[]>") {
$from = Qpsmtpd::Address->new("<>");
@ -290,7 +290,7 @@ sub rcpt {
my ($rcpt) = ($_[0] =~ m/to:(.*)/i)[0];
$rcpt = $_[1] unless $rcpt;
$self->log(LOGWARN, "to email address : [$rcpt]");
$self->log(LOGALERT, "to email address : [$rcpt]");
$rcpt = (Qpsmtpd::Address->parse($rcpt))[0];
return $self->respond(501, "could not parse recipient") unless $rcpt;

13
plugins/logging/devnull Normal file
View File

@ -0,0 +1,13 @@
#!/usr/bin/perl
# this is a simple 'drop packets on the floor' plugin
sub register {
my $self = shift;
$self->register_hook('logging', 'wlog');
}
sub wlog {
return DECLINED;
}

38
plugins/logging/warn Normal file
View File

@ -0,0 +1,38 @@
#!/usr/bin/perl
# this is a simple 'warn' plugin like the default builtin logging
#
# It demonstrates that a logging plugin can call ->log itself as well
# as how to ignore log entries from itself
sub register {
my ($self, $qp, $loglevel) = @_;
$self->{_level} = LOGWARN;
if (defined($loglevel) and ($loglevel =~ /^\d+$/)) {
$self->{_level} = $loglevel;
}
$self->register_hook('logging', 'wlog');
# 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::warn 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;
warn
join(" ", $$ .
(defined $plugin ? " $plugin plugin:" :
defined $hook ? " running plugin ($hook):" : ""),
@log), "\n"
if ($trace <= $self->{_level});
return DECLINED;
}

View File

@ -163,7 +163,7 @@ sub clam_scan {
my $filename = $transaction->body_filename;
unless (defined $filename) {
$self->log(LOGERROR, "didn't get a filename");
$self->log(LOGWARN, "didn't get a filename");
return DECLINED;
}
my $mode = (stat($self->{_spool_dir}))[2];

View File

@ -64,7 +64,7 @@ sub uvscan {
unless ( $content_type
&& $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i )
{
$self->log( LOGERROR, "non-multipart mail - skipping" );
$self->log( LOGWARN, "non-multipart mail - skipping" );
return DECLINED;
}

View File

@ -57,7 +57,7 @@ sub REAPER {
$SIG{CHLD} = \&REAPER;
while ( defined(my $chld = waitpid(-1, WNOHANG)) ){
last unless $chld > 0;
warn("$$ cleaning up after $chld\n");
::log(LOGINFO,"cleaning up after $chld");
delete $childstatus{$chld};
}
}
@ -79,7 +79,6 @@ my $server = IO::Socket::INET->new(LocalPort => $PORT,
Reuse => 1,
Listen => SOMAXCONN )
or die "Creating TCP socket $LOCALADDR:$PORT: $!\n";
::log(LOGINFO,"Listening on port $PORT");
# Drop priviledges
my (undef, undef, $quid, $qgid) = getpwnam $USER or
@ -91,15 +90,15 @@ POSIX::setuid($quid) or
die "unable to change uid: $!\n";
$> = $quid;
::log(LOGINFO, 'Running as user '.
(getpwuid($>) || $>) .
', group '.
(getgrgid($)) || $)));
# Load plugins here
my $plugin_loader = Qpsmtpd::TcpServer->new();
$plugin_loader->load_plugins;
::log(LOGINFO,"Listening on port $PORT");
::log(LOGINFO, 'Running as user '.
(getpwuid($>) || $>) .
', group '.
(getgrgid($)) || $)));
while (1) {
my $running = scalar keys %childstatus;
@ -189,8 +188,7 @@ while (1) {
sub log {
my ($level,$message) = @_;
# $level not used yet. this is reimplemented from elsewhere anyway
warn("$$ $message\n");
$plugin_loader->log($level,$message);
}
__END__