byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

r3744@embla: ask | 2006-06-28 13:04:50 -0700

Browse Source 
Support "module" plugins ("My::Plugin" in the config/plugins file)
 


git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@648 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen 2006-06-28 20:05:04 +00:00
parent 25d9fe85a8
commit bf2419df33
3 changed files with 50 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Changes
View File

@ -1,5 +1,7 @@
0.33 0.33
Support "module" plugins ("My::Plugin" in the config/plugins file)
Add SSL encryption method to header to mirror other qmail/SSL patches. Add SSL encryption method to header to mirror other qmail/SSL patches.
Add tls_before_auth to suppress AUTH unless TLS has already been Add tls_before_auth to suppress AUTH unless TLS has already been
established (Robin Johnson). established (Robin Johnson).

50
lib/Qpsmtpd.pm
View File

@ -260,31 +260,49 @@ sub _load_plugins {
my @ret; my @ret;
for my $plugin_line (@plugins) { for my $plugin_line (@plugins) {
my ($plugin, @args) = split ' ', $plugin_line; my ($plugin, @args) = split ' ', $plugin_line;
my $plugin_name = $plugin;
$plugin =~ s/:\d+$//; # after this point, only used for filename
# Escape everything into valid perl identifiers my $package;
$plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg;
# second pass cares for slashes and words starting with a digit if ($plugin =~ m/::/) {
$plugin_name =~ s{ # "full" package plugin (My::Plugin)
$package = $plugin;
$package =~ s/[^_a-z0-9:]+//gi;
my $eval = qq[require $package;\n]
.qq[sub ${plugin}::plugin_name { '$plugin' }];
$eval =~ m/(.*)/s;
$eval = $1;
eval $eval;
die "Failed loading $package - eval $@" if $@;
$self->log(LOGDEBUG, "Loading $package ($plugin_line)")
unless $plugin_line =~ /logging/;
}
else {
# regular plugins/$plugin plugin
my $plugin_name = $plugin;
$plugin =~ s/:\d+$//; # after this point, only used for filename
# Escape everything into valid perl identifiers
$plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg;
# second pass cares for slashes and words starting with a digit
$plugin_name =~ s{
(/+) # directory (/+) # directory
(\d?) # package's first character (\d?) # package's first character
}[ }[
"::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "") "::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "")
]egx; ]egx;
my $package = "Qpsmtpd::Plugin::$plugin_name"; $package = "Qpsmtpd::Plugin::$plugin_name";
# don't reload plugins if they are already loaded # don't reload plugins if they are already loaded
unless ( defined &{"${package}::plugin_name"} ) { unless ( defined &{"${package}::plugin_name"} ) {
Qpsmtpd::Plugin->compile($plugin_name, Qpsmtpd::Plugin->compile($plugin_name,
$package, "$dir/$plugin", $self->{_test_mode}); $package, "$dir/$plugin", $self->{_test_mode});
$self->log(LOGDEBUG, "Loading $plugin_line") $self->log(LOGDEBUG, "Loading $plugin_line")
unless $plugin_line =~ /logging/; unless $plugin_line =~ /logging/;
}
} }
my $plug = $package->new(); my $plug = $package->new();
push @ret, $plug; push @ret, $plug;
$plug->_register($self, @args); $plug->_register($self, @args);

20
lib/Qpsmtpd/Plugin.pm
View File

@ -19,6 +19,10 @@ sub new {
bless ({}, $class); bless ({}, $class);
} }
sub hook_name {
return shift->{_hook};
}
sub register_hook { sub register_hook {
my ($plugin, $hook, $method, $unshift) = @_; my ($plugin, $hook, $method, $unshift) = @_;
@ -29,11 +33,16 @@ sub register_hook {
# I can't quite decide if it's better to parse this code ref or if # 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. # we should pass the plugin object and method name ... hmn.
$plugin->qp->_register_hook($hook, { code => sub { local $plugin->{_qp} = shift; local $plugin->{_hook} = $hook; $plugin->$method(@_) }, $plugin->qp->_register_hook
name => $plugin->plugin_name, ($hook,
}, { code => sub { local $plugin->{_qp} = shift;
$unshift, local $plugin->{_hook} = $hook;
); $plugin->$method(@_)
},
name => $plugin->plugin_name,
},
$unshift,
);
} }
sub _register { sub _register {
@ -149,7 +158,6 @@ sub compile {
'@ISA = qw(Qpsmtpd::Plugin);', '@ISA = qw(Qpsmtpd::Plugin);',
($test_mode ? 'use Test::More;' : ''), ($test_mode ? 'use Test::More;' : ''),
"sub plugin_name { qq[$plugin] }", "sub plugin_name { qq[$plugin] }",
"sub hook_name { return shift->{_hook}; }",
$line, $line,
$sub, $sub,
"\n", # last line comment without newline? "\n", # last line comment without newline?