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

[email protected] 29 Mar 2005 20:15:53 -0000
Newsgroups perl.cvs.qpsmtpd
Message-ID <[email protected]>
Author: jpeacock
Date: Tue Mar 29 12:15:53 2005
New Revision: 401

Added:
   trunk/README.logging
   trunk/plugins/logging/adaptive
Modified:
   trunk/   (props changed)
   trunk/config.sample/loglevel
   trunk/lib/Qpsmtpd.pm
   trunk/lib/Qpsmtpd/Constants.pm
   trunk/plugins/logging/warn
Log:
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


Added: trunk/README.logging
==============================================================================
--- (empty file)
+++ trunk/README.logging	Tue Mar 29 12:15:53 2005
@@ -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.
+

Modified: trunk/config.sample/loglevel
==============================================================================
--- trunk/config.sample/loglevel	(original)
+++ trunk/config.sample/loglevel	Tue Mar 29 12:15:53 2005
@@ -1,11 +1,10 @@
 # Log levels
-# LOGDEBUG   = 8
-# LOGINFO    = 7
-# LOGNOTICE  = 6
-# LOGWARN    = 5
-# LOGERROR   = 4
-# LOGCRIT    = 3
-# LOGALERT   = 2
-# LOGEMERG   = 1
-# LOGRADAR   = 0
-4
\ No newline at end of file
+# LOGDEBUG   = 7
+# LOGINFO    = 6
+# LOGNOTICE  = 5
+# LOGWARN    = 4
+# LOGERROR   = 3
+# LOGCRIT    = 2
+# LOGALERT   = 1
+# LOGEMERG   = 0
+4

Modified: trunk/lib/Qpsmtpd.pm
==============================================================================
--- trunk/lib/Qpsmtpd.pm	(original)
+++ trunk/lib/Qpsmtpd.pm	Tue Mar 29 12:15:53 2005
@@ -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 @@
 
 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 @@
   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 @@
       (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 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 @@
             $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");
 	}
 

Modified: trunk/lib/Qpsmtpd/Constants.pm
==============================================================================
--- trunk/lib/Qpsmtpd/Constants.pm	(original)
+++ trunk/lib/Qpsmtpd/Constants.pm	Tue Mar 29 12:15:53 2005
@@ -2,39 +2,69 @@
 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

Added: trunk/plugins/logging/adaptive
==============================================================================
--- (empty file)
+++ trunk/plugins/logging/adaptive	Tue Mar 29 12:15:53 2005
@@ -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 <[email protected]>
+
+=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
+

Modified: trunk/plugins/logging/warn
==============================================================================
--- trunk/plugins/logging/warn	(original)
+++ trunk/plugins/logging/warn	Tue Mar 29 12:15:53 2005
@@ -8,8 +8,13 @@
   my ($self, $qp, $loglevel) = @_;
 
   $self->{_level} = LOGWARN;
-  if (defined($loglevel) and ($loglevel =~ /^\d+$/)) {
-      $self->{_level} = $loglevel;
+  if ( defined($loglevel) ) {
+      if ($loglevel =~ /^\d+$/) {
+	  $self->{_level} = $loglevel;
+      }
+      else {
+	  $self->{_level} = log_level($loglevel);
+      }
   }
   $self->register_hook('logging', 'wlog');
 
@@ -36,3 +41,39 @@
   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 <[email protected]>
+
+=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
+