[svn:qpsmtpd] r588 - in trunk: . config.sample lib lib/Qpsmtpd plugins plugins/queue plugins/virus t
[email protected] 22 Dec 2005 21:30:54 -0000
| Newsgroups | perl.cvs.qpsmtpd |
|---|---|
| Message-ID | <[email protected]> |
Author: jpeacock
Date: Thu Dec 22 13:30:53 2005
New Revision: 588
Added:
trunk/.perltidyrc
trunk/config.sample/invalid_resolvable_fromhost
trunk/config.sample/size_threshold
trunk/plugins/queue/exim-bsmtp (contents, props changed)
Modified:
trunk/ (props changed)
trunk/Changes
trunk/MANIFEST
trunk/README
trunk/STATUS
trunk/lib/Qpsmtpd.pm
trunk/lib/Qpsmtpd/Address.pm
trunk/lib/Qpsmtpd/Auth.pm
trunk/lib/Qpsmtpd/Plugin.pm
trunk/lib/Qpsmtpd/PollServer.pm
trunk/lib/Qpsmtpd/SMTP.pm
trunk/lib/Qpsmtpd/TcpServer.pm
trunk/lib/Qpsmtpd/Transaction.pm
trunk/plugins/dnsbl
trunk/plugins/require_resolvable_fromhost
trunk/plugins/rhsbl
trunk/plugins/tls
trunk/plugins/virus/clamdscan
trunk/qpsmtpd
trunk/qpsmtpd-forkserver
trunk/t/qpsmtpd-address.t
Log:
Merge branches/0.3x back to trunk.
Too many individual changes to document. Trust me... ;-)
Lightly tested (i.e. it accepts and delivers mail with minimal plugins).
NOTES/LIMITATIONS:
logging/adaptive currently eats some log messages.
auth_vpopmail_sql is currently broken (needs continuations?).
'make test' fails in dnsbl (no Test::Qpsmtpd::input_sock() method).
Added: trunk/.perltidyrc
==============================================================================
--- (empty file)
+++ trunk/.perltidyrc Thu Dec 22 13:30:53 2005
@@ -0,0 +1,16 @@
+
+-i=4 # 4 space indentation (we used to use 2; in the future we'll use 4)
+-ci=2 # continuation indention
+
+-pt=2 # tight parens
+-sbt=2 # tight square parens
+-bt=2 # tight curly braces
+-bbt=0 # open code block curly braces
+
+-lp # line up with parentheses
+-cti=1 # align closing parens with opening parens ("closing token placement")
+
+# -nolq # don't outdent long quotes (not sure if we should enable this)
+
+
+
Modified: trunk/Changes
==============================================================================
--- trunk/Changes (original)
+++ trunk/Changes Thu Dec 22 13:30:53 2005
@@ -1,10 +1,20 @@
0.40
- Make the clamdscan plugin temporarily deny mail if if can't talk to clamd
- (Filippo Carletti)
+0.31.1 - 2005/11/18
+ Add missing files to the distribution, oops... (Thanks Budi Ang!)
+ (exim plugin, tls plugin, various sample configuration files)
-0.31 -
+
+0.31 - 2005/11/16
+
+ STARTTLS support (see plugins/tls)
+
+ Added queue/exim-bsmtp plugin to spool accepted mail into an Exim
+ backend via BSMTP. (Devin Carraway)
+
+ New plugin inheritance system, see the bottom of README.plugins for
+ more information
qpsmtpd-forkserver: --listen-address may now be given more than once, to
request listening on multiple local addresses (Devin Carraway)
@@ -17,14 +27,41 @@
postfix backend, which expects to have write permission to a fifo
which usually belongs to group postdrop). (pjh)
+ qpsmtpd-forkserver: if -d or --detach is given on the commandline,
+ forkserver will detach from the controlling terminal and daemonize
+ itself (Devin Carraway)
+
+ replace some fun smtp comments with boring ones.
+
+ example patterns for badrcptto plugin - Gordon Rowell
+
+ Extend require_resolvable_fromhost to include a configurable list of
+ "impossible" addresses to combat spammer forging. (Hanno Hecker)
+
+ Use qmail/control/smtpdgreeting if it exists, otherwise
+ show the original qpsmtpd greeting (with version information).
+
+ Apply slight variation on patch from Peter Holzer to allow specification of
+ an explicit $QPSMTPD_CONFIG variable to specify where the config lives,
+ overriding $QMAIL/control and /var/qmail/control if set. The usual
+ "last location with the file wins" rule still applies.
+
+ Refactor Qpsmtpd::Address
+
when disconncting with a temporary failure, return 421 rather than
450 or 451. (Peter J. Holzer)
The unrecognized_command hook now uses DENY_DISCONNECT return
for disconnecting the user.
+ If the environment variable $QPSMTPD_CONFIG is set, qpsmtpd will look
+ for its config files in the directory given therein, in addition to (and
+ in preference to) other locations. (Peter J. Holzer)
+
Updated documentation
+ Various minor cleanups
+
0.30 - 2005/07/05
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Thu Dec 22 13:30:53 2005
@@ -1,6 +1,8 @@
Changes
config.sample/badhelo
+config.sample/badrcptto_patterns
config.sample/dnsbl_zones
+config.sample/invalid_resolvable_fromhost
config.sample/IP
config.sample/logging
config.sample/loglevel
@@ -8,6 +10,7 @@ config.sample/plugins
config.sample/relayclients
config.sample/require_resolvable_fromhost
config.sample/rhsbl_zones
+config.sample/size_threshold
CREDITS
lib/Apache/Qpsmtpd.pm
lib/Qpsmtpd.pm
@@ -55,6 +58,7 @@ plugins/logging/adaptive
plugins/logging/devnull
plugins/logging/warn
plugins/milter
+plugins/queue/exim-bsmtp
plugins/queue/maildir
plugins/queue/postfix-queue
plugins/queue/qmail-queue
@@ -65,6 +69,7 @@ plugins/require_resolvable_fromhost
plugins/rhsbl
plugins/sender_permitted_from
plugins/spamassassin
+plugins/tls
plugins/virus/aveclient
plugins/virus/bitdefender
plugins/virus/check_for_hi_virus
Modified: trunk/README
==============================================================================
--- trunk/README (original)
+++ trunk/README Thu Dec 22 13:30:53 2005
@@ -57,13 +57,9 @@ run the following command in the /home/s
svn co http://svn.perl.org/qpsmtpd/trunk .
-Or if you want a specific release, use for example
+Beware that the trunk might be unstable and unsuitable for anything but development, so you might want to get a specific release, for example:
- svn co http://svn.perl.org/qpsmtpd/tags/0.30 .
-
-In the branch L<http://svn.perl.org/qpsmtpd/branches/high_perf/> we
-have an experimental event based version of qpsmtpd that can handle
-thousands of simultaneous connections with very little overhead.
+ svn co http://svn.perl.org/qpsmtpd/tags/0.31.1 .
chmod o+t ~smtpd/qpsmtpd/ (or whatever directory you installed qpsmtpd
in) to make supervise start the log process.
Modified: trunk/STATUS
==============================================================================
--- trunk/STATUS (original)
+++ trunk/STATUS Thu Dec 22 13:30:53 2005
@@ -10,13 +10,15 @@ pez (or pezmail)
Near term roadmap
=================
-0.31:
+0.32:
- Bugfixes
- add module requirements to the META.yml file
0.40:
- Add user configuration plugin
- Add plugin API for checking if a local email address is valid
+ - use keyword "ESMTPA" in Received header in case of authentication to comply with RFC 3848.
+
0.50:
Include the popular check_delivery[1] functionality via the 0.30 API
Added: trunk/config.sample/invalid_resolvable_fromhost
==============================================================================
--- (empty file)
+++ trunk/config.sample/invalid_resolvable_fromhost Thu Dec 22 13:30:53 2005
@@ -0,0 +1,6 @@
+# include full network block including mask
+127.0.0.0/8
+0.0.0.0/8
+224.0.0.0/4
+169.254.0.0/16
+10.0.0.0/8
Added: trunk/config.sample/size_threshold
==============================================================================
--- (empty file)
+++ trunk/config.sample/size_threshold Thu Dec 22 13:30:53 2005
@@ -0,0 +1,3 @@
+# Messages below the size below will be stored in memory and not spooled.
+# Without this file, the default is 0 bytes, i.e. all messages will be spooled.
+10000
Modified: trunk/lib/Qpsmtpd.pm
==============================================================================
--- trunk/lib/Qpsmtpd.pm (original)
+++ trunk/lib/Qpsmtpd.pm Thu Dec 22 13:30:53 2005
@@ -1,13 +1,13 @@
package Qpsmtpd;
use strict;
-use vars qw($VERSION $Logger $TraceLevel $Spool_dir);
+use vars qw($VERSION $Logger $TraceLevel $Spool_dir $Size_threshold);
use Sys::Hostname;
use Qpsmtpd::Constants;
use Qpsmtpd::Transaction;
use Qpsmtpd::Connection;
-$VERSION = "0.31-dev";
+$VERSION = "0.40-dev";
sub version { $VERSION };
@@ -242,8 +242,6 @@ sub expand_inclusion_ {
}
-#our $HOOKS;
-
sub load_plugins {
my $self = shift;
@@ -480,6 +478,29 @@ sub temp_dir {
return $dirname;
}
+sub size_threshold {
+ my $self = shift;
+ unless ( defined $Size_threshold ) {
+ $Size_threshold = $self->config('size_threshold') || 0;
+ $self->log(LOGNOTICE, "size_threshold set to $Size_threshold");
+ }
+ return $Size_threshold;
+}
+
+sub auth_user {
+ my ($self, $user) = @_;
+ $user =~ s/[\r\n].*//s;
+ $self->{_auth_user} = $user if $user;
+ return (defined $self->{_auth_user} ? $self->{_auth_user} : "" );
+}
+
+sub auth_mechanism {
+ my ($self, $mechanism) = @_;
+ $mechanism =~ s/[\r\n].*//s;
+ $self->{_auth_mechanism} = $mechanism if $mechanism;
+ return (defined $self->{_auth_mechanism} ? $self->{_auth_mechanism} : "" );
+}
+
1;
__END__
Modified: trunk/lib/Qpsmtpd/Address.pm
==============================================================================
--- trunk/lib/Qpsmtpd/Address.pm (original)
+++ trunk/lib/Qpsmtpd/Address.pm Thu Dec 22 13:30:53 2005
@@ -1,16 +1,74 @@
+#!/usr/bin/perl -w
package Qpsmtpd::Address;
use strict;
+=head1 NAME
+
+Qpsmtpd::Address - Lightweight E-Mail address objects
+
+=head1 DESCRIPTION
+
+Based originally on cut and paste from Mail::Address and including
+every jot and tittle from RFC-2821/2822 on what is a legal e-mail
+address for use during the SMTP transaction.
+
+=head1 USAGE
+
+ my $rcpt = Qpsmtpd::Address->new('<[email protected]>');
+
+The objects created can be used as is, since they automatically
+stringify to a standard form, and they have an overloaded comparison
+for easy testing of values.
+
+=head1 METHODS
+
+=cut
+
+use overload (
+ '""' => \&format,
+ 'cmp' => \&_addr_cmp,
+);
+
+=head2 new()
+
+Can be called two ways:
+
+=over 4
+
+=item * Qpsmtpd::Address->new('<[email protected]>')
+
+The normal mode of operation is to pass the entire contents of the
+RCPT TO: command from the SMTP transaction. The value will be fully
+parsed via the L<canonify> method, using the full RFC 2821 rules.
+
+=item * Qpsmtpd::Address->new("user", "host")
+
+If the caller has already split the address from the domain/host,
+this mode will not L<canonify> the input values. This is not
+recommended in cases of user-generated input for that reason. This
+can be used to generate Qpsmtpd::Address objects for accounts like
+"<postmaster>" or indeed for the bounce address "<>".
+
+=back
+
+The resulting objects can be stored in arrays or used in plugins to
+test for equality (like in badmailfrom).
+
+=cut
+
sub new {
- my ($class, $address) = @_;
- my $self = [ ];
- if ($address =~ /^<(.*)>$/) {
- $self->[0] = $1;
- } else {
- $self->[0] = $address;
+ my ($class, $user, $host) = @_;
+ my $self = {};
+ if ($user =~ /^<(.*)>$/ ) {
+ ($user, $host) = $class->canonify($user)
}
- bless ($self, $class);
- return $self;
+ elsif ( not defined $host ) {
+ my $address = $user;
+ ($user, $host) = $address =~ m/(.*)(?:\@(.*))/;
+ }
+ $self->{_user} = $user;
+ $self->{_host} = $host;
+ return bless $self, $class;
}
# Definition of an address ("path") from RFC 2821:
@@ -110,6 +168,15 @@ sub new {
#
# (We ignore all obs forms)
+=head2 canonify()
+
+Primarily an internal method, it is used only on the path portion of
+an e-mail message, as defined in RFC-2821 (this is the part inside the
+angle brackets and does not include the "human readable" portion of an
+address). It returns a list of (local-part, domain).
+
+=cut
+
sub canonify {
my ($dummy, $path) = @_;
my $atom = '[a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~]+';
@@ -131,60 +198,131 @@ sub canonify {
# empty path is ok
return "" if $path eq "";
- #
+ # bare postmaster is permissible, perl RFC-2821 (4.5.1)
+ return ("postmaster", undef) if $path eq "postmaster";
+
my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/);
- return undef unless defined $localpart;
+ return (undef) unless defined $localpart;
if ($localpart =~ /^$atom(\.$atom)*/) {
# simple case, we are done
- return $path;
+ return ($localpart, $domainpart);
}
if ($localpart =~ /^"(($qtext|\\$text)*)"$/) {
$localpart = $1;
$localpart =~ s/\\($text)/$1/g;
- return "$localpart\@$domainpart";
+ return ($localpart, $domainpart);
}
- return undef;
+ return (undef);
}
+=head2 parse()
+
+Retained as a compatibility method, it is completely equivalent
+to new() called with a single parameter.
+=cut
-sub parse {
- my ($class, $line) = @_;
- my $a = $class->canonify($line);
- return ($class->new($a)) if (defined $a);
- return undef;
+sub parse { # retain for compatibility only
+ return shift->new(shift);
}
+=head2 address()
+
+Can be used to reset the value of an existing Q::A object, in which
+case it takes a parameter with or without the angle brackets.
+
+Returns the stringified representation of the address. NOTE: does
+not escape any of the characters that need escaping, nor does it
+include the surrounding angle brackets. For that purpose, see
+L<format>.
+
+=cut
+
sub address {
my ($self, $val) = @_;
- my $oldval = $self->[0];
- return $self->[0] = $val if (defined($val));
- return $oldval;
+ if ( defined($val) ) {
+ $val = "<$val>" unless $val =~ /^<.+>$/;
+ my ($user, $host) = $self->canonify($val);
+ $self->{_user} = $user;
+ $self->{_host} = $host;
+ }
+ return ( defined $self->{_user} ? $self->{_user} : '' )
+ . ( defined $self->{_host} ? '@'.$self->{_host} : '' );
}
+=head2 format()
+
+Returns the canonical stringified representation of the address. It
+does escape any characters requiring it (per RFC-2821/2822) and it
+does include the surrounding angle brackets. It is also the default
+stringification operator, so the following are equivalent:
+
+ print $rcpt->format();
+ print $rcpt;
+
+=cut
+
sub format {
my ($self) = @_;
my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]';
- my $s = $self->[0];
- return '<>' unless $s;
- my ($user, $host) = $s =~ m/(.*)\@(.*)/;
- if ($user =~ s/($qchar)/\\$1/g) {
- return qq{<"$user"\@$host>};
+ return '<>' unless defined $self->{_user};
+ if ( ( my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) {
+ return qq(<"$user")
+ . ( defined $self->{_host} ? '@'.$self->{_host} : '' ). ">";
}
- return "<$s>";
+ return "<".$self->address().">";
}
+=head2 user()
+
+Returns the "localpart" of the address, per RFC-2821, or the portion
+before the '@' sign.
+
+=cut
+
sub user {
my ($self) = @_;
- my ($user, $host) = $self->[0] =~ m/(.*)\@(.*)/;
- return $user;
+ return $self->{_user};
}
+=head2 host()
+
+Returns the "domain" part of the address, per RFC-2821, or the portion
+after the '@' sign.
+
+=cut
+
sub host {
my ($self) = @_;
- my ($user, $host) = $self->[0] =~ m/(.*)\@(.*)/;
- return $host;
+ return $self->{_host};
+}
+
+sub _addr_cmp {
+ require UNIVERSAL;
+ my ($left, $right, $swap) = @_;
+ my $class = ref($left);
+
+ unless ( UNIVERSAL::isa($right, $class) ) {
+ $right = $class->new($right);
+ }
+
+ #invert the address so we can sort by domain then user
+ $left = lc($left->host.'='.$left->user);
+ $right = lc($right->host.'='.$right->user);
+
+ if ( $swap ) {
+ ($right, $left) = ($left, $right);
+ }
+
+ return ($left cmp $right);
}
+=head1 COPYRIGHT
+
+Copyright 2004-2005 Peter J. Holzer. See the LICENSE file for more
+information.
+
+=cut
+
1;
Modified: trunk/lib/Qpsmtpd/Auth.pm
==============================================================================
--- trunk/lib/Qpsmtpd/Auth.pm (original)
+++ trunk/lib/Qpsmtpd/Auth.pm Thu Dec 22 13:30:53 2005
@@ -226,19 +226,6 @@ sub e64
return($res);
}
-sub Qpsmtpd::SMTP::auth {
- my ( $self, $arg, @stuff ) = @_;
-
- #they AUTH'd once already
- return $self->respond( 503, "but you already said AUTH ..." )
- if ( defined $self->{_auth}
- and $self->{_auth} == OK );
- return $self->respond( 503, "AUTH not defined for HELO" )
- if ( $self->connection->hello eq "helo" );
-
- return $self->{_auth} = Qpsmtpd::Auth::SASL( $self, $arg, @stuff );
-}
-
sub SASL {
# $DB::single = 1;
@@ -326,9 +313,8 @@ sub SASL {
$session->connection->relay_client(1);
$session->log( LOGINFO, $msg );
- $session->{_auth_user} = $user;
- $session->{_auth_mechanism} = $mechanism;
- s/[\r\n].*//s for ($session->{_auth_user}, $session->{_auth_mechanism});
+ $session->auth_user($user);
+ $session->auth_mechanism($mechanism);
return OK;
}
Modified: trunk/lib/Qpsmtpd/Plugin.pm
==============================================================================
--- trunk/lib/Qpsmtpd/Plugin.pm (original)
+++ trunk/lib/Qpsmtpd/Plugin.pm Thu Dec 22 13:30:53 2005
@@ -37,9 +37,9 @@ sub _register {
my $self = shift;
my $qp = shift;
local $self->{_qp} = $qp;
- $self->init($qp, @_);
+ $self->init($qp, @_) if $self->can('init');
$self->_register_standard_hooks($qp, @_);
- $self->register($qp, @_);
+ $self->register($qp, @_) if $self->can('register');
}
# Designed to be overloaded
@@ -73,6 +73,14 @@ sub spool_dir {
shift->qp->spool_dir;
}
+sub auth_user {
+ shift->qp->auth_user(@_);
+}
+
+sub auth_mechanism {
+ shift->qp->auth_mechanism(@_);
+}
+
sub temp_file {
my $self = shift;
my $tempfile = $self->qp->temp_file;
Modified: trunk/lib/Qpsmtpd/PollServer.pm
==============================================================================
--- trunk/lib/Qpsmtpd/PollServer.pm (original)
+++ trunk/lib/Qpsmtpd/PollServer.pm Thu Dec 22 13:30:53 2005
@@ -15,6 +15,8 @@ use fields qw(
hooks
start_time
_auth
+ _auth_user
+ _auth_mechanism
_commands
_config_cache
_connection
Modified: trunk/lib/Qpsmtpd/SMTP.pm
==============================================================================
--- trunk/lib/Qpsmtpd/SMTP.pm (original)
+++ trunk/lib/Qpsmtpd/SMTP.pm Thu Dec 22 13:30:53 2005
@@ -196,7 +196,9 @@ sub ehlo_respond {
$conn->hello_host($hello_host);
$self->transaction;
- my @capabilities = @{ $self->transaction->notes('capabilities') };
+ my @capabilities = $self->transaction->notes('capabilities')
+ ? @{ $self->transaction->notes('capabilities') }
+ : ();
# Check for possible AUTH mechanisms
my %auth_mechanisms;
@@ -227,6 +229,19 @@ HOOK: foreach my $hook ( keys %{$self->{
}
}
+sub auth {
+ my ( $self, $arg, @stuff ) = @_;
+
+ #they AUTH'd once already
+ return $self->respond( 503, "but you already said AUTH ..." )
+ if ( defined $self->{_auth}
+ and $self->{_auth} == OK );
+ return $self->respond( 503, "AUTH not defined for HELO" )
+ if ( $self->connection->hello eq "helo" );
+
+ return $self->{_auth} = Qpsmtpd::Auth::SASL( $self, $arg, @stuff );
+}
+
sub mail {
my $self = shift;
return $self->respond(501, "syntax error in parameters") if !$_[0] or $_[0] !~ m/^from:/i;
@@ -365,7 +380,6 @@ sub rcpt_respond {
return 0;
}
-
sub help {
my $self = shift;
$self->respond(214,
Modified: trunk/lib/Qpsmtpd/TcpServer.pm
==============================================================================
--- trunk/lib/Qpsmtpd/TcpServer.pm (original)
+++ trunk/lib/Qpsmtpd/TcpServer.pm Thu Dec 22 13:30:53 2005
@@ -39,7 +39,7 @@ sub run {
my $self = shift;
# should be somewhere in Qpsmtpd.pm and not here...
- $self->load_plugins;
+ $self->load_plugins unless $self->{hooks};
my $rc = $self->start_conversation;
return if $rc != DONE;
Modified: trunk/lib/Qpsmtpd/Transaction.pm
==============================================================================
--- trunk/lib/Qpsmtpd/Transaction.pm (original)
+++ trunk/lib/Qpsmtpd/Transaction.pm Thu Dec 22 13:30:53 2005
@@ -15,9 +15,6 @@ sub start {
my %args = @_;
my $self = { _notes => { capabilities => [] }, _rcpt => [], started => time };
bless ($self, $class);
- my $sz = $self->config('memory_threshold');
- $sz = 10_000 unless defined($sz);
- $self->{_size_threshold} = $sz;
return $self;
}
@@ -91,13 +88,28 @@ sub body_current_pos {
return $self->{_body_current_pos} || 0;
}
-# TODO - should we create the file here if we're storing as an array?
sub body_filename {
my $self = shift;
- return unless $self->{_body_file};
+ $self->body_spool() unless $self->{_filename};
+ $self->{_body_file}->flush(); # so contents won't be cached
return $self->{_filename};
}
+sub body_spool {
+ my $self = shift;
+ $self->log(LOGINFO, "spooling message to disk");
+ $self->{_filename} = $self->temp_file();
+ $self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
+ or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
+ if ($self->{_body_array}) {
+ foreach my $line (@{ $self->{_body_array} }) {
+ $self->{_body_file}->print($line) or die "Cannot print to temp file: $!";
+ }
+ $self->{_body_start} = $self->{_header_size};
+ }
+ $self->{_body_array} = undef;
+}
+
sub body_write {
my $self = shift;
my $data = shift;
@@ -125,19 +137,7 @@ sub body_write {
$self->{_body_size} += length($1);
++$self->{_body_current_pos};
}
- if ($self->{_body_size} >= $self->{_size_threshold}) {
- #warn("spooling to disk\n");
- $self->{_filename} = $self->temp_file();
- $self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
- or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
- if ($self->{_body_array}) {
- foreach my $line (@{ $self->{_body_array} }) {
- $self->{_body_file}->print($line) or die "Cannot print to temp file: $!";
- }
- $self->{_body_start} = $self->{_header_size};
- }
- $self->{_body_array} = undef;
- }
+ $self->body_spool if ( $self->{_body_size} >= $self->size_threshold() );
}
}
Modified: trunk/plugins/dnsbl
==============================================================================
--- trunk/plugins/dnsbl (original)
+++ trunk/plugins/dnsbl Thu Dec 22 13:30:53 2005
@@ -2,13 +2,18 @@
use Danga::DNS;
-sub register {
- my ($self) = @_;
- $self->register_hook("connect", "connect_handler");
- $self->register_hook("connect", "pickup_handler");
+sub init {
+ my ($self, $qp, $denial ) = @_;
+ if ( defined $denial and $denial =~ /^disconnect$/i ) {
+ $self->{_dnsbl}->{DENY} = DENY_DISCONNECT;
+ }
+ else {
+ $self->{_dnsbl}->{DENY} = DENY;
+ }
+
}
-sub connect_handler {
+sub hook_connect {
my ($self, $transaction) = @_;
my $remote_ip = $self->connection->remote_ip;
@@ -99,8 +104,9 @@ sub process_txt_result {
# $qp->finish_continuation if $qp->input_sock->readable;
}
-sub pickup_handler {
- my ($self, $transaction) = @_;
+sub hook_rcpt {
+ my ($self, $transaction, $rcpt) = @_;
+ my $connection = $self->qp->connection;
# RBLSMTPD being non-empty means it contains the failure message to return
if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') {
@@ -115,6 +121,14 @@ sub pickup_handler {
return DECLINED;
}
+sub hook_disconnect {
+ my ($self, $transaction) = @_;
+
+ $self->qp->connection->notes('dnsbl_sockets', undef);
+
+ return DECLINED;
+}
+
1;
=head1 NAME
Added: trunk/plugins/queue/exim-bsmtp
==============================================================================
--- (empty file)
+++ trunk/plugins/queue/exim-bsmtp Thu Dec 22 13:30:53 2005
@@ -0,0 +1,138 @@
+=head1 NAME
+
+exim-bsmtp
+
+$Id$
+
+=head1 DESCRIPTION
+
+This plugin enqueues mail from qpsmtpd into Exim via BSMTP
+
+=head1 INSTALLATION
+
+The qpsmtpd user B<must> be configured in the I<trusted_users> setting
+in your Exim configuration. If it is not, queueing will still work,
+but sender addresses will not be honored by exim, which will make all
+mail appear to originate from the smtpd user itself.
+
+=head1 CONFIGURATION
+
+The plugin accepts configuration settings in space-delimited name/value
+pairs. For example:
+
+ queue/exim-bsmtp exim_path /usr/sbin/exim4
+
+=over 4
+
+=item exim_path I<path>
+
+The path to use to execute the Exim BSMTP receiver; by default this is
+I</usr/sbin/rsmtp>. The commandline switch '-bS' will be added (this is
+actually redundant with rsmtp, but harmless).
+
+=cut
+
+=head1 LICENSE
+
+Copyright (c) 2004 by Devin Carraway <[email protected]>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+=cut
+
+use strict;
+use warnings;
+
+use IO::File;
+use Sys::Hostname qw(hostname);
+use File::Temp qw(tempfile);
+
+sub register {
+ my ($self, $qp, %args) = @_;
+
+ $self->{_exim_path} = $args{exim_path} || '/usr/sbin/rsmtp';
+ $self->{_exim_path} = $1 if $self->{_exim_path} =~ /(.*)/;
+ unless (-x $self->{_exim_path}) {
+ $self->log(LOGERROR, "Could not find exim at $self->{_exim_path};".
+ " please set exim_path in config/plugins");
+ return undef;
+ }
+}
+
+sub hook_queue {
+ my ($self, $txn) = @_;
+
+ my $tmp_dir = $self->qp->config('spool_dir') || '/tmp';
+ $tmp_dir = $1 if ($tmp_dir =~ /(.*)/);
+ my ($tmp, $tmpfn) = tempfile("exim-bsmtp.$$.XXXXXX", DIR => $tmp_dir);
+ unless ($tmp && $tmpfn) {
+ $self->log(LOGERROR, "Couldn't create tempfile: $!");
+ return (DECLINED, 'Internal error enqueueing mail');
+ }
+
+ print $tmp "HELO ", hostname(), "\n",
+ "MAIL FROM:<", ($txn->sender->address || ''), ">\n";
+ print $tmp "RCPT TO:<", ($_->address || ''), ">\n"
+ for $txn->recipients;
+ print $tmp "DATA\n",
+ $txn->header->as_string, "\n";
+ $txn->body_resetpos;
+ while (my $line = $txn->body_getline) {
+ $line =~ s/^\./../;
+ print $tmp $line;
+ }
+ print $tmp ".\nQUIT\n";
+ close $tmp;
+
+ my $cmd = "$self->{_exim_path} -bS < $tmpfn";
+ $self->log(LOGDEBUG, "executing cmd $cmd");
+ my $exim = new IO::File "$cmd|";
+ unless ($exim) {
+ $self->log(LOGERROR, "Could not execute $self->{_exim_path}: $!");
+ unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!");
+ return (DECLINED, "Internal error enqueuing mail");
+ }
+ # Normally exim produces no output in BSMTP mode; anything that
+ # does come out is an error worth logging.
+ my $start = time;
+ while (<$exim>) {
+ chomp;
+ $self->log(LOGERROR, "exim: $_");
+ }
+ $self->log(LOGDEBUG, "BSMTP finished (".(time - $start)." sec)");
+ $exim->close;
+ my $exit = $?;
+ unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!");
+
+ $self->log(LOGDEBUG, "Exitcode from exim: $exit");
+ if (($exit >> 8) != 0) {
+ $self->log(LOGERROR, 'BSMTP enqueue failed; exitcode '.($exit >> 8).
+ " from $self->{_exim_path} -bS");
+ return (DECLINED, 'Internal error enqueuing mail');
+ }
+
+ $self->log(LOGINFO, "Enqueued to exim via BSMTP");
+ return (OK, "Queued!");
+}
+
+
+1;
+
+# vi: ts=4 sw=4 expandtab syn=perl
+
Modified: trunk/plugins/require_resolvable_fromhost
==============================================================================
--- trunk/plugins/require_resolvable_fromhost (original)
+++ trunk/plugins/require_resolvable_fromhost Thu Dec 22 13:30:53 2005
@@ -1,22 +1,29 @@
#!/usr/bin/perl
-
use Danga::DNS;
-sub register {
- my ($self) = @_;
- $self->register_hook("mail", "mail_handler");
- $self->register_hook("rcpt", "rcpt_handler");
+my %invalid = ();
+
+sub init {
+ my ($self, $qp) = @_;
+ foreach my $i ($qp->config("invalid_resolvable_fromhost")) {
+ $i =~ s/^\s*//;
+ $i =~ s/\s*$//;
+ if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
+ $invalid{$1} = $3;
+ }
+ }
}
-sub mail_handler {
+sub hook_mail {
my ($self, $transaction, $sender) = @_;
+ return DECLINED
+ if ($self->qp->connection->notes('whitelistclient'));
$self->transaction->notes('resolvable', 1);
return DECLINED if $sender->format eq "<>";
return $self->check_dns($sender->host);
}
-
sub check_dns {
my ($self, $host) = @_;
@@ -66,7 +73,7 @@ sub dns_result {
}
-sub rcpt_handler {
+sub hook_rcpt {
my ($self, $transaction) = @_;
if (!$transaction->notes('resolvable')) {
Modified: trunk/plugins/rhsbl
==============================================================================
--- trunk/plugins/rhsbl (original)
+++ trunk/plugins/rhsbl Thu Dec 22 13:30:53 2005
@@ -2,14 +2,7 @@
use Danga::DNS;
-sub register {
- my ($self) = @_;
-
- $self->register_hook('mail', 'mail_handler');
- $self->register_hook('rcpt', 'rcpt_handler');
-}
-
-sub mail_handler {
+sub hook_mail {
my ($self, $transaction, $sender) = @_;
my %rhsbl_zones_map = ();
@@ -59,7 +52,7 @@ sub process_result {
}
}
-sub rcpt_handler {
+sub hook_rcpt {
my ($self, $transaction, $rcpt) = @_;
my $result = $transaction->notes('rhsbl');
Modified: trunk/plugins/tls
==============================================================================
--- trunk/plugins/tls (original)
+++ trunk/plugins/tls Thu Dec 22 13:30:53 2005
@@ -39,6 +39,7 @@ sub init {
SSL_server => 1
) or die "Could not create SSL context: $!";
+ # now extract the password...
$self->ssl_context($ssl_ctx);
# Check for possible AUTH mechanisms
@@ -104,10 +105,18 @@ sub hook_unrecognized_command {
my $conn = $self->connection;
# Create a new connection object with subset of information collected thus far
- my $newconn = Qpsmtpd::Connection->new();
- for (qw(local_ip local_port remote_ip remote_port remote_host remote_info relay_client)) {
- $newconn->$_($conn->$_());
- }
+ my $newconn = Qpsmtpd::Connection->new(
+ map { $_ => $conn->$_ }
+ qw(
+ local_ip
+ local_port
+ remote_ip
+ remote_port
+ remote_host
+ remote_info
+ relay_client
+ ),
+ );
$self->qp->connection($newconn);
$self->qp->reset_transaction;
if ($self->qp->isa('Danga::Socket')) {
Modified: trunk/plugins/virus/clamdscan
==============================================================================
--- trunk/plugins/virus/clamdscan (original)
+++ trunk/plugins/virus/clamdscan Thu Dec 22 13:30:53 2005
@@ -118,7 +118,7 @@ sub hook_data_post {
unless ( $content_type
&& $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i )
{
- $self->log( LOGERROR, "non-multipart mail - skipping" );
+ $self->log( LOGNOTICE, "non-multipart mail - skipping" );
return DECLINED;
}
@@ -153,7 +153,10 @@ sub hook_data_post {
$clamd = Clamd->new(); # default unix domain socket
}
- return (DENYSOFT) unless $clamd->ping();
+ unless ( $clamd->ping() ) {
+ $self->log( LOGERROR, "Cannot ping clamd server - did you provide the correct clamd port or socket?" );
+ return DECLINED;
+ }
if ( my %found = $clamd->scan($filename) ) {
my $viruses = join( ",", values(%found) );
Modified: trunk/qpsmtpd
==============================================================================
--- trunk/qpsmtpd (original)
+++ trunk/qpsmtpd Thu Dec 22 13:30:53 2005
@@ -24,9 +24,6 @@ use Getopt::Long;
$|++;
-# For debugging
-# $SIG{USR1} = sub { Carp::confess("USR1") };
-
use Socket qw(SOMAXCONN IPPROTO_TCP SO_KEEPALIVE TCP_NODELAY SOL_SOCKET);
$SIG{'PIPE'} = "IGNORE"; # handled manually
Modified: trunk/qpsmtpd-forkserver
==============================================================================
--- trunk/qpsmtpd-forkserver (original)
+++ trunk/qpsmtpd-forkserver Thu Dec 22 13:30:53 2005
@@ -39,7 +39,7 @@ usage: qpsmtpd-forkserver [ options ]
-u, --user U : run as a particular user (default 'smtpd')
-m, --max-from-ip M : limit connections from a single IP; default 5
--pid-file P : print main servers PID to file P
- --detach : detach from controlling terminal (daemonize)
+ -d, --detach : detach from controlling terminal (daemonize)
EOT
exit 0;
}
@@ -51,8 +51,8 @@ GetOptions('h|help' => \&usage,
'p|port=i' => \$PORT,
'u|user=s' => \$USER,
'pid-file=s' => \$PID_FILE,
- 'd|debug+' => \$DEBUG,
- 'detach' => \$DETACH,
+ 'debug+' => \$DEBUG,
+ 'd|detach' => \$DETACH,
) || &usage;
# detaint the commandline
@@ -172,6 +172,10 @@ if ($PID_FILE) {
close PID;
}
+# Populate class cached variables
+$qpsmtpd->spool_dir;
+$qpsmtpd->size_threshold;
+
while (1) {
REAPER();
my $running = scalar keys %childstatus;
@@ -189,7 +193,6 @@ while (1) {
# possible something condition...
next;
}
-
# Make this client blocking while we figure out if we actually want to
# do something with it.
IO::Handle::blocking($client, 1);
@@ -233,7 +236,17 @@ while (1) {
::log(LOGINFO, "Connection Timed Out");
exit; };
- ::log(LOGINFO, "Accepted connection $running/$MAXCONN");
+ my $localsockaddr = getsockname($client);
+ my ($lport, $laddr) = sockaddr_in($localsockaddr);
+ $ENV{TCPLOCALIP} = inet_ntoa($laddr);
+ # my ($port, $iaddr) = sockaddr_in($hisaddr);
+ $ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
+ $ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, AF_INET) || "Unknown";
+
+ # don't do this!
+ #$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}";
+
+ ::log(LOGINFO, "Accepted connection $running/$MAXCONN from $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}");
$::LineMode = 1;
@@ -245,11 +258,11 @@ while (1) {
$qp->push_back_read("Connect\n");
Qpsmtpd::PollServer->AddTimer(0.1, sub { });
while (1) {
- $qp->enable_read;
- my $line = $qp->get_line;
- last if !defined($line);
- my $output = $qp->process_line($line);
- $qp->write($output) if $output;
+ $qp->enable_read;
+ my $line = $qp->get_line;
+ last if !defined($line);
+ my $output = $qp->process_line($line);
+ $qp->write($output) if $output;
}
exit; # child leaves
Modified: trunk/t/qpsmtpd-address.t
==============================================================================
--- trunk/t/qpsmtpd-address.t (original)
+++ trunk/t/qpsmtpd-address.t Thu Dec 22 13:30:53 2005
@@ -2,7 +2,7 @@
use strict;
$^W = 1;
-use Test::More tests => 28;
+use Test::More tests => 29;
BEGIN {
use_ok('Qpsmtpd::Address');
@@ -16,6 +16,11 @@ $ao = Qpsmtpd::Address->parse($as);
ok ($ao, "parse $as");
is ($ao->format, $as, "format $as");
+$as = '<postmaster>';
+$ao = Qpsmtpd::Address->parse($as);
+ok ($ao, "parse $as");
+is ($ao->format, $as, "format $as");
+
$as = '<[email protected]>';
$ao = Qpsmtpd::Address->parse($as);
ok ($ao, "parse $as");
@@ -38,21 +43,6 @@ $ao = Qpsmtpd::Address->parse($as);
ok ($ao, "parse $as");
is ($ao->format, '<"foo\ bar"@example.com>', "format $as");
-
-$as = '[email protected]';
-$ao = Qpsmtpd::Address->parse($as);
-is ($ao, undef, "can't parse $as");
-
-$as = '<@example.com>';
-is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
-
-$as = '<@123>';
-is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
-
-$as = '<user>';
-is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
-
-
$as = '[email protected]';
$ao = Qpsmtpd::Address->new($as);
ok ($ao, "new $as");
@@ -79,10 +69,35 @@ $as = '<[email protected]>';
$ao = Qpsmtpd::Address->new($as);
ok ($ao, "new $as");
is ($ao->format, $as, "format $as");
+is ("$ao", $as, "overloaded stringify $as");
$as = '[email protected]';
ok ($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
is ($ao && $ao->address, $as, "address $as");
+ok ($ao eq $as, "overloaded 'cmp' operator");
+
+my @unsorted_list = map { Qpsmtpd::Address->new($_) }
+ qw(
+ "[email protected]"@wifo.ac.at
+ [email protected]
+ [email protected]
+ [email protected]
+ [email protected]
+ [email protected]
+ );
+
+# NOTE that this is sorted by _host_ not by _domain_
+my @sorted_list = map { Qpsmtpd::Address->new($_) }
+ qw(
+ [email protected]
+ [email protected]
+ [email protected]
+ [email protected]
+ [email protected]
+ "[email protected]"@wifo.ac.at
+ );
+my @test_list = sort @unsorted_list;
+is_deeply( \@test_list, \@sorted_list, "sort via overloaded 'cmp' operator");