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
parent
aef508cb7b
commit
e331f6b248
1
config.sample/logging
Normal file
1
config.sample/logging
Normal file
@ -0,0 +1 @@
|
||||
logging/warn 9
|
||||
126
lib/Qpsmtpd.pm
126
lib/Qpsmtpd.pm
@ -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 {
|
||||
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;
|
||||
# Get the loglevel - we localise loglevel to zero while we do this
|
||||
my $loglevel = do {
|
||||
local $LogLevel = 0;
|
||||
$self->config("loglevel");
|
||||
};
|
||||
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,13 +257,18 @@ sub run_hooks {
|
||||
if ($hooks->{$hook}) {
|
||||
my @r;
|
||||
for my $code (@{$hooks->{$hook}}) {
|
||||
$self->log(LOGINFO, "running plugin ($hook):", $code->{name});
|
||||
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!")
|
||||
." running the $hook hook returned undef!")
|
||||
and next;
|
||||
|
||||
if ($self->transaction) {
|
||||
@ -230,8 +286,14 @@ 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 $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");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
@ -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?
|
||||
|
||||
@ -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
13
plugins/logging/devnull
Normal 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
38
plugins/logging/warn
Normal 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;
|
||||
}
|
||||
|
||||
@ -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];
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
|
||||
@ -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__
|
||||
|
||||
Loading…
Reference in New Issue
Block a user