r3744@embla: ask | 2006-06-28 13:04:50 -0700
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:
parent
25d9fe85a8
commit
bf2419df33
2
Changes
2
Changes
@ -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).
|
||||||
|
@ -261,6 +261,23 @@ sub _load_plugins {
|
|||||||
for my $plugin_line (@plugins) {
|
for my $plugin_line (@plugins) {
|
||||||
my ($plugin, @args) = split ' ', $plugin_line;
|
my ($plugin, @args) = split ' ', $plugin_line;
|
||||||
|
|
||||||
|
my $package;
|
||||||
|
|
||||||
|
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;
|
my $plugin_name = $plugin;
|
||||||
$plugin =~ s/:\d+$//; # after this point, only used for filename
|
$plugin =~ s/:\d+$//; # after this point, only used for filename
|
||||||
|
|
||||||
@ -275,7 +292,7 @@ sub _load_plugins {
|
|||||||
"::" . (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"} ) {
|
||||||
@ -284,6 +301,7 @@ sub _load_plugins {
|
|||||||
$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;
|
||||||
|
@ -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,7 +33,12 @@ 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
|
||||||
|
($hook,
|
||||||
|
{ code => sub { local $plugin->{_qp} = shift;
|
||||||
|
local $plugin->{_hook} = $hook;
|
||||||
|
$plugin->$method(@_)
|
||||||
|
},
|
||||||
name => $plugin->plugin_name,
|
name => $plugin->plugin_name,
|
||||||
},
|
},
|
||||||
$unshift,
|
$unshift,
|
||||||
@ -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?
|
||||||
|
Loading…
Reference in New Issue
Block a user