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
Support "module" plugins ("My::Plugin" in the config/plugins file)
Add SSL encryption method to header to mirror other qmail/SSL patches.
Add tls_before_auth to suppress AUTH unless TLS has already been
established (Robin Johnson).

42
lib/Qpsmtpd.pm
View File

@ -261,28 +261,46 @@ sub _load_plugins {
for my $plugin_line (@plugins) {
my ($plugin, @args) = split ' ', $plugin_line;
my $plugin_name = $plugin;
$plugin =~ s/:\d+$//; # after this point, only used for filename
my $package;
# Escape everything into valid perl identifiers
$plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg;
if ($plugin =~ m/::/) {
# "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
# second pass cares for slashes and words starting with a digit
$plugin_name =~ s{
# 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
(\d?) # package's first character
}[
"::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "")
]egx;
my $package = "Qpsmtpd::Plugin::$plugin_name";
$package = "Qpsmtpd::Plugin::$plugin_name";
# don't reload plugins if they are already loaded
unless ( defined &{"${package}::plugin_name"} ) {
Qpsmtpd::Plugin->compile($plugin_name,
# don't reload plugins if they are already loaded
unless ( defined &{"${package}::plugin_name"} ) {
Qpsmtpd::Plugin->compile($plugin_name,
$package, "$dir/$plugin", $self->{_test_mode});
$self->log(LOGDEBUG, "Loading $plugin_line")
unless $plugin_line =~ /logging/;
$self->log(LOGDEBUG, "Loading $plugin_line")
unless $plugin_line =~ /logging/;
}
}
my $plug = $package->new();

20
lib/Qpsmtpd/Plugin.pm
View File

@ -19,6 +19,10 @@ sub new {
bless ({}, $class);
}
sub hook_name {
return shift->{_hook};
}
sub register_hook {
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
# 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(@_) },
name => $plugin->plugin_name,
},
$unshift,
);
$plugin->qp->_register_hook
($hook,
{ code => sub { local $plugin->{_qp} = shift;
local $plugin->{_hook} = $hook;
$plugin->$method(@_)
},
name => $plugin->plugin_name,
},
$unshift,
);
}
sub _register {
@ -149,7 +158,6 @@ sub compile {
'@ISA = qw(Qpsmtpd::Plugin);',
($test_mode ? 'use Test::More;' : ''),
"sub plugin_name { qq[$plugin] }",
"sub hook_name { return shift->{_hook}; }",
$line,
$sub,
"\n", # last line comment without newline?