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

(Working) support for multiple plugin directories, with a fix from Nick

Browse Source 
Leverton <nj|@|leverton.org>.  The inner _load_plugins() routine is changed to
load only a single plugin given a search path, and the (two) calls to it pass
in the configured list of plugin dirs.  The non-module case of _load_plugin()
simply loops on the plugin dir list until a matching plugin file is found;
the first match stops the search for that plugin, regardless of success or
failure in loading it.


git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@671 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Devin Carraway 2006-11-05 09:54:03 +00:00
parent 02bf7b80e5
commit af5f025b51
2 changed files with 76 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Changes
View File

@ -1,3 +1,7 @@
0.3x
Add support for multiple plugin directories, whose paths are given by the
'plugin_dirs' configuration. (Devin Carraway, Nick Leverton)
0.33
New Qpsmtpd::Postfix::Constants to encapsulate all of the current return
codes from Postfix, plus script to generate it. (Hanno Hecker)

122
lib/Qpsmtpd.pm
View File

@ -19,11 +19,17 @@ sub load_logging {
my $configdir = $self->config_dir("logging");
my $configfile = "$configdir/logging";
my @loggers = $self->_config_from_file($configfile,'logging');
my $dir = $self->plugin_dir;
$self->_load_plugins($dir, @loggers);
$configdir = $self->config_dir('plugin_dirs');
$configfile = "$configdir/plugin_dirs";
my @plugin_dirs = $self->_config_from_file($configfile,'plugin_dirs');
foreach my $logger (@loggers) {
my @loaded;
for my $logger (@loggers) {
push @loaded, $self->_load_plugin($logger, @plugin_dirs);
}
foreach my $logger (@loaded) {
$self->log(LOGINFO, "Loaded $logger");
}
@ -121,9 +127,15 @@ sub config_dir {
return $configdir;
}
sub plugin_dir {
my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
my $dir = "$name/plugins";
sub plugin_dirs {
my $self = shift;
my @plugin_dirs = $self->config('plugin_dirs');
unless (@plugin_dirs) {
my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
@plugin_dirs = ( "$name/plugins" );
}
return @plugin_dirs;
}
sub get_qmail_config {
@ -244,71 +256,73 @@ sub load_plugins {
$self->{hooks} = {};
my @plugins = $self->config('plugins');
my @loaded;
my $dir = $self->plugin_dir;
$self->log(LOGNOTICE, "loading plugins from $dir");
for my $plugin_line (@plugins) {
push @loaded, $self->_load_plugin($plugin_line, $self->plugin_dirs);
}
@plugins = $self->_load_plugins($dir, @plugins);
return @plugins;
return @loaded;
}
sub _load_plugins {
sub _load_plugin {
my $self = shift;
my ($dir, @plugins) = @_;
my ($plugin_line, @plugin_dirs) = @_;
my @ret;
for my $plugin_line (@plugins) {
my ($plugin, @args) = split ' ', $plugin_line;
my ($plugin, @args) = split ' ', $plugin_line;
my $package;
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;
$plugin =~ s/:\d+$//; # after this point, only used for filename
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
# Escape everything into valid perl identifiers
$plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg;
# 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;
# 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;
$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,
$package, "$dir/$plugin", $self->{_test_mode});
$self->log(LOGDEBUG, "Loading $plugin_line")
unless $plugin_line =~ /logging/;
# don't reload plugins if they are already loaded
unless ( defined &{"${package}::plugin_name"} ) {
PLUGIN_DIR: for my $dir (@plugin_dirs) {
if (-e "$dir/$plugin") {
Qpsmtpd::Plugin->compile($plugin_name, $package,
"$dir/$plugin", $self->{_test_mode});
$self->log(LOGDEBUG, "Loading $plugin_line from $dir/$plugin")
unless $plugin_line =~ /logging/;
last PLUGIN_DIR;
}
}
}
my $plug = $package->new();
push @ret, $plug;
$plug->_register($self, @args);
}
my $plug = $package->new();
$plug->_register($self, @args);
push @ret, $plug;
return @ret;
}