#!/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}} ) {
      next unless scalar @$row; # skip over empty log lines
      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; # skip over empty log lines
      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