develooper Front page | perl.cvs.qpsmtpd | Postings from May 2006

[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 vetin

From:
jpeacock
Date:
May 12, 2006 11:50
Subject:
[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 vetin
Message ID:
20060512184842.55586CBA47@x12.develooper.com
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 <hjp@hjp.at>
+vetinari = Hanno Hecker <vetinari@ankh-morp.org>
+
+

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,peter.holzer@wsr.ac.at,wifo.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
+    postmaster@,wsr.ac.at,wifo.at: sysadm@wsr.ac.at
+    sysadm@wsr.ac.at: hjp@wsr.ac.at,gina@wsr.ac.at
+
+The addresses <postmaster>, <postmaster@wsr.ac.at> and <postmaster@wifo.ac.at> would 
+all be expanded to <sysadm@wsr.ac.at>, which in turn would be expanded
+to two adresses (<hjp@wsr.ac.at>, <gina@wsr.ac.at>), of which the first
+would again be expanded to <hjp@asherah.wsr.ac.at>.
+
+So if you send mail to <postmaster+test@wsr.ac.at>, it will be delivered
+to <hjp+test@asherah.wsr.ac.at> and <gina+test@wsr.ac.at>.
+
+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:
+
+    hjp@wsr.ac.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
+    peter.holzer@wsr.ac.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
+    hjp@wifo.at: hjp@asherah.wsr.ac.at (denysoft_greylist, spamassassin_reject_threshold=10)
+    peter.holzer@wifo.at: hjp@asherah.wsr.ac.at (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:
+
+    {
+        'hjp@wsr.ac.at'          => [ 'hjp@asherah.wsr.ac.at' },
+        'peter.holzer@wsr.ac.at' => [ 'hjp@asherah.wsr.ac.at' },
+        ...
+        'postmaster@wsr.ac.at'   => [
+                                      'hjp@asherah.wsr.ac.at',
+                                      'gina@wsr.ac.at'
+                                    ],
+        ...
+    }
+
+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:
+
+    {
+        'hjp@wsr.ac.at' => {
+                               denysoft_greylist => 1,
+                               spamassassin_reject_threshold => 10
+                           },
+        'peter.holzer@wsr.ac.at' => {
+                               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:
+
+    {
+        'hjp@wsr.ac.at'          => [ 'hjp@asherah.wsr.ac.at' },
+        'peter.holzer@wsr.ac.at' => [ 'hjp@asherah.wsr.ac.at' },
+        ...
+        'postmaster@wsr.ac.at'   => [
+                                      'hjp@asherah.wsr.ac.at',
+                                      'gina@wsr.ac.at'
+                                    ],
+        ...
+    }
+
+=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 <hjp@wsr.ac.at>
+
+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: hjp@hjp.at
+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 <hjp@hjp.at> 181-1
+- Upstream version 180: Honor the connection->relay_client property.
+- Upstream version 181: Updated spec file.
+
+* Thu Aug 23 2005 <hjp@hjp.at> 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 <hjp@hjp.at> 158-1
+- Upstream version 158: Cleaned up log messages.
+
+* Thu Aug 18 2005 <hjp@hjp.at> 154-1
+- Upstream version 154: Fixed typo introduced in r153.
+
+* Thu Aug 18 2005 <hjp@hjp.at> 153-1
+- Upstream version 153: Documentation and debug messages cleaned up.
+- Changed buildarchitecture to noarch.
+
+* Sat Jul 16 2005 <hjp@hjp.at> 138-1
+- Upstream version 137: Changes for forkserver.
+- Upstream version 138: Moved parsing of config files to pre-connection hook.
+
+* Fri Jul 15 2005 <hjp@hjp.at> 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: hjp@hjp.at
+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 <hjp@hjp.at> 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 <gavin@openfusion.com.au>.
+This version was modified by Peter J. Holzer <hjp@hjp.at>. 
+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: hjp@hjp.at
+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 <hjp@hjp.at> 163-1
+- Added Makefile to build rpm package.
+- Added plugin parameter db for location of database. (r150)
+
+* Sun Jul 17 2005 <hjp@hjp.at> 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 <hjp@hjp.at>, based on a plugin by 
+Devin Carraway <qpsmtpd@devin.com>
+
+=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:
+
+    mylist@example.com: mylist@lists.example.com (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: hjp@hjp.at
+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 <hjp@hjp.at> 175-1
+- Added conflicts line to prevent old/buggy cf_wrapper.
+- Fixed stupid error in previous version.
+
+* Fri Jan 27 2006 <hjp@hjp.at> 174-1
+- New upstream version 174:
+- Returns useable error message together with return code.
+
+* Tue Nov 29 2005 <hjp@hjp.at> 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 <hjp@hjp.at> 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 <hjp@hjp.at>. 
+
+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 user@dom.ain 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:someuser@somedomain.com
+  user2:another@another.org
+  user3:localuser
+  alias1:foo@bar.com
+  alias1:me@mydomain.net
+
+with the valid recipients user1@mydomain.org, user2@mydomain.org, 
+user3@mydomain.org and alias1@mydomain.org.
+
+=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 USER@mydomain.com and 
+I</etc/qpsmtpd/another-dom.net> for RCPT TO addesses of NAME@another-dom.net.
+
+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 <hah@uu-x.de>
+
+=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 <hah@uu-x.de>
+based on the auth_ldap_bind plugin by Elliot Foster <elliotf@gratuitous.net>
+
+=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
+  me@myhost.org           OK       Accepting mail
+  /^user\d+\@doma\.in$/   OK       Accepting mail
+  info@myhost.com         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



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About