[svn:qpsmtpd] r638 - in contrib: . hjp hjp/aliases hjp/cf_wrapper hjp/check_content_type hjp/check_text hjp/client_options hjp/client_stats hjp/denysoft_greylist hjp/logging_file_connection hjp/majordomo hjp/rcpt_accept hjp/require_resolvable_client vetinari
[email protected] Fri, 12 May 2006 11:48:42 -0700 (PDT)
| Newsgroups | perl.cvs.qpsmtpd |
|---|---|
| Message-ID | <[email protected]> |
Author: jpeacock Date: Fri May 12 11:48:40 2006 New Revision: 638 Added: contrib/README.contrib contrib/hjp/ contrib/hjp/aliases/ contrib/hjp/aliases/Makefile contrib/hjp/aliases/TODO contrib/hjp/aliases/aliases_check contrib/hjp/aliases/aliases_rewrite contrib/hjp/aliases/qpsmtpd-plugin-aliases.spec contrib/hjp/cf_wrapper/ contrib/hjp/cf_wrapper/cf_wrapper contrib/hjp/cf_wrapper/check_cookie contrib/hjp/check_content_type/ contrib/hjp/check_content_type/check_content_type contrib/hjp/check_text/ contrib/hjp/check_text/Makefile contrib/hjp/check_text/check_text contrib/hjp/check_text/qpsmtpd-plugin-check_text.spec contrib/hjp/client_options/ contrib/hjp/client_options/client_options contrib/hjp/client_stats/ contrib/hjp/client_stats/client_stats contrib/hjp/client_stats/denysoft_client_stats contrib/hjp/client_stats/expire_client_stats (contents, props changed) contrib/hjp/denysoft_greylist/ contrib/hjp/denysoft_greylist/Makefile contrib/hjp/denysoft_greylist/denysoft_greylist contrib/hjp/denysoft_greylist/qpsmtpd-plugin-denysoft_greylist.spec contrib/hjp/logging_file_connection/ contrib/hjp/logging_file_connection/file_connection contrib/hjp/majordomo/ contrib/hjp/majordomo/Makefile contrib/hjp/majordomo/majordomo contrib/hjp/majordomo/qpsmtpd-plugin-majordomo.spec contrib/hjp/rcpt_accept/ contrib/hjp/rcpt_accept/rcpt_accept contrib/hjp/require_resolvable_client/ contrib/hjp/require_resolvable_client/require_resolvable_client contrib/vetinari/ contrib/vetinari/ContentType.pm contrib/vetinari/charset (contents, props changed) contrib/vetinari/check_dns_user contrib/vetinari/check_user_cdb contrib/vetinari/check_vuser contrib/vetinari/connection_time contrib/vetinari/rcpt_ldap contrib/vetinari/rcpt_regexp Log: Initial addition of contributed plugins. See README.contrib for details. Added: contrib/README.contrib ============================================================================== --- (empty file) +++ contrib/README.contrib Fri May 12 11:48:40 2006 @@ -0,0 +1,21 @@ +This directory contains plugins contributed by various authors which +have not been added to the qpsmtpd core (for whatever reason). These +plugins have been added to the repository to: + +a) ensure that they remain available +b) keep revision history available as well +c) ease moving suitable plugins into the core (with history) + +<include discussion of how to run these without copying> +<include instructions for authors to request write access> + +The plugins are seperated by author (to facilitate authorization control) +and possibly by subdirectory within the author directories (where multiple +files are involved). + +Current author folders are: + +hjp = Peter J. Holzer <[email protected]> +vetinari = Hanno Hecker <[email protected]> + + Added: contrib/hjp/aliases/Makefile ============================================================================== --- (empty file) +++ contrib/hjp/aliases/Makefile Fri May 12 11:48:40 2006 @@ -0,0 +1,8 @@ +PKG = qpsmtpd-plugin-aliases +all: + +rpm: $(PKG).tar.gz + rpm -ta --clean --sign --rmsource $^ + +$(PKG).tar.gz: $(PKG).spec aliases_check aliases_rewrite + tar cfz $@ $^ Added: contrib/hjp/aliases/TODO ============================================================================== --- (empty file) +++ contrib/hjp/aliases/TODO Fri May 12 11:48:40 2006 @@ -0,0 +1 @@ +* Either make Time::HiRes optional or add it to dependencies. Added: contrib/hjp/aliases/aliases_check ============================================================================== --- (empty file) +++ contrib/hjp/aliases/aliases_check Fri May 12 11:48:40 2006 @@ -0,0 +1,434 @@ +=head1 NAME + +aliases_check - check recipients against aliases file + +=head1 DESCRIPTION + +This plugin looks up recipients (argument to the RCPT TO command) in an +alias file. +Recipients which are not found are immediately rejected. +For each found recipient, the recursive expansion of the alias and the +per-recipient options (if any) are noted. Typically, the aliases_rewrite +plugin is then used to replace the recipient list. The options can be +used by other modules to implement different behaviour for different +recipients. + +An alias can expand to one or more addresses, +a detail string (everything after '+' in the local part) is preserved in the expansion. + +Duplicates are eliminated. + +Unlike the sendmail aliases file, the aliases are complete email addresses, not just the local part. + + +=head1 CONFIGURATION + +The aliases file is a simple text file, with one alias-pattern/expansion pair per line, separated by a colon. + +The alias pattern consists of a list of local parts, an @ sign and a list of +domains, optionally followed by a parenthesized list of of options. + +The expansion consists of a list of email-addresses. + +Lists are comma-separated, whitespace is insignificant. + +For example, consider the alias file: + + hjp,[email protected],wifo.at: [email protected] (denysoft_greylist, spamassassin_reject_threshold=10) + postmaster@,wsr.ac.at,wifo.at: [email protected] + [email protected]: [email protected],[email protected] + +The addresses <postmaster>, <[email protected]> and <[email protected]> would +all be expanded to <[email protected]>, which in turn would be expanded +to two adresses (<[email protected]>, <[email protected]>), of which the first +would again be expanded to <[email protected]>. + +So if you send mail to <[email protected]>, it will be delivered +to <[email protected]> and <[email protected]>. + +The options are stored in the transaction notes with key recipient_options and +can be accessed by other plugins. They are not recursively expanded, however, so +in the above example, the greylisting plugin would only be active for the +hjp and peter.holzer addresses, not for postmaster and sysadm. + +The ability to specify patterns doesn't add any functionality: The first +line in the example above is exactly equivalent to: + + [email protected]: [email protected] (denysoft_greylist, spamassassin_reject_threshold=10) + [email protected]: [email protected] (denysoft_greylist, spamassassin_reject_threshold=10) + [email protected]: [email protected] (denysoft_greylist, spamassassin_reject_threshold=10) + [email protected]: [email protected] (denysoft_greylist, spamassassin_reject_threshold=10) + +But it should help to keep the expansions consistent. + +The order of lines is not significant. If two lines for the same alias +exist, it is undefined which one is used. (In the current +implementation, later entries override earlier ones but this should not +be relied upon). + +=head1 HOOKS + +=over + +=item rcpt + +check_rcpt + +=back + +=head1 TRANSACTION NOTES + +This plugin fills in two transaction notes with information about the +recipients: + +=over + +=item expanded_recipients + +A reference to a hash of arrays. The keys of the hash are the recipients +as passed in the RCPT commands and as stored in +$transaction->recipients. Each value is a list of addresses this +recipient should be replaced with. All addresses are strings, not +Qpsmtpd::Address objects, and they are full RFC-2821-style addresses, +except that delimiting angle brackets are omitted. + +So the aliases file from the example above will result in the followin +hash: + + { + '[email protected]' => [ '[email protected]' }, + '[email protected]' => [ '[email protected]' }, + ... + '[email protected]' => [ + '[email protected]', + '[email protected]' + ], + ... + } + +Typically a plugin hooking into data_post or queue (e.g., +aliases_rewrite) will then replace all recipients with the addresses in +this note before queuing the message. + + +=item recipient_options + +A reference to a hash of hashes. The keys are the recipients (same as in +expanded_recipients - i.e., I<before> expansion), the values are hashes +of options. This plugin produces only simple key/value pairs, but +theoretically the options couls be arbitrarily complex data structures. + +The aliases file from the example results in the following +recipient_options note: + + { + '[email protected]' => { + denysoft_greylist => 1, + spamassassin_reject_threshold => 10 + }, + '[email protected]' => { + denysoft_greylist => 1, + spamassassin_reject_threshold => 10 + }, + ... + } + +=cut + +use strict; +use Time::HiRes qw(time); +use Data::Dumper; + +my $al; +my $al_ts = 0; +sub parse_al1 { + my ($self, $file) = @_; + + my $t0 = time(); + open(UL, "<$file"); + while (<UL>) { + s/#.*//; + my $options; + if (/(.*)\((.*)\)/) { + # options are parenthesized + $options = $2; + $_ = $1; + } + s/\s+//gs; + next if /^$/; + my ($alias, $exp) = split(/:/); + my ($a_local, $a_dom) = split(/\@/, $alias); + my @locals = split(/,/, $a_local); + my @domains = split(/,/, $a_dom); + my @exp = split(/,/, $exp); + for my $l (@locals) { + for my $d (@domains) { + $al->{"$l\@$d"}{exp} = [@exp]; + if ($options) { + my @opt = split(/,/, $options); + for my $o (@opt) { + if ($o =~ m/(.*?)=(.*)/) { + my ($k, $v) = ($1, $2); + $k =~ s/^\s*(.*?)\s*$/$1/; + $v =~ s/^\s*(.*?)\s*$/$1/; + $self->set_option("$l\@$d", $k, $v); + $self->log(LOGDEBUG, "aliases: parse_al: option <$k>=<$v>"); + } else { + $o =~ s/^\s*(.*?)\s*$/$1/; + $self->set_option("$l\@$d", $o, 1); + $self->log(LOGDEBUG, "aliases: parse_al: option <$o>"); + } + } + } + } + } + } + close(UL); + my $t1 = time(); + + $self->log(LOGINFO, "parsed $file in ", $t1 - $t0, " seconds") +} + +sub set_option { + my ($self, $rcpt, $key, $value) = @_; + $self->log(LOGDEBUG, "aliases: set_option: rcpt <$rcpt>, option <$key>=<$value>"); + my @kc = split('/', $key); + my $n = $al->{$rcpt}{opt}; + unless ($n) { + $n = $al->{$rcpt}{opt} = {}; + } + for (my $i = 0; $i < $#kc; $i++) { + $self->log(LOGDEBUG, "aliases: set_option: \$kc[$i]=<$kc[$i]>"); + unless (ref($n->{$kc[$i]}) eq 'HASH') { + $n = $n->{$kc[$i]} = {}; + } + } + $n->{$kc[$#kc]} = $value; + + my $d = Data::Dumper->new([$al->{$rcpt}{opt}], ["$al->{$rcpt}{opt}"]); + $d->Indent(0); + $self->log(LOGDEBUG, $d->Dump); +} + + +sub parse_al { + my ($self) = @_; + + my $t0 = time(); + my $configdir = $self->qp->config_dir('aliases'); + + # check if on disk config has changed + my $ts = 0; + for my $file ("$configdir/aliases", "$configdir/aliases.d", glob("$configdir/aliases.d/*")) { + my $filets = (stat($file))[9]; + $ts = $filets if ($filets > $ts); + } + $self->log(LOGINFO, "ts = $ts, al_ts = $al_ts"); + + # reload if it has + if ($ts > $al_ts) { + $al = undef; + for my $file ("$configdir/aliases", glob("$configdir/aliases.d/*")) { + $self->parse_al1($file); + } + $al_ts = $ts; + } + my $t1 = time(); + + $self->log(LOGINFO, "parsed aliases file(s) in ", $t1 - $t0, " seconds") + +} + + +sub register { + my ($self, $qp) = @_; + $self->log(LOGDEBUG, "register called on $self"); + + $self->register_hook("rcpt", "check_rcpt"); + $self->register_hook("pre-connection", "pre_connection"); + + # parse once during register for qpsmtpd-tcpserver. + # qpsmtpd-forkserver will check in each pre-connection hook if + # reparsing is needed. + $self->parse_al(); +} + +sub pre_connection { + my ($self, $qp) = @_; + $self->log(LOGDEBUG, "pre_connection called on $self"); + + $self->parse_al(); + +} + +# expand the given alias, returnung a hashref of mailaddresses. +# +# $detail is a detail string which is inserted into every expanded +# mail address. +# +# if $null_ok is set, an alias which isn't found expands to itself. +# +# $seen is a hashref used to avoid infinite recursion. + +sub expand_alias { + my ($self, $alias, $detail, $null_ok, $seen) = @_; + my $exp = undef; + + $self->log(LOGDEBUG, "expand_alias($alias, " . ($detail || 'undef'), ", $null_ok, {" . join(', ', keys %$seen) . "})"); + + # check for infinite recursion + return [ $alias] if ($seen->{$alias}); + $seen = { %$seen, $alias => 1 }; + + my $t0 = time(); + $self->log(LOGDEBUG, "trying to expand '$alias'"); + my $e = $al->{$alias}{exp}; + $self->log(LOGDEBUG, "result = " . ($e || "undef")); + + if ($e) { + $self->log(LOGDEBUG, "success -> recursing"); + for (@$e) { + my $e1 = $self->expand_alias($_, $detail, 1, $seen); + push @$exp, @$e1; + } + } else { + $self->log(LOGDEBUG, "failure -> trying wildcard"); + + $alias =~ m/(.*)@(.*)/; + my ($local, $domain) = ($1, $2); + $self->log(LOGDEBUG, "trying to expand '*\@$domain'"); + $e = $al->{"*\@$domain"}{exp}; + $self->log(LOGDEBUG, "result = " . ($e || "undef")); + if ($e) { + $self->log(LOGDEBUG, "success (wildcard) -> recursing"); + for (@$e) { + my ($mailbox, $server) = split(/@/); + $_ = $mailbox . ($detail ? "+$detail" : "") . + '@' . $server; + s/\*/$local/; + ($mailbox, $server) = split(/@/); + if ($mailbox =~ m/(.*?)\+(.*)/) { + $mailbox = $1; + $detail = $2; + } + $_ = "$mailbox\@$server"; + my $e1 = $self->expand_alias($_, $detail, 1, $seen); + push @$exp, @$e1; + } + } elsif ($null_ok) { + $self->log(LOGDEBUG, "failure on wildcard but null_ok -> returning"); + my ($mailbox, $server) = split(/@/, $alias); + $exp = [ + $mailbox . ($detail ? "+$detail" : "") . + '@' . $server + ]; + } + } + my $t1 = time(); + $self->log(LOGDEBUG, "$alias expanded to ", + ($exp ? scalar(@$exp) : 0), " recipients in : ", + $t1 - $t0, " seconds"); + return $exp; +} + + +sub alias_options { + my ($self, $alias) = @_; + + $self->log(LOGDEBUG, "looking up options for $alias"); + my $opt = $al->{$alias}{opt}; + if ($opt) { + my $d = Data::Dumper->new([$opt], ['opt']); + $d->Indent(0)->Terse(1); + $self->log(LOGDEBUG, "found options: " . $d->Dump); + return $opt + } + + $alias =~ m/(.*)@(.*)/; + my ($local, $domain) = ($1, $2); + $opt = $al->{"*\@$domain"}{opt}; + if ($opt) { + my $d = Data::Dumper->new([$opt], ['opt']); + $d->Indent(0)->Terse(1); + $self->log(LOGDEBUG, "found options: " . $d->Dump); + return $opt + } else { + $self->log(LOGDEBUG, "found no options"); + return undef; + } +} + +=head1 METHODS + +=head2 rcpt: check_rcpt + +The check_rcpt method plugs into the rcpt hook. It looks up the +recipient's email address in the aliases file, expands it, and stores +the result and per-address options (if any) in transaction notes. + +If the address is not found and $connection->relay_client is not set, +the request is DENYd, otherwise the +request is DECLINED. This plugin should be run before any other plugin +which makes use of recipient_options. The last plugin to run must then +return OK for all recipients it doesn't DENY. (there is a rcpt_ok plugin +which simply accepts all recipients which haven't yet been denied). + +=cut + +sub check_rcpt { + my ($self, $transaction, $recipient) = @_; + + # get current list of recipients. + my $exprcpt = $transaction->notes('expanded_recipients'); + $exprcpt = {} unless $exprcpt; + + # split recipient into local part, detail and domain + # (local part and domain are case insensitive) + # + my $orig = $recipient->address; + my $local_part = $recipient->user; + my $detail; + if ($local_part =~ m/([^+]+)\+(.*)/) { + $local_part = $1; + $detail = $2; + } + $local_part = lc $local_part; + my $domain = lc $recipient->host; + my $rcpt = "$local_part\@$domain"; + + # look up alias + my $e = $self->expand_alias($rcpt, $detail, 0); + + if (!$e && $self->qp->connection->relay_client()) { + $e = [ $orig ]; + } + + return (DENY, "no such user <$rcpt>") unless ($e); + + $exprcpt->{$orig} = $e; + $transaction->notes('expanded_recipients', $exprcpt); + $transaction->notes('recipient_options', $self->alias_options($rcpt)); + return (DECLINED, ""); +} + + +=head1 BUGS + +None known (yet). + +=head1 TODO + +Parsing a text file is fast enough for a few thousand aliases. For +larger user bases the text file should be replaced by a database with +proper indexes (*DBM, relational, LDAP, whatever). + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2003-2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + Added: contrib/hjp/aliases/aliases_rewrite ============================================================================== --- (empty file) +++ contrib/hjp/aliases/aliases_rewrite Fri May 12 11:48:40 2006 @@ -0,0 +1,113 @@ +#!/usr/bin/perl +=head1 NAME + +aliases_rewrite - rewrite recipient list according to alias expansion + +=head1 DESCRIPTION + +This plugin maps the recipients of the message to addresses stored in +the expanded_recipients transaction note. Typically this note was filled +in by the companion plugin aliases_check. + + +=head1 HOOKS + +=over + +=item data_post + +replace_rcpt + +=back + +=head1 TRANSACTION NOTES + +This plugin uses one transaction note: + +=over + +=item expanded_recipients + +A reference to a hash of arrays. The keys of the hash are the recipients +as passed in the RCPT commands and as stored in +$transaction->recipients. Each value is a list of addresses this +recipient should be replaced with. All addresses are strings, not +Qpsmtpd::Address objects, and they are full RFC-2821-style addresses, +except that delimiting angle brackets are omitted. + +So the note should look something like this: + + { + '[email protected]' => [ '[email protected]' }, + '[email protected]' => [ '[email protected]' }, + ... + '[email protected]' => [ + '[email protected]', + '[email protected]' + ], + ... + } + +=cut + +use strict; +use Time::HiRes qw(time); +use Data::Dumper; + + +sub register { + my ($self, $qp) = @_; + + $self->log(LOGINFO, "in register"); + $self->register_hook("data_post", "replace_rcpt"); +} + +=head2 data_post: replace_rcpt + +Replace all recipients with the list collected in note 'expanded_recipients'. + +=cut + +sub replace_rcpt { + my ($self, $transaction) = @_; + + my $exprcpt = $transaction->notes('expanded_recipients'); + + $self->log(LOGDEBUG, "exprcpt", Dumper $exprcpt); + $self->log(LOGDEBUG, "clearing recipients"); + my @new_recipients = (); + for ($transaction->recipients()) { + my $e = $exprcpt->{$_->address()}; + push (@new_recipients, @$e) if ($e); + $self->log(LOGINFO, "replace_rcpt: recipient: ", $_->address(), " -> @$e"); + } + return (DENY, "no recipients") unless @new_recipients; + my @nra = (); + for (@new_recipients) { + $self->log(LOGDEBUG, "adding $_"); + push @nra, Qpsmtpd::Address->new($_); + } + $transaction->recipients(@nra); + $self->log(LOGDEBUG, "checking recipients"); + for ($transaction->recipients()) { + $self->log(LOGDEBUG, "recipient: ", $_->address()); + } + $self->log(LOGDEBUG, "checking recipients done"); + + return DECLINED; +} + +=head1 BUGS + +None known (yet). + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2003-2006 Peter J. Holzer <[email protected]> + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + Added: contrib/hjp/aliases/qpsmtpd-plugin-aliases.spec ============================================================================== --- (empty file) +++ contrib/hjp/aliases/qpsmtpd-plugin-aliases.spec Fri May 12 11:48:40 2006 @@ -0,0 +1,67 @@ +Name: qpsmtpd-plugin-aliases +Version: 181 +Release: 1 +Packager: [email protected] +Summary: aliases plugin for qpsmtpd +License: distributable +Group: System Environment/Daemons +URL: http://smtpd.develooper.com/ +BuildRoot: %{_tmppath}/%{name}-root +#Source0: %{name}-%{version}.tar.gz +Source0: %{name}.tar.gz +BuildArchitectures: noarch + +%description +This module looks up recipients (argument to the RCPT TO command) in an +alias file. +Recipients which are not found are immediately rejected. +After all recipients are known, the aliases are recursively expanded. + +%prep +#%setup -q -n %{name}-%{version} +%setup -q -c %{name} + +%build + +%clean +rm -rf $RPM_BUILD_ROOT + +%install +rm -rf $RPM_BUILD_ROOT +mkdir -p $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins +cp aliases_* $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins + +[ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress + + +%files +%defattr(-,root,root) +/usr/share/qpsmtpd/plugins/aliases_check +/usr/share/qpsmtpd/plugins/aliases_rewrite + +%changelog +* Wed Apr 19 2006 <[email protected]> 181-1 +- Upstream version 180: Honor the connection->relay_client property. +- Upstream version 181: Updated spec file. + +* Thu Aug 23 2005 <[email protected]> 160-1 +- Upstream version 159: Parse aliases file in register hook, too. +- Upstream version 160: Added Makefile to build RPM package. + +* Thu Aug 21 2005 <[email protected]> 158-1 +- Upstream version 158: Cleaned up log messages. + +* Thu Aug 18 2005 <[email protected]> 154-1 +- Upstream version 154: Fixed typo introduced in r153. + +* Thu Aug 18 2005 <[email protected]> 153-1 +- Upstream version 153: Documentation and debug messages cleaned up. +- Changed buildarchitecture to noarch. + +* Sat Jul 16 2005 <[email protected]> 138-1 +- Upstream version 137: Changes for forkserver. +- Upstream version 138: Moved parsing of config files to pre-connection hook. + +* Fri Jul 15 2005 <[email protected]> 133-1 +- First RPM package. + Added: contrib/hjp/cf_wrapper/cf_wrapper ============================================================================== --- (empty file) +++ contrib/hjp/cf_wrapper/cf_wrapper Fri May 12 11:48:40 2006 @@ -0,0 +1,205 @@ +#!/usr/bin/perl +=head1 NAME + +cf_wrapper - wrapper for content filters + +=head1 DESCRIPTION + +The SMTP protocol (unlike LMTP) allows only a single result code to the +DATA command. However, often a mail to multiple recipients should be +accepted for some recipients but rejected for others (As an example, +consider the case where each recipient uses a bayesian filter to +categorize mails into spam and ham). A simple solution would be to +accept only one recipient per transaction and temporarily reject all others. +However, for mails with many recipients this will lead to unacceptable +delays. Another method would be to identify recipients with the same +configuration and accept or temporarily reject mails to them as a group. +However, if there are many possible configurations (e.g., for the +bayesian filter example mentioned above), it is unlikely that any two +recipients have the same configuration, so this will also lead to +unacceptable delays. + +This plugin uses the results of transactions to categorize +sender/recipient pairs into sets. These sets are then used to accept or +temporarily reject the recipients, so that when a DATA command is +processed there are only recipients in the same set which will hopefully +either all accept or all reject the mail. If the result for the DATA +command is not unanimous, a temporary failure will be generated and the +set will be split into two subsets. (In the worst case, this will result +in a lot of sets with one member - however, it is to be expected that +for a given sender, the sets of accepting and rejecting recipients will +be relatively stable). + +=head1 CONFIG + +The following parameters can be passed to cf_wrapper: + +=over 4 + +=item dbi_credentials <filename> + +Name of the file which contains the datasource, username and password +for the database. The file should only be readable for the qpsmtpd user. + +Default: none. This parameter must be specified! + + +=back + +=head1 NOTES + +This plugin makes use of the following transaction notes: + +=over + +=item cf_wrapper_accept_set + +The currently accepted set. Set the first time the rcpt hook is called, +and queried for subsequent recipients. + +=item cf_wrapper_accept_rcpt + +The recipient for which cf_wrapper_accept_set was set. This is only used +in 4xx responses to RCPT commands. + +=item cf_wrapper_results + +A hashref indexed by recipient addresses with the per-recipient results. +This must be filled in by the content filter plugins and is used by this +plugin decide whether to accept, reject or temporarily reject the +message and to categorize sender/recipient-pairs. + +=back + +=head1 BUGS + +None known. + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2005-2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +use Data::Dumper; +use DBI; + +my $dbh; + +sub register { + my ($self, $qp, %arg) = @_; + $self->{_client_stats_credfile} = $arg{dbi_credentials}; + $self->register_hook("rcpt", "rcpt_handler"); + $self->register_hook("data_post", "data_post_handler"); +} + +sub rcpt_handler { + my ($self, $transaction, $rcpt) = @_; + unless ($dbh) { + my @cred = read_cred($self->{_client_stats_credfile}); + $dbh = DBI->connect($cred[0], $cred[1], $cred[2], + {RaiseError => 0, AutoCommit => 0}); + unless ($dbh) { + $self->log(LOGINFO, "cannot connect to database $cred[0]", + DBI->error); + return DECLINED; + } + $dbh->{FetchHashKeyName} = 'NAME_lc'; + } + my $set = $dbh->selectrow_array("select cfw_set from cf_wrapper_sets + where sender=? and recipient=?", + {}, + $transaction->sender->address, + $rcpt->address) || 0; + my $accept_set = $transaction->notes('cf_wrapper_accept_set'); + $self->log(LOGINFO, "set=$set, accept_set=", + defined($accept_set) ? $accept_set : "(undef)"); + unless (defined($accept_set)) { + $transaction->notes('cf_wrapper_accept_set', $set); + $transaction->notes('cf_wrapper_accept_rcpt', $rcpt->address); + return DECLINED; + } + if ($set == $accept_set) { + return DECLINED; + } else { + return (DENYSOFT, "Mail to " . $rcpt->address . " and " . + $transaction->notes('cf_wrapper_accept_rcpt') . + " not accepted in the same transaction. Please try again"); + } +} + +sub data_post_handler { + my ($self, $transaction) = @_; + my $results = $transaction->notes('cf_wrapper_results'); + return DECLINED unless $results; + + my %count; + my %msg; + for ($transaction->recipients()) { + my $rr = $results->{$_->address}; + my ($rc, $msg); + if (defined $rr) { + if (ref $rr eq "ARRAY") { + $rc = $rr->[0]; + $msg = $rr->[1]; + } else { + $rc = $rr; + } + } else { + $rc = DECLINED; + } + $count{$rc}++; + $msg{$rc}{$msg} = 1; + } + for (keys %count) { + $self->log(LOGINFO, "$count{$_} recipients with result $_"); + } + if (keys %count < 1) { + # can this happen? + return DECLINED; + } elsif (keys %count == 1) { + my $rc = (keys %count)[0]; + my $msg = join ("\n", sort keys %{ $msg{$rc} }); + return $rc, $msg; + } else { + my @rc = sort { $count{$b} <=> $count{$a} } keys %count; + my $mfres = shift(@rc); + $self->log(LOGINFO, "leaving recipients with result $mfres alone"); + for my $res (@rc) { + my $set = $dbh->selectrow_array("select max(cfw_set)+1 from cf_wrapper_sets"); + $self->log(LOGINFO, "moving recipients with result $res into set $set"); + for my $r (keys %$results) { + if (($results->{$r}[0] || DECLINED) == $res) { + $self->log(LOGINFO, "inserting " . $transaction->sender->address . ", $r, $set"); + $dbh->do("delete from cf_wrapper_sets + where sender=? and recipient=?", + {}, + $transaction->sender->address, + $r); + $dbh->do("insert into cf_wrapper_sets(sender, recipient, cfw_set) values(?, ?, ?)", + {}, + $transaction->sender->address, + $r, + $set); + } + } + } + return DENYSOFT, "recipients disagree on whether they want to accept or reject the message. Please try again with a subset."; + } +} + + +sub read_cred { + my ($fn) = @_; + + open(FN, "<$fn") or die "cannot open $fn: $!"; + my $line = <FN>; + close(FN); + my @cred = split(/[\s\n]/, $line); + return @cred; +} + Added: contrib/hjp/cf_wrapper/check_cookie ============================================================================== --- (empty file) +++ contrib/hjp/cf_wrapper/check_cookie Fri May 12 11:48:40 2006 @@ -0,0 +1,90 @@ +#!/usr/bin/perl +=head1 NAME + +check_cookie - check for X-Cookie header + +=head1 DESCRIPTION + +Example plugin for cf_wrapper. This plugin checks if the mail has an +X-Cookie header specified by the recipient. + +=head1 NOTES + +=over 4 + +=item 'recipient_options'->{check_cookie} + +The cookie to be checked. + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2005-2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +sub register { + my ($self, $qp, @args) = @_; + $self->register_hook("rcpt", "rcpt_handler"); + $self->register_hook("data_post", "data_post_handler"); +} + +sub rcpt_handler { + my ($self, $transaction, $rcpt) = @_; + my $ro = $transaction->notes('recipient_options'); + if ($ro && $ro->{check_cookie}) { + my $c = $transaction->notes('check_cookie'); + $self->log(LOGINFO, "setting cookie for recipient ", $rcpt->address, " to ", $ro->{check_cookie}); + $c->{$rcpt->address} = $ro->{check_cookie}; + $transaction->notes('check_cookie', $c); + } + return DECLINED; +} + +sub data_post_handler { + my ($self, $transaction) = @_; + + my $cookie = $transaction->header->get('X-Cookie') || ''; + $cookie =~ s/^\s*(.*?)\s*$/$1/s; + $self->log(LOGINFO, "X-Cookie $cookie found in message"); + my $results = $transaction->notes('cf_wrapper_results'); + for ($transaction->recipients()) { + my $r = $_->address; + $self->log(LOGINFO, "checking cookie for recipient $r"); + my $rc = $results->{$r}; + if (!defined($rc) || $rc == DECLINED) { + my $msg = "Ok"; + if (defined($transaction->notes('check_cookie'))) { + $self->log(LOGINFO, "check_cookie note exists"); + my $c = ($transaction->notes('check_cookie')->{$r}); + if (defined($c)) { + $self->log(LOGINFO, "check_cookie note for $r is $c"); + if ($c eq $cookie) { + $rc = DECLINED; + } else { + $rc = DENY; + $msg = "Please include 'X-Cookie: $c' in your message"; + } + } else { + return DECLINED; + } + } else { + $rc = DECLINED + } + $self->log(LOGINFO, "setting result for $r to $rc"); + $results->{$r} = [$rc, $msg]; + $transaction->notes('cf_wrapper_results', $results); + } else { + $self->log(LOGINFO, "$r already has result $rc, skipping"); + } + } + return DECLINED; +} + +#vim: sw=2 ts=8 + Added: contrib/hjp/check_content_type/check_content_type ============================================================================== --- (empty file) +++ contrib/hjp/check_content_type/check_content_type Fri May 12 11:48:40 2006 @@ -0,0 +1,197 @@ +=head1 NAME + +check_content_types - check content types + +=head1 DESCRIPTION + +This module parses a MIME message into its components and compares the +content types of all parts with the contents of config/content_types. It +returns OK, DENY or DECLINED on the first match, or DECLINED if there is +no match. + +The content-types from the message have all LFWS replaced by a single +space. For nested parts, all the content-types leading to this part are +concatenated, separated by tabs. Thus, a text/plain part of a signed +multipart message may be represented as: + + multipart-signed; micalg=pgp-sha1; + protocol="application/pgp-signature"; + boundary="boundary-1"<TAB>multipart/mixed; + boundary="boundary-2"<TAB>text/plain; charset=iso-8859-1 + +(all on one line, of course) + +This allows distinguishing between e.g., an HTML-only message and a +multipart/alternative message containing an HTML version. + +=head1 CONFIGURATION + +The content_type files contains one pattern and result per line, e.g. + + m{application/x-evil} DENY + m{text/plain} DECLINED + m{application/x-ikwid} OK + +The patterns are perl regular expressions including the quotes. Thus, +the first example would also match "x-application/x-evillage", which may +or may not be intended and it will not match "APPLICATION/X-EVIL", which +almost certainly isn't. Thus some care in writing the regexps is +necessary. + +The result values are the same as for qpsmtpd plugins: + +=over + +=item OK + +accept the message and skip all further plugins which might want to +inspect the contents of the message. This could be used to skip virus +filters for text/plain messages, for example. + +=item DENY + +reject the message with a "552 Message denied" response. + +=item DECLINED + +no decision whether the message should be accepted or rejected. The +message will be passed on to the next plugin. + +=back + +Therefore, somewhat unintuitively, the normal return value for +acceptable content types is DECLINED. + + +Some more examples: + + m{^(.*\t)*application/x-evil(\s|;|$)}i + +would match every part of type application/x-evil. + + m{^text/plain(\s|;|$)}i + +would match only a message of type text plain, not text/plain parts of a +multipart message. OTOH, + + m{\tTeXT/Plain(\s|;|$)} + +would match only text plain parts of multipart messages with a funny +capitalization. + +You can also match on arbitrary parameters, e.g. + + /charset="?GB2312"?/ + +would match all parts in a certain alphabet which I cannot read. + +=head1 SECURITY CONCERNS + +The patterns are used to construct a sub which is then compiled and +executed. Thus anyone with write access to the config/content_types file +can execute arbitrary code as user smtpd. This doesn't matter since +presumably the person who can write this file can add arbitrary plugins, +anyway, but if this module is ever changed to permit per-user +configuration, proper checking must be added. + +=head1 HOOKS + +data_post: check_content_type($self, $transaction) + +=cut + +use MIME::Parser; + +sub register { + my ($self, $qp) = @_; + $self->register_hook("data_post", "check_content_type"); +} + +sub check_content_type { + my ($self, $transaction) = @_; + + my @rules = $self->qp->config("content_types") + or return (DECLINED); + + my $code = "sub check1 { my (\$c) = \@_;\n"; + for (@rules) { + if (/(.*?)\s+(DECLINED|DENY|OK)\s*$/) { + $code .= "if (\$c =~ $1) { return $2 }\n"; + } + } + $code .= 'return undef; }'; + + $self->log(6, "check_content_type: code = $code"); + + + + # reconstruct message + my $rawmsg = $transaction->header->as_string(); + $transaction->body_resetpos; + while (my $line = $transaction->body_getline) { + $rawmsg .= $line; + } + my $spool_dir = $self->qp->config('spool_dir') ? $self->qp->config('spool_dir') + : Qpsmtpd::Utils::tildeexp('~/tmp/'); + my $parser = new MIME::Parser(); + $parser->output_to_core(1); + # $parser->output_under($spool_dir); + my $entity = $parser->parse_data($rawmsg) or die "couldn't parse MIME stream"; + + eval($code); + my $rc = $self->check_part($entity, ''); + if (defined ($rc)) { return $rc } + + return (DECLINED); +} + +sub check_part { + my ($self, $entity, $prefix) = @_; + my $head = $entity->head(); + + # get the content type. + # if there is none, we assume that this is not a MIME message + # and substitute text/plain. Actually we should do that only + # if this is the top level and there isn't any MIME-Version header, + # but there is probably no harm in misinterpreting some broken MIME + # messages. + + my $ct = $head->get("Content-Type") || 'text/plain'; + $ct =~ s/\s+/ /sg; + + $ct = $prefix . $ct; + my $rc = check1($ct); + if (defined ($rc)) { + $self->log(6, "check_part: $ct matched, returning $rc"); + return $rc + } + + my @parts = $entity->parts; + for (@parts) { + my $rc = $self->check_part($_, "$ct\t"); + if (defined ($rc)) { return $rc } + } + return undef; +} + + +=head1 BUGS + +None known (yet). + +=head1 TODO + +Nothing yet. Looks pretty complete to me except that interdependencies +(e.g., match if there is a part of type X and a part of type Y) cannot +be expressed. I think such checks are better left to specialized +modules. + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2003-2004 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut Added: contrib/hjp/check_text/Makefile ============================================================================== --- (empty file) +++ contrib/hjp/check_text/Makefile Fri May 12 11:48:40 2006 @@ -0,0 +1,8 @@ +PKG = qpsmtpd-plugin-check_text +all: + +rpm: $(PKG).tar.gz + rpm -ta --clean --sign --rmsource $^ + +$(PKG).tar.gz: $(PKG).spec check_text + tar cfz $@ $^ Added: contrib/hjp/check_text/check_text ============================================================================== --- (empty file) +++ contrib/hjp/check_text/check_text Fri May 12 11:48:40 2006 @@ -0,0 +1,178 @@ +#!/usr/bin/perl +=head1 NAME + +check_text - check whether a message contains some text + +=head1 DESCRIPTION + +This plugin checks whether a message contains some text and rejects it +if it doesn't and the recipient has indicated that they don't want mails +without text. + +Currently "text" is defined as text/plain, non-markup inside +text/html, or encrypted message parts. For multipart/alternative, the +plugin first checks for a text/plain, then a text/html part and +considers only the first part it finds (i.e. a multipart/alternative +with an empty text/plain is considered empty, even if there is a +non-empty HTML part). + +This plugin rejects mails only for recipients which have +$transaction ->notes('recipient_options') ->{$recipient->address} +->{check_text} set to a true value. To do this even when this is true +for only some of the recipients, the cf_wrapper plugin is used. The +recipient_options note is typically set by the aliases_check plugin. +So this plugin needs to be after aliases_check, but before cf_wrapper in +$confdir/plugins. + +=head1 NOTES + +This plugin makes use of the following transaction notes: + +=over + +=item recipient_options + +Contains per-recipient options (see above and the aliases_* plugins for +details). + +=item check_text + +Internally used to pass information from the rcpt to the data_post hook. + +=item cf_wrapper_results + +Used to pass return codes and messages to the cf_wrapper plugins. + +=back + +=cut + +use warnings; +use strict; +use Data::Dumper; +use MIME::Parser; + +sub hook_rcpt { + my ($self, $transaction, $recipient) = @_; + my $ro; + my $list; + return DECLINED + unless ($ro = $transaction->notes('recipient_options') and + $list = $ro->{check_text}); + $self->log(LOGINFO, $recipient->address . " enabled check_text"); + my $n = $self->transaction->notes('check_text'); + $n->{$recipient->address} = $list; + $self->transaction->notes('check_text', $n); + return DECLINED; +} + + +sub hook_data_post { + my ($self, $transaction) = @_; + + my $results = $transaction->notes('cf_wrapper_results'); + my $text; + for ($transaction->recipients()) { + my $r = $_->address; + my $rc = defined $results->{$r} + ? (ref $results->{$r} eq "ARRAY" + ? $results->{$r}[0] + : $results->{$r} + ) + : DECLINED; + if ($rc == DECLINED) { + my $ml; + my $list; + my $msg = "no objection, your honor!"; + my $ct = $transaction->notes('check_text'); + $self->log(LOGINFO, "ct = $ct"); + $self->log(LOGINFO, "ct->{$r} = $ct->{$r}"); + + if ($ct && $ct->{$r}) { + $self->log(LOGINFO, "doing check_text for $r"); + unless (defined $text) { + # reconstruct message + my $rawmsg = $transaction->header->as_string(); + $transaction->body_resetpos; + while (my $line = $transaction->body_getline) { + $rawmsg .= $line; + } + my $parser = new MIME::Parser; + $parser->output_to_core(1); + my $entity = $parser->parse_data($rawmsg); + $text = extract_text($entity); + } + + $self->log(LOGINFO, "text length:", length($text)); + if (length($text) == 0) { + $self->log(LOGINFO, "$r doesn't want mails without text"); + ($rc, $msg) = (DENY, "$r doesn't want mails without text"); + } + } + $self->log(LOGINFO, "setting result for $r to $rc"); + $results->{$r} = [$rc, $msg]; + $transaction->notes('cf_wrapper_results', $results); + } + } + return DECLINED; + +} + +sub extract_text { + my ($entity) = @_; + + if ($entity->parts) { + if ($entity->effective_type eq 'multipart/alternative') { + print STDERR "Found multipart/alternative: scanning for text parts\n"; + my @parts = $entity->parts; + my @p; + if (@p = grep { $_->effective_type eq 'text/plain'} @parts) { + print STDERR "Fount text/plain part in multipart/alternative\n"; + return extract_text($p[0]); + } elsif (@p = grep { $_->effective_type eq 'text/html'} @parts) { + print STDERR "Fount text/html part in multipart/alternative (ignoring)\n"; + return extract_text($p[0]); + } + + + } elsif ($entity->effective_type eq 'multipart/encrypted') { + return "encrypted message\n"; + } else { + print STDERR "Found ", $entity->effective_type, ": scanning for text parts\n"; + my $text = ""; + for ($entity->parts) { + $text .= extract_text($_); + } + return $text; + } + } else { + if ($entity->effective_type eq 'text/plain') { + print STDERR "Found text/plain part\n"; + return $entity->bodyhandle->as_string; + } + if ($entity->effective_type eq 'text/html') { + my $document = $entity->bodyhandle->as_string; + my $p = HTML::TokeParser->new( \$document ); + my $text = ""; + while (my $token = $p->get_token) { + if ($token->[0] eq 'T') { + $text .= $token->[1]; + } + } + return $text; + } + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +#vim: tw=0 + Added: contrib/hjp/check_text/qpsmtpd-plugin-check_text.spec ============================================================================== --- (empty file) +++ contrib/hjp/check_text/qpsmtpd-plugin-check_text.spec Fri May 12 11:48:40 2006 @@ -0,0 +1,45 @@ +Name: qpsmtpd-plugin-check_text +Version: 182 +Release: 1 +Packager: [email protected] +Summary: plugin for qpsmtpd to reject mails without text +License: distributable +Group: System Environment/Daemons +URL: http://smtpd.develooper.com/ +BuildRoot: %{_tmppath}/%{name}-root +Source0: %{name}.tar.gz +BuildArch: noarch +Requires: qpsmtpd-plugin-cf_wrapper >= 173 + +%description +This plugin checks whether incoming mails contain "text", where "text" +is currently defined as a non-empty text/plain part, a text/html part +containing some text or an encrypted part. + +Mails without text can be rejected on a per-recipient basis. + + +%prep +%setup -q -c %{name} + +%build + +%clean +rm -rf $RPM_BUILD_ROOT + +%install +rm -rf $RPM_BUILD_ROOT +mkdir -p $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins +cp check_text $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins + +[ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress + + +%files +%defattr(-,root,root) +/usr/share/qpsmtpd/plugins/check_text + +%changelog +* Fri May 05 2006 <[email protected]> 182-1 +- First RPM package. + Added: contrib/hjp/client_options/client_options ============================================================================== --- (empty file) +++ contrib/hjp/client_options/client_options Fri May 12 11:48:40 2006 @@ -0,0 +1,179 @@ +=head1 NAME + +client_options - set client-specific options + +=head1 DESCRIPTION + +The client_options plugin adds values to the connection note "client_options" +depending on the connecting client's IP address or host name. + +The "client_options" note (together with its brethren "sender_options" +and "recipient_options") establishes a common mechanism to set and query +configuration data specific to the current transaction. The value of the +note is a hashref, where each value can be either a simple scalar or +another hashref. By convention the keys at the top level are the names +of the plugins "owning" them. + +Thus, the plugin "foo" could check + + $self->qp->connection->notes('client_options')->{foo}{active} and + $self->qp->connection->notes('client_options')->{foo}{action}{failure} + +to find out whether it should be active for that client at all and +what the action in case of a failure for that client should be. + +In the configuration file of the client_options plugin, these options +could be set with: + + 10.1.2.3: foo/active=1, foo/active/failure=LOGONLY + 10.1.0.0/16: foo/active=1, foo/active/failure=DENY + example.net: foo/active=0 + + +=head1 CONFIGURATION + +To enable the plugin, add it to the ~qpsmtpd/config/plugins file as usual. +It should precede any plugins which need to access the options. + +Each line of the configuration file "config/client_options" consists of +a pattern and a list of options, separated by a colon and optional +whitespace. The pattern can be an IP address, an IP network (written in +x.x.x.x/y CIDR notation), or a domain name. If an IP address is given, +the client's IP address must match exactly. For an IP network, the +client's address must lie within the range of addresses. For a domain +name, all PTR records for the clients address are looked up and for each +result all A records are looked up. All domain names for which at least +one A record matches the client's IP address are considered valid host +names of the client and matched against the pattern. A match occurs if +a host name is equal to the pattern or is a subdomain of the pattern. + +If a match occurs, the options specified on the same line are set and +the plugin returns DECLINED. + +The option list is a list of comma-separated key=value pairs. The +namespace for keys is hierarchical, with / as a delimiter. + +=head1 HOOKS + +connect: connect_handler($self, $transaction) + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2003-2004 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +use Net::DNS; +use Data::Dumper; + +sub register { + my ($self, $qp) = @_; + + $self->register_hook("connect", "connect_handler"); +} + + +sub connect_handler { + my ($self, $transaction) = @_; + my $ip = $self->qp->connection->remote_ip || return (DECLINED); + my @names; + my $nslookup_done; + $self->log(LOGDEBUG, "ip = $ip"); + + for ($self->qp->config('client_options')) { + my ($pattern, $options) = split(/\s*:\s*/, $_, 2); + $self->log(LOGDEBUG, "pattern=" . ($pattern || "") . ", options=" . ($options || "")); + if (my ($net, $bcast) = ip_range($pattern)) { + $self->log(LOGDEBUG, "net=" . ($net || "") . ", bcast=" . ($bcast || "")); + my @ip = split(/\./, $ip); + my $ip2 = ($ip[0] << 24) | ($ip[1] << 16) | ($ip[2] << 8) | $ip[3]; + if ($net <= $ip2 && $ip2 <= $bcast) { + $self->log(LOGINFO, "$ip matched $pattern"); + $self->set_client_options($options); + return DECLINED; + } + } else { + # not an IP range, so its a domain name. + # determine all names of the client + unless ($nslookup_done) { + my $res = Net::DNS::Resolver->new(); + my @ip = split(/\./, $ip); + my $query = + $res->search( + "$ip[3].$ip[2].$ip[1].$ip[0].in-addr.arpa.", + 'PTR'); + if ($query) { + for my $rr ($query->answer) { + next unless $rr->type eq 'PTR'; + my $ptrdname = $rr->ptrdname; + my $fwdquery = + $res->search($ptrdname, 'A'); + if ($fwdquery) { + for my $rr ($fwdquery->answer) { + next unless $rr->type eq 'A'; + if ($rr->address eq $ip) { + push @names, $ptrdname; + } + } + } + } + } + $nslookup_done = 1; + } + # and compare them to the pattern. + for my $name (@names) { + if ($name eq $pattern || $name =~ m/\.\Q$pattern\E$/) { + $self->set_client_options($options); + return DECLINED; + } + } + } + } + + return DECLINED; +} + + +sub ip_range { + my ($s) = @_; + my ($ip, $mask); + + if ($s =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/) { + $ip = ($1 << 24) | ($2 << 16) | ($3 << 8) | $4; + $mask = -1 << (32 - $5); + } elsif ($s =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { + $ip = ($1 << 24) | ($2 << 16) | ($3 << 8) | $4; + $mask = -1; + } else { + return (); + } + my $net = $ip & $mask; + my $bcast = $ip | ~$mask; + return ($net, $bcast); +} + + +sub set_client_options { + my ($self, $options) = @_; + my $note = $self->qp->connection->notes('client_options') || {}; + + my (@options) = split(/\s*,\s*/, $options); + for (@options) { + my ($key, $value) = split(/\s*=\s*/); + $self->log(LOGINFO, "key=$key, value=$value"); + my @kc = split('/', $key); + my $n = $note; + for (my $i = 0; $i < $#kc; $i++) { + unless (ref($n->{$kc[$i]} eq 'HASH')) { + $n = $n->{$kc[$i]} = {}; + } + } + $n->{$kc[$#kc]} = $value; + } + $self->log(LOGINFO, "note=" . Dumper($note)); + $self->qp->connection->notes('client_options', $note); +} Added: contrib/hjp/client_stats/client_stats ============================================================================== --- (empty file) +++ contrib/hjp/client_stats/client_stats Fri May 12 11:48:40 2006 @@ -0,0 +1,188 @@ +=head1 NAME + +client_stats + +=head1 DESCRIPTION + +Plugin to record per client statistics of successful and failed +deliveries, These can be used to distinguish between "good" and "bad" +clients. + +=head1 CONFIG + +The following parameters can be passed to denysoft_greylist: + +=over 4 + +=item dbi_credentials <filename> + +Name of the file which contains the datasource, username and password +for the database. The file should only be readable for the qpsmtpd user. + +Default: none. This parameter must be specified! + + +=back + +=head1 NOTES + +This plugin makes use of the following connection notes: + +=over + +=item 'client_stats' + +Contains the stats for the connected client at the beginning of this +connection. + +=back + +=head1 BUGS + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2004-2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +use Data::Dumper; +use DBI; + +my $dbh; + +sub register { + my ($self, $qp, %arg) = @_; + $self->{_client_stats_credfile} = $arg{dbi_credentials}; + $self->register_hook("connect", "connect_handler"); + $self->register_hook("deny", "deny_handler"); + $self->register_hook("data_post", "data_post_handler"); +} + + +my @net; +sub connect_handler { + my ($self, $transaction) = @_; + my $ip = $self->qp->connection->remote_ip || return (DECLINED); + unless ($dbh) { + my @cred = read_cred($self->{_client_stats_credfile}); + $dbh = DBI->connect($cred[0], $cred[1], $cred[2], + {RaiseError => 0, AutoCommit => 0}); + $dbh->{FetchHashKeyName} = 'NAME_lc'; + } + my @o = split(/\./, $ip); + my $ipn = ($o[0] << 24) + ($o[1] << 16) + ($o[2] << 8) + $o[3]; + my @q; + for (my ($mask, $bits) = (32, 0xFFFF_FFFF); $mask >= 0; $mask--, $bits <<= 1) { + $ipn &= $bits; + $o[0] = ($ipn >> 24) & 0xFF; + $o[1] = ($ipn >> 16) & 0xFF; + $o[2] = ($ipn >> 8) & 0xFF; + $o[3] = ($ipn >> 0) & 0xFF; + $net[$mask] = [@o]; + push (@q, "ip1=$o[0] and ip2=$o[1] and ip3=$o[2] and ip4=$o[3] and mask=$mask"); + } + my $q = "select * from ipstats where " . join(" or ", @q); + my $s = $dbh->selectall_hashref($q, "mask"); + for (my $mask = 32; $mask >= 0; $mask--) { + if ($s->{$mask}) { + $s->{mostspecific} = $s->{$mask}; + { + local $Data::Dumper::Indent = 0; + $self->log(LOGINFO, + Data::Dumper->Dump([$s->{mostspecific}], "client_stats")); + } + last; + } + } + + $self->qp->connection->notes('client_stats', $s); + return DECLINED; +} + + +sub deny_handler { + my ($self, $transaction, $plugin, $code, $message) = @_; + + $self->log(LOGDEBUG, "in deny_handler: code=$code message=$message"); + return DECLINED unless($code == DENY || $code == DENY_DISCONNECT); + + my $sths = $dbh->prepare_cached( + "select * from ipstats + where ip1=? and ip2=? and ip3=? and ip4=? and mask=? for update" + ); + my $sthi = $dbh->prepare_cached( + "insert into ipstats(ip1, ip2, ip3, ip4, mask, permfail) + values(?,?,?,?,?,1)" + ); + my $sthu = $dbh->prepare_cached( + "update ipstats + set permfail=permfail+1 + where ip1=? and ip2=? and ip3=? and ip4=? and mask=?" + ); + for my $mask (0..32) { + my @ip = @{$net[$mask]}; + $self->log(LOGINFO, "incrementing permfail for $ip[0].$ip[1].$ip[2].$ip[3]/$mask"); + if ($dbh->selectrow_arrayref($sths, {}, @ip, $mask)) { + $sthu->execute(@ip, $mask); + } else { + $sthi->execute(@ip, $mask); + } + } + $dbh->commit; + return DECLINED; +} + + +sub data_post_handler { + my ($self, $transaction) = @_; + my $n = $transaction->recipients(); + my $sths = $dbh->prepare_cached( + "select * from ipstats + where ip1=? and ip2=? and ip3=? and ip4=? and mask=? for update" + ); + my $sthi = $dbh->prepare_cached( + "insert into ipstats(ip1, ip2, ip3, ip4, mask, success) + values(?,?,?,?,?,?)" + ); + my $sthu = $dbh->prepare_cached( + "update ipstats + set success=success+? + where ip1=? and ip2=? and ip3=? and ip4=? and mask=?" + ); + for my $mask (0..32) { + my @ip = @{$net[$mask]}; + $self->log(LOGINFO, "incrementing success for $ip[0].$ip[1].$ip[2].$ip[3]/$mask by $n"); + my $rc; + my $errstr; + if ($dbh->selectrow_arrayref($sths, {}, @ip, $mask)) { + $rc = $sthu->execute($n, @ip, $mask); + $errstr = $sthu->errstr; + } else { + $rc = $sthi->execute(@ip, $mask, $n); + $errstr = $sthi->errstr; + } + if ($rc) { + $self->log(LOGINFO, "successful"); + } else { + $self->log(LOGERROR, "update failed: $errstr"); + } + } + $dbh->commit; + return DECLINED; +} + + +sub read_cred { + my ($fn) = @_; + + open(FN, "<$fn") or die "cannot open $fn: $!"; + my $line = <FN>; + close(FN); + my @cred = split(/[\s\n]/, $line); + return @cred; +} + Added: contrib/hjp/client_stats/denysoft_client_stats ============================================================================== --- (empty file) +++ contrib/hjp/client_stats/denysoft_client_stats Fri May 12 11:48:40 2006 @@ -0,0 +1,141 @@ +=head1 NAME + +denysoft_client_stats + +=head1 DESCRIPTION + +Plugin to randomly generate temporary failures based on past behaviour +of the client. + +Currently the number of successful deliveries and permanent failures for +the client is used to determine the probability of a rejection. + +=head1 CONFIG + +The following parameters can be passed to denysoft_client_stats: + +=over 4 + + +=item per_recipient <bool> + +Per recipient flag - if this is set, the plugin is only run for +recipients which have recipient_option 'denysoft_client_stats' set. +This can be set by the aliases plugin. +Default: 0. + +=item at_connect <bool> + +If this flag is set, the temporary failure will be generated immediately +after the connect and the connection will be terminated. Otherwise, it +will be generated in response to RCPT TO commands. +Dropping the connection immediately saves resources and prevents address +harvesting. On the other hand, it cannot be (de)activated per recipient. +Default: 0 + +=item success_bias <integer> +Constant to add to the number of successful deliveries in the +computation of the failure probability. The ratio between success_bias +and permfail_bias determines whether clients with insufficient data +will be treated friendly or hostile, and the absolute value determines +the weight of the collected data. +Default: 1 + +=item permfail_bias <integer> +Constant to add to the number of permanent failures in the +computation of the failure probability. +Default: 1 + +=back + +=head1 NOTES + +This plugin makes use of the following connection notes: + +=over + +=item 'client_stats' + +Contains the stats for the connected client at the beginning of this +connection. Note that if the client is unknown, the stats are taken from +the smallest surrounding network for which stats are known. Thus a new +zombie from a network which has already a lot of zombies gets a high +probability of rejection. + + +=item 'client_options'->{denysoft_client_stats}{skip} + +If true, do nothing. This note is usually set by the +client_options plugin. + +=back + +and of the following transaction notes: + +=over + +=item 'sender_options'->{denysoft_client_stats}{skip} + +If true, do nothing. There is currently no plugin which sets +this option, but it is intended for whitelisting based on the reverse +path. + +=item 'recipient_options'->{denysoft_client_stats} + +If true, generate random temporary failures based on past behaviour of +the client. This is only used if the +per_recipient flag is set. This note is usually set by the aliases +plugin. + +=back + +=head1 BUGS + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2004-2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + + +use Data::Dumper; + +sub register { + my ($self, $qp, %arg) = @_; + $self->{_client_stats_per_recipient} = $arg{per_recipient}; + $self->{_client_stats_success_bias} = $arg{success_bias} || 1; + $self->{_client_stats_permfail_bias} = $arg{permfail_bias} || 1; + if ($arg{at_connect}) { + $self->register_hook("connect", "handler"); + } else { + $self->register_hook("rcpt", "handler"); + } +} + + +sub handler { + my ($self, $transaction) = @_; + + if ($self->{_client_stats_per_recipient}) { + my $ro = $transaction->notes('recipient_options'); + return DECLINED unless ($ro && $ro->{denysoft_client_stats}); + } + my $s = $self->qp->connection->notes('client_stats'); + my $m = $s->{mostspecific}; + my $p = ($m->{permfail} + $self->{_client_stats_permfail_bias}) / + ($m->{permfail} + $self->{_client_stats_permfail_bias} + + $m->{success} + $self->{_client_stats_success_bias}); + my $client = $m->{ip1}.".".$m->{ip2}.".".$m->{ip3}.".".$m->{ip4}."/".$m->{mask}; + if (rand() < $p) { + $self->log(LOGINFO, "$m->{permfail} permanent failures, $m->{success} successful deliveries from $client: Rejecting with probability $p"); + return (DENYSOFT, "$m->{permfail} permanent failures, $m->{success} successful deliveries from $client: Rejecting with probability $p"); + } else { + $self->log(LOGINFO, "$m->{permfail} permanent failures, $m->{success} successful deliveries from $client: Passing"); + return (DECLINED); + } +} + Added: contrib/hjp/client_stats/expire_client_stats ============================================================================== --- (empty file) +++ contrib/hjp/client_stats/expire_client_stats Fri May 12 11:48:40 2006 @@ -0,0 +1,71 @@ +#!/usr/bin/perl +=head1 SYNOPSIS + +expire_client_stats dbi_credentials + +=head1 DESCRIPTION + +Script to expire the per client statistics collected by the client_stats +plugin. The counts of all rows are reduces by 10 % and rows which have +not been changed for 1 month are removed. This script should be run once +per week. + +NOTE: The intervals of 1 week and 1 month and the factor of 9/10 are +rather arbitrary. Feel free to modify them. + +The following parameters can be passed to expire_client_stats: + +=over 4 + +=item dbi_credentials + +Name of the file which contains the datasource, username and password +for the database. The file should only be readable for the qpsmtpd user. + +Default: none. This parameter must be specified! + + +=back + +=head1 BUGS + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2004-2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +use strict; +use warnings; +use DBI; + +my $dbh; + +my @cred = read_cred($ARGV[0]); +$dbh = DBI->connect($cred[0], $cred[1], $cred[2], + {RaiseError => 0, AutoCommit => 0}); +my $rc = $dbh->do("update ipstats set success=floor(success*9/10), + permfail=floor(permfail*9/10)"); +print STDERR "updated $rc rows\n"; + +$rc = $dbh->do("delete from ipstats + where ts < now() - interval 1 month"); +print STDERR "deleted $rc rows\n"; +$dbh->commit; +$dbh->disconnect; + + +sub read_cred { + my ($fn) = @_; + + open(FN, "<$fn") or die "cannot open $fn: $!"; + my $line = <FN>; + close(FN); + my @cred = split(/[\s\n]/, $line); + return @cred; +} + Added: contrib/hjp/denysoft_greylist/Makefile ============================================================================== --- (empty file) +++ contrib/hjp/denysoft_greylist/Makefile Fri May 12 11:48:40 2006 @@ -0,0 +1,8 @@ +PKG = qpsmtpd-plugin-denysoft_greylist +all: + +rpm: $(PKG).tar.gz + rpm -ta --clean --sign --rmsource $^ + +$(PKG).tar.gz: $(PKG).spec denysoft_greylist + tar cfz $@ $^ Added: contrib/hjp/denysoft_greylist/denysoft_greylist ============================================================================== --- (empty file) +++ contrib/hjp/denysoft_greylist/denysoft_greylist Fri May 12 11:48:40 2006 @@ -0,0 +1,315 @@ +=head1 NAME + +denysoft_greylist + +=head1 DESCRIPTION + +Plugin to implement the 'greylisting' algorithm proposed by Evan +Harris in http://projects.puremagic.com/greylisting/. Greylisting is +a form of denysoft filter, where unrecognised new connections are +temporarily denied for some initial period, to foil spammers using +fire-and-forget spamware, http_proxies, etc. + +Greylisting adds two main features: it tracks incoming connections +using a triplet of remote IP address, sender, and recipient, rather +than just using the remote IP; and it uses a set of timeout periods +(black/grey/white) to control whether connections are allowed, instead +of using connection counts or rates. + +This plugin allows connection tracking on any or all of IP address, +sender, and recipient (but uses IP address only, by default), with +configurable greylist timeout periods. A simple dbm database is used +for tracking connections, and relayclients are always allowed +through. The plugin supports whitelisting using the whitelist_soft +plugin (optional). + + +=head1 CONFIG + +The following parameters can be passed to denysoft_greylist: + +=over 4 + +=item remote_ip <bool> + +Whether to include the remote ip address in tracking connections. +Default: 1. + +=item sender <bool> + +Whether to include the sender in tracking connections. Default: 0. + +=item recipient <bool> + +Whether to include the recipient in tracking connections. Default: 0. + +=item deny_late <bool> + +Whether to defer denials during the 'mail' hook until 'data_post' +e.g. to allow per-recipient logging. Default: 0. + +=item black_timeout <timeout_seconds> + +The initial period, in seconds, for which we issue DENYSOFTs for +connections from an unknown (or timed out) IP address and/or sender +and/or recipient (a 'connection triplet'). Default: 50 minutes. + +=item grey_timeout <timeout_seconds> + +The subsequent 'grey' period, after the initial black blocking period, +when we will accept a delivery from a formerly-unknown connection +triplet. If a new connection is received during this time, we will +record a successful delivery against this IP address, which whitelists +it for future deliveries (see following). Default: 3 hours 20 minutes. + +=item white_timeout <timeout_seconds> + +The period after which a known connection triplet will be considered +stale, and we will issue DENYSOFTs again. New deliveries reset the +timestamp on the address and renew this timeout. Default: 36 days. + +=item testonly <bool> + +Testing flag - if this is set we log and track connections as normal, +but never actually issue DENYSOFTs. Useful for seeding the database +and testing without actually impacting deliveries. Default: 0. + +=item per_recipient <bool> + +Per recipient flag - if this is set, the plugin is only run for +recipients which have recipient_option 'denysoft_greylist' set. +This can be set by the aliases plugin. +Default: 0. + +=back + +=head1 NOTES + +This plugin makes use of the following connection notes: + +=over + +=item 'client_options'->{denysoft_greylist}{skip} + +If true, greylisting is skipped. This note is usually set by the +client_options plugin. + +=back + +and of the following transaction notes: + +=over + +=item 'sender_options'->{denysoft_greylist}{skip} + +If true, greylisting is skipped. There is currently no plugin which sets +this option, but it is intended for whitelisting based on the reverse +path. + +=item 'denysoft_greylist' + +Internal use. Indicates that a temporary failure should be returned and +contains the message to be returned to the client. + +=item 'recipient_options'->{denysoft_greylist} + +If true, greylisting is performed. This is only used if the +per_recipient flag is set. This note is usually set by the aliases +plugin. + +=back + +=head1 BUGS + +Database locking is implemented using flock, which may not work on +network filesystems e.g. NFS. If this is a problem, you may want to +use something like File::NFSLock instead. + +=head1 COPYRIGHT AND LICENSE + +Written by Gavin Carr <[email protected]>. +This version was modified by Peter J. Holzer <[email protected]>. +All bugs are probably Peter's fault, the good stuff is from Gavin :-). + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } +use AnyDBM_File; +use Fcntl qw(:DEFAULT :flock); +use strict; + +my $VERSION = '0.05'; + +my $BLACK_DEFAULT = 50 * 60; +my $GREY_DEFAULT = 3 * 3600 + 20 * 60; +my $WHITE_DEFAULT = 36 * 24 * 3600; + + +sub register { + my ($self, $qp, %arg) = @_; + $self->{_greylist_ip} = $arg{remote_ip}; + $self->{_greylist_sender} = $arg{sender}; + $self->{_greylist_rcpt} = $arg{recipient}; + $self->{_greylist_ip} = 1 if ! defined $self->{_greylist_ip}; + $self->{_greylist_sender} = 0 if ! defined $self->{_greylist_sender}; + $self->{_greylist_rcpt} = 0 if ! defined $self->{_greylist_rcpt}; + $self->{_greylist_black} = $arg{black_timeout} || $BLACK_DEFAULT; + $self->{_greylist_grey} = $arg{grey_timeout} || $GREY_DEFAULT; + $self->{_greylist_white} = $arg{white_timeout} || $WHITE_DEFAULT; + $self->{_greylist_deny_late} = $arg{deny_late}; + $self->{_greylist_testonly} = $arg{testonly}; + $self->{_greylist_per_recipient} = $arg{per_recipient}; + $self->{_greylist_db} = $arg{db} + ? $arg{db} + : $self->qp->config('db_dir') + ? $self->qp->config('db_dir') . "/denysoft_greylist.dbm" + : $self->qp->config_dir() . "/denysoft_greylist.dbm" + ; + # why are config items tainted? + if ($self->{_greylist_db} =~ m{^([-a-zA-Z0-9./_]+)$}) { + $self->{_greylist_db} = $1; + } + $self->log(LOGDEBUG, "_greylist_db: " . $self->{_greylist_db}); + + unless ($self->{_greylist_rcpt}) { + $self->register_hook("mail", "mail_handler"); + } else { + $self->register_hook("rcpt", "rcpt_handler"); + } + $self->register_hook("data_post", "data_handler"); +} + +sub mail_handler { + my ($self, $transaction, $sender) = @_; + my ($status, $msg) = $self->denysoft_greylist($transaction, $sender, undef); + if ($status == DENYSOFT) { + return (DENYSOFT, $msg) unless $self->{_greylist_deny_late}; + $transaction->notes('denysoft_greylist', $msg) + } + return (DECLINED); +} + +sub rcpt_handler { + my ($self, $transaction, $rcpt) = @_; + + if ($self->{_greylist_per_recipient}) { + my $ro = $transaction->notes('recipient_options'); + return DECLINED unless ($ro && $ro->{denysoft_greylist}); + } + + my $sender = $transaction->sender; + my ($status, $msg) = $self->denysoft_greylist($transaction, $sender, $rcpt); + if ($status == DENYSOFT) { + # Deny here (per-rcpt) unless this is a <> sender, for smtp probes + return (DENYSOFT, $msg) if $sender->address; + $transaction->notes('denysoft_greylist', $msg); + } + return (DECLINED); +} + +sub data_handler { + my ($self, $transaction) = @_; + my $note = $transaction->notes('denysoft_greylist'); + return (DECLINED) unless $note; + return (DENYSOFT, $note); +} + +sub denysoft_greylist { + my ($self, $transaction, $sender, $rcpt) = @_; + my $denymsg = "This mail is temporarily denied"; + + # Always allow relayclients and whitelisted hosts/senders + return (DECLINED) if exists $ENV{RELAYCLIENT}; + + if (my $co = $self->qp->connection->notes('client_options')) { + if ($co->{denysoft_greylist}{skip}) { + $self->log(2, "client is whitelisted, skipping greylist checks"); + return DECLINED + } + } + if (my $co = $transaction->notes('sender_options')) { + if ($co->{denysoft_greylist}{skip}) { + $self->log(2, "sender is whitelisted, skipping greylist checks"); + return DECLINED + } + } + + my $remote_ip = $self->qp->connection->remote_ip; + my $fmt = "%s:%d:%d:%d"; + + # Check denysoft db + unless (open LOCK, ">" . $self->{_greylist_db} . ".lock") { + $self->log(2, "opening lockfile failed: $!"); + return (DECLINED); + } + unless (flock LOCK, LOCK_EX) { + $self->log(2, "flock of lockfile failed: $!"); + close LOCK; + return (DECLINED); + } + my %db = (); + unless (tie %db, 'AnyDBM_File', $self->{_greylist_db}, O_CREAT|O_RDWR, 0600) { + $self->log(2, "tie to database $self->{_greylist_db} failed: $!"); + close LOCK; + return (DECLINED); + } + my @key; + push @key, $remote_ip if $self->{_greylist_ip}; + push @key, $sender->address || '' if $self->{_greylist_sender}; + push @key, $rcpt->address if $rcpt && $self->{_greylist_rcpt}; + my $key = join ':', @key; + my ($ts, $new, $black, $white) = (0,0,0,0); + if ($db{$key}) { + ($ts, $new, $black, $white) = split /:/, $db{$key}; + $self->log(3, "ts: " . localtime($ts) . ", now: " . localtime); + if (! $white) { + # Black IP - deny, but don't update timestamp + if (time - $ts < $self->{_greylist_black}) { + $db{$key} = sprintf $fmt, $ts, $new, ++$black, 0; + $self->log(2, "key $key black DENYSOFT - $black failed connections"); + untie %db; + close LOCK; + return $self->{_greylist_testonly} ? (DECLINED) : (DENYSOFT, $denymsg); + } + # Grey IP - accept unless timed out + elsif (time - $ts < $self->{_greylist_grey}) { + $db{$key} = sprintf $fmt, time, $new, $black, 1; + $self->log(2, "key $key updated grey->white"); + untie %db; + close LOCK; + return (DECLINED); + } + else { + $self->log(3, "key $key has timed out (grey)"); + } + } + # White IP - accept unless timed out + else { + if (time - $ts < $self->{_greylist_white}) { + $db{$key} = sprintf $fmt, time, $new, $black, ++$white; + $self->log(2, "key $key is white, $white deliveries"); + untie %db; + close LOCK; + return (DECLINED); + } + else { + $self->log(3, "key $key has timed out (white)"); + } + } + } + + # New ip or entry timed out - record new and return DENYSOFT + $db{$key} = sprintf $fmt, time, ++$new, $black, 0; + $self->log(2, "key $key initial DENYSOFT, unknown"); + untie %db; + close LOCK; + return $self->{_greylist_testonly} ? (DECLINED) : (DENYSOFT, $denymsg); +} + +1; +# tag: plugin to implement greylisting + Added: contrib/hjp/denysoft_greylist/qpsmtpd-plugin-denysoft_greylist.spec ============================================================================== --- (empty file) +++ contrib/hjp/denysoft_greylist/qpsmtpd-plugin-denysoft_greylist.spec Fri May 12 11:48:40 2006 @@ -0,0 +1,45 @@ +Name: qpsmtpd-plugin-denysoft_greylist +Version: 163 +Release: 1 +Packager: [email protected] +Summary: denysoft_greylist plugin for qpsmtpd +License: distributable +Group: System Environment/Daemons +URL: http://www.hjp.at/projekte/qpsmtpd/denysoft_greylist/ +BuildRoot: %{_tmppath}/%{name}-root +Source0: %{name}.tar.gz +BuildArchitectures: noarch + +%description +A modified version of the greylisting plugin which works together with +the aliases plugin. + +%prep +#%setup -q -n %{name}-%{version} +%setup -q -c %{name} + +%build + +%clean +rm -rf $RPM_BUILD_ROOT + +%install +rm -rf $RPM_BUILD_ROOT +mkdir -p $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins +cp denysoft_greylist $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins + +[ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress + + +%files +%defattr(-,root,root) +/usr/share/qpsmtpd/plugins/denysoft_greylist + +%changelog +* Wed Sep 21 2005 <[email protected]> 163-1 +- Added Makefile to build rpm package. +- Added plugin parameter db for location of database. (r150) + +* Sun Jul 17 2005 <[email protected]> 146-1 +- First RPM package. + Added: contrib/hjp/logging_file_connection/file_connection ============================================================================== --- (empty file) +++ contrib/hjp/logging_file_connection/file_connection Fri May 12 11:48:40 2006 @@ -0,0 +1,184 @@ +#!/usr/bin/perl +# $Id: file 478 2005-07-19 07:40:16Z aqua $ + +=head1 NAME + +file_connection - Simple per session log-to-file logging for qpsmtpd + +=head1 DESCRIPTION + +The 'file_connection' logging plugin for qpsmtpd records qpsmtpd log messages into a +file (or a named pipe, if you prefer.) + +The file is reopened for each connection. To facilitate automatic +logfile switching the filename can contain strftime conversion +specifiers, which are expanded immediately before opening the file. This +ensures that a single connection is never split across logfiles. + +The list of supported conversion specifiers depends on the strftime +implementation of your C library. See strftime(3) for details. +Additionally, %i exands to a (hopefully) unique session-id. + + +=head1 CONFIGURATION + +To enable the logging plugin, add a line of this form to the qpsmtpd plugins +configuration file: + +=over + +logging/file_connection [loglevel I<level>] I<path> + +For example: + +logging/file_connection loglevel LOGINFO /var/log/qpsmtpd/%Y-%m-%d + +=back + +Multiple instances of the plugin can be configured by appending :I<N> for any +integer(s) I<N>, to log to multiple files simultaneously, e.g. to log critical +errors and normally verbose logs elsewhere. + +The following optional configuration setting can be supplied: + +=over + +=item loglevel I<loglevel> + +The internal log level below which messages will be logged. The I<loglevel> +given should be chosen from this list. Priorities count downward (for example, +if LOGWARN were selected, LOGERROR, LOGCRIT and LOGEMERG messages would be +logged as well): + +=over + +=item B<LOGDEBUG> + +=item B<LOGINFO> + +=item B<LOGNOTICE> + +=item B<LOGWARN> + +=item B<LOGERROR> + +=item B<LOGCRIT> + +=item B<LOGALERT> + +=item B<LOGEMERG> + +=back + +=back + + +The chosen I<path> should be writable by the user running qpsmtpd; it will be +created it did not already exist, and appended to otherwise. + +=head1 AUTHOR + +Peter J. Holzer <[email protected]>, based on a plugin by +Devin Carraway <[email protected]> + +=head1 LICENSE + +Copyright (c) 2005, Devin Carraway. + +This plugin is licensed under the same terms as the qpsmtpd package itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +use strict; +use warnings; + +use IO::File; +#use Sys::Hostname; +use POSIX qw(strftime); + +sub register { + my ($self, $qp, @args) = @_; + my %args; + + $self->{_loglevel} = LOGWARN; + + while (1) { + last if !@args; + if (lc $args[0] eq 'loglevel') { + shift @args; + my $ll = shift @args; + if (!defined $ll) { + warn "Malformed arguments to logging/file_connection plugin"; + return; + } + if ($ll =~ /^(\d+)$/) { + $self->{_loglevel} = $1; + } + elsif ($ll =~ /^(LOG\w+)$/) { + $self->{_loglevel} = log_level($1); + defined $self->{_loglevel} or $self->{_loglevel} = LOGWARN; + } + } + else { last } + } + + unless (@args && $args[0]) { + warn "Malformed arguments to syslog plugin"; + return; + } + + $self->{_logfile} = join(' ', @args); + $self->{_log_session_id_prefix} = sprintf("%08x%04x", time(), $$); + $self->{_log_session_id_counter} = 0; + + $self->register_hook('logging', 'write_log'); + $self->register_hook('pre-connection', 'open_log'); + $self->open_log($qp); +} + +sub open_log { + my ($self, $qp) = @_; + my $output = $self->{_logfile}; + $self->{_log_session_id} = + $self->{_log_session_id_prefix} . "." . + ++$self->{_log_session_id_counter}; + + $output =~ s/%i/$self->{_log_session_id}/; + $output = strftime($output, localtime); + #print STDERR "open_log: output=$output, uid=$>\n"; + if ($output =~ /^\s*\|(.*)/) { + unless ($self->{_f} = new IO::File "|$1") { + warn "Error opening log output to command $1: $!"; + return; + } + } elsif ($output =~ /^(.*)/) { # detaint + unless ($self->{_f} = new IO::File ">>$1") { + warn "Error opening log output to path $1: $!"; + return; + } + } + $self->{_f}->autoflush(1); + + return DECLINED; +} + +sub write_log { + my ($self, $txn, $trace, $hook, $plugin, @log) = @_; + + return DECLINED if $trace > $self->{_loglevel}; + return DECLINED if defined $plugin and $plugin eq $self->plugin_name; + $self->open_log unless($self->{_f}); + + my $f = $self->{_f}; + print STDERR "no open file\n" unless (defined $f); + print $f join(" ", + strftime("%Y-%m-%dT%H:%M:%S%z", localtime), $self->{_log_session_id}, + (defined $plugin ? " $plugin plugin:" : + defined $hook ? " running plugin ($hook):" : ""), + @log), "\n"; + return DECLINED; +} + +# vi: tabstop=4 shiftwidth=4 expandtab: + Added: contrib/hjp/majordomo/Makefile ============================================================================== --- (empty file) +++ contrib/hjp/majordomo/Makefile Fri May 12 11:48:40 2006 @@ -0,0 +1,8 @@ +PKG = qpsmtpd-plugin-majordomo +all: + +rpm: $(PKG).tar.gz + rpm -ta --clean --sign --rmsource $^ + +$(PKG).tar.gz: $(PKG).spec majordomo + tar cfz $@ $^ Added: contrib/hjp/majordomo/majordomo ============================================================================== --- (empty file) +++ contrib/hjp/majordomo/majordomo Fri May 12 11:48:40 2006 @@ -0,0 +1,200 @@ +#!/usr/bin/perl + +=head1 NAME + +majordomo - check majordomo configuration before accepting mail + +=head1 DESCRIPTION + +This module reads the majordomo configuration for recipients marked as +majordomo lists and does some checks before accepting the mail. + +Currently the only check implemented is "restrict_post": If this option +is set for the mailing-list, mails from senders which aren't on the +lists are rejected. + +=head1 CONFIGURATION + +This plugin is designed to work together with the aliases plugin. Set +the recpient option majordomo_list in the aliases file: + + [email protected]: [email protected] (majordomo_list=/var/lib/majordomo/mylist) + +The following parameters are recognized + +=over + +=item check_envelope <bool> + +If this is set, the envelope sender is checked. This is easy, but some +people don't like it (Hi, Waldi!). +(Default: 1) + +=item check_header <bool> + +If this is set the From: header of the mail is checked. This is the way +majordomo does it and hence less surprising to your users. It is more +expensive, though and needs the cf_wrapper plugin to work. +(Default: 0) + +=back + +It is possible to combine both. + +=head1 HOOKS + +=cut + +use Mail::Address; + +sub register { + my ($self, $qp, %arg) = @_; + + if (defined($arg{check_envelope}) ? $arg{check_envelope} : 1) { + $self->register_hook("rcpt", "check_envelope"); + } + if (defined($arg{check_header}) ? $arg{check_header} : 0) { + $self->register_hook("rcpt", "save_list"); + $self->register_hook("data_post", "check_header"); + } + +} + +=head2 rcpt: check_envelope + +The check_envelope method performs the checks described above on the +envelope sender. + +=cut + +sub check_envelope { + my ($self, $transaction, $recipient) = @_; + my $ro; + my $list; + return DECLINED + unless ($ro = $transaction->notes('recipient_options') and + $list = $ro->{majordomo_list}); + $self->log(LOGINFO, $recipient->address . " is majordomo list $list"); + return $self->check_address($transaction->sender->address, $recipient->address, $list); +} + +=head2 rcpt: save_list + +The save_list method saves the list information in a note so that +check_header can get at it later. + +=cut + +sub save_list { + my ($self, $transaction, $recipient) = @_; + my $ro; + my $list; + return DECLINED + unless ($ro = $transaction->notes('recipient_options') and + $list = $ro->{majordomo_list}); + $self->log(LOGINFO, $recipient->address . " is majordomo list $list"); + my $n = $self->transaction->notes('majordomo_list'); + $n->{$recipient->address} = $list; + $self->transaction->notes('majordomo_list', $n); + return DECLINED; +} + +=head2 data_post: check_header + +The check_header method performs the checks described above on the +From: header. + +=cut + +sub check_header { + my ($self, $transaction, $recipient) = @_; + my $from = $transaction->header->get('From') || ''; + my $fa = (Mail::Address->parse($from))[0]->address || ''; + $self->log(LOGINFO, "From: $fa found in message"); + my $results = $transaction->notes('cf_wrapper_results'); + for ($transaction->recipients()) { + my $r = $_->address; + my $rc = defined $results->{$r} + ? (ref $results->{$r} eq "ARRAY" + ? $results->{$r}[0] + : $results->{$r} + ) + : DECLINED; + if ($rc == DECLINED) { + my $ml; + my $list; + my $msg = "no objection, your honor!"; + if ($ml = $transaction->notes('majordomo_list') and + $list = $ml->{$r}) { + $self->log(LOGINFO, $r . " is majordomo list $list"); + ($rc, $msg) = $self->check_address($fa, $r, $list); + } + $self->log(LOGINFO, "setting result for $r to $rc"); + $results->{$r} = [$rc, $msg]; + $transaction->notes('cf_wrapper_results', $results); + } + } + return DECLINED; +} + +sub check_address { + my ($self, $sa, $rcpt, $list) = @_; + return DECLINED + unless (open(C, "<$list.config")); + $self->log(LOGDEBUG, "reading config file $list.config"); + $sa = lc($sa); + while (<C>) { + chomp; + s/#.*//; + if (/^\s*restrict_post\s*=\s*(.*)/) { + $self->log(LOGDEBUG, "found $_"); + my $reject; + FILE: for my $l (split(/\s+/, $1)) { + if ($l =~ m|^[^/]|) { + my $d = $list; + $d =~ s|[^/]*$||; + $l = "$d/$l"; + } + $self->log(LOGDEBUG, "checking sender list $l"); + next unless (open (L, "<$l")); + $reject = 1; + while (<L>) { + chomp; + my ($a) = Mail::Address->parse($_); + my $aa = lc($a->address); + $self->log(LOGDEBUG, "checking $sa against $aa"); + if ($aa eq $sa) { + $self->log(LOGINFO, "$sa matched $_ in $l"); + $reject = 0; + last FILE; + } + } + close (L); + $self->log(LOGINFO, "$sa didn't match any address in $l"); + } + return (DENY, "$sa is not subscribed to $rcpt") if ($reject); + #return DENY if ($reject); + } + } + return DECLINED; +} + +=head1 BUGS + +The address comparison is case insensitive, which isn't really correct. + +=head1 TODO + +Implement alternate checks on the message (e.g., PGP signature). In fact +we could replace the whole resend.pl from majordomo with this. + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2004-2006 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + + +=cut Added: contrib/hjp/majordomo/qpsmtpd-plugin-majordomo.spec ============================================================================== --- (empty file) +++ contrib/hjp/majordomo/qpsmtpd-plugin-majordomo.spec Fri May 12 11:48:40 2006 @@ -0,0 +1,56 @@ +Name: qpsmtpd-plugin-majordomo +Version: 175 +Release: 1 +Packager: [email protected] +Summary: majordomo plugin for qpsmtpd +License: distributable +Group: System Environment/Daemons +URL: http://smtpd.develooper.com/ +BuildRoot: %{_tmppath}/%{name}-root +Source0: %{name}.tar.gz +BuildArch: noarch +Conflicts: qpsmtpd-plugin-cf_wrapper < 173 + +%description +This module reads the majordomo configuration for recipients marked as +majordomo lists and does some checks before accepting the mail. + +%prep +%setup -q -c %{name} + +%build + +%clean +rm -rf $RPM_BUILD_ROOT + +%install +rm -rf $RPM_BUILD_ROOT +mkdir -p $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins +cp majordomo $RPM_BUILD_ROOT/usr/share/qpsmtpd/plugins + +[ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress + + +%files +%defattr(-,root,root) +/usr/share/qpsmtpd/plugins/majordomo + +%changelog +* Fri Jan 27 2006 <[email protected]> 175-1 +- Added conflicts line to prevent old/buggy cf_wrapper. +- Fixed stupid error in previous version. + +* Fri Jan 27 2006 <[email protected]> 174-1 +- New upstream version 174: +- Returns useable error message together with return code. + +* Tue Nov 29 2005 <[email protected]> 168-1 +- New upstream version 168: +- Fixed several bugs and made address comparisons case insensitive. +- Changed buildarch to noarch +- Moved spec file into svn repository and fixed makefile so that + make rpm works. + +* Fri Jul 15 2005 <[email protected]> 134-1 +- First RPM package. + Added: contrib/hjp/rcpt_accept/rcpt_accept ============================================================================== --- (empty file) +++ contrib/hjp/rcpt_accept/rcpt_accept Fri May 12 11:48:40 2006 @@ -0,0 +1,54 @@ +=head1 NAME + +rcpt_ok - allow all recipients + +=head1 DESCRIPTION + +This module simply returns OK for each rcpt request. +It is meant to be called after other plugins which return DECLINED for +addresses which are ok (e.g, the aliases plugin). + +=head1 CONFIGURATION + +Nothing to configure + +=head1 HOOKS + +=cut + +sub register { + my ($self, $qp) = @_; + $self->register_hook("rcpt", "rcpt_ok"); +} + +=head2 rcpt: rcpt_ok + +Returns OK + +=cut + +sub rcpt_ok { + my ($self, $transaction, $recipient) = @_; + + $self->log(6, "rcpt_ok:"); + return OK; +} + +=head1 BUGS + +None known (yet). + +=head1 TODO + +Nothing (I hope). + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2003 Peter J. Holzer + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + + +=cut Added: contrib/hjp/require_resolvable_client/require_resolvable_client ============================================================================== --- (empty file) +++ contrib/hjp/require_resolvable_client/require_resolvable_client Fri May 12 11:48:40 2006 @@ -0,0 +1,120 @@ +=head1 NAME + +require_resolvable_client + +=head1 DESCRIPTION + +Plugin to reject mails if the IP address of the client doesn't resolve +to a hostname. + +=head1 CONFIG + +The following parameters can be passed to require_resolvable_client: + +=over 4 + + +=item per_recipient <bool> + +Per recipient flag - if this is set, the plugin is only run for +recipients which have recipient_option 'require_resolvable_client' set. +This can be set by the aliases plugin. +Default: 0. + +=item at_connect <bool> + +If this flag is set, the temporary failure will be generated immediately +after the connect and the connection will be terminated. Otherwise, it +will be generated in response to RCPT TO commands. +Dropping the connection immediately saves resources and prevents address +harvesting. On the other hand, it cannot be (de)activated per recipient. +Default: 0 + +=item permfail <bool> + +If this flag is set, a permanent failure is reported. Otherwise it is +only a temporary failure, giving the admin of the client a chance to fix +the problem before the user notices it. +Default: 0 +=back + +=head1 NOTES + +This plugin makes use of the following connection notes: + +=over + +=item 'client_options'->{require_resolvable_client}{skip} + +If true, do nothing. This note is usually set by the +client_options plugin. + +=back + +and of the following transaction notes: + +=over + +=item 'recipient_options'->{require_resolvable_client} + +If true, greylisting is performed. This is only used if the +per_recipient flag is set. This note is usually set by the aliases +plugin. + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 Peter J. Holzer <[email protected]>. + +This plugin is licensed under the same terms as the qpsmtpd package +itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + + +sub register { + my ($self, $qp, %arg) = @_; + $self->{_require_resolvable_client_per_recipient} = $arg{per_recipient}; + $self->{_require_resolvable_client_permfail} = $arg{permfail}; + if ($arg{at_connect}) { + $self->register_hook("connect", "handler"); + } else { + $self->register_hook("rcpt", "handler"); + } +} + +sub handler { + my ($self, $transaction) = @_; + + $self->log(LOGDEBUG, "in handler"); + if (my $co = $self->qp->connection->notes('client_options')) { + if ($co->{denysoft_greylist}{skip}) { + $self->log(LOGINFO, "client is whitelisted, skipping greylist checks"); + return DECLINED + } + } + if ($self->{_require_resolvable_client_per_recipient}) { + my $ro = $transaction->notes('recipient_options'); + return DECLINED unless ($ro && $ro->{require_resolvable_client}); + } + my $hostname = $self->connection->remote_host; + $self->log(LOGDEBUG, "hostname $hostname"); + if ($hostname eq "Unknown" || $hostname =~ m /^\[[\d.]+\]$/ || $hostname =~ m /^[\d.]+$/ ) { + $self->log(LOGINFO, "$hostname not a FQDN, returning failure"); + return $self->{_require_resolvable_client_permfail} ? DENY : DENYSOFT, + "Reverse lookup for " . $self->connection->remote_ip . " failed"; + } + $self->log(LOGDEBUG, "checking addresses of $hostname against " . $self->connection->remote_ip); + my $ip = pack("C*", split(/\./, $self->connection->remote_ip)); + my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($hostname); + for (@addrs) { + $self->log(LOGDEBUG, "checking address " . join(".", unpack("C4", $_))); + return DECLINED if ($ip eq $_); + } + $self->log(LOGINFO, "no address matches " . $self->connection->remote_ip . ", returning failure"); + return $self->{_require_resolvable_client_permfail} ? DENY : DENYSOFT, + "Host name " . $self->connection->remote_host . " doesn't match IP address " . $self->connection->remote_ip; +} + Added: contrib/vetinari/ContentType.pm ============================================================================== --- (empty file) +++ contrib/vetinari/ContentType.pm Fri May 12 11:48:40 2006 @@ -0,0 +1,242 @@ + +=head1 NAME + +Qpsmtpd::ContentType - parse and access the contents of the Content-Type header + +=head1 DESCRIPTION + +This plugin parses the contents of the given I<Content-Type:> header according +to RFC 1521 ``MIME (Multipurpose Internet Mail Extensions) Part One: +Mechanisms for Specifying and Describing the Format of Internet Message Bodies'' + +=head1 SYNOPSIS + + sub hook_data_post { + my ($self,$transaction) = @_; + my $ct = $transaction->notes('Content-Type'); + unless ($ct) { + my $ct_head = $transaction->header->get('Content-Type'); + $ct = Qpsmtpd::ContentType->parse($ct_head); + $transaction->notes('Content-Type', $ct); + } + if ($ct->type eq 'text') { + return (DENY, "HTML only mails not accepted here") + if ($ct->subtype eq 'html'); + [... do something else ... ] + } + return (DECLINED); + } + +=head1 API + +=head2 parse( $value_of_Content_Type_header ) + +Parses the contents of the I<Content-Type:> header and returns an object +where the fields can be accessed. + +=head2 illegal( ) + +True, if an error occured. + +=head2 error( ) + +The error message if B<illegal()> returned true. + +=head2 type( ) + +The main type of the MIME-Type, e.g. B<text> for a I<text/plain> type. + +=head2 subtype( ) + +The subtype if the MIME-Type, e.g. B<plain> for a I<text/plain> type. + +=head2 param(NAME) + +Returns the value of the parameter NAME or I<undef()> if not present in +the Content-Type header. + +=cut + +package Qpsmtpd::ContentType; + +# In the Augmented BNF notation of RFC 822, a Content-Type header field +# value is defined as follows: +# +# content := "Content-Type" ":" type "/" subtype *(";" +# parameter) +# ; case-insensitive matching of type and subtype +# +# type := "application" / "audio" +# / "image" / "message" +# / "multipart" / "text" +# / "video" / extension-token +# ; All values case-insensitive +# +# extension-token := x-token / iana-token +# +# iana-token := <a publicly-defined extension token, +# registered with IANA, as specified in +# appendix E> +# +# x-token := <The two characters "X-" or "x-" followed, with +# no intervening white space, by any token> +# +# subtype := token ; case-insensitive +# +# parameter := attribute "=" value +# +# attribute := token ; case-insensitive +# +# value := token / quoted-string +# +# token := 1*<any (ASCII) CHAR except SPACE, CTLs, +# or tspecials> +# +# tspecials := "(" / ")" / "<" / ">" / "@" +# / "," / ";" / ":" / "\" / <"> +# / "/" / "[" / "]" / "?" / "=" +# ; Must be in quoted-string, +# ; to use within parameter values + +sub parse { + my $me = shift; + my $ct = shift; + my $self = {}; + bless $self, $me; + + $self->illegal(0); + + my $tspecials = '\(\)<>@,;:\\"/\[\]?='; + my $tclass = "[^\x00-\x1F\x7F-\xFF $tspecials]"; + my $token = qr#$tclass(?:$tclass)*#; + my $x_token = qr#X-$token#; # will match X- and x- tokens :) + my $iana_token = qr#$token#; # is this true? + my $ext_token = qr#($x_token|$iana_token)#; + my $parameter = qr# *($token) *= *($token|(['"]).+?\3)(?:( *;|$))#; + my $type = qr#($token|$ext_token)#; + my $sub = qr#($token|(["']).+\2)(?:( *;|$))#; + + $ct =~ s/(\n\s)/ /gs if $ct; + $ct =~ s/^ *// if $ct; + unless ($ct) { + $ct = "text/plain; charset=us-ascii"; + } + # print STDERR "Content-Type: $ct\n"; + if ($ct =~ s#^$type/##i) { + $self->{' _type'} = lc $1; + if ($ct =~ s#^$sub##i) { + $self->{' _sub'} = lc $1; + } + else { + $self->error("No SUBTYPE in Content-Type"); + return $self; + } + } + else { + # Note also that a subtype specification is MANDATORY. + # There are no default subtypes. + $self->error("No TYPE/ in Content-Type"); + return $self; + } + + while ($ct =~ s/^$parameter//i) { + my ($k,$v) = (lc $1, $2); + $v =~ s/^(['"])?(.+)\1$/$2/; + $self->{$k} = $v; + } + + if ($self->type eq 'text') { + $self->param('charset', (lc $self->param('charset') || 'us-ascii')); + return $self; + } + + if ($self->type eq 'multipart') { + my $bcharsnospace = qr#[0-9a-zA-Z'()+_,-./:=?]#; + my $boundary = $self->param('boundary') || ""; + $boundary =~ s/\s*$//; + if ($boundary =~ m#^( |$bcharsnospace){0,69}$bcharsnospace$#) { + $self->param('boundary', $boundary); + } + else { + $self->error("illegal boundary parameter"); + } + return $self; + } + + if ($self->type eq 'message') { + if ($self->subtype eq 'partial') { + unless ($self->param('id') and $self->param('number')) { + # luckily: + # Note that part numbering begins with 1, not 0. + $self->error("no ID or NUMBER parameter"); + return $self; + } + unless ($self->param('number') =~ /^\d+$/) { + $self->error("value of NUMBER not just digits"); + return $self; + } + if ($self->param('total') && $self->param('total') !~ /^\d+$/) { + $self->error("value of TOTAL not just digits"); + return $self; + } + return $self; + } + elsif ($self->subtype eq 'external-body') { + unless ($self->param('access-type')) { + $self->error("no ACCESS-TYPE parameter"); + return $self; + } + $self->param('access-type', lc $self->param('access-type')); + if ($self->param('access-type') =~ /^(anon-|t)?ftp$/) { + unless ($self->param('name') && $self->param('site')) { + $self->error("no NAME or SITE parameter"); + return $self; + } + + if ($self->param('access-type') =~ /^(anon-)?ftp$/) { + $self->param('mode', ($self->param('mode') || 'ascii')); + } + else { + $self->param('mode', ($self->param('mode') || 'netascii')); + } + } + elsif ($self->param('access-type') =~ /^(local-file|afs)$/) { + unless ($self->param('name')) { + $self->error("no NAME parameter"); + return $self; + } + } + elsif ($self->param('access-type') eq 'mail-server') { + unless ($self->param('server')) { + $self->error("no SERVER parameter"); + return $self; + } + } + } + return $self; + } + + return $self; +} + +sub error { + my ($self, $msg) = @_; + if (defined $msg) { + $self->{' _error'} = $msg; + $self->illegal(1); + } + return $self->{' _error'}; +} + +sub illegal { $_[1] ? ($_[0]->{' _illegal'} = $_[1]) : $_[0]->{' _illegal'}; } +sub type { $_[0]->{' _type'} } +sub subtype { $_[0]->{' _sub'} } +sub param { + my ($self,$key,$value) = @_; + if (defined $value) { + $self->{lc $key} = $value; + } + return ($self->{$key} || undef); +} + +1; Added: contrib/vetinari/charset ============================================================================== --- (empty file) +++ contrib/vetinari/charset Fri May 12 11:48:40 2006 @@ -0,0 +1,90 @@ +#! perl +# +# charset - demo and real life plugin for the Qpsmtpd::ContentType module +# +use Qpsmtpd::ContentType; +use Qpsmtpd::DSN; + +=head1 NAME + +charset - filter messages based on the given charset of the Content-Type + +=head1 DESCRIPTION + +This plugin uses the B<Qpsmtpd::ContentType> module and looks in the +I<Content-Type:> header for the I<text/*; charset=NAME> parameter. If it +matches one given in the B<charsets> config file it will act on it. + +=head1 CONFIG + +The plugin takes no arguments. It reads the charset, a return code (which must +be a vaild return code from I<Qpsmtpd::Constants>) and an optional message +from the B<charsets> config file. + +=head1 EXAMPLE + +This is an example B<charsets> config file. + + iso-2022-jp DENY Charset iso-2022-jp not accepted here + shift-jis DENY Charset shift-jis not accepted here + koi8-r DENY Charset koi8-r not accepted here + GB2312 DENY Charset GB2312 not accepted here + big5 DENY Charset big5 not accepted here + +Charset names are case insensitive and any ``_'' will be replaced by +a ``-''. + +=head1 HINTS + +Don't DENY an "us-ascii" charset, as this is the default for messages +without a I<Content-Type:> header (see RFC 1521). + +=cut + +sub hook_data_post { + my ($self,$transaction) = @_; + my %charsets; + # let's see if some other plugins have parsed the Content-Type + # header before us + my $ct = $transaction->notes('Content-Type'); + unless ($ct) { + # no? ok, remember it for the following plugins + my $ct_head = $transaction->header->get('Content-Type'); + $ct = Qpsmtpd::ContentType->parse($ct_head); + $transaction->notes('Content-Type', $ct); + } + + ## XXX: Don't enable until you're 110% sure I made no mistake + ## in the Qpsmtpd::ContentType module AND you just get broken + ## Content-Type headers from spam only sources + # return Qpsmtpd::DSN->media_unsupported(DENY, + # "Malformed Content-Type header: ".$ct->error) + # if $ct->illegal; + + if ($ct->type eq 'text') { + my $cset = lc $ct->param('charset'); + $cset =~ tr/_/-/; + + my %cs = map { split ' ', $_, 2; } $self->qp->config('charsets'); + foreach my $k (keys %cs) { + $charsets{lc $k} = $cs{$k}; + $charsets{lc $k} =~ tr/_/-/; + } + return (DECLINED) unless exists $charsets{$cset}; + + my ($code,$msg) = split ' ', $charsets{$cset}, 2; + $code = uc $code; + if ($code eq 'OK' || $code eq 'DECLINED' || $code eq 'DONE') { + return (DECLINED); + } + + my $ret = Qpsmtpd::Constants::return_code($code); + unless (defined $ret) { + $self->log(LOGWARN, "Unknown return code $code..."); + return (DECLINED); + } + return Qpsmtpd::DSN->media_unsupported($ret, + ($msg || 'Content-Type denied')); + } + return (DECLINED); +} Added: contrib/vetinari/check_dns_user ============================================================================== --- (empty file) +++ contrib/vetinari/check_dns_user Fri May 12 11:48:40 2006 @@ -0,0 +1,120 @@ +# +# check_dns_user - see if RCPT TO address can be found (in a special DNS zone) +# + +=head1 NAME + +check_dns_user - see if RCPT TO address can be found (in a special DNS zone) + +=head1 DESCRIPTION + +The B<check_dns_user> plugin tries to lookup users stored as hostnames. + +=head1 CONFIGURATION + +Add the plugin to the qpsmtpd plugin config as usual. At least one parameter +must be given: a list of domains to query. + +The RCPT TO address [email protected] is converted to user.at.dom.ain. Then an A +lookup for user.at.dom.ain is done. If the host exists and has the address +127.0.0.2, 127.0.0.3 or 127.0.0.4 the next plugin decides about the mail. +Else the RCPT TO returns DENY. + +=head1 NOTES + +This can only be used for usernames consisting of the charachters I<a-z>, +I<0-9>, I<-> and I<.>. + +This plugin was inspired by some discussion on the qpsmtpd mailing list. +It was written, because + +=over 3 + +=item * + +the userlist of valid users can be done on one internal server by adduser +and /usr/local/sbin/adduser.local. The latter updates the .at.dom.ain zone +and reloads the name server. + +=item * + +the mail server already was a DNS slave for the main server inside. +so all lookups are local. + +=item * + +nothing has to be done for keeping this list in sync on both servers, as DNS +servers do this automagically. + +=back + +=cut + +use Net::DNS; + +use constant DNSMAIL_USER => "127.0.0.2"; +use constant DNSMAIL_GROUP => "127.0.0.3"; +use constant DNSMAIL_ALIAS => "127.0.0.4"; + +sub register { + my ($self, $qp, @args) = @_; + $self->{_check_dns_domains} = [@args]; +} + +sub hook_rcpt { + my ($self, $transaction, $recipient) = @_; + # return (DECLINED) + # if $self->qp->connection->relay_client; + + return (DECLINED) + unless $recipient->host && $recipient->user; + my $host = lc $recipient->host; + my $user = lc $recipient->user; + my $rcpt = $user.'@'.$host; + my ($res,$query,$answer,$domain); + + foreach $domain (@{$self->{_check_dns_domains}}) { + next unless $host eq $domain; + $res = new Net::DNS::Resolver; + $query = $res->search("$user.at.$domain", "A"); + + unless ($query) { + if ($res->errorstring eq 'NXDOMAIN') { + $self->log(LOGNOTICE, "denying mail for $rcpt (resolver said: NXDOMAIN)"); + return (DENY, "mail for recipient not accepted here"); + } + + elsif ($res->errorstring eq 'SERVFAIL') { + if ($user =~ /\.$/ || $user =~ /[^a-z0-9\-.]/) { + ### err.. this has a reason, but I forgot... + ### it was added during testing, because one (valid) RCPT TO failed + $self->log(LOGNOTICE, "denying mail for $rcpt (resolver said: SERVFAIL)"); + return(DENY, "mail for recipient not accepted here"); + } + $self->log(LOGWARN, "User resolver error: '".$res->errorstring."'"); + return(DECLINED); + } + + $self->log(LOGWARN, "User resolver error: '".$res->errorstring."'"); + return (DENYSOFT, "temporary error validating user's address"); + } + + $answer = 0; + foreach my $rr ($query->answer) { + unless ($answer) { + next unless $rr->type eq "A"; + $answer = $rr->address; + } + } + # $self->log(LOGDEBUG, "answer was $answer"); + if ($answer eq DNSMAIL_USER || $answer eq DNSMAIL_GROUP || $answer eq DNSMAIL_ALIAS) { + $self->log(LOGDEBUG, "accepting mail for $rcpt"); + return (DECLINED); + } else { + $self->log(LOGWARN, "got unexpected answer '$answer' for '$rcpt'"); + } + } # end: foreach $domain ( + return (DECLINED); +} + +# vim: ts=2 sw=2 expandtab syn=perl Added: contrib/vetinari/check_user_cdb ============================================================================== --- (empty file) +++ contrib/vetinari/check_user_cdb Fri May 12 11:48:40 2006 @@ -0,0 +1,128 @@ +# +# +# + +=head1 NAME + +check_user_cdb - validate recipients from a .cdb file + +=head1 DESCRIPTION + +The B<check_user_cdb> plugin tries to lookup recipients stored in a .cdb file +(see L<http://cr.yp.to/cdb.html> for more info). If a user is not found in an +existing .cdb file, it will reject the recipient, else other plugins can +decide about the future of this RCPT TO. + +=head1 CONFIGURATION + +Add the plugin to the qpsmtpd plugin config as usual. At least two parameters +must be given in the order described here: + +=over 2 + +=item * + +the directory where the .cdb files are stored. This directory must be +accessible by the user qpsmtpd is running as. The .cdb files must be readable +by the same user. + +=item * + +a list of domain names of which you want to validate the recipients for + +=back + +=head1 CDB FILE FORMAT + +The only required thing to make this plugin work is the key of the .cdb file. +The value(s) can be used for anything. Currently I'm using this to map recpient +addresses in some domains to forward the mails to their home address. The +source file for the mydomain.org.cdb file looks like + + user1:[email protected] + user2:[email protected] + user3:localuser + alias1:[email protected] + alias1:[email protected] + +with the valid recipients [email protected], [email protected], [email protected] and [email protected]. + +=head1 EXAMPLE + +check_user_cdb /etc/qpsmtpd mydomain.com another-dom.net + +This will check the files I</etc/qpsmtpd/mydomain.com.cdb> for all recipients +with the RCPT TO address of [email protected] and +I</etc/qpsmtpd/another-dom.net> for RCPT TO addesses of [email protected]. + +Both files can be used by the local MTA to decide what to to with the mail. + + +=head1 REQUIREMENTS + +This plugin requires the CDB_File module found on CPAN here: +L<http://search.cpan.org/~msergeant/CDB_File-0.94/> + +=head1 AUTHOR + +Hanno Hecker <[email protected]> + +=head1 LICENCE + +Copyright (c) 2005 Hanno Hecker + +This plugin is licensed under the same terms as the qpsmtpd package itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +use CDB_File; +our (%users,$cdb); + +sub register { + my ($self,$qp,$cdb_dir,@domains) = @_; + $self->register_hook("rcpt", "cdb_lookup"); + die "no cdb_dir given" unless $cdb_dir; + die "no domains given" unless @domains; + $self->{_cdb_dir} = $cdb_dir; + $self->{_cdb_domains} = [@domains]; +} + +sub cdb_lookup { + my ($self,$transaction,$recipient) = @_; + my $found = 0; + my $cdb_file; + my $host = lc $recipient->host; + my $user = lc $recipient->user; + $host = $self->qp->config("me") + if ($host eq "" && (lc $user eq "postmaster" || lc $user eq "abuse")); + my $rcpt = $user.'@'.$host; + + foreach my $domain (@{$self->{_cdb_domains}}) { + next unless ($domain eq $host); + $cdb_file = $self->{_cdb_dir}."/$domain.cdb"; + if (-r $cdb_file) { + $found = 1; + last; + } + } + return (DECLINED) unless ($found); + + my $cdb = tie %users, "CDB_File", $cdb_file + or do { + $self->log(LOGWARN, "CDB_File tie($cdb_file) failed: $!"); + undef $cdb; + untie %users; + return (DENYSOFT, "temporary error validating recipient"); + # return (DENYSOFT, "temporary error validating $rcpt"); + }; + my @rcpts = @{$cdb->multi_get($user)}; + undef $cdb; + untie %users; + # return (DENY, "mail for $rcpt not accepted here") + return (DENY, "mail for recipient not accepted here") unless (@rcpts); + return (DECLINED); +} + +# vim: ts=2 sw=2 expandtab syn=perl Added: contrib/vetinari/check_vuser ============================================================================== --- (empty file) +++ contrib/vetinari/check_vuser Fri May 12 11:48:40 2006 @@ -0,0 +1,74 @@ +# this plugin checks if the vuser_dir exists and else denies the mail +# ... see the --virtual-config-dir option for spamd and run spamc with +# -u $rcpt_to + +=head1 NAME + +check_vuser - checks if a local vpop style dir exists and denies recpient +if not + +=head1 CONFIGURATION + +check_vuser /var/vusers/%d/%u mydom.ain anotherdom.ain + + or + +check_vuser /var/vusers/%d/%u one_filename_without_a_dot_with_list_of_domains + +=cut + +sub register { + my ($self, $qp, $dir, @domains) = @_; + die "didn't get a (valid) vuser_dir..." + unless $dir =~ m!^/(.+)!; + $self->{_vuser_dir} = $dir; + if (@domains == 1 && $domains[0] !~ /\./) { + $self->{_vuser_config} = $domains[0]; + $self->{_vuser_domains} = []; + } else { + $self->{_vuser_domains} = [@domains]; + } +} + +sub hook_rcpt { + my ($self, $transaction, $recipient) = @_; + return (DECLINED) + unless ($recipient->host && $recipient->user); + + my $host = lc $recipient->host; + my $user = lc $recipient->user; + my $to = $user.'@'.$host; + + if (@{$self->{_vuser_domains}} || $self->qp->config($self->{_vuser_config})) { + my $found = 0; + foreach my $domain (@{ $self->{_vuser_domains} }, $self->qp->config( $self->{_vuser_config} )) + { + # $found = 1, last if $host eq lc $domain; + if ($host eq lc($domain)) { + $found = 1; + last; + } + } + return (DECLINED) unless $found; + } + + $user =~ tr/-A-Za-z0-9+_.,@=/_/c; # clean $user like spamd does + $host =~ tr/-A-Za-z0-9+_.,@=/_/c; # clean $host like spamd does + my $rcpt = $user.'@'.$host; + + #$self->log(LOGDEBUG, "to='$to', rcpt='$rcpt'"); + + my $dir = $self->{_vuser_dir}; + $dir =~ s/\%l/$user/g; + $dir =~ s/\%d/$host/g; + $dir =~ s/\%u/$rcpt/g; + #$self->log(LOGDEBUG, "dir='$dir', ".(-e $dir ? "exists" : "does not exist")); + unless (-e $dir) { + $self->log(LOGINFO, "Denied mail to $to ($dir doesn't exist)"); + # return (DENY, "mail to $to not accepted here"); + return (DENY, "mail to recipient not accepted here"); + } + return (DECLINED); +} + +# vim: ts=2 sw=2 expandtab syn=perl Added: contrib/vetinari/connection_time ============================================================================== --- (empty file) +++ contrib/vetinari/connection_time Fri May 12 11:48:40 2006 @@ -0,0 +1,42 @@ + +=head1 NAME + +connection_time - log the duration of a connection + +=head1 DESCRIPTION + +The B<connection_time> plugin records the time of a connection between the +first and the last possible hook in qpsmtpd (I<pre-connection> and +I<post-connection>) and writes a LOGNOTICE line to the log. + +=head1 CONFIG + +No config :) + +=cut + +use Time::HiRes qw(gettimeofday tv_interval); + +sub hook_pre_connection { + my ($self, @foo) = @_; + $self->connection->notes('_connection_start' => [gettimeofday]); + return (DECLINED); +} + +sub hook_post_connection { + my ($self, @foo) = @_; + if ($self->connection->notes('_connection_start')) { + my $remote = $self->connection->remote_ip; + my $elapsed = sprintf( + "%.3f", + tv_interval( + $self->connection->notes('_connection_start'), + [gettimeofday] + ) + ); + $self->log(LOGINFO, "Connection time from $remote: $elapsed sec."); + } + return (DECLINED); +} + +# vim: ts=4 sw=4 expandtab syn=perl Added: contrib/vetinari/rcpt_ldap ============================================================================== --- (empty file) +++ contrib/vetinari/rcpt_ldap Fri May 12 11:48:40 2006 @@ -0,0 +1,219 @@ +#!/usr/bin/perl -w + +# POD is at the end + +sub register { + my ( $self, $qp, @args ) = @_; + $self->register_hook( "rcpt", "ldap_rcpt" ); + + # pull config defaults in from file + %{ $self->{"ldconf"} } = map { + (split /\s+/, $_, 2)[0,1] + } $self->qp->config('ldap'); + + # override ldap config defaults with plugin args + for my $ldap_arg (@args) { + %{ $self->{"ldconf"} } = map { (split /\s+/, $_, 2)[0,1] } $ldap_arg; + } + + # do light validation of ldap_host and ldap_port to satisfy -T + my $ldhost = $self->{"ldconf"}->{'ldap_host'}; + my $ldport = $self->{"ldconf"}->{'ldap_port'}; + if (($ldhost) && ($ldhost =~ m/^(([a-z0-9]+\.?)+)$/)) { + $self->{"ldconf"}->{'ldap_host'} = $1 + } else { + undef $self->{"ldconf"}->{'ldap_host'}; + } + if (($ldport) && ($ldport =~ m/^(\d+)$/)) { + $self->{"ldconf"}->{'ldap_port'} = $1 + } else { + undef $self->{"ldconf"}->{'ldap_port'}; + } + + # set any values that are not already + $self->{"ldconf"}->{"ldap_host"} ||= "127.0.0.1"; + $self->{"ldconf"}->{"ldap_port"} ||= 389; + $self->{"ldconf"}->{"ldap_timeout"} ||= 5; + $self->{"ldconf"}->{"ldap_rcpt_filter_attr"} ||= "dn"; + $self->{"ldconf"}->{"ldap_rcpt_filter"} ||= + '(& (objectClass=inetOrgPerson)(| (mail=%r)(mailAlternateAddress=%r) ) )'; + # %r rcpt address + # %h host part of %r + # %u user part of %r +} + +sub ldap_rcpt { + use Net::LDAP qw(:all); + use Qpsmtpd::Constants; + + my ($self, $transaction, $recipient) = @_; + my ($ldhost, $ldport, $ldwait, $ldbase, $ldfattr, $ldfilter, $lduserdn, + $ldh, $mesg, $rcpt, $user, $host); + + unless (&is_rcpthost($self,$recipient->user,$recipient->host)) { + return (OK) if $self->qp->connection->relay_client; + return (DECLINED); + } + + # pull values in from config + $ldhost = $self->{"ldconf"}->{"ldap_host"}; + $ldport = $self->{"ldconf"}->{"ldap_port"}; + $ldbase = $self->{"ldconf"}->{"ldap_base"}; + + # log error here and DECLINE if no baseDN, because a custom + # baseDN is required: + unless ($ldbase) { + $self->log(LOGERROR, "ldap_rcpt - please configure ldap_base") && + return (DECLINED, "temporary user lookup error"); + } + $ldwait = $self->{"ldconf"}->{'ldap_timeout'}; + $ldfattr = $self->{"ldconf"}->{'ldap_rcpt_filter_attr'}; + + # find dn of user matching supplied username + $ldh = Net::LDAP->new($ldhost, port=>$ldport, timeout=>$ldwait) or + $self->log(LOGALERT, "ldap_rcpt - error in initial conn") && + return (DENYSOFT, "temporary user lookup error"); + + ($rcpt = $recipient->address) =~ s/[()]/\\$1/g; + ($user = $recipient->user) =~ s/[()]/\\$1/g; + $host = $recipient->host; + + mbox_retry: + $ldfilter = $self->{"ldconf"}->{'ldap_rcpt_filter'}; + $ldfilter =~ s/\%r/$rcpt/g; + $ldfilter =~ s/\%h/$host/g; + $ldfilter =~ s/\%u/$user/g; + + + # find the user's DN + $mesg = $ldh->search( + base=>$ldbase, + scope=>'sub', + filter=>$ldfilter, + attrs=>[$ldfattr], + timeout=>$ldwait + ) + or $self->log(LOGALERT, "ldap_rcpt - err in search for user") + && return (DENYSOFT, "temporary user lookup error"); + + # deal with errors if they exist + if ($mesg->code) { + $self->log(LOGALERT, "ldap_rcpt - err ".$mesg->code + ." in search for user"); + return (DENYSOFT, "temporary user lookup error"); + } + + # bind against directory as user with password supplied + if ($mesg->count) { + $self->log(LOGWARN, "ldap_rcpt - '".$recipient->user + ."' lookup success"); + return (OK, "ldap_rcpt"); + } else { + # if the plugin couldn't find user's entry + while ($user =~ s/^(.*)\+.*$/$1/) { + $rcpt = $user.'@'.$host; + $self->log(LOGINFO, "ldap_rcpt - retrying with '$user'"); + goto mbox_retry; + } + $self->log(LOGALERT, "ldap_rcpt - user ".$recipient->address + ." not found") + && return (DENY, "User not found"); + } + ### err ... this should be called earlier?!?! (pre return()); + $ldh->disconnect; +} + +### this is an ugly duplication of code... it should be in Qpsmtpd::* +### somewhere (from plugins/rcpt_ok) +sub is_rcpthost { + my ($self, $user, $host) = @_; + + my @rcpt_hosts = ($self->qp->config("me"), $self->qp->config("rcpthosts")); + + # Allow 'no @' addresses for 'postmaster' and 'abuse' + # qmail-smtpd will do this for all users without a domain, but we'll + # be a bit more picky. Maybe that's a bad idea. + $host = $self->qp->config("me") + if ($host eq "" && (lc $user eq "postmaster" || lc $user eq "abuse")); + + # Check if this recipient host is allowed + for my $allowed (@rcpt_hosts) { + $allowed =~ s/^\s*(\S+)/$1/; + return 1 if $host eq lc $allowed; + return 1 if substr($allowed,0,1) eq "." and $host =~ m/\Q$allowed\E$/i; + } + + my $more_rcpt_hosts = $self->qp->config('morercpthosts', 'map'); + return(exists $more_rcpt_hosts->{$host}); +} + +1; + +=head1 NAME + +rcpt_ldap - verify local users by looking in LDAP + +=head1 DESCRIPTION + +This plugin looks up users in an LDAP Directory. This plugin uses the +'ldap_rcpt_filter' to match the recipient address. + +=head1 CONFIGURATION + +Configuration items can be held in either the 'ldap' configuration file, or as +arguments to the plugin. + +Configuration items in the 'ldap' configuration file +are set one per line, starting the line with the configuration item key, +followed by a space, then the values associated with the configuration item. + +Configuration items given as arguments to the plugin are keys and values +separated by spaces. Be sure to quote any values that have spaces in them. + +The only configuration item which is required is 'ldap_base'. This tells the +plugin what your base DN is. The plugin will not work until it has been +configured. + +The configuration items 'ldap_host' and 'ldap_port' specify the host and port +at which your Directory server may be contacted. If these are not specified, +the plugin will use port '389' on 'localhost'. + +The configuration item 'ldap_timeout' specifies how long the plugin should +wait for a response from your Directory server. By default, the value is 5 +seconds. + +The configuration item 'ldap_rcpt_filter' specifies how the plugin should +find the user in your Directory. By default, the plugin will look up the +recipient based on the 'mail' or 'mailAlternateAddress' attributes. + +=head1 NOTES + +The default 'ldap_rcpt_filter' assumes the qmail.schema from +http://www.qmail-ldap.org/ (inside the diff against qmail). Any filter +will work, as long as at least one result is returned. +Any '%r' in the filter will be replaced by the recpient address, any '%h' +with the host part of '%r' and any '%u' with the user part of '%r'. + +=head1 FUTURE DIRECTION / THOUGHTS + +Any LDAP plugin should use the same config file ('ldap') for qpsmtpd. + +=head1 CHANGES + +- added $user+$mbox support + +=head1 AUTHOR + +Hanno Hecker <[email protected]> +based on the auth_ldap_bind plugin by Elliot Foster <[email protected]> + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2005 Hanno Hecker + +This plugin is licensed under the same terms as the qpsmtpd package itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +# vim: ts=4 sw=4 expandtab syn=perl Added: contrib/vetinari/rcpt_regexp ============================================================================== --- (empty file) +++ contrib/vetinari/rcpt_regexp Fri May 12 11:48:40 2006 @@ -0,0 +1,99 @@ +use Qpsmtpd::Constants; + +sub register { + my ($self, $qp, @args) = @_; + $self->register_hook("rcpt", "check_regexp_rcpt"); +} + +sub check_regexp_rcpt { + my ($self, $transaction, $recipient) = @_; + return (DECLINED) + unless $recipient->host && $recipient->user; + + my $rcpt = lc $recipient->user . '@' . $recipient->host; + my ($re, $const, $comment, $str, $ok, $err); + + foreach ($self->qp->config("rcpt_regexp")) { + s/^\s*//; + ($re, $const, $comment) = split /\s+/, $_, 3; + $str = undef; + if ($re =~ m#^/(.*)/$#) { + $re = $1; + $ok = eval { $re = qr/$re/i; }; + if ($@) { + ($err = $@) =~ s/\s*at \S+ line \d+\.\s*$//; + $self->log(LOGWARN, "REGEXP '$re' not valid: $err"); + next; + } + $re = $ok; + } + else { + $str = lc $re; + } + + unless (defined $const) { + $self->(LOGWARN, "rcpt_regexp - no return code"); + next; + } + + $ok = $const; + $const = Qpsmtpd::Constants::return_code($const); + unless (defined $const) { + $self->log(LOGWARN, + "rcpt_regexp - '$ok' is not a valid " + . "constant, ignoring this line" + ); + next; + } + + if (defined $str) { + next unless $str eq $rcpt; + $self->log(LOGDEBUG, "String $str matched $rcpt, returning $ok"); + } + else { + next unless $rcpt =~ $re; + $self->log(LOGDEBUG, "RE $re matched $rcpt, returning $ok"); + } + + return ($const, $comment); + } + return (DECLINED); +} + +=head1 NAME + +rcpt_regexp - check recipients against a list of regular expressions + +=head1 DESCRIPTION + +B<rcpt_regexp> reads a list of regular expressions, return codes and comments +from the I<rcpt_regexp> config file. If the regular expression does NOT match +I<m#^(/.*/)$#>, it is used as a string which is compared with I<eq lc($rcpt)>. +The recipient addresses are checked against this list, and if the first +matches, the return code from that line and the comment are returned to +qpsmtpd. Return code can be any valid plugin return code from +Qpsmtpd::Constants. Matching is always done case insenstive. + +=head1 CONFIG FILE + +The config file I<rcpt_regexp> contains lines with a perl RE, including the +"/"s, a return code and a comment, which will be returned to the sender, if +the code is not OK or DECLINED. Example: + + # rcpt_regexp - config for rcpt_regexp plugin + [email protected] OK Accepting mail + /^user\d+\@doma\.in$/ OK Accepting mail + [email protected] DENY User not found. + /^unused\@.*/ DENY User not found. + /^.*$/ DECLINED Fall through to next rcpt plugin + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2005 Hanno Hecker + +This plugin is licensed under the same terms as the qpsmtpd package itself. +Please see the LICENSE file included with qpsmtpd for details. + +=cut + +# vim: ts=4 sw=4 expandtab syn=perl