New for 0.28: Log levels and $Include for config/plugins
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@217 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant
parent
f59721ed1b
commit
9c700b18e1
11
config.sample/loglevel
Normal file
11
config.sample/loglevel
Normal file
@ -0,0 +1,11 @@
|
||||
# Log levels
|
||||
# LOGDEBUG = 8
|
||||
# LOGINFO = 7
|
||||
# LOGNOTICE = 6
|
||||
# LOGWARN = 5
|
||||
# LOGERROR = 4
|
||||
# LOGCRIT = 3
|
||||
# LOGALERT = 2
|
||||
# LOGEMERG = 1
|
||||
# LOGRADAR = 0
|
||||
4
|
||||
@ -1,20 +1,39 @@
|
||||
package Qpsmtpd;
|
||||
use strict;
|
||||
|
||||
$Qpsmtpd::VERSION = "0.28-dev";
|
||||
sub TRACE_LEVEL () { 6 }
|
||||
use vars qw($VERSION $LogLevel);
|
||||
|
||||
use Sys::Hostname;
|
||||
use Qpsmtpd::Constants;
|
||||
|
||||
sub version { $Qpsmtpd::VERSION };
|
||||
$VERSION = "0.28-dev";
|
||||
sub TRACE_LEVEL { $LogLevel }
|
||||
|
||||
sub version { $VERSION };
|
||||
|
||||
$Qpsmtpd::_hooks = {};
|
||||
|
||||
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 log {
|
||||
my ($self, $trace, @log) = @_;
|
||||
my $level = TRACE_LEVEL();
|
||||
$level = $self->init_logger unless defined $level;
|
||||
warn join(" ", $$, @log), "\n"
|
||||
if $trace <= TRACE_LEVEL;
|
||||
if $trace <= $level;
|
||||
}
|
||||
|
||||
|
||||
@ -49,7 +68,7 @@ sub config {
|
||||
|
||||
sub get_qmail_config {
|
||||
my ($self, $config, $type) = @_;
|
||||
$self->log(8, "trying to get config for $config");
|
||||
$self->log(LOGDEBUG, "trying to get config for $config");
|
||||
if ($self->{_config_cache}->{$config}) {
|
||||
return wantarray ? @{$self->{_config_cache}->{$config}} : $self->{_config_cache}->{$config}->[0];
|
||||
}
|
||||
@ -64,23 +83,28 @@ sub get_qmail_config {
|
||||
eval { require CDB_File };
|
||||
|
||||
if ($@) {
|
||||
$self->log(0, "No $configfile.cdb support, could not load CDB_File module: $@");
|
||||
$self->log(LOGERROR, "No $configfile.cdb support, could not load CDB_File module: $@");
|
||||
}
|
||||
my %h;
|
||||
unless (tie(%h, 'CDB_File', "$configfile.cdb")) {
|
||||
$self->log(0, "tie of $configfile.cdb failed: $!");
|
||||
return DECLINED;
|
||||
$self->log(LOGERROR, "tie of $configfile.cdb failed: $!");
|
||||
return +{};
|
||||
}
|
||||
#warn Data::Dumper->Dump([\%h], [qw(h)]);
|
||||
# should we cache this?
|
||||
return \%h;
|
||||
}
|
||||
|
||||
return $self->_config_from_file($configfile, $config);
|
||||
}
|
||||
|
||||
sub _config_from_file {
|
||||
my ($self, $configfile, $config) = @_;
|
||||
return unless -e $configfile;
|
||||
open CF, "<$configfile" or warn "$$ could not open configfile $configfile: $!" and return;
|
||||
my @config = <CF>;
|
||||
chomp @config;
|
||||
@config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/} @config;
|
||||
@config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/} @config;
|
||||
close CF;
|
||||
#$self->log(10, "returning get_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]));
|
||||
$self->{_config_cache}->{$config} = \@config;
|
||||
@ -94,12 +118,43 @@ sub load_plugins {
|
||||
|
||||
my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
|
||||
my $dir = "$name/plugins";
|
||||
$self->log(2, "loading plugins from $dir");
|
||||
$self->log(LOGNOTICE, "loading plugins from $dir");
|
||||
|
||||
$self->_load_plugins($dir, @plugins);
|
||||
}
|
||||
|
||||
sub _load_plugins {
|
||||
my $self = shift;
|
||||
my ($dir, @plugins) = @_;
|
||||
|
||||
for my $plugin (@plugins) {
|
||||
$self->log(7, "Loading $plugin");
|
||||
$self->log(LOGINFO, "Loading $plugin");
|
||||
($plugin, my @args) = split /\s+/, $plugin;
|
||||
|
||||
if (lc($plugin) eq '$include') {
|
||||
my $inc = shift @args;
|
||||
my $config_dir = ($ENV{QMAIL} || '/var/qmail') . '/control';
|
||||
my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
|
||||
$config_dir = "$name/config" if (-e "$name/config/$inc");
|
||||
if (-d "$config_dir/$inc") {
|
||||
$self->log(LOGDEBUG, "Loading include dir: $config_dir/$inc");
|
||||
opendir(DIR, "$config_dir/$inc") || die "opendir($config_dir/$inc): $!";
|
||||
my @plugconf = sort grep { -f $_ } map { "$config_dir/$inc/$_" } grep { !/^\./ } readdir(DIR);
|
||||
closedir(DIR);
|
||||
foreach my $f (@plugconf) {
|
||||
$self->_load_plugins($dir, $self->_config_from_file($f, "plugins"));
|
||||
}
|
||||
}
|
||||
elsif (-f "$config_dir/$inc") {
|
||||
$self->log(LOGDEBUG, "Loading include file: $config_dir/$inc");
|
||||
$self->_load_plugins($dir, $self->_config_from_file("$config_dir/$inc", "plugins"));
|
||||
}
|
||||
else {
|
||||
$self->log(LOGCRIT, "CRITICAL PLUGIN CONFIG ERROR: Include $config_dir/$inc not found");
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
my $plugin_name = $plugin;
|
||||
|
||||
# Escape everything into valid perl identifiers
|
||||
@ -113,8 +168,10 @@ sub load_plugins {
|
||||
"::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "")
|
||||
]egx;
|
||||
|
||||
my $package = "Qpsmtpd::Plugin::$plugin_name";
|
||||
|
||||
# don't reload plugins if they are already loaded
|
||||
next if defined &{"Qpsmtpd::Plugin::${plugin_name}::register"};
|
||||
next if defined &{"${package}::register"};
|
||||
|
||||
my $sub;
|
||||
open F, "$dir/$plugin" or die "could not open $dir/$plugin: $!";
|
||||
@ -124,8 +181,6 @@ sub load_plugins {
|
||||
}
|
||||
close F;
|
||||
|
||||
my $package = "Qpsmtpd::Plugin::$plugin_name";
|
||||
|
||||
my $line = "\n#line 1 $dir/$plugin\n";
|
||||
|
||||
my $eval = join(
|
||||
@ -161,18 +216,18 @@ sub run_hooks {
|
||||
if ($self->{_hooks}->{$hook}) {
|
||||
my @r;
|
||||
for my $code (@{$self->{_hooks}->{$hook}}) {
|
||||
$self->log(5, "running plugin ", $code->{name});
|
||||
$self->log(LOGINFO, "running plugin ", $code->{name});
|
||||
eval { (@r) = $code->{code}->($self, $self->can('transaction') ? $self->transaction : {}, @_); };
|
||||
$@ and $self->log(0, "FATAL PLUGIN ERROR: ", $@) and next;
|
||||
$@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
|
||||
!defined $r[0]
|
||||
and $self->log(1, "plugin ".$code->{name}
|
||||
and $self->log(LOGERROR, "plugin ".$code->{name}
|
||||
."running the $hook hook returned undef!")
|
||||
and next;
|
||||
|
||||
# should we have a hook for "OK" too?
|
||||
if ($r[0] == DENY or $r[0] == DENYSOFT) {
|
||||
$r[1] = "" if not defined $r[1];
|
||||
$self->log(10, "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");
|
||||
}
|
||||
|
||||
|
||||
@ -2,13 +2,12 @@ package Qpsmtpd::Constants;
|
||||
use strict;
|
||||
require Exporter;
|
||||
|
||||
my (@common) = qw(OK DECLINED DONE DENY DENYSOFT DENYHARD TRACE);
|
||||
my (@common) = qw(OK DECLINED DONE DENY DENYSOFT DENYHARD);
|
||||
my (@loglevels) = qw(LOGDEBUG LOGINFO LOGNOTICE LOGWARN LOGERROR LOGCRIT LOGALERT LOGEMERG LOGRADAR);
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT);
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = @common;
|
||||
|
||||
use constant TRACE => 10;
|
||||
@EXPORT = (@common, @loglevels);
|
||||
|
||||
use constant OK => 900;
|
||||
use constant DENY => 901;
|
||||
@ -17,6 +16,16 @@ use constant DECLINED => 909;
|
||||
use constant DONE => 910;
|
||||
use constant DENYHARD => 903;
|
||||
|
||||
# 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;
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@ -1,6 +1,11 @@
|
||||
package Qpsmtpd::Plugin;
|
||||
use strict;
|
||||
|
||||
my %hooks = map { $_ => 1 } qw(
|
||||
config queue data_post quit rcpt mail ehlo helo
|
||||
connect reset_transaction unrecognized_command disconnect
|
||||
);
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
@ -10,6 +15,9 @@ sub new {
|
||||
|
||||
sub register_hook {
|
||||
my ($plugin, $hook, $method) = @_;
|
||||
|
||||
die $plugin->plugin_name . " : Invalid hook: $hook" unless $hooks{$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(@_) },
|
||||
|
||||
@ -68,7 +68,7 @@ sub dispatch {
|
||||
|
||||
if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) {
|
||||
my ($result) = eval { $self->$cmd(@_) };
|
||||
$self->log(0, "XX: $@") if $@;
|
||||
$self->log(LOGERROR, "XX: $@") if $@;
|
||||
return $result if defined $result;
|
||||
return $self->fault("command '$cmd' failed unexpectedly");
|
||||
}
|
||||
@ -205,7 +205,7 @@ sub mail {
|
||||
}
|
||||
else {
|
||||
my $from_parameter = join " ", @_;
|
||||
$self->log(2, "full from_parameter: $from_parameter");
|
||||
$self->log(LOGINFO, "full from_parameter: $from_parameter");
|
||||
my ($from) = ($from_parameter =~ m/^from:\s*(\S+)/i)[0];
|
||||
warn "$$ from email address : [$from]\n";
|
||||
if ($from eq "<>" or $from =~ m/\[undefined\]/) {
|
||||
@ -222,22 +222,22 @@ sub mail {
|
||||
}
|
||||
elsif ($rc == DENY) {
|
||||
$msg ||= $from->format . ', denied';
|
||||
$self->log(2, "deny mail from " . $from->format . " ($msg)");
|
||||
$self->log(LOGINFO, "deny mail from " . $from->format . " ($msg)");
|
||||
$self->respond(550, $msg);
|
||||
}
|
||||
elsif ($rc == DENYSOFT) {
|
||||
$msg ||= $from->format . ', temporarily denied';
|
||||
$self->log(2, "denysoft mail from " . $from->format . " ($msg)");
|
||||
$self->log(LOGINFO, "denysoft mail from " . $from->format . " ($msg)");
|
||||
$self->respond(450, $msg);
|
||||
}
|
||||
elsif ($rc == DENYHARD) {
|
||||
$msg ||= $from->format . ', denied';
|
||||
$self->log(2, "deny mail from " . $from->format . " ($msg)");
|
||||
$self->log(LOGINFO, "deny mail from " . $from->format . " ($msg)");
|
||||
$self->respond(550, $msg);
|
||||
$self->disconnect;
|
||||
}
|
||||
else { # includes OK
|
||||
$self->log(2, "getting mail from ".$from->format);
|
||||
$self->log(LOGINFO, "getting mail from ".$from->format);
|
||||
$self->respond(250, $from->format . ", sender OK - how exciting to get mail from you!");
|
||||
$self->transaction->sender($from);
|
||||
}
|
||||
@ -269,7 +269,7 @@ sub rcpt {
|
||||
}
|
||||
elsif ($rc == DENYHARD) {
|
||||
$msg ||= 'delivery denied';
|
||||
$self->log(2, "delivery denied ($msg)");
|
||||
$self->log(LOGINFO, "delivery denied ($msg)");
|
||||
$self->respond(550, $msg);
|
||||
$self->disconnect;
|
||||
}
|
||||
@ -337,7 +337,7 @@ sub data {
|
||||
my $in_header = 1;
|
||||
my $complete = 0;
|
||||
|
||||
$self->log(8, "max_size: $max_size / size: $size");
|
||||
$self->log(LOGDEBUG, "max_size: $max_size / size: $size");
|
||||
|
||||
my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE");
|
||||
|
||||
@ -392,12 +392,12 @@ sub data {
|
||||
|
||||
$size += length $_;
|
||||
}
|
||||
#$self->log(5, "size is at $size\n") unless ($i % 300);
|
||||
#$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
|
||||
|
||||
alarm $timeout;
|
||||
}
|
||||
|
||||
$self->log(6, "max_size: $max_size / size: $size");
|
||||
$self->log(LOGDEBUG, "max_size: $max_size / size: $size");
|
||||
|
||||
$self->transaction->header($header);
|
||||
|
||||
|
||||
@ -29,8 +29,10 @@ $SIG{INT} = $SIG{TERM} = sub { $QUIT++ };
|
||||
|
||||
sub log {
|
||||
my ($self, $trace, @log) = @_;
|
||||
my $level = Qpsmtpd::TRACE_LEVEL();
|
||||
$level = $self->init_logger unless defined $level;
|
||||
warn join(" ", fileno($self->client), @log), "\n"
|
||||
if $trace <= Qpsmtpd::TRACE_LEVEL();
|
||||
if $trace <= $level;
|
||||
}
|
||||
|
||||
sub main {
|
||||
@ -75,7 +77,7 @@ sub main {
|
||||
my $qp = Qpsmtpd::SelectServer->new();
|
||||
$qp->client($qpclient);
|
||||
$qp{$qpclient} = $qp;
|
||||
$qp->log(1, "Connection number " . keys(%qp));
|
||||
$qp->log(LOGINFO, "Connection number " . keys(%qp));
|
||||
$inbuffer{$qpclient} = '';
|
||||
$outbuffer{$qpclient} = '';
|
||||
$ready{$qpclient} = [];
|
||||
@ -118,7 +120,7 @@ sub main {
|
||||
$qp->data_line($req . CRLF);
|
||||
}
|
||||
else {
|
||||
$qp->log(1, "dispatching $req");
|
||||
$qp->log(LOGINFO, "dispatching $req");
|
||||
defined $qp->dispatch(split / +/, $req)
|
||||
or $qp->respond(502, "command unrecognized: '$req'");
|
||||
}
|
||||
@ -174,7 +176,7 @@ sub start_connection {
|
||||
my $remote_ip = shift;
|
||||
my $remote_host = shift;
|
||||
|
||||
$self->log(1, "Connection from $remote_host [$remote_ip]");
|
||||
$self->log(LOGNOTICE, "Connection from $remote_host [$remote_ip]");
|
||||
my $remote_info = 'NOINFO';
|
||||
|
||||
# if the local dns resolver doesn't filter it out we might get
|
||||
@ -212,7 +214,7 @@ sub respond {
|
||||
my $client = $self->client || die "No client!";
|
||||
while (my $msg = shift @messages) {
|
||||
my $line = $code . (@messages?"-":" ").$msg;
|
||||
$self->log(1, ">$line");
|
||||
$self->log(LOGINFO, ">$line");
|
||||
$outbuffer{$client} .= "$line\r\n";
|
||||
}
|
||||
return 1;
|
||||
@ -244,7 +246,7 @@ sub data_line {
|
||||
local $_ = shift;
|
||||
|
||||
if ($_ eq ".\r\n") {
|
||||
$self->log(6, "max_size: $self->{__max_size} / size: $self->{__size}");
|
||||
$self->log(LOGDEBUG, "max_size: $self->{__max_size} / size: $self->{__size}");
|
||||
delete $indata{$self->client()};
|
||||
|
||||
my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
|
||||
|
||||
@ -50,7 +50,7 @@ sub read_input {
|
||||
while (<STDIN>) {
|
||||
alarm 0;
|
||||
$_ =~ s/\r?\n$//s; # advanced chomp
|
||||
$self->log(1, "dispatching $_");
|
||||
$self->log(LOGDEBUG, "dispatching $_");
|
||||
defined $self->dispatch(split / +/, $_)
|
||||
or $self->respond(502, "command unrecognized: '$_'");
|
||||
alarm $timeout;
|
||||
@ -61,8 +61,8 @@ sub respond {
|
||||
my ($self, $code, @messages) = @_;
|
||||
while (my $msg = shift @messages) {
|
||||
my $line = $code . (@messages?"-":" ").$msg;
|
||||
$self->log(1, "$line");
|
||||
print "$line\r\n" or ($self->log(1, "Could not print [$line]: $!"), return 0);
|
||||
$self->log(LOGDEBUG, "$line");
|
||||
print "$line\r\n" or ($self->log(LOGERROR, "Could not print [$line]: $!"), return 0);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
@ -121,7 +121,7 @@ sub DESTROY {
|
||||
|
||||
undef $self->{_body_file} if $self->{_body_file};
|
||||
if ($self->{_filename} and -e $self->{_filename}) {
|
||||
unlink $self->{_filename} or $self->log(0, "Could not unlink ", $self->{_filename}, ": $!");
|
||||
unlink $self->{_filename} or $self->log(LOGERROR, "Could not unlink ", $self->{_filename}, ": $!");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -34,9 +34,9 @@ sub connect_handler {
|
||||
|
||||
$in->add(\*STDIN) || return DECLINED;
|
||||
if ($in->can_read(1)) {
|
||||
$self->log(1, "remote host started talking before we said hello");
|
||||
$self->log(LOGDEBUG, "remote host started talking before we said hello");
|
||||
return (DENYSOFT, "Don't be rude and talk before I say hello!");
|
||||
}
|
||||
$self->log(10,"remote host said nothing spontaneous, proceeding");
|
||||
$self->log(LOGINFO,"remote host said nothing spontaneous, proceeding");
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
@ -28,7 +28,7 @@ sub check_helo {
|
||||
|
||||
for my $bad ($self->qp->config('badhelo')) {
|
||||
if ($host eq lc $bad) {
|
||||
$self->log(5, "Denying HELO from host claiming to be $bad");
|
||||
$self->log(LOGDEBUG, "Denying HELO from host claiming to be $bad");
|
||||
return (DENY, "Uh-huh. You're $host, and I'm a boil on the bottom of the Marquess of Queensbury's great-aunt.");
|
||||
}
|
||||
}
|
||||
|
||||
@ -12,10 +12,10 @@ sub register {
|
||||
if ($args[0] =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
|
||||
$self->{_clamscan_loc} = $1;
|
||||
} else {
|
||||
$self->log(1, "FATAL ERROR: Unexpected characters in clamav argument 1");
|
||||
$self->log(LOGERROR, "FATAL ERROR: Unexpected characters in clamav argument 1");
|
||||
exit 3;
|
||||
}
|
||||
$self->log(1, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
||||
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
||||
} else {
|
||||
$self->{_clamscan_loc} = "/usr/local/bin/clamscan";
|
||||
}
|
||||
@ -35,7 +35,7 @@ sub clam_scan {
|
||||
|
||||
# Now do the actual scanning!
|
||||
my $cmd = $self->{_clamscan_loc}." --stdout -i --max-recursion=50 --disable-summary $filename 2>&1";
|
||||
$self->log(1, "Running: $cmd");
|
||||
$self->log(LOGDEBUG, "Running: $cmd");
|
||||
my $output = `$cmd`;
|
||||
|
||||
my $result = ($? >> 8);
|
||||
@ -46,20 +46,20 @@ sub clam_scan {
|
||||
|
||||
$output =~ s/^.* (.*) FOUND$/$1 /mg;
|
||||
|
||||
$self->log(1, "clamscan results: $output");
|
||||
$self->log(LOGDEBUG, "clamscan results: $output");
|
||||
|
||||
if ($signal) {
|
||||
$self->log(1, "clamscan exited with signal: $signal");
|
||||
$self->log(LOGINFO, "clamscan exited with signal: $signal");
|
||||
return (DECLINED);
|
||||
}
|
||||
if ($result == 1) {
|
||||
$self->log(1, "Virus(es) found");
|
||||
$self->log(LOGINFO, "Virus(es) found");
|
||||
# return (DENY, "Virus Found: $output");
|
||||
$transaction->header->add('X-Virus-Found', 'Yes');
|
||||
$transaction->header->add('X-Virus-Details', $output);
|
||||
}
|
||||
elsif ($result) {
|
||||
$self->log(1, "ClamAV error: $result\n");
|
||||
$self->log(LOGWARN, "ClamAV error: $result\n");
|
||||
}
|
||||
$transaction->header->add('X-Virus-Checked', 'Checked');
|
||||
return (DECLINED);
|
||||
|
||||
@ -20,7 +20,7 @@ sub register {
|
||||
|
||||
if (@args > 0) {
|
||||
$self->{_unrec_cmd_max} = $args[0];
|
||||
$self->log(1, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
||||
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
||||
} else {
|
||||
$self->{_unrec_cmd_max} = 4;
|
||||
}
|
||||
@ -32,7 +32,7 @@ sub register {
|
||||
sub check_unrec_cmd {
|
||||
my ($self, $cmd) = @_[0,2];
|
||||
|
||||
$self->log(5, "Unrecognized command '$cmd'");
|
||||
$self->log(LOGINFO, "Unrecognized command '$cmd'");
|
||||
|
||||
my $badcmdcount =
|
||||
$self->qp->connection->notes('unrec_cmd_count',
|
||||
@ -40,7 +40,7 @@ sub check_unrec_cmd {
|
||||
);
|
||||
|
||||
if ($badcmdcount >= $self->{_unrec_cmd_max}) {
|
||||
$self->log(5, "Closing connection. Too many unrecognized commands.");
|
||||
$self->log(LOGINFO, "Closing connection. Too many unrecognized commands.");
|
||||
return (DENY, "Closing connection. $badcmdcount unrecognized commands. Perhaps you should read RFC 2821?");
|
||||
}
|
||||
|
||||
|
||||
@ -40,10 +40,10 @@ sub connect_handler {
|
||||
for my $dnsbl (keys %dnsbl_zones) {
|
||||
# fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp
|
||||
if (defined($dnsbl_zones{$dnsbl})) {
|
||||
$self->log(7, "Checking $reversed_ip.$dnsbl for A record in the background");
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background");
|
||||
$sel->add($res->bgsend("$reversed_ip.$dnsbl"));
|
||||
} else {
|
||||
$self->log(7, "Checking $reversed_ip.$dnsbl for TXT record in the background");
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background");
|
||||
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
|
||||
}
|
||||
}
|
||||
@ -69,12 +69,12 @@ sub process_sockets {
|
||||
|
||||
my $result;
|
||||
|
||||
$self->log(8, "waiting for dnsbl dns");
|
||||
$self->log(LOGDEBUG, "waiting for dnsbl dns");
|
||||
|
||||
# don't wait more than 8 seconds here
|
||||
my @ready = $sel->can_read(8);
|
||||
|
||||
$self->log(8, "DONE waiting for dnsbl dns, got " , scalar @ready, " answers ...") ;
|
||||
$self->log(LOGDEBUG, "DONE waiting for dnsbl dns, got " , scalar @ready, " answers ...") ;
|
||||
return '' unless @ready;
|
||||
|
||||
for my $socket (@ready) {
|
||||
@ -91,9 +91,9 @@ sub process_sockets {
|
||||
my $name = $rr->name;
|
||||
($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl;
|
||||
$dnsbl = $name unless $dnsbl;
|
||||
$self->log(9, "name ", $rr->name);
|
||||
$self->log(LOGDEBUG, "name ", $rr->name);
|
||||
next unless $rr->type eq "TXT";
|
||||
$self->log(10, "got txt record");
|
||||
$self->log(LOGDEBUG, "got txt record");
|
||||
$result = $rr->txtdata and last;
|
||||
}
|
||||
#$a_record and $result = "Blocked by $dnsbl";
|
||||
@ -110,7 +110,7 @@ sub process_sockets {
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->log(4, "$dnsbl query failed: ", $res->errorstring)
|
||||
$self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring)
|
||||
unless $res->errorstring eq "NXDOMAIN";
|
||||
}
|
||||
|
||||
|
||||
@ -36,14 +36,14 @@ sub register {
|
||||
|
||||
sub http_config {
|
||||
my ($self, $transaction, $config) = @_;
|
||||
$self->log(0, "http_config called with $config");
|
||||
$self->log(LOGNOTICE, "http_config called with $config");
|
||||
for my $url (@urls) {
|
||||
$self->log(10, "http_config loading from $url");
|
||||
$self->log(LOGDEBUG, "http_config loading from $url");
|
||||
my @config = split /[\r\n]+/, (get "$url$config" || "");
|
||||
chomp @config;
|
||||
@config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } @config;
|
||||
close CF;
|
||||
# $self->log(0, "returning http_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]));
|
||||
# $self->log(LOGNOTICE, "returning http_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]));
|
||||
return (OK, @config) if @config;
|
||||
}
|
||||
return DECLINED;
|
||||
|
||||
@ -66,7 +66,7 @@ sub check_results {
|
||||
my ($self, $transaction, $where, @results) = @_;
|
||||
foreach my $result (@results) {
|
||||
next if $result->{action} eq 'continue';
|
||||
$self->log(1, "milter $self->{name} result action: $result->{action}");
|
||||
$self->log(LOGINFO, "milter $self->{name} result action: $result->{action}");
|
||||
if ($result->{action} eq 'reject') {
|
||||
die("Rejected at $where by $self->{name} milter ($result->{explanation})");
|
||||
}
|
||||
@ -96,7 +96,7 @@ sub check_results {
|
||||
sub connect_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
$self->log(1, "milter $self->{name} opening connection to milter backend");
|
||||
$self->log(LOGDEBUG, "milter $self->{name} opening connection to milter backend");
|
||||
my $milter = Net::Milter->new();
|
||||
$milter->open($self->{host}, $self->{port}, 'tcp');
|
||||
$milter->protocol_negotiation();
|
||||
@ -105,7 +105,7 @@ sub connect_handler {
|
||||
|
||||
my $remote_ip = $self->qp->connection->remote_ip;
|
||||
my $remote_host = $self->qp->connection->remote_host;
|
||||
$self->log(1, "milter $self->{name} checking connect from $remote_host\[$remote_ip\]");
|
||||
$self->log(LOGDEBUG, "milter $self->{name} checking connect from $remote_host\[$remote_ip\]");
|
||||
|
||||
eval {
|
||||
$self->check_results($transaction, "connection",
|
||||
@ -128,7 +128,7 @@ sub helo_handler {
|
||||
my $helo = $self->qp->connection->hello;
|
||||
my $host = $self->qp->connection->hello_host;
|
||||
|
||||
$self->log(1, "milter $self->{name} checking HELO $host");
|
||||
$self->log(LOGDEBUG, "milter $self->{name} checking HELO $host");
|
||||
|
||||
eval { $self->check_results($transaction, "HELO",
|
||||
$milter->send_helo($host)) };
|
||||
@ -142,7 +142,7 @@ sub mail_handler {
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter');
|
||||
|
||||
$self->log(1, "milter $self->{name} checking MAIL FROM " . $address->format);
|
||||
$self->log(LOGDEBUG, "milter $self->{name} checking MAIL FROM " . $address->format);
|
||||
eval { $self->check_results($transaction, "MAIL FROM",
|
||||
$milter->send_mail_from($address->format)) };
|
||||
return(DENY, $@) if $@;
|
||||
@ -155,7 +155,7 @@ sub rcpt_handler {
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter');
|
||||
|
||||
$self->log(1, "milter $self->{name} checking RCPT TO " . $address->format);
|
||||
$self->log(LOGDEBUG, "milter $self->{name} checking RCPT TO " . $address->format);
|
||||
|
||||
eval { $self->check_results($transaction, "RCPT TO",
|
||||
$milter->send_rcpt_to($address->format)) };
|
||||
@ -169,7 +169,7 @@ sub data_handler {
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter');
|
||||
|
||||
$self->log(1, "milter $self->{name} checking headers");
|
||||
$self->log(LOGDEBUG, "milter $self->{name} checking headers");
|
||||
|
||||
my $headers = $transaction->header(); # Mail::Header object
|
||||
foreach my $h ($headers->tags) {
|
||||
@ -177,7 +177,7 @@ sub data_handler {
|
||||
$h =~ s/\b(\w)/\U$1/g;
|
||||
$h =~ s/\bid\b/ID/g;
|
||||
foreach my $val ($headers->get($h)) {
|
||||
# $self->log(1, "milter $self->{name} checking header: $h: $val");
|
||||
# $self->log(LOGDEBUG, "milter $self->{name} checking header: $h: $val");
|
||||
eval { $self->check_results($transaction, "header $h",
|
||||
$milter->send_header($h, $val)) };
|
||||
return(DENY, $@) if $@;
|
||||
@ -197,7 +197,7 @@ sub data_handler {
|
||||
last unless length($line);
|
||||
}
|
||||
|
||||
$self->log(1, "milter $self->{name} checking body");
|
||||
$self->log(LOGDEBUG, "milter $self->{name} checking body");
|
||||
|
||||
my $data = '';
|
||||
while (my $line = $transaction->body_getline) {
|
||||
|
||||
@ -26,7 +26,7 @@ sub register {
|
||||
|
||||
if (@args > 0) {
|
||||
$self->{_queue_exec} = $args[0];
|
||||
$self->log(1, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
||||
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
||||
}
|
||||
else {
|
||||
$self->{_queue_exec} = ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue";
|
||||
@ -86,7 +86,8 @@ sub queue_handler {
|
||||
if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) {
|
||||
$queue_exec = $1;
|
||||
} else {
|
||||
$self->log(1, "FATAL ERROR: Unexpected characters in qmail-queue plugin argument");
|
||||
$self->log(LOGERROR, "FATAL ERROR: Unexpected characters in qmail-queue plugin argument");
|
||||
# This exit is ok as we're exiting a forked child process.
|
||||
exit 3;
|
||||
}
|
||||
|
||||
@ -97,7 +98,7 @@ sub queue_handler {
|
||||
POSIX::dup2(fileno(MESSAGE_READER), 0) or die "Unable to dup MESSAGE_READER: $!";
|
||||
POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!";
|
||||
|
||||
$self->log(7, "Queuing to $queue_exec");
|
||||
$self->log(LOGNOTICE, "Queuing to $queue_exec");
|
||||
|
||||
my $rc = exec $queue_exec;
|
||||
|
||||
|
||||
@ -36,7 +36,7 @@ sub register {
|
||||
if (@args > 1 and $args[1] =~ /^(\d+)$/) {
|
||||
$self->{_smtp_port} = $1;
|
||||
}
|
||||
$self->log(1, "WARNING: Ignoring additional arguments.") if (@args > 2);
|
||||
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 2);
|
||||
} else {
|
||||
die("No SMTP server specified in smtp-forward config");
|
||||
}
|
||||
@ -46,7 +46,7 @@ sub register {
|
||||
sub queue_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
$self->log(1, "forwarding to $self->{_smtp_server}:$self->{_smtp_port}");
|
||||
$self->log(LOGINFO, "forwarding to $self->{_smtp_server}:$self->{_smtp_port}");
|
||||
my $smtp = Net::SMTP->new(
|
||||
$self->{_smtp_server},
|
||||
Port => $self->{_smtp_port},
|
||||
@ -62,6 +62,6 @@ sub queue_handler {
|
||||
}
|
||||
$smtp->dataend();
|
||||
$smtp->quit() or return(DECLINED, "Unable to queue message ($!)");
|
||||
$self->log(1, "finished queueing");
|
||||
$self->log(LOGINFO, "finished queueing");
|
||||
return (OK, "Queued!");
|
||||
}
|
||||
|
||||
@ -34,7 +34,7 @@ sub rcpt_handler {
|
||||
sub check_rhsbl {
|
||||
my ($self, $rhsbl, $host) = @_;
|
||||
return 0 unless $host;
|
||||
$self->log(2, "checking $host in $rhsbl");
|
||||
$self->log(LOGDEBUG, "checking $host in $rhsbl");
|
||||
return 1 if ((gethostbyname("$host.$rhsbl"))[4]);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -97,7 +97,7 @@ sub rcpt_handler {
|
||||
}
|
||||
|
||||
if ($result eq 'fail' or $result eq 'softfail') {
|
||||
$self->log(1, "result for $rcpt->address was $result: $comment");
|
||||
$self->log(LOGDEBUG, "result for $rcpt->address was $result: $comment");
|
||||
}
|
||||
|
||||
return DECLINED;
|
||||
@ -117,7 +117,7 @@ sub data_handler {
|
||||
|
||||
my ($result, $smtp_comment, $comment) = $query->message_result2();
|
||||
|
||||
$self->log(1, "result was $result: $comment") if ($result);
|
||||
$self->log(LOGDEBUG, "result was $result: $comment") if ($result);
|
||||
|
||||
$transaction->header->add('Received-SPF' => "$result ($comment)", 0);
|
||||
|
||||
|
||||
@ -70,7 +70,7 @@ sub register {
|
||||
my ($self, $qp, @args) = @_;
|
||||
$self->register_hook("data_post", "check_spam");
|
||||
|
||||
$self->log(0, "Bad parameters for the spamassassin plugin")
|
||||
$self->log(LOGERROR, "Bad parameters for the spamassassin plugin")
|
||||
if @_ % 2;
|
||||
|
||||
%{$self->{_args}} = @args;
|
||||
@ -94,7 +94,7 @@ sub check_spam {
|
||||
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
|
||||
die "No port" unless $port;
|
||||
my $iaddr = inet_aton($remote) or
|
||||
$self->log(1, "Could not resolve host: $remote") and return (DECLINED);
|
||||
$self->log(LOGERROR, "Could not resolve host: $remote") and return (DECLINED);
|
||||
my $paddr = sockaddr_in($port, $iaddr);
|
||||
|
||||
my $proto = getprotobyname('tcp');
|
||||
@ -102,18 +102,18 @@ sub check_spam {
|
||||
my $spamd_socket = $1;
|
||||
|
||||
socket(SPAMD, PF_UNIX, SOCK_STREAM, 0)
|
||||
or $self->log(1, "Could not open socket: $!") and return (DECLINED);
|
||||
or $self->log(LOGERROR, "Could not open socket: $!") and return (DECLINED);
|
||||
|
||||
$paddr = sockaddr_un($spamd_socket);
|
||||
}
|
||||
else {
|
||||
socket(SPAMD, PF_INET, SOCK_STREAM, $proto)
|
||||
or $self->log(1, "Could not open socket: $!") and return (DECLINED);
|
||||
or $self->log(LOGERROR, "Could not open socket: $!") and return (DECLINED);
|
||||
}
|
||||
|
||||
connect(SPAMD, $paddr)
|
||||
or $self->log(1, "Could not connect to spamassassin daemon: $!") and return DECLINED;
|
||||
$self->log(6, "check_spam: connected to spamd");
|
||||
or $self->log(LOGERROR, "Could not connect to spamassassin daemon: $!") and return DECLINED;
|
||||
$self->log(LOGDEBUG, "check_spam: connected to spamd");
|
||||
|
||||
SPAMD->autoflush(1);
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user