[svn:qpsmtpd] rev 398 - in trunk: . config.sample lib lib/Qpsmtpd plugins/logging plugins/virus

[email protected] 24 Mar 2005 21:16:35 -0000
Newsgroups perl.cvs.qpsmtpd
Message-ID <[email protected]>
Author: jpeacock
Date: Thu Mar 24 13:16:35 2005
New Revision: 398

Added:
   trunk/config.sample/logging
   trunk/plugins/logging/
   trunk/plugins/logging/devnull
   trunk/plugins/logging/warn
Modified:
   trunk/   (props changed)
   trunk/lib/Qpsmtpd.pm
   trunk/lib/Qpsmtpd/Plugin.pm
   trunk/lib/Qpsmtpd/SMTP.pm
   trunk/plugins/virus/clamav
   trunk/plugins/virus/uvscan
   trunk/qpsmtpd-forkserver
Log:
1

Added: trunk/config.sample/logging
==============================================================================
--- (empty file)
+++ trunk/config.sample/logging	Thu Mar 24 13:16:35 2005
@@ -0,0 +1 @@
+logging/warn 9

Modified: trunk/lib/Qpsmtpd.pm
==============================================================================
--- trunk/lib/Qpsmtpd.pm	(original)
+++ trunk/lib/Qpsmtpd.pm	Thu Mar 24 13:16:35 2005
@@ -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 @@
   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 @@
     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 @@
   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;
-
-      !defined $r[0]
-        and $self->log(LOGERROR, "plugin ".$code->{name}
-                       ."running the $hook hook returned undef!")
+      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!")
           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 @@
   }
 }
 
-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

Modified: trunk/lib/Qpsmtpd/Plugin.pm
==============================================================================
--- trunk/lib/Qpsmtpd/Plugin.pm	(original)
+++ trunk/lib/Qpsmtpd/Plugin.pm	Thu Mar 24 13:16:35 2005
@@ -5,7 +5,7 @@
     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 @@
 
   # 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 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 @@
 		    '@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?

Modified: trunk/lib/Qpsmtpd/SMTP.pm
==============================================================================
--- trunk/lib/Qpsmtpd/SMTP.pm	(original)
+++ trunk/lib/Qpsmtpd/SMTP.pm	Thu Mar 24 13:16:35 2005
@@ -239,7 +239,7 @@
     ($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 @@
 
   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;

Added: trunk/plugins/logging/devnull
==============================================================================
--- (empty file)
+++ trunk/plugins/logging/devnull	Thu Mar 24 13:16:35 2005
@@ -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;
+}
+

Added: trunk/plugins/logging/warn
==============================================================================
--- (empty file)
+++ trunk/plugins/logging/warn	Thu Mar 24 13:16:35 2005
@@ -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;
+}
+

Modified: trunk/plugins/virus/clamav
==============================================================================
--- trunk/plugins/virus/clamav	(original)
+++ trunk/plugins/virus/clamav	Thu Mar 24 13:16:35 2005
@@ -163,7 +163,7 @@
 
   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];

Modified: trunk/plugins/virus/uvscan
==============================================================================
--- trunk/plugins/virus/uvscan	(original)
+++ trunk/plugins/virus/uvscan	Thu Mar 24 13:16:35 2005
@@ -64,7 +64,7 @@
   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;
   }
 

Modified: trunk/qpsmtpd-forkserver
==============================================================================
--- trunk/qpsmtpd-forkserver	(original)
+++ trunk/qpsmtpd-forkserver	Thu Mar 24 13:16:35 2005
@@ -57,7 +57,7 @@
   $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 @@
                                    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 @@
       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 @@
 
 sub log {
   my ($level,$message) = @_;
-  # $level not used yet.  this is reimplemented from elsewhere anyway
-  warn("$$ $message\n");
+  $plugin_loader->log($level,$message);
 }
 
 __END__