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

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