121 lines
3.5 KiB
Plaintext
121 lines
3.5 KiB
Plaintext
# this plugin checks the peers directory for config
|
|
# file most closely matching the client IP address
|
|
# and loads it if found.
|
|
#
|
|
# Note that init() borrows some internals from Qpsmtpd.pm - I
|
|
# didn't see a suitable public interface.
|
|
|
|
sub init {
|
|
my $self = shift;
|
|
my $qp = shift;
|
|
my $plugins_list_file = shift || 'peers/0';
|
|
my @plugins = $qp->config($plugins_list_file);
|
|
my @plugin_dirs = $qp->plugin_dirs;
|
|
|
|
for my $plugin_line (@plugins) {
|
|
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;
|
|
$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
|
|
(\d?) # package's first character
|
|
}[
|
|
"::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "")
|
|
]egx;
|
|
|
|
$package = "Qpsmtpd::Plugin::$plugin_name";
|
|
|
|
# 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}, $plugin);
|
|
Qpsmtpd->varlog(LOGDEBUG, "init", "peers", "Loading $plugin_line from $dir/$plugin")
|
|
unless $plugin_line =~ /logging/;
|
|
last PLUGIN_DIR;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub _peer_plugins {
|
|
my $qp = shift;
|
|
my $hook = shift;
|
|
my $config = shift;
|
|
|
|
my $hooks;
|
|
$hooks->{$_} = delete $qp->hooks->{$_} foreach keys %{$qp->hooks};
|
|
|
|
my @plugins = $qp->config($config);
|
|
unshift @plugins, "peers $config";
|
|
my @loaded;
|
|
|
|
for my $plugin_line (@plugins) {
|
|
my $this_plugin = $qp->_load_plugin($plugin_line, $qp->plugin_dirs);
|
|
push @loaded, $this_plugin if $this_plugin;
|
|
}
|
|
|
|
if ($hook eq 'set_hooks') {
|
|
foreach my $c (@{$hooks->{connect}}) {
|
|
unshift @{$qp->hooks->{connect}}, $c unless grep { $c->{name} eq $_->{name} } @{$hooks->{connect}};
|
|
}
|
|
}
|
|
|
|
return @loaded;
|
|
}
|
|
|
|
sub hook_set_hooks {
|
|
my ($self, $transaction) = @_;
|
|
my $qp = $self->qp;
|
|
my $connection = $qp->connection;
|
|
|
|
my $client_ip = $qp->connection->remote_ip;
|
|
while ($client_ip) {
|
|
if (-f "config/peers/$client_ip") {
|
|
_peer_plugins($qp, "set_hooks", "peers/$client_ip");
|
|
return (DECLINED);
|
|
}
|
|
$client_ip =~ s/\.?\d+$//; # strip off another 8 bits
|
|
}
|
|
if (-f "config/peers/0") {
|
|
_peer_plugins($qp, "set_hooks", "peers/0");
|
|
return (DECLINED);
|
|
}
|
|
return (DENY);
|
|
}
|
|
|
|
sub hook_valid_auth {
|
|
my ( $self, $transaction) = @_;
|
|
my $qp = $self->qp;
|
|
_peer_plugins($qp, "valid_auth", "peers/local") if (-f "config/peers/local");
|
|
return (DECLINED);
|
|
}
|