smeserver-qpsmtpd/root/usr/share/qpsmtpd/plugins/peers

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);
}