New "skip plugin API" + example plugin skip_plugins, see perldoc

Qpsmtpd::Plugins for more info. This can be used to disable (and re-
enable) loaded plugins for the current connection.


git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@700 958fd67b-6ff1-0310-b445-bb7760255be9

Changes

@@ -1,5 +1,9 @@
 0.33 (to be)
 
+  New "skip plugin API" + example plugin skip_plugins, see perldoc 
+  Qpsmtpd::Plugins for more info. This can be used to disable (and re-
+  enable) loaded plugins for the current connection (Hanno Hecker)
+
   Support "module" plugins ("My::Plugin" in the config/plugins file)
 
   Make the badmailfrom plugin support (optional) rejection messages after the 

config.sample/plugins

@@ -12,6 +12,9 @@
 # from one IP!
 hosts_allow
 
+# skip selected plugins for some hosts:
+skip_plugins
+
 # enable to accept MAIL FROM:/RCPT TO: addresses without surrounding <>
 dont_require_anglebrackets
 

lib/Qpsmtpd.pm

@@ -367,6 +367,11 @@ sub run_continuation {
       $@ and warn("FATAL LOGGING PLUGIN ERROR: ", $@) and next;
     }
     else {
+      my $skip = $self->connection->notes('_skip_plugins');
+      if (exists $skip->{$code->{name}} and $skip->{$code->{name}}) {
+        $self->log(LOGDEBUG, "skipping plugin ".$code->{name});
+        next;
+      }
       $self->varlog(LOGDEBUG, $hook, $code->{name});
       eval { (@r) = $code->{code}->($self, $self->transaction, @$args); };
       $@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;

lib/Qpsmtpd/Plugin.pm

@@ -1,6 +1,7 @@
 package Qpsmtpd::Plugin;
 use Qpsmtpd::Constants;
 use strict;
+use vars qw(%symbols);
 
 # more or less in the order they will fire
 our @hooks = qw(
@@ -116,6 +117,8 @@ sub isa_plugin {
 
   # don't reload plugins if they are already loaded
   return if defined &{"${newPackage}::plugin_name"};
+  ### someone test this please:
+  # return if $self->plugin_is_loaded($newPackage);
 
   $self->compile($self->plugin_name . "_isa_$cleanParent",
                     $newPackage,
@@ -183,5 +186,211 @@ sub _register_standard_hooks {
   }
 }
 
+=head1 SKIP PLUGINS API
+
+These functions allow to disable and re-enable loaded plugins. Loading 
+plugins after the initial loading phase is not possible. The earliest 
+place to disable a plugin is in C<hook_connect()>. 
+
+If you want to run a plugin just for some clients, load it like a usual 
+plugin and either hook it to the C<hook_connect()> (or any later hook) 
+and disable it there, use the C<skip_plugins> plugin or write your own 
+disabling plugin.
+
+These modifications of disabling/re-enabling a plugin are valid for the
+full connection, not transaction! For transaction based disabling of plugins,
+use the C<reset_transaction> hook to reset the list of disabled plugins. 
+
+A small warning: the C<reset_transaction> hook is called at least three
+times: after the client sent the C<(HE|EH)LO>, every time the client
+issues a C<MAIL FROM:> and after the mail was queued (or rejected by a 
+C<data_post> hook). Don't forget it is also called after C<RSET> and 
+connection closing (e.g. after C<QUIT>).
+
+=over 7
+
+=item plugin_is_loaded( $plugin )
+
+Returns true, if the given (escaped) plugin name is a loaded plugin
+
+=cut
+
+sub plugin_is_loaded {
+    my ($self, $plugin) = @_;
+    $plugin =~ s/^Qpsmtpd::Plugin:://; # for _loaded();
+    # each plugin has a sub called "plugin_name()", see compile() above...
+    # ... this restricts qpsmtpd a bit: No module named 
+    # Qpsmtpd::Plugin(|::Something) must have a sub "plugin_name()", or 
+    # it will be returned as a loaded plugin...
+    return defined &{"Qpsmtpd::Plugin::${plugin}::plugin_name"}; 
+}
+
+=item plugin_status( $plugin )
+
+Shows the status of the given plugin. It returns undef if no plugin name 
+given or the plugin is not loaded, "0" if plugin is loaded, but disabled 
+and "1" if the plugin is loaded and active. The plugin name must be escaped
+by B<escape_plugin()>.
+
+=cut
+
+sub plugin_status {
+    my ($self, $plugin) = @_;
+    return undef unless $plugin;
+    return undef unless $self->plugin_is_loaded($plugin);
+    my $skip = $self->qp->connection->notes('_skip_plugins') || {};
+    return 0 if (exists $skip->{$plugin} and $skip->{$plugin});
+    return 1;
+}
+
+=item loaded_plugins( )
+
+This returns a hash. Keys are (escaped, see below) plugin names of loaded 
+plugins. The value tells you if the plugin is currently active (1) or 
+disabled (0).
+
+=cut
+
+sub loaded_plugins {
+    my $self = shift;
+    # all plugins are in their own class "below" Qpsmtpd::Plugin,
+    # so we start searching the symbol table at this point
+    my %plugins = map { 
+                        s/^Qpsmtpd::Plugin:://; 
+                        ($_, 1) 
+                      } $self->_loaded("Qpsmtpd::Plugin");
+    foreach ($self->disabled_plugins) {
+        $plugins{$_} = 0;
+    }
+    return %plugins;
+}
+
+sub _loaded {
+    my $self   = shift;
+    my $base   = shift;
+    my @loaded = ();
+    my (@sub, $symbol);
+    # let's see what's in this name space
+    no strict 'refs';
+    local (*symbols) = *{"${base}::"};
+    use strict 'refs';
+    foreach my $name (values %symbols) { 
+        # $name is read only while walking the stash
+
+        # not a class name? ok, next 
+        ($symbol = $name) =~ s/^\*(.*)::$/$1/ || next; 
+        next if $symbol eq "Qpsmtpd::Plugin";
+
+        # in qpsmtpd we have no way of loading a plugin with the same
+        # name as a sub directory inside the ./plugins dir, so we can safely
+        # use either the list of sub classes or the class itself we're 
+        # looking at (unlike perl, e.g. Qpsmtpd.pm <-> Qpsmtpd/Plugin.pm).
+        @sub = $self->_loaded($symbol);
+
+        if (@sub) {
+            push @loaded, @sub;
+        }
+        else {
+            # is this really a plugin?
+            next unless $self->plugin_is_loaded($symbol);
+            push @loaded, $symbol;
+        }
+    }
+    return @loaded;
+}
+
+=item escape_plugin( $plugin_name )
+
+Turns a plugin filename into the way it is used inside qpsmtpd. This needs to
+be done before you B<plugin_disable()> or B<plugin_enable()> a plugin. To 
+see if a plugin is loaded, use something like
+
+ my %loaded = $self->loaded_plugins;
+ my $wanted = $self->escape_plugin("virus/clamav");
+ if (exists $loaded{$wanted}) {
+   ...
+ }
+... or shorter:
+
+ if ($self->plugin_is_loaded($self->escape_plugin("virus/clamav"))) {
+   ...
+ }
+
+=cut
+
+sub escape_plugin {
+    my $self        = shift;
+    my $plugin_name = shift;
+    # "stolen" from Qpsmtpd.pm
+    # 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;
+    return $plugin_name;
+}
+
+=item disabled_plugins( )
+
+This returns a list of all plugins which are disabled for the current 
+connection. 
+
+=cut
+
+sub disabled_plugins {
+    my $self    = shift;
+    my @skipped = ();
+    my $skip    = $self->qp->connection->notes('_skip_plugins') || {};
+    foreach my $s (keys %{$skip}) {
+        push @skipped, $s if $skip->{$s};
+    }
+    return @skipped;
+}
+
+=item plugin_disable( $plugin )
+
+B<plugin_disable()> disables a (loaded) plugin, it requires the plugin name
+to be escaped by B<escape_plugin()>. It returns true, if the given plugin
+name is a loaded plugin (and disables it of course).
+
+=cut
+
+sub plugin_disable {
+    my ($self, $plugin) = @_;
+    # do a basic check if the supplied plugin name is really a plugin
+    return 0 unless $self->plugin_is_loaded($plugin);
+
+    my $skip = $self->qp->connection->notes('_skip_plugins') || {};
+    $skip->{$plugin} = 1;
+    $self->qp->connection->notes('_skip_plugins', $skip);
+    return 1;
+}
+
+=item plugin_enable( $plugin )
+
+B<plugin_enable()> re-enables a (loaded) plugin, it requires the plugin name
+to be escaped by B<escape_plugin()>. It returns "0", if the given plugin
+name is not a loaded plugin. Else it returns "1" after enabling.
+
+=cut
+
+sub plugin_enable {
+    my ($self, $plugin) = @_;
+    return 0 unless $self->plugin_is_loaded($plugin);
+
+    my $skip = $self->qp->connection->notes('_skip_plugins') || {};
+    $skip->{$plugin} = 0;
+    $self->qp->connection->notes('_skip_plugins', $skip);
+    return 1;
+}
+
+=back
+
+=cut
 
 1;

plugins/skip_plugins

@@ -0,0 +1,97 @@
+
+=head1 NAME
+
+skip_plugins - don't run selected plugins for some hosts
+
+=head1 DESCRIPTION
+
+The B<skip_plugins> plugin allows you to skip selected plugins for some 
+clients. This is similar to some whitelist plugins, without the need to 
+modify any plugin. 
+
+This plugin should be run before any other plugins hooking to the
+I<hook_connect>. The config allows to run all plugins for one host in a 
+subnet and skip some for all other hosts in this network.
+
+=head1 CONFIG
+
+The config file I<skip_plugins> contains lines with two or three items per
+line. The first field is a network/mask pair (or just a single IP address).
+An action is set in the second field: currently B<continue> or B<skip> are 
+valid actions. 
+
+If a host matches a B<continue> line, the parsing is stopped and all 
+plugins are run for this host. A B<skip> action tells qpsmtpd to skip
+the plugins listed in the third field for this connection. 
+
+The plugin list in the third field must be separated by "," without any spaces.
+
+=head1 EXAMPLE
+
+ 10.7.7.2        continue    
+ 10.7.7.0/24     skip    spamassassin,check_earlytalker
+
+To disable a plugin for all clients except for one subnet:
+
+ 10.1.0.0/16    continue
+ 0.0.0.0/0      skip    virus/clamdscan
+
+=head1 NOTES 
+
+See perldoc Qpsmtpd::Plugin for more about disabling / re-enabling plugins 
+for the current connection.
+
+=head1 BUGS
+
+This plugin does not have IPv6 support.
+
+=cut 
+
+use Socket;
+
+sub hook_connect {
+    my ($self,$transaction) = @_;
+
+    my %skip = ();
+    #my %l = $self->loaded_plugins;
+    #foreach my $p (keys %l) {
+    #    $self->log(LOGDEBUG, "LOADED: $p");
+    #}
+    my $remote = $self->qp->connection->remote_ip;
+    foreach ($self->qp->config("skip_plugins")) {
+        chomp;
+        s/^\s*//;
+        s/\s*$//;
+        my ($ipmask, $action, $plugins) = split /\s+/, $_, 3;
+        next unless defined $action;
+        $action  = lc $action;
+        $plugins = "" unless defined $plugins;
+
+        my ($net,$mask) = split '/', $ipmask, 2;
+        if (!defined $mask) {
+            $mask = 32;
+        }
+        $mask = pack "B32", "1"x($mask)."0"x(32-$mask);
+        if (join(".", unpack("C4", inet_aton($remote) & $mask)) eq $net) {
+            if ($action eq 'skip') {
+                foreach my $plugin (split /,/, $plugins) {
+                    $self->plugin_disable($self->escape_plugin($plugin)) 
+                      or $self->log(LOGWARN, "tried to disable a plugin "
+                                            ."which was not loaded: $plugin");
+                }
+                $self->log(LOGDEBUG, "skipping plugins "
+                                    .join(",", $self->disabled_plugins));
+            }
+            elsif ($action eq 'continue') {
+                $self->log(LOGDEBUG, "ok, doing nothing with the plugins");
+            }
+            else {
+                $self->log(LOGWARN, "unknown action '$action' for $ipmask");
+            }
+            last;
+        }
+    }
+    return (DECLINED);
+}
+
+# vim: sw=4 ts=4 expandtab syn=perl