I wish to have different configurations for different connecting clients.
And I'd like to have finer grained control than just whether they are
permitted to relay or not. I've roughed out a plugin for doing that, and
I'd appreciate some feedback.
I've called my plugin "peers". It takes a single argument, which is the
name of a config file containing a list of plugins to be compiled (but not
loaded). The plugin's init() method compiles each of the plugins.
The plugin contains a connect hook method. When connection arrives from
client a.b.c.d, it searches in config/peers/ for a secondary plugin
config file called "a.b.c.d", then "a.b.c" then "a.b"
then "a" and finally "0". If none is found, the plugin returns 'DENY'.
Otherwise, the plugin configuration specified is loaded, and 'DECLINED' is
returned.
This essentially defers some choice of plugin until connection time, and
also defers initialisation of some plugins until connection time.
Comments?
[Yes, init() borrows some internals from Qpsmtpd.pm - I didn't see a
suitable public interface.]
# this plugin checks the peers directory for config
# file most closely matching the client IP address
# and loads it if found.
#
sub init {
my $self = shift;
my $qp = shift;
my $plugins_list_file = shift;
my @plugins = $qp->config($plugins_list_file);
my $dir = $qp->plugin_dir;
for my $plugin (@plugins) {
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;
my $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, "Compiling $plugin")
unless $plugin =~ /logging/;
}
}
return 1;
}
sub _peer_plugins {
my $qp = shift;
my $config = shift;
my @plugins = $qp->config($config);
$qp->log(LOGNOTICE, "loading plugins @plugins from $config");
return $qp->_load_plugins($qp->plugin_dir, @plugins);
}
sub hook_connect {
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, "peers/$client_ip");
return (DECLINED);
}
$client_ip =~ s/\.+\d+\.?$//; # strip off another 8 bits
}
if (-f "config/peers/0") {
_peer_plugins($qp, "peers/0");
return (DECLINED);
}
return (DENY);
}
