debian_pkg-listmaster/sa-plugins/Subscriber.pm

#!/usr/bin/perl
# $Id:$

=head1 NAME

Subscriber - plugin for checking if a user is in the subscriber list

=head1 INSTALLATION

Just copy Subscriber.pm into your SpamAssassin Plugin path 
(e.g /usr/share/perl5/Mail/SpamAssassin/Plugin/) and
add a loadplugin call into your init.pre file. 

=head1 SYNOPSIS

  loadplugin    Mail::SpamAssassin::Plugin::Subscriber

=head1 USER SETTINGS

=over 4

=item subscriber_file [ file ]	

Where to find the subscribers
Subscribers are E-Mail adresses one per line

=cut 

=back 

=cut 

=head1 DESCRIPTION

Checks if one of the from addresses is in the subscriber file. 
If you want to use this plugin load it from a config file (e.g. init.pre):

B<loadplugin Mail::SpamAssassin::Plugin::Subscriber>

Afterwards you have to define the test:

B<header IS_SUBSCRIBER                 eval:check_for_subscriber('subscriberfile')>

check_for_subscriber accepts a filename which will be checked instead of the default file or the one specified 
in the config. 

B<score IS_SUBSCRIBER -50>

=head1 AUTHOR

Alexander Wirt <formorer@formorer.de>

=head1 COPYRIGHT

 Copyright 2006 Alexander Wirt <formorer@formorer.de> 
 
 Licensed under the Apache License,  Version 2.0 (the "License"); 
 you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
 http://www.apache.org/licenses/LICENSE-2.0 Unless required 
 by applicable law or agreed to in writing, software distributed 
 under the License is distributed on an "AS IS" BASIS, WITHOUT 
 WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 
 See the License for the specific language governing permissions 
 and limitations under the License.

=cut

package Mail::SpamAssassin::Plugin::Subscriber; 

use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use strict;
use warnings;
use Data::Dumper;

use vars qw(@ISA);
@ISA = qw(Mail::SpamAssassin::Plugin);

sub new {
    my ($class, $mailsa) = @_;

    # the usual perlobj boilerplate to create a subclass object
    $class = ref($class) || $class;
    my $self = $class->SUPER::new($mailsa);
    bless ($self, $class);

    # register our config options
    $self->set_config($mailsa->{conf});

    $self->register_eval_rule ("check_for_subscriber");

    # and return the new plugin object
    return $self;
}

sub set_config {
    my ($self, $conf) = @_;
    my @cmds = ();
    push (@cmds, {
	    setting => 'subscriber_file', 
	    default => '',
	    type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
    });

    $conf->{parser}->register_commands(\@cmds);
}

sub check_for_subscriber {
	my ($self, $message_status, $filename) = @_;

	my $subscribers = $filename || $message_status->{main}->{conf}->{subscriber_file}; 
	return 0 unless $subscribers; 
	my %subscribers; 

	if (-f $subscribers) {
		if (open (my $fh,'<', $subscribers)) {
			while (<$fh>) {
				chomp; 
				$subscribers { $_ } = 1; 
			}
			close($fh);
		} else {
			dbg("subscribers: could not open subscriber file $subscribers: $!"); 
			return 0; 
		}
	} else {
		dbg("subscribers: subscribers file '$subscribers' does not exist");
		return 0;

	}

	foreach my $from (@{$message_status->{all_from_addrs}}) {
		return 1 if exists  $subscribers{ $from }; 
	}
	return 0;
}

1;

# vim: syntax=perl sw=4 ts=4 noet shiftround