Permalink
Browse files

yay, plugin support works! :-D

git-svn-id: https://svn.perl.org/qpsmtpd/branches/v010@34 958fd67b-6ff1-0310-b445-bb7760255be9
  • Loading branch information...
1 parent a032ced commit 2fe35f1b8d161fe953ca3a49ef6f61b6f92e1b61 @abh abh committed Jul 8, 2002
View
@@ -0,0 +1,87 @@
+#
+# read this with 'perldoc README.plugins' ...
+#
+
+=head1 qpsmtpd plugin system; developer documentation
+
+See the examples in plugins/ and ask questions on the qpsmtpd
+mailinglist; subscribe by sending mail to qpsmtpd-subscribe@perl.org.
+
+=head1 General return codes
+
+Each plugin must return an allowed constant for the hook and (usually)
+optionally a "message".
+
+Generally all plugins for a hook are processed until one returns
+something other than "DECLINED".
+
+Plugins are run in the order they are listed in the "plugins"
+configuration.
+
+=over 4
+
+=item OK
+
+Action allowed
+
+=item DENY
+
+Action denied
+
+=item DENYSOFT
+
+Action denied; return a temporary rejection code (say 450 instead of 550).
+
+=item DECLINED
+
+Plugin declined work; proceed as usual. This return code is always
+allowed unless noted otherwise.
+
+=item DONE
+
+Finishing processing of the request. Usually used when the plugin
+sent the response to the client.
+
+=back
+
+See more detailed description for each hook below.
+
+=head1 Hooks
+
+=head2 mail
+
+Called right after the envelope sender address is passed. The plugin
+gets passed a Mail::Address object. Default is to allow the
+recipient.
+
+Allowed return codes
+
+ OK - sender allowed
+ DENY - Return a hard failure code
+ DENYSOFT - Return a soft failure code
+ DONE - skip further processing
+
+
+=head2 rcpt
+
+Hook for the "rcpt" command. Defaults to deny the mail with a soft
+error code.
+
+Allowed return codes
+
+ OK - recipient allowed
+ DENY - Return a hard failure code
+ DENYSOFT - Return a soft failure code
+ DONE - skip further processing
+
+
+=head2 quit
+
+Called on the "quit" command.
+
+Allowed return codes:
+
+ DONE
+
+All other codes will qpsmtpd do the default response.
+
View
25 STATUS
@@ -2,29 +2,40 @@
things to do for v0.10
----------------------
-transaction should probably be a part of the connection object instead
+transaction should maybe be a part of the connection object instead
of off the main object
-get timeouts to work in "tcpserver" mode (or generally...)
+get timeouts to work in "tcpserver" mode (or generally; not sure where
+it fits best)
plugin support;
- load plugins in a funny namespace
- let them register the "hooks" they want to run in
+ support plugins for the rest of the commands.
+
+ specify a priority in register_hook. ("LAST", "FIRST", "MIDDLE", or
+ maybe a number)
+
+ proper access to the message body through the transaction
data command
- how to spool the file?
+ how to spool message to a file when it grows large and still give
+ reasonable easy access to the data from plugins?
...
+TRACE in Constants.pm is not actually being used. Should it?
-TRACE in Constants.pm is not actually being used.
+Future Ideas
+============
-Plugin Documentation!
+Methods to create a bounce message easily; partly so we can accept a
+mail for one user but bounce it right away for another RCPT'er.
+David Carraway has some thoughts for "user filters"
+http://nntp.perl.org/group/perl.qpsmtpd/2
View
@@ -1,4 +1,4 @@
-0
+64.81.84.165
# the first line of this file is being used as the IP
# address tcpserver will bind to. Use 0 to bind to all
# interfaces.
View
@@ -1,3 +1,7 @@
quit_fortune
+require_resolvable_fromhost
+rhsbl
# dnsbl
+# this plugin needs to run after all other "rcpt" plugins
+check_relay
@@ -2,3 +2,4 @@ dsn.rfc-ignorant.org does not accept bounces. This violates RFC 821/2505/2821 ht
+
View
@@ -72,8 +72,6 @@ sub dispatch {
my $self = shift;
my ($cmd) = lc shift;
- warn "command: $cmd";
-
#$self->respond(553, $state{dnsbl_blocked}), return 1
# if $state{dnsbl_blocked} and ($cmd eq "rcpt");
@@ -164,16 +162,25 @@ sub mail {
}
return $self->respond(501, "could not parse your mail from command") unless $from;
- # this needs to be moved to a plugin --- FIXME
- 0 and $from->format ne "<>"
- and $self->config("require_resolvable_fromhost")
- and !check_dns($from->host)
- and return $self->respond(450, $from->host ? "Could not resolve ". $from->host : "FQDN required in the envelope sender");
-
- $self->log(2, "getting mail from ".$from->format);
- $self->respond(250, $from->format . ", sender OK - how exciting to get mail from you!");
-
- $self->transaction->sender($from);
+ my ($rc, $msg) = $self->run_hooks("mail", $from);
+ if ($rc == DONE) {
+ return 1;
+ }
+ elsif ($rc == DENY) {
+ $msg ||= $from->format . ', denied';
+ $self->log(2, "deny mail from " . $from->format . " ($msg)");
+ $self->respond(550, $msg);
+ }
+ elsif ($rc == DENYSOFT) {
+ $msg ||= $from->format . ', temporarily denied';
+ $self->log(2, "denysoft mail from " . $from->format . " ($msg)");
+ $self->respond(450, $msg);
+ }
+ else { # includes OK
+ $self->log(2, "getting mail from ".$from->format);
+ $self->respond(250, $from->format . ", sender OK - how exciting to get mail from you!");
+ $self->transaction->sender($from);
+ }
}
}
@@ -182,41 +189,34 @@ sub rcpt {
return $self->respond(501, "syntax error in parameters") unless $_[0] =~ m/^to:/i;
return(503, "Use MAIL before RCPT") unless $self->transaction->sender;
- my $from = $self->transaction->sender;
-
- # Move to a plugin -- FIXME
- if (0 and $from->format ne "<>" and $self->config('rhsbl_zones')) {
- my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->config('rhsbl_zones');
- my $host = $from->host;
- for my $rhsbl (keys %rhsbl_zones) {
- $self->respond("550", "Mail from $host rejected because it $rhsbl_zones{$rhsbl}"), return 1
- if check_rhsbl($rhsbl, $host);
- }
- }
-
my ($rcpt) = ($_[0] =~ m/to:(.*)/i)[0];
$rcpt = $_[1] unless $rcpt;
$rcpt = (Mail::Address->parse($rcpt))[0];
return $self->respond(501, "could not parse recipient") unless $rcpt;
- return $self->respond(550, "will not relay for ". $rcpt->host) unless $self->check_relay($rcpt->host);
- $self->transaction->add_recipient($rcpt);
- $self->respond(250, $rcpt->format . ", recipient ok");
-}
-
-sub check_relay {
- my $self = shift;
- my $host = lc shift;
- my @rcpt_hosts = $self->config("rcpthosts");
- return 1 if exists $ENV{RELAYCLIENT};
- 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 ($rc, $msg) = $self->run_hooks("rcpt", $rcpt);
+ if ($rc == DONE) {
+ return 1;
+ }
+ elsif ($rc == DENY) {
+ $msg ||= 'relaying denied';
+ $self->respond(550, $msg);
+ }
+ elsif ($rc == DENYSOFT) {
+ $msg ||= 'relaying denied';
+ return $self->respond(550, $msg);
+ }
+ elsif ($rc == OK) {
+ $self->respond(250, $rcpt->format . ", recipient ok");
+ return $self->transaction->add_recipient($rcpt);
+ }
+ else {
+ return $self->respond(450, "Could not determine of relaying is allowed");
}
return 0;
}
+
sub get_qmail_config {
my ($self, $config) = (shift, shift);
$self->log(5, "trying to get config for $config");
@@ -269,9 +269,10 @@ sub rset {
sub quit {
my $self = shift;
- my @fortune = `/usr/games/fortune -s`;
- @fortune = map { chop; s/^/ \/ /; $_ } @fortune;
- $self->respond(221, $self->config('me') . " closing connection. Have a wonderful day.", @fortune);
+ my ($rc, $msg) = $self->run_hooks("quit");
+ if ($rc != DONE) {
+ $self->respond(221, $self->config('me') . " closing connection. Have a wonderful day.");
+ }
exit;
}
@@ -449,37 +450,57 @@ sub load_plugins {
my $eval = join(
"\n",
"package $package;",
+ 'use Qpsmtpd::Constants;',
"require Qpsmtpd::Plugin;",
'use vars qw(@ISA);',
'@ISA = qw(Qpsmtpd::Plugin);',
-# $line,
+ $line,
$sub,
"\n", # last line comment without newline?
);
warn "eval: $eval";
- $eval =~ m/(.*)/;
+ $eval =~ m/(.*)/s;
$eval = $1;
eval $eval;
warn "EVAL: $@";
die "eval $@" if $@;
- #my $package_path = $package;
- #$package_path =~ s!::!/!g;
- #$package_path .= ".pm";
- #$INC{$package_path} = "$dir/$plugin";
- #use Data::Dumper;
- #warn Data::Dumper->Dump([\%INC, \@INC], [qw(INCh INCa)]);
+ my $plug = $package->new(qpsmtpd => $self);
+ $plug->register($self);
- my $plug = $package->new();
- $plug->register();
+ }
+}
+sub run_hooks {
+ my ($self, $hook) = (shift, shift);
+ if ($self->{_hooks}->{$hook}) {
+ my @r;
+ for my $code (@{$self->{_hooks}->{$hook}}) {
+ (@r) = &{$code}($self->transaction, @_);
+ last unless $r[0] == DECLINED;
+ }
+ return @r;
}
+ warn "Did not run any hooks ...";
+ return (0, '');
+}
+
+sub _register_hook {
+ my $self = shift;
+ my ($hook, $code) = @_;
+ #my $plugin = shift; # see comment in Plugin.pm:register_hook
+
+ $self->{_hooks} ||= {};
+ my $hooks = $self->{_hooks};
+ push @{$hooks->{$hook}}, $code;
}
+
+
1;
View
@@ -1,7 +1,21 @@
package Qpsmtpd::Constants;
use strict;
+require Exporter;
+
+my (@common) = qw(OK DECLINED DONE DENY DENYSOFT TRACE);
+
+use vars qw($VERSION @ISA @EXPORT);
+@ISA = qw(Exporter);
+@EXPORT = @common;
+
use constant TRACE => 10;
+use constant OK => 900;
+use constant DENY => 901;
+use constant DENYSOFT => 902;
+use constant DECLINED => 909;
+use constant DONE => 910;
+
1;
View
@@ -4,14 +4,28 @@ use strict;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
- bless ({}, $class);
+ my %args = @_;
+ bless ({ _qp => $args{qpsmtpd} }, $class);
}
+sub register_hook {
+ my ($plugin, $hook, $method) = @_;
+ # I can't quite decide if it's better to parse this code ref or if
+ # we should pass the plugin object and method name ... hmn.
+ $plugin->qp->_register_hook($hook, sub { $plugin->$method(@_) });
+}
+sub qp {
+ shift->{_qp};
+}
-sub register_hook {
- warn "REGISTER HOOK!";
+sub log {
+ shift->qp->log(@_);
}
+sub transaction {
+ # not sure if this will work in a non-forking or a threaded daemon
+ shift->qp->transaction;
+}
1;
Oops, something went wrong.

0 comments on commit 2fe35f1

Please sign in to comment.