Attachment #366 for bug #579

View | Details | Raw Unified | Return to bug 579
Collapse All | Expand All





###########################################################################

# Mail::SpamAssassin::Conf::extract_line($prefs)
#  Extract a single "line" from the configuration data-string. If multi-line
#  rules are ever implemented, this is where the change should go.
#
#  Don't handle empty lines here, otherwise we can't get a line number if we
#  want it.
sub extract_line {  # static
    return undef unless $_[0]=~/./o;
    $_[0]=~s/^([^\n]*)\n?//o; # pull out everything up to and including the
    local $_=$1;              #   first \n (or the whole thing if no \n)
    s/(?<!\\)#.*$//o;         # strip comments
    s/^\s*|\s*$//go;          # strip leading/trailig whitespace
    return $_;
}

sub parse_scores_only {
  my ($self) = @_;
  $self->_parse ($_[1], 1); # don't copy $rules!

  my $currentfile = '(no file)';
  my $skipfile = 0;

  my $rules=$_[1];  # copy rules here, extract_line changes it's parameter.
  while(defined($_=extract_line($rules))){
    s/^\s+|\s+$//g;  # remove leading and trailing spaces (including newlines)
    next unless($_); # skip empty lines

    # handle i18n




=head1 NAME

Mail::SpamAssassin::ConfSourceAlt - load prefs from any of several sources

=head1 DESCRIPTION

This is really an 'adapter' class, which loads the prefs from the first of its
sub-sources that returns a calid result.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfSourceAlt;

use Carp;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfSourceGeneric;
@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfSourceAlt->new($source, ...)

Create a new object. If any of the sources is not a
Mail::SpamAssassin::ConfStoreGeneric subclass, an exception will be thrown.

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my $sources = [@_];

    for my $s (@$sources){
        die "$s is not a Mail::SpamAssassin::ConfStoreGeneric\n" unless UNIVERSAL::isa($s, 'Mail::SpamAssassin::ConfStoreGeneric');
    }

    my $self = {
        'sources' => $sources,
    };

    bless ($self, $class);
    $self;
}

###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

sub get_prefs {
    my ($self, $user)=@_;

    for my $s (@{$self->{'sources'}}){
        my ($ret, $prefs, $err)=$s->get_prefs($user);
        return ret($ret, $prefs, $err) if defined($prefs);
    }
    return ret("EX_OK", undef, "No user prefs");
}

sub get_length {
    my ($self, $user)=@_;

    for my $s (@{$self->{'sources'}}){
        my ($ret, $len, $err)=$s->get_length($user);
        return ret($ret, $len, $err) if defined($len);
    }
    return ret("EX_DATAERR", undef, "No user prefs");
}

sub get_checksum {
    my ($self, $user)=@_;

    for my $s (@{$self->{'sources'}}){
        my ($ret, $sum, $err)=$s->get_checksum($user);
        return ret($ret, $sum, $err) if defined($sum);
    }
    return ret("EX_DATAERR", undef, "No user prefs");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfSourceCat - load prefs from multiple sources

=head1 DESCRIPTION

This is really an 'adapter' class, which loads the prefs from all its
sub-sources and concatentates them.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfSourceCat;

use Carp;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfSourceGeneric;
@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfSourceCat->new($source, ...)

Create a new object. If any of the sources is not a
Mail::SpamAssassin::ConfStoreGeneric subclass, an exception will be thrown.

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my $sources = [@_];

    for my $s (@$sources){
        die "$s is not a Mail::SpamAssassin::ConfStoreGeneric\n" unless UNIVERSAL::isa($s, 'Mail::SpamAssassin::ConfStoreGeneric');
    }

    my $self = {
        'sources' => $sources,
    };

    bless ($self, $class);
    $self;
}

###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

sub get_prefs {
    my ($self, $user)=@_;
    my $i=0;
    my $prefs="";
    my $flag=0;

    for($i=0; $i<@{$self->{'sources'}}; $i++){
        my ($ret, $p, $err)=$self->{'sources'}->[$i]->get_prefs($user);
        next unless(defined($p) || $ret ne "EX_OK");
        ($p="# $err")=~s/(\r?\n)/$1# /g unless defined($p);
        $flag=1;
        $prefs.="# Source #".($i+1)."\r\n$p\r\n";
    }

    return ret("EX_OK", undef, "No user prefs") unless $flag;
    return ret("EX_OK", $prefs, "Success");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfSourceGeneric - base class for SpamAssassin configuration sources.

=head1 DESCRIPTION

This is the base class for SpamAssassin configuration sources. It provides a
few utility functions, and defines the interface sources should implement.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfSourceGeneric;

use Carp;
use strict;

use vars qw{
        @ISA
};

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

###########################################################################

sub new {
    sa_die("Cannot create a Mail::SpamAssassin::ConfSourceGeneric");
    return undef;
}

###########################################################################

=item Mail::SpamAssassin::ConfSourceGeneric->load_modules()

Preload any modules that may be conditionally loaded later on, for speed.

=cut

sub load_modules {		# static
    # do any preloading that will speed up operation
}

###########################################################################

=item $source->get_prefs($user)

Retrieve the prefs data. In a scalar context, the prefs data string is
returned. In a list context, a list of the form ("EX_OK", $prefs, "Success")
is returned. If no prefs exist for the specified user, undef or ("EX_OK",
undef, "No user prefs") is returned. If an error occurred, undef or
("EX_...", undef, "... some error message ...") is returned.

Stores are encouraged to recognize the user '@GLOBAL' as a request for
global preferences, and '@DEFAULT' as a request for default preferences (i.e.
preferences in the case there is no named user). Stores must implement this
method.

=cut

sub get_prefs {
    sa_die("get_prefs was not implemented");
}

=item $source->get_length($user)

Retrieve the length of the prefs data. In a scalar context, the numeric
length is returned. In a list context, a list of the form ("EX_OK", $len,
"Success") is returned. If no prefs exist for the specified user, undef or
("EX_DATAERR", undef, "No user prefs") is returned. If an error occurred,
undef or ("EX_...", undef, "... some error message ...") is returned.

If a source does not override this method, the length of the return value of
$source->get_prefs($user) will be returned (or the error will be passed
along).

=cut

sub get_length {
    my ($self, $user)=@_;
    my ($ret, $prefs, $err)=$self->get_prefs($user);
    return ret($ret, undef, $err) if($ret ne "EX_OK");
    return ret("EX_DATAERR", undef, $err) unless defined($prefs);
    return ($ret, length($prefs), $err);
}

=item $source->get_checksum($user)

Retrieve the checksum of the prefs data. In a scalar context, the numeric
checksum is returned. In a list context, a list of the form ("EX_OK",
$checksum, "Success") is returned. If no prefs exist for the specified user,
undef or ("EX_DATAERR", undef, "No user prefs") is returned. If an error
occurred, undef or ("EX_...", undef, "... some error message ...") is
returned.

If a source does not override this method, the checksum of the return value of
$source->get_prefs($user) will be returned (or the error will be passed
along).

=cut

sub get_checksum {
    my ($self, $user)=@_;

    my ($ret, $text, $err)=$self->get_prefs($user);
    return ret($ret, undef, $err) if($ret ne "EX_OK");
    return ret("EX_DATAERR", undef, $err) unless defined($text);
    return ret($ret, $self->calc_checksum($text), $err);
}

=item $source->apply_prefs($conf, $user)

Apply the prefs to the given Mail::SpamAssassin::Conf object. Returns
"EX_OK" in a scalar context, ("EX_OK", "Success") in a list context. If an
error occurs, "EX_..." or ("EX_...", "... error message ...") is returned.
If the user has no preferences, the default preferences should be applied.

If a source does not override this method, the data returned by
$source->get_prefs($user) (or $source->get_prefs('@DEFAULT')) will be passed
to $conf->parse_scores_only().

=cut

sub apply_prefs {
    my ($self, $conf, $user)=@_;

    my ($ret, $prefs, $err)=$self->get_prefs($user);
    if(!defined($prefs)){
        $prefs=$self->get_prefs('@DEFAULT') if($ret eq "EX_OK");
        return ret($ret, $err) unless defined($prefs);
    }
    $conf->parse_scores_only($prefs);
    return ret("EX_OK", "Success");
}

###########################################################################

=back

=head1 UTILITY FUNCTIONS

These functions are intended for the use of subclasses only.

=over 4

=item Mail::SpamAssassin::ConfSourceGeneric::ret(@data)

In an array context, returns @data. In a scalar context, returns $data[0] if
@data<3, otherwise $data[1]. Use this to get the return values of the various public functions correct. For example:

=over 6

return ret("EX_OK", undef, "No user prefs");

return ret("EX_IOERR", "open failed: $!");

=back

=cut

sub ret {
    return @_ if wantarray;
    return $_[0] if scalar(@_)<3;
    return $_[1];
}

=item $source->calc_checksum($text, [$crc])

Calculates the checksum of the text. If $crc is not specified, it defaults
to 0. For the most part, $crc should not be specified, it's only useful if
you intend to calculate the checksum piece-wise.

=cut

sub calc_checksum {
    my $self=shift;
    my $text=shift;
    my $len=length($text);
    my $crc=shift || 0;

    $crc=(~$crc)&0xffffffff;
    for(my $i=0; $i<$len; $i++){
        $crc=$crc^ord(substr($text, $i, 1));
        for(my $j=0; $j<8; $j++){
            if($crc&1){
                $crc=0xedb88320^($crc>>1);
            } else {
                $crc>>=1;
            }
        }
    }
    return (~$crc)&0xffffffff;
}

=item Mail::SpamAssassin::ConfSourceGeneric::dbg(@data)

Forwards the data to Mail::SpamAssassin::dbg().

=item Mail::SpamAssassin::ConfSourceGeneric::sa_die(@data)

Calls Mail::SpamAssassin::sa_die(1, @data).

=cut

sub dbg { Mail::SpamAssassin::dbg (@_); }
sub sa_die { Mail::SpamAssassin::sa_die (1, @_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfSourceSpamc - load prefs from the spamc client

=head1 DESCRIPTION

This is really an 'adapter' class, which accepts data from a spamc client
and saves it in an arbitrary Mail::SpamAssassin::ConfStoreGeneric subclass.
The source interface methods similarly just forward to the backend store.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfSourceSpamc;

use Carp;
use Socket qw(:crlf);
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfSourceGeneric;
@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfSourceSpamc->new($sink)

Create a new object. If $sink is not a Mail::SpamAssassin::ConfStoreGeneric
subclass, an exception will be thrown.

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my ($sink) = @_;
    die "\$sink ($sink) is not a Mail::SpamAssassin::ConfStoreGeneric\n" unless UNIVERSAL::isa($sink, 'Mail::SpamAssassin::ConfStoreGeneric');

    my $self = {
        'sink' => $sink,
    };

    bless ($self, $class);
    $self;
}

###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

=item $f->handle_protocol($infd, $outfd)

Handle the spamc preference-transfer protocol. In particular, when you
receive the preference offer (e.g. "OFFER_PREFS SPAMC/1.3"), you should call
this function. $infd is the read file descriptor, $outfd is the write file
descriptor. Returns ("EX_OK", "Success"), or ("EX_...", "... error message
...") on error. Note that the caller is responsible for sending the final
status message to the client.

See below for details on the protocol.

=cut

sub handle_protocol {
    my ($self, $infd, $outfd) = @_;
    my ($user, $checksum, $len)=(undef, undef, undef);
    local $|=1;

    # Read the rest of the headers
    while(1){
        $_=readline($infd);
        return ("EX_PROTOCOL", "EOF reading headers") unless defined($_);
        last if /^${CRLF}/o;
        if(/^User: (.*)${CRLF}/o){
            $user=$1;
        }
        if(/^Checksum: (0x[a-fA-F0-9]+)${CRLF}/o){
            $checksum=hex($1);
        }
        if(/^Checksum: (\d+)${CRLF}/o){
            $checksum=$1;
        }
        if(/^Content-length: (\d+)${CRLF}/oi){
            $len=$1;
        }
    }

    return ("EX_PROTOCOL", "'User' header not found") unless defined($user);
    return ("EX_PROTOCOL", "'User' may not be '\@GLOBAL'") if($user eq '@GLOBAL');
    return ("EX_PROTOCOL", "'User' may not be '\@DEFAULT'") if($user eq '@DEFAULT');
    return ("EX_PROTOCOL", "'Checksum' header not found") unless defined($checksum);
    return ("EX_PROTOCOL", "'Content-length' header not found") unless defined($len);

    my ($old_len, $old_sum);
    if(defined($old_len=$self->{'sink'}->get_length($user)) && $old_len==$len &&
    defined($old_sum=$self->{'sink'}->get_checksum($user)) && $old_sum==$checksum){
        # Checksum the same, say no thanks
        printf $outfd "1 No thanks${CRLF}";
        return ("EX_OK", "Success");
    }

    dbg("Receiving user prefs for $user from client");
    printf $outfd "0 Please send${CRLF}";

    # Read the prefs file
    my $prefs="";
    my $read_len=0;
    my $i=0;
    while($read_len<$len && ($i=read($infd, $prefs, $len-$read_len, $read_len))>0){
        $read_len+=$i;
    }
    return ("EX_IOERR", "Read error: $!") if $i<0;
    return ("EX_DATAERR", "Expected $len bytes, read $read_len") unless $read_len==$len;
    $_=readline($infd);
    return ("EX_DATAERR", "More than $len bytes sent") unless /^${CRLF}/o;

    my @ret=$self->{'sink'}->save_prefs($user, $prefs);
    return @ret;
}

=item Mail::SpamAssassin::ConfSourceSpamc->reject_protocol($infd, $outfd)

Just like handle_protocol(), except it always rejects the offer. In other
words, it always replies to spamc with "1 No thanks".

See below for details on the protocol.

=cut

sub reject_protocol {
    my ($class, $infd, $outfd) = @_;
    local $|=1;

    # Read the rest of the headers
    while(1){
        $_=readline($infd);
        return ("EX_PROTOCOL", "EOF reading headers") unless defined($_);
        last if /^${CRLF}/o;
    }

    printf $outfd "1 No thanks${CRLF}";
    return ("EX_OK", "Success");
}

###########################################################################

sub get_prefs {
    my ($self, $user)=@_;
    return $self->{'sink'}->get_prefs($user);
}

sub get_length {
    my ($self, $user)=@_;
    return $self->{'sink'}->get_length($user);
}

sub get_checksum {
    my ($self, $user)=@_;
    return $self->{'sink'}->get_checksum($user);
}

sub apply_prefs {
    my ($self, $main, $user)=@_;
    return $self->{'sink'}->apply_prefs($main, $user);
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 PROTOCOL

All line terminators are expected to be \r\n-style.

The client first offers the preference file to the server:

 < OFFER_PREFS SPAMC/1.3
 < User: (.+)
 < Checksum: (0x[a-zA-Z0-9]+|\d+)
 < Content-length: (\d+)
 <

handle_protocol() (or reject_protocol()) should be called after the OFFER_PREFS
line, it will take care of reading the various variables.

ConfSoureSpamc may return at this point with an error message ($code, $msg),
which should be sent to the client formatted as follows: ($codeval is the
sysexit.h numeric value corresponding to $code). The '$code:' portion isn't
strictly necessary.

 > SPAMD/1.2 $codeval $code: $msg
 (goto the "End" portion below)

Otherwise, ConfSoureSpamc will respond to the client with either '0'
(indicating to send the prefs) or '1' (indicating to not send the prefs), and
some explanatory text (this entire response shall always be less than 80
characters in length). It may then return at this point, again the return
message should be written to the client.

If 0 is sent, the client will then send Content-length bytes, followed by a
\r\n sequence. ConfSoureSpamc will then return an error (or success) message
which must be forwarded to the client.

Thus, we may proceed in two ways here:

 > 1 No thanks
 > SPAMD/1.2 0 EX_OK: Success
     or
 > 0 Please send
 < { content-length bytes }
 > SPAMD/1.2 $codeval $code: $msg

("End" here)

At this point, the client may send another request (e.g. PROCESS), or it may
close the connection. If the code was not "EX_OK", the server may also close
the connection, otherwise it must await the client's next action.

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreDirectory - Store user preferences in a directory.

=head1 DESCRIPTION

This store will maintain a collection of files, one per user, in an
arbitrary directory. Note that this module will follow symlinks, which will
allow the calling process to read or overwrite any file it has permissions
to. So either don't run as a privelaged user, or don't put yourself in a
situation where links can be created.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfStoreDirectory;

use IO::File;
use Carp;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfStoreGeneric;
@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfStoreDirectory->new($dir, $mode)

Create a new object. The calling process must be allowed to read, overwrite,
and create any files in $dir. New files are created with mode $mode, as
modified by the calling process's umask (if $mode is not specified, 0600 is
used).

Global and default preferences are stored in the files "$dir/@GLOBAL.prefs"
and "$dir/@DEFAULT.prefs".

The recommended setup is a directory owned by the calling process with group
and other permissions zeroed. If users must be able to modify the files by
hand, deny write permissions to the directory, create each user's prefs file
by hand (thus they can edit, but not remove or rename the file), and make
all prefs files readable by the group of the calling process (or make them
world-readable).

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my ($dir) = @_;

    my $self = {
        'dir' => $dir,
    };

    bless ($self, $class);
    $self;
}


###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

sub get_filename {
    my ($self, $user)=@_;

    return $self->{'dir'}.'/@GLOBAL.prefs' if($user eq '@GLOBAL');
    return $self->{'dir'}.'/@DEFAULT.prefs' if($user eq '@DEFAULT');
    my $filename="${user}.prefs";
    if($filename=~s/([^a-zA-Z0-9_.\-])/ sprintf("%%%02x", ord($1)) /goe){
        dbg("Bad characters in username!");
    }
    $filename=$self->{'dir'}."/$filename";
    return $filename;
}

=item $store->save_prefs($user, $prefs)

Saves the prefs for the specified user to the file $dir/$user.prefs.
However, note that unusual characters in the username will be encoded
URL-style (at the moment, 'unusual' is 'anything matching the regular
expression [^a-zA-Z0-9_.\-]').

=cut

sub save_prefs {
    my ($self, $user, $prefs)=@_;
    my $fh;
    my $filename;
    
    $fh=IO::File->new();
    $filename=$self->get_filename($user);
    dbg("Saving prefs for $user to $filename");
    unless($fh->open(">$filename")){
        dbg("ConfStoreDirectory: Can't create output file $filename: $!");
        return ret("EX_CANTCREAT", "Can't create output file: $!");
    }
    $fh->printf("%s", $prefs);
    $fh->close();
    return ret("EX_OK", "Success");
}

sub get_prefs {
    my ($self, $user)=@_;
    my $fh;
    my $prefs;

    my $filename=$self->get_filename($user);
    return ret("EX_OK", undef, "No user prefs") unless -r $filename;
    dbg("Reading prefs for $user from $filename");

    $fh=IO::File->new();
    unless($fh->open("<$filename")){
        dbg("ConfStoreDirectory: Can't open input file $filename: $!");
        return ret("EX_IOERR", "", "Can't open input file: $!");
    }
    $prefs=join("", $fh->getlines());
    $fh->close();
    return ret("EX_OK", $prefs, "Success");
}
    
=item $f->get_length($user)

Note that this method depends on perl's '-s' file test working correctly.

=cut

sub get_length {
    my ($self, $user)=@_;
    my $f=$self->get_filename($user);
    return ret("EX_DATAERR", undef, "No user prefs") unless -r $f;
    my $size=-s $f;
    return ret("EX_IOERR", undef, $!) unless defined($size);
    return ret("EX_OK", $size, "Success");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<Mail::SpamAssassin::ConfStoreGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreGeneric - base class for SpamAssassin configuration stores.

=head1 DESCRIPTION

This is the base class for SpamAssassin configuration stores. A store is
simply a source that can be saved to, and as such this is a subclass of
Mail::SpamAssassin::ConfSoureGeneric.

=head1 PUBLIC FUNCTIONS

All those defined for Mail::SpamAssassin::ConfSoureGeneric, as well as the
following.

=over 4

=cut

package Mail::SpamAssassin::ConfStoreGeneric;

use Carp;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfSourceGeneric;
@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);

###########################################################################

sub new {
    sa_die("Cannot create a Mail::SpamAssassin::ConfStoreGeneric");
    return undef;
}

###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

=item $store->save_prefs($user, $prefs)

Save the prefs to whatever backing store you have, overwriting any old prefs
for that user. It is also permissable to 'forget' other user's prefs, e.g.
in the case of an LRU cache, but this must be documented. In a scalar
contect, return "EX_OK", in a list contect return ("EX_OK", "Success"). If
an error occurs, return "EX_..." or ("EX_...", "... error message ...").

$store->get_prefs() must return these preferences in the same order, however
comments, whitespace, and other 'noise' may be stripped. If the get_prefs()
output is not identical, this should be documented.

$store->get_length() and $store->get_checksum() must return the length and
checksum of the data passed to save_prefs(), NOT that returned by
get_prefs()! The intention is that the caller may check the length and
checksum against those of a cached pref set, and refrain from saving/reading
the prefs if they happen to be the same.

=cut

sub save_prefs {
    sa_die("save_prefs was not implemented");
}

###########################################################################

=back

=head UTILITY FUNCTIONS

Mail::SpamAssassin::ConfStoreGeneric provides versions of the non-method
utility functions (the methods, of course, are inherited).

=cut

sub ret { Mail::SpamAssassin::ConfSourceGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfSourceGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfSourceGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreHomedir - Store preferences in a user's home directory.

=head1 DESCRIPTION

This class reads prefs from a prefs file in a user's home directory. It can
also attempt to write the prefs file. Symlinks are followed, so be aware that
this source can be used to read or write any file to which the calling program
has permissions.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfStoreHomedir;

use IO::File;
use File::Path;
use Carp;
use Config;
use strict;

use vars qw{
    @ISA @default_prefs_path @default_userprefs_path
};

use Mail::SpamAssassin::ConfStoreGeneric;
@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);

@default_prefs_path = (
    '__local_rules_dir__/user_prefs.template',
    '__prefix__/etc/mail/spamassassin/user_prefs.template',
    '__prefix__/share/spamassassin/user_prefs.template',
    '/etc/spamassassin/user_prefs.template',
    '/etc/mail/spamassassin/user_prefs.template',
    '/usr/local/share/spamassassin/user_prefs.template',
    '/usr/share/spamassassin/user_prefs.template',
);

@default_userprefs_path = (
    '~/.spamassassin/user_prefs',
);

sub sed_path {
    my ($self, $path) = @_;
    return undef if (!defined $path);
    $path =~ s/__local_rules_dir__/$self->{LOCAL_RULES_DIR} || ''/ges;
    $path =~ s/__def_rules_dir__/$self->{DEF_RULES_DIR} || ''/ges;
    $path =~ s/__prefix__/$self->{PREFIX} || $Config{prefix}/gs;
    $path =~ s/^\~([^\/]*)/$self->expand_name($1)/es;
    $path;
}

sub get_homedir {
    my ($self, $user)=@_;
    return (getpwnam($user))[7] || undef;
}

###########################################################################

=item Mail::SpamAssassin::ConfStoreHomedir->new($user_paths, $default_paths)

Return a new Mail::SpamAssassin::ConfStoreHomedir object.

$user_paths is a listref containing paths to search for the user
preferences. A scalar value is taken as the listref containing that scalar.
If $user_paths is undef, the values in
@Mail::SpamAssassin::ConfStoreHomedir::default_userprefs_path are used
instead.

$default_paths is used for locating the prefs for the @DEFAULT user. If it
is undefined, the values in
@Mail::SpamAssassin::ConfStoreHomedir::default_prefs_path are used instead.

When saving, only those paths containing a ~ are attempted (unless the user
is @DEFAULT, in which case only values not beginning in '_' are attepmted).

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my ($dirs, $default)=@_;
    $dirs=\@Mail::SpamAssassin::ConfStoreHomedir::defaut_userprefs_path unless defined($dirs);
    $default=\@Mail::SpamAssassin::ConfStoreHomedir::default_prefs_path unless defined($default);
    $dirs=[$dirs] unless ref($dirs);
    $default=[$default] unless ref($default);

    my $self = {
        'paths'   => $dirs,
        'default' => $default,
    };

    bless ($self, $class);
    $self;
}


###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

sub get_filehandle {
    my ($self, $user, $writeflag)=@_;
    my @failed;

    # No global prefs for Homedir
    return (undef, "EX_UNAVAILABLE", "No global prefs") if($user eq '@GLOBAL');
    
    my $homedir=$self->get_homedir($user);
    my @paths;
    if($user eq '@DEFAULT'){
        # Filter _-paths if writing, and then replace replacement vars
        @paths=map(sed_path, grep {!$writeflag || /^[^_]/o} (@{$self->{'default'}}));
    } else {
        # Filter non-~-paths if writing, and ~-paths if no $homedir
        @paths=map { my $x; ($x=$_)=~s/~/$homedir/go; $x }
                   grep {(!$writeflag || /~/o) &&
                         (defined($homedir) || !/~/o)}
                        @{$self->{'paths'}};
    }
    return (undef, "EX_UNAVAILABLE", "No available paths for $user") unless @paths;

    my $fh=IO::File->new();
    for my $filename (@paths){
        if($writeflag){
            # Writing, create the path if necessary
            my $p=$filename;
            $p=~s![^/]*$!!o;
            if(!-d $p){
                eval { mkpath($p, 0, 0700) || die "$!\n" };
                if($@){
                    my $err=$@;
                    $err=$1 if $err=~/^mkdir .*: (.*) at .*ConfStoreHomedir.* line \d+/o;
                    dbg("Creation of $p failed: $err");
                    @failed=("EX_CANTCREAT", "Prefs dir creation failed: $err") unless @failed;
                    next;
                }
                dbg("ConfStoreHomedir created $p for user prefs");
            }

            # Don't bother if the filename exists and isn't a regular file
            next if(-e $filename && !-f $filename);
            
            # Now, see if we can open it for writing
            unless($fh->open(">$filename")){
                dbg("Cannot open $filename: $!");
                @failed=("EX_CANTCREAT", "Can't open prefs file: $!");
                next;
            }
            dbg("Writing prefs for $user to $filename");
            return ($fh, "EX_OK", "Success");
        } else {
            # Reading, just make sure it's a regular file (or a symlink to a
            # regular file) and that it's readable
            next unless -f $filename;
            unless($fh->open("<$filename")){
                dbg("Cannot read $filename: $!");
                @failed=("EX_IOERR", "Can't read prefs file: $!");
                next;
            }
            dbg("Reading prefs for $user from $filename");
            return ($fh, "EX_OK", "Success");
        }
    }
    return (undef, @failed?@failed:("EX_OK", "No user prefs"));
}

sub save_prefs {
    my ($self, $user, $prefs)=@_;

    return ("EX_UNAVAILABLE", "No global prefs") if($user eq '@GLOBAL');
    my ($fh, $code, $err)=$self->get_filehandle($user, 1);
    return ($code, $err) unless $fh;
    $fh->print($prefs);
    $fh->close();
    return ret("EX_OK", "Success");
}

sub get_prefs {
    my ($self, $user)=@_;
    
    return ret("EX_UNAVAILABLE", undef, "No global prefs") if($user eq '@GLOBAL');
    my ($fh, $code, $err)=$self->get_filehandle($user, 0);
    return ret($code, undef, $err) unless $fh;
    my $prefs=join("", $fh->getline());
    $fh->close();
    return ret("EX_OK", $prefs, "Success");
}

=item $f->get_length($user)

Note that this method depends on perl's stat getting the correct size.

=cut

sub get_length {
    my ($self, $user)=@_;
    my ($fh, $code, $err)=$self->get_filehandle($user);
    return ret($code ne "EX_OK"?$code:"EX_DATAERR", undef, $err) unless $fh;
    my $size=($fh->stat())[7];
    $fh->close();
    return ret("EX_IOERR", undef, $!) unless(defined($size) && $size>=0);
    return ret("EX_OK", $size, "Success");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<Mail::SpamAssassin::ConfStoreGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreMemory - cache preferences in memory

=head1 DESCRIPTION

This module will cache preferences in memory, for the lifetime of the
object. It works properly across forks. Optionally, it can limit memory
usage via LRU elimination.

For the curious, it forks a process which listens on a random TCP socket and
speaks a simple protocol to store and retrieve the data. The methods connect
to this socket. To prevent arbitrary process from connecting to the cache
process, the cache binds only to localhost. Also, a pipe is kept open from
the parent (and thus, all forked children) to the cache process. All
children wishing to connect first bind a socket on localhost, send the port
number over the pipe, and only then try to connect. The cache thus rejects
connections from any ports it is not told about within the past few seconds
via the pipe.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfStoreMemory;

use Carp;
use IO::Handle;
use IO::Socket::INET;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfStoreGeneric;
@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfStoreMemory->new($maxsize)

Create a new object. This function also forks the cache process. It may
die in various ways. $maxsize, if specified, is the maximim size in 'bytes'
for the cache. If the total size of everything in the cache is greater than
this, the least recently accessed entry will be freed until the total size
falls below.

Note that the size isn't true bytes. It's more or less the length of the
stored data plus an arbitraty allowance for storage overhead.

Note that the cache process is actually a perl "one"-liner exec'ed after the
fork. It saves memory, slightly. Better than relying on copy-on-write,
because even though the cache will not write many of those mapped pages, the
parent probably will and thus those pages will end up duplicated anyway.
Sorry for cluttering up your process listing.

WARNING: This function does not work for Perl 5.005. If you know a way to do
'open(STDOUT, ">&", $fh)' (i.e. dup using a IO::Handle instead of a glob),
let me know.

=cut

sub do_exec {
    my ($self, $size)=@_;

    $size=0xffffffff unless defined($size);
    my $cacher=<<'CACHER' ;
  use IO::Handle;
  use IO::Socket::INET;

  $rd=IO::Handle->new_from_fd(fileno(\*STDIN), "r");
  $rd->blocking(0);
  $server=IO::Socket::INET->new(Type => SOCK_STREAM, LocalHost => "localhost", Listen => 5, Timeout => 5);
  die "socket creation: $!\n" unless defined($server);
  $server->autoflush(1);
  $|=1;
  print $server->sockaddr()."\n";
  print $server->sockport()."\n";

  %cache=();
  @cache=();
  %auth=();
  $totalsize=0;
  sub del {
      my $user=shift;
      return unless exists($cache{$user});
      $totalsize-=length($cache{$user}->[1])+20;
      delete($cache{$user});
      for(my $i=0; $i<@cache; $i++){
          splice(@cache,$i--,1) if $cache[$i] eq $user;
      }
  }
  sub touch {
      my $user=shift;
      for(my $i=0; $i<@cache; $i++){
          splice(@cache,$i--,1) if $cache[$i] eq $user;
      }
      push @cache, $user;
  }
  sub auth {
      undef($!);
      while(defined($_=$rd->getline())){
          chomp;
          $auth{$_}=time()+60;
      }
      exit(0) unless $!{EAGAIN};
  }
  do {
      %auth=();
      auth();
      undef($!);
      for(; $client=$server->accept(); $client->close()){
          auth();
          next unless(exists($auth{$client->peerport()}) && $auth{$client->peerport()}>=time());
          next unless defined($_=$client->getline());
          chomp;
          if(/^SAVE (\d+) (.*)$/o){
              ($checksum, $user)=($1, $2);
              $x=join("", $client->getlines());
              $client->print("OK\n");
              del($user);
              $totalsize+=length($x)+20;
              del($cache[0]) while(@cache && $totalsize>#!$size!#);
              $cache{$user}=[0+$checksum, $x];
              push @cache, $user;
          } elsif(/^RETR (.*)$/o){ 
              if(exists($cache{$1})){
                  touch($1);
                  $client->print("OK\n");
                  $client->print($cache{$1}->[1]);
              } else {
                  $client->print("ENOENT\n");
              }
          } elsif(/^LEN (.*)$/o){ 
              if(exists($cache{$1})){
                  touch($1);
                  $client->print(length($cache{$1}->[1])."\n");
              } else {
                  $client->print("-1\n");
              }
          } elsif(/^CSUM (.*)$/o){
              if(exists($cache{$1})){
                  touch($1);
                  $client->print($cache{$1}->[0]."\n");
              } else {
                  $client->print("-1\n");
              }
          } else {
              $client->print("Unknown command\n");
          }
      }
  } while($!{ETIMEDOUT} || $!==1);
  $server->close();
CACHER

    $cacher=~s/#!(.*?)!#/ eval $1 /goe;
    exec($^X, '-e', <<NOTE , '-e', $cacher) || die "exec failed: $!\n";
# Mail::SpamAssassin::ConfStoreMemory cache process #
# It will exit when the originating perl object is GCed #
NOTE
}

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my ($size)=@_;

    my ($rd1, $wr1)=(IO::Handle->new, IO::Handle->new);
    my ($rd2, $wr2)=(IO::Handle->new, IO::Handle->new);
    if(!pipe($rd1, $wr1)){ sa_die("ConfStoreMemory: pipe failed: $!"); }
    if(!pipe($rd2, $wr2)){ sa_die("ConfStoreMemory: pipe failed: $!"); }
    $wr1->autoflush(1);
    $wr2->autoflush(1);
    
    my $pid=fork();
    if(!defined($pid)){ sa_die("ConfStoreMemory: couldn't fork: $!"); }
    if(!$pid){
        my $pid=fork();
        if(!defined($pid)){ sa_die("ConfStoreMemory: couldn't fork: $!"); }
        exit(0) if($pid);
        open(STDIN, "<&", $rd1) || sa_die("ConfStoreMemory: couldn't dup stdin: $!");
        open(STDOUT, ">&", $wr2) || sa_die("ConfStoreMemory: couldn't dup stdout: $!");
        close($rd1);
        close($rd2);
        close($wr1);
        close($wr2);
        dbg("Execing ConfStoreMemory process");
        # exec a simple little perl script to conserve memory slightly
        $class->do_exec($size);
    }
    waitpid($pid, 0);
    close($rd1);
    close($wr2);

    my $host=<$rd2> || die "Read from ConfStoreMemory process failed\n";
    my $port=<$rd2> || die "Read from ConfStoreMemory process failed\n";
    chomp($host);
    chomp($port);
    dbg("ConfStoreMemory cache on port $port");

    my $self = {
        'auth' => $wr1,
        'host' => $host,
        'port' => $port,
    };

    bless ($self, $class);
    $self;
}

###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

sub get_key {
    my ($self, $user)=@_;
    my $key=$user;
    if($key=~s/([^a-zA-Z0-9_.\-])/ sprintf("%%%02x", ord($1)) /goe){
        dbg("Bad characters in username!");
    }
    return $key;
}

sub get_sock {
    my ($self)=@_;

    my $sock=IO::Socket::INET->new(Type => SOCK_STREAM);
    $sock->bind(0, $self->{'host'}) || return (undef, "bind failed: $!");
    $self->{'auth'}->print($sock->sockport()."\n");
    $sock->connect($self->{'port'}, $self->{'host'}) || return (undef, "connect failed: $!");
    return ($sock, "Success");
}

sub save_prefs {
    my ($self, $user, $prefs)=@_;

    dbg("Saving prefs for $user to ConfStoreMemory process");
    my ($sock, $err)=$self->get_sock();
    return ret("EX_OSERR", $err) unless $sock;
    $sock->printf("SAVE %u %s\n%s", $self->calc_checksum($prefs), $self->get_key($user), $prefs);
    $sock->shutdown(1);
    my $response=$sock->getline();
    $sock->close();
    return ret("EX_OK", "Success") if $response=~/^OK/o;
    return ret("EX_IOERR", "ConfStoreMemory process error: $response");
}

sub get_prefs {
    my ($self, $user)=@_;

    dbg("Reading prefs for $user from ConfStoreMemory process");
    my ($sock, $err)=$self->get_sock();
    return ret("EX_OSERR", undef, $err) unless $sock;
    $sock->printf("RETR %s\n", $self->get_key($user));
    my $response=$sock->getline();
    my $prefs=join("", $sock->getlines());
    $sock->close();
    return ret("EX_OK", undef, "No user prefs") if $response=~/^ENOENT/o;
    chomp $response;
    return ret("EX_IOERR", undef, $response) unless $response=~/^OK$/o;
    return ret("EX_OK", $prefs, "Success");
}

sub get_length {
    my ($self, $user)=@_;

    my ($sock, $err)=$self->get_sock();
    return ret("EX_OSERR", undef, $err) unless $sock;
    $sock->printf("LEN %s\n", $self->get_key($user));
    my $response=$sock->getline();
    $sock->close();
    return ret("EX_DATAERR", undef, "No user prefs") if $response=~/^-1/o;
    return ret("EX_OK", 0+$response, "Success");
}

sub get_checksum {
    my ($self, $user)=@_;

    my ($sock, $err)=$self->get_sock();
    return ret("EX_OSERR", undef, $err) unless $sock;
    $sock->printf("CSUM %s\n", $self->get_key($user));
    my $response=$sock->getline();
    return ret("EX_DATAERR", undef, "No user prefs") if $response=~/^-1/o;
    return ret("EX_OK", 0+$response, "Success");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<Mail::SpamAssassin::ConfStoreGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreNull - Pretend to store prefs

=head1 DESCRIPTION

This module doesn't actually store any prefs. The main use would be to prevent
the use of any user prefs.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfStoreNull;

use Carp;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfStoreGeneric;
@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfStoreNull->new()

Create a new object.

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;

    bless ({}, $class);
}

###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

=item $f->save_prefs($user, $prefs)

Always returns an EX_UNAVAILABLE failure.

=cut

sub save_prefs {
    return ret("EX_UNAVAILABLE", "ConfStoreNull saves no prefs");
}

=item $f->get_prefs($user)

Always returns a "No user prefs" result.

=cut

sub get_prefs {
    return ret("EX_OK", undef, "No user prefs");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<Mail::SpamAssassin::ConfStoreGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreSQL - store prefs in an SQL database

=head1 DESCRIPTION

This module uses Perl's DBI module to store prefs in an SQL database. In
particular, it supports any database DBI supports with placeholders.

See below for some table creation commands for various databases.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfStoreSQL;

use Carp;
use DBI;
use Mail::SpamAssassin::Conf;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfStoreGeneric;
@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfStoreSQL->new($dsn, $username, $password, $tablename)

Create a new object. $dsn is the Perl DBI data source name. $username and
$password are the username and password, respectively. $tablename is the
name of the table to read from. Note that no database connection is
attempted at this time.

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my ($dsn, $username, $password, $tablename)=@_;

    sa_die("Invalid table name '$tablename'") unless $tablename=~/^[a-zA-Z0-9_]+$/o;
    my $self = {
        'dsn'   => $dsn,
        'user'  => $username,
        'pass'  => $password,
        'table' => $tablename,
        'dbi'   => [0, undef],
    };

    bless ($self, $class);
    $self;
}

###########################################################################

=item $store->load_modules()

If this is called as shown instead of statically as
Mail::SpamAssassin::ConfStoreSQL->load_modules(), a connection will be made
to the database, and a true value will be returned if the connect seemed to
succeed. This has the side effect of loading the appropriate DBD modules,
which cannot be easily determined beforehand.

=cut

sub load_modules {		# static
    my ($self)=@_;
    Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
    eval {
        $self->do_connect() if ref($self);
    };
    dbg($@) if $@;
    return $@?0:1;
    # do any preloading that will speed up operation
}

###########################################################################

=item $f->save_prefs($user, $prefs)

Note that leading and trailing whitespace and comments are stripped from the
saved data. Whitespace within the "lang xx " preference modifier or within
the preference itself is collapsed to a single space.

For those looking at the actual database, two extra pseudo-prefs are
inserted with negative line numbers, to store the original length and checksum.

=cut

sub do_connect {
    my ($self)=@_;
    
    if($self->{'dbi'}->[0]!=$$){
        # If we have an old dbh from a fork, set InactiveDestroy so we don't
        # disconnect our parent.
        $self->{'dbi'}->[1]->{InactiveDestroy}=1 if defined($self->{'dbi'}->[1]);
        $self->{'dbi'}->[0]=$$;
        dbg("Connecting to database...");
        $self->{'dbi'}->[1]=DBI->connect($self->{'dsn'}, $self->{'user'}, $self->{'pass'}, { PrintError => 0, RaiseError => 1, AutoCommit => 0}) or die $DBI::errstr;
    }
    die "Our dbh is unsuspectedly undef" unless defined($self->{'dbi'}->[1]);
    return $self->{'dbi'}->[1];
}

sub save_prefs {
    my ($self, $user, $prefs)=@_;
    my $dbh=undef;
    my $ins=undef;

    dbg("Saving prefs for $user to the SQL database");
    eval {
        $dbh=$self->do_connect();
        my $table=$self->{'table'};
        # RaiseError is set, so we have no need to check for errors.
        # AutoCommit is off, so nothing should happen until we $dbh->commit().

        $dbh->do("DELETE FROM $table WHERE username=?", {}, $user);
        $ins=$dbh->prepare("INSERT INTO $table (username,preference,value,line) VALUES (?,?,?,?)");
        $ins->execute($user, "saved length", "".length($prefs), -2);
        $ins->execute($user, "saved checksum", "".$self->calc_checksum($prefs), -1);
        my ($line, $num, $pref, $value);
        $num=0;
        while(defined($line=Mail::SpamAssassin::Conf::extract_line($prefs))){
            $num++;
            next unless($line);           # skip empty lines
            $line=~s/^lang\s+(\S+)\s+/lang $1 /o;
            die "Invalid input at line $num\n" unless $line=~/^((?:lang \S+ )?\S+)\s*(.*)$/o;
            ($pref, $value)=($1, $2);
            $ins->execute($user, $pref, $value, $num);
        }
        $ins->finish();
        $dbh->commit();
    };
    if($@){
        my $err=$@;
        eval {
            $ins->finish() if $ins;
            $dbh->rollback() if $dbh;
        };
        return ret("EX_IOERR", $err);
    }
    return ret("EX_OK", "Success");
}

=item $f->get_prefs($user)

Note that the return isn't exactly what was given to save_prefs(), see the
note there for details.

=cut

sub get_prefs {
    my ($self, $user)=@_;
    my $prefs=undef;

    dbg("Reading prefs for $user from the SQL database");
    eval {
        my $dbh=$self->do_connect();
        my $table=$self->{'table'};
        # RaiseError is set, so we have no need to check for errors.
        # AutoCommit is off, so nothing should happen until we $dbh->commit().

        my $ref=$dbh->selectall_arrayref("SELECT preference, value FROM $table WHERE username=? AND line>=0 ORDER BY line ASC", {}, $user);
        $prefs=join("\n", map { join(" ", @$_) } @$ref)."\n" if @$ref;
    };
    return ret("EX_IOERR", undef, $@) if($@);
    return ret("EX_OK", undef, "No user prefs") unless defined($prefs);
    return ret("EX_OK", $prefs, "Success");
}

sub get_length {
    my ($self, $user)=@_;
    my $len=undef;
    my $exists=0;

    eval {
        my $dbh=$self->do_connect();
        my $table=$self->{'table'};
        # RaiseError is set, so we have no need to check for errors.
        # AutoCommit is off, so nothing should happen until we $dbh->commit().

        $len=$dbh->selectrow_array("SELECT value FROM $table WHERE username=? AND line=-2 AND preference=?", {}, $user, "saved length");
        $exists=defined($len) || $dbh->selectrow_array("SELECT COUNT(*) FROM $table WHERE username=?", {}, $user);
    };
    return ret("EX_IOERR", undef, $@) if($@);
    return ret("EX_DATAERR", undef, "No user prefs") unless($exists);
    return ret("EX_OK", $len, "Success") if defined($len);
    return $self->SUPER::get_length($user);
}

sub get_checksum {
    my ($self, $user)=@_;
    my $sum=undef;
    my $exists=0;

    eval {
        my $dbh=$self->do_connect();
        my $table=$self->{'table'};
        # RaiseError is set, so we have no need to check for errors.
        # AutoCommit is off, so nothing should happen until we $dbh->commit().

        $sum=$dbh->selectrow_array("SELECT value FROM $table WHERE username=? AND line=-1 AND preference=?", {}, $user, "saved checksum");
        $exists=defined($sum) || $dbh->selectrow_array("SELECT COUNT(*) FROM $table WHERE username=?", {}, $user);
    };
    return ret("EX_IOERR", undef, $@) if($@);
    return ret("EX_DATAERR", undef, "No user prefs") unless($exists);
    return ret("EX_OK", $sum, "Success") if defined($sum);
    return $self->SUPER::get_checksum($user);
}

sub apply_prefs {
    my ($self, $conf, $user)=@_;
    my $sth=undef;

    dbg("Applying prefs for $user from the SQL database");
    eval {
        my $dbh=$self->do_connect();
        my $table=$self->{'table'};
        # RaiseError is set, so we have no need to check for errors.
        # AutoCommit is off, so nothing should happen until we $dbh->commit().

        my $sth=$dbh->prepare("SELECT preference, value FROM $table WHERE username=? AND line>=0 ORDER BY line ASC");
        $sth->execute($user);
        my ($pref, $val);
        $sth->bind_columns(\$pref, \$val);

        $conf->parse_scores_only("$pref $val") while($sth->fetch);
        $sth->finish();
    };
    if($@){
        my $err=$@;
        return ret("EX_IOERR", $err);
    }
    return ret("EX_OK", "Success");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 DATABASE TABLES

=head2 In general

The table schema has changed slightly from the ConfSourceSQL version:

 username   varchar
 preference varchar
 value      varchar
 line       integer

The sizes of the varchars don't matter too much, as long as they're big
enough to hold whatever possible values you'll be putting in them. The line
column is new, it avoids the problem of ConfSourceSQL where the rows are not
guaranteed to be returned in any particular order. Thus, you could end up
with your report template all mixed up, or you could end up with
clear-report-template after your report lines!

Selects are performed mainly using username and line, so an appropriate
index would be on those two columns. The combination of the two should be
unique. This module has little need for an index on preference, and none for
an index on value.

=head2 PostgreSQL

Table creation:

 CREATE TABLE userpref (
   username VARCHAR(32) NOT NULL,
   preference VARCHAR(50) NOT NULL,
   value VARCHAR(100) NOT NULL,
   line INTEGER NOT NULL,
   PRIMARY KEY (username, line)
 );
                   
Note that the lengths of the varchars may be adjusted to suit your
situation. Note that 'preference' may contain "lang xx pref" as well as just
"pref". The primary key setting isn't strictly necessary, but it speeds
queries slightly.

Granting permissions:

 GRANT SELECT, INSERT, UPDATE, DELETE ON userpref TO spamassassin;

If you only want to use get_prefs, only SELECT is necessary. UPDATE probably
isn't necessary for most cases either.

If you need to copy prefs from an old-style table (without the 'line'
column), something like this should do it unless you created the old table
without oids:

 INSERT INTO new_userpref SELECT *, oid AS line FROM old_userpref;

=head2 MySQL

Table creation:

 CREATE TABLE userpref (
   username varchar(32) NOT NULL,
   preference varchar(50) NOT NULL,
   value varchar(100) NOT NULL,
   prefid int(11) NOT NULL auto_increment,
   line int(11) NOT NULL,
   PRIMARY KEY (prefid),
   INDEX (username)
 ) TYPE=MyISAM;

The lines containing 'prefid' are not strictly necessary, i suspect they're
there to provide a unique column for the primary key.

Since I don't use MySQL, I can't give any suggestions for permissions or
copying (although, if you have the prefid column in your old table you can
copy that to line).
 
=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<Mail::SpamAssassin::ConfStoreGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreSimple - Store a single set of prefs.

=head1 DESCRIPTION

ConfStoreSimple stores the prefs for a single user at a time. The intended
use is as a store for Mail::SpamAssassin::ConfSourceSpamc when you would
rather have the prefs sent over the wire for every message instead of using
the memory/disk space the other stores require.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfStoreSimple;

use Carp;
use strict;

use vars qw{
        @ISA
};

use Mail::SpamAssassin::ConfStoreGeneric;
@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);

###########################################################################

=item Mail::SpamAssassin::ConfStoreSimple->new()

Create a new object.

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;

    my $self = {
        'user'  => undef,
        'prefs' => undef,
    };

    bless ($self, $class);
    $self;
}

###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

=item $f->save_prefs($user, $prefs)

Save the prefs, forgetting any old prefs for any user.

=cut

sub save_prefs {
    my ($self, $user, $prefs)=@_;

    dbg("Saving prefs for $user in a ConfStoreSimple");
    $self->{'user'}=$user;
    $self->{'prefs'}=$prefs;
    return ret("EX_OK", "Success");
}

sub get_prefs {
    my ($self, $user)=@_;

    dbg("Reading prefs for $user from ConfStoreSimple");
    return ret("EX_OK", undef, "No user prefs") unless($user eq $self->{'user'});
    return ret("EX_OK", $self->{'prefs'}, "Success");
}

sub get_length {
    my ($self, $user)=@_;

    return ret("EX_DATAERR", undef, "No user prefs") unless $user eq $self->{'user'};
    return ret("EX_OK", length($self->{'prefs'}), "Success");
}

sub get_checksum {
    my ($self, $user)=@_;
    my $prefs;

    return ret("EX_DATAERR", undef, "No user prefs") unless $user eq $self->{'user'};
    return ret("EX_OK", $self->calc_checksum($self->{'prefs'}), "Success");
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<Mail::SpamAssassin::ConfStoreGeneric>
C<spamassassin>
C<spamd>





=head1 NAME

Mail::SpamAssassin::ConfStoreVPopmail - Look for users in a vpopmail config

=head1 DESCRIPTION

This is a modification of Mail::SpamAssassin::ConfStoreHomedir which looks up
users by calling vpopmail's vuserinfo instead of using the getpwnam system
call.

=head1 PUBLIC FUNCTIONS

=over 4

=cut

package Mail::SpamAssassin::ConfStoreVPopmail;

use Carp;
use IO::File;
use strict;

use vars qw{
    @ISA,
};

use Mail::SpamAssassin::ConfStoreHomedir;
@ISA = qw(Mail::SpamAssassin::ConfStoreHomedir);

sub get_homedir {
    my ($self, $user)=@_;
    my $dir=$self->{'vpopdir'};

    # Taken from perlsec, using backquotes is really insecure
    my $fh=IO::File->new();
    my $pid=$fh->open("-|"));
    if(!defined($pid)){
        dbg("Can't fork: $!");
        return undef;
    }
    if(!$pid){
        exec("$dir/bin/vuserinfo", '-d', $user) or die "exec failed: $!\n";
    }
    $dir=join("", $fh->getlines());
    $dir=~s/\n//g;
    return undef unless $dir=~/./o; # catch in case exec failed
    return $dir;
}

###########################################################################

=item Mail::SpamAssassin::ConfStoreVPopmail->new($vpopuser, $user_paths, $default_paths)

Return a new Mail::SpamAssassin::ConfStoreVPopmail object.

$vpopuser is the userid of the vpopmail user, which is needed to get the
individual user configs.

$user_paths and $default_paths are passed to
Mail::SpamAssassin::ConfStoreHomedir.

=cut

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my ($vpopuser, $userpath, $default)=@_;
    my $dir=(getpwnam($vpopuser))[7] or die "User $vpopuser not found: $!";

    my $self = Mail::SpamAssassin::ConfStoreHomedir->new($userpath, $default);
    $self->{'vpopdir'}=$dir;

    bless ($self, $class);
    $self;
}


###########################################################################

sub load_modules {		# static
    Mail::SpamAssassin::ConfStoreHomedir->load_modules(@_);
    # do any preloading that will speed up operation
}

###########################################################################

sub ret { Mail::SpamAssassin::ConfStoreHomedir::ret(@_); }
sub dbg { Mail::SpamAssassin::ConfStoreHomedir::dbg (@_); }
sub sa_die { Mail::SpamAssassin::ConfStoreHomedir::sa_die (@_); }

###########################################################################

1;
__END__

=back

=head1 SEE ALSO

C<Mail::SpamAssassin>
C<Mail::SpamAssassin::Conf>
C<Mail::SpamAssassin::ConfSourceGeneric>
C<Mail::SpamAssassin::ConfStoreGeneric>
C<Mail::SpamAssassin::ConfStoreHomedir>
C<spamassassin>
C<spamd>


Return to bug 579

Lines 188-193 Link Here

(-)lib-old/Mail/SpamAssassin/Conf.pm (-3 / +17 lines)
188		188
189	###########################################################################	189	###########################################################################
190		190
		191	# Mail::SpamAssassin::Conf::extract_line($prefs)
		192	# Extract a single "line" from the configuration data-string. If multi-line
		193	# rules are ever implemented, this is where the change should go.
		194	#
		195	# Don't handle empty lines here, otherwise we can't get a line number if we
		196	# want it.
		197	sub extract_line { # static
		198	return undef unless $_[0]=~/./o;
		199	$_[0]=~s/^([^\n]*)\n?//o; # pull out everything up to and including the
		200	local $_=$1; # first \n (or the whole thing if no \n)
		201	s/(?<!\\)#.*$//o; # strip comments
		202	s/^\s\|\s$//go; # strip leading/trailig whitespace
		203	return $_;
		204	}
		205
191	sub parse_scores_only {	206	sub parse_scores_only {
192	my ($self) = @_;	207	my ($self) = @_;
193	$self->_parse ($_[1], 1); # don't copy $rules!	208	$self->_parse ($_[1], 1); # don't copy $rules!
Lines 214-222 Link Here
214	my $currentfile = '(no file)';	229	my $currentfile = '(no file)';
215	my $skipfile = 0;	230	my $skipfile = 0;
216		231
217	foreach (split (/\n/, $_[1])) {	232	my $rules=$_[1]; # copy rules here, extract_line changes it's parameter.
218	s/(?<!\\)#.*$//; # remove comments	233	while(defined($_=extract_line($rules))){
219	s/^\s+\|\s+$//g; # remove leading and trailing spaces (including newlines)
220	next unless($_); # skip empty lines	234	next unless($_); # skip empty lines
221		235
222	# handle i18n	236	# handle i18n

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfSourceAlt.pm (+113 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfSourceAlt - load prefs from any of several sources
		4
		5	=head1 DESCRIPTION
		6
		7	This is really an 'adapter' class, which loads the prefs from the first of its
		8	sub-sources that returns a calid result.
		9
		10	=head1 PUBLIC FUNCTIONS
		11
		12	=over 4
		13
		14	=cut
		15
		16	package Mail::SpamAssassin::ConfSourceAlt;
		17
		18	use Carp;
		19	use strict;
		20
		21	use vars qw{
		22	@ISA
		23	};
		24
		25	use Mail::SpamAssassin::ConfSourceGeneric;
		26	@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);
		27
		28	###########################################################################
		29
		30	=item Mail::SpamAssassin::ConfSourceAlt->new($source, ...)
		31
		32	Create a new object. If any of the sources is not a
		33	Mail::SpamAssassin::ConfStoreGeneric subclass, an exception will be thrown.
		34
		35	=cut
		36
		37	sub new {
		38	my $class = shift;
		39	$class = ref($class) \|\| $class;
		40	my $sources = [@_];
		41
		42	for my $s (@$sources){
		43	die "$s is not a Mail::SpamAssassin::ConfStoreGeneric\n" unless UNIVERSAL::isa($s, 'Mail::SpamAssassin::ConfStoreGeneric');
		44	}
		45
		46	my $self = {
		47	'sources' => $sources,
		48	};
		49
		50	bless ($self, $class);
		51	$self;
		52	}
		53
		54	###########################################################################
		55
		56	sub load_modules { # static
		57	Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
		58	# do any preloading that will speed up operation
		59	}
		60
		61	###########################################################################
		62
		63	sub get_prefs {
		64	my ($self, $user)=@_;
65
66	for my $s (@{$self->{'sources'}}){
67	my ($ret, $prefs, $err)=$s->get_prefs($user);
68	return ret($ret, $prefs, $err) if defined($prefs);
69	}
70	return ret("EX_OK", undef, "No user prefs");
71	}
72
73	sub get_length {
74	my ($self, $user)=@_;
75
76	for my $s (@{$self->{'sources'}}){
77	my ($ret, $len, $err)=$s->get_length($user);
78	return ret($ret, $len, $err) if defined($len);
79	}
80	return ret("EX_DATAERR", undef, "No user prefs");
81	}
82
83	sub get_checksum {
84	my ($self, $user)=@_;
85
86	for my $s (@{$self->{'sources'}}){
87	my ($ret, $sum, $err)=$s->get_checksum($user);
88	return ret($ret, $sum, $err) if defined($sum);
89	}
90	return ret("EX_DATAERR", undef, "No user prefs");
91	}
92
93	###########################################################################
94
95	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
96	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
97	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
98
99	###########################################################################
100
101	1;
102	__END__
103
104	=back
105
106	=head1 SEE ALSO
107
108	C<Mail::SpamAssassin>
109	C<Mail::SpamAssassin::Conf>
110	C<Mail::SpamAssassin::ConfSourceGeneric>
111	C<spamassassin>
112	C<spamd>
113

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreDirectory.pm (+170 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreDirectory - Store user preferences in a directory.
		4
		5	=head1 DESCRIPTION
		6
		7	This store will maintain a collection of files, one per user, in an
		8	arbitrary directory. Note that this module will follow symlinks, which will
		9	allow the calling process to read or overwrite any file it has permissions
		10	to. So either don't run as a privelaged user, or don't put yourself in a
		11	situation where links can be created.
		12
		13	=head1 PUBLIC FUNCTIONS
		14
		15	=over 4
		16
		17	=cut
		18
		19	package Mail::SpamAssassin::ConfStoreDirectory;
		20
		21	use IO::File;
		22	use Carp;
		23	use strict;
		24
		25	use vars qw{
		26	@ISA
		27	};
		28
		29	use Mail::SpamAssassin::ConfStoreGeneric;
		30	@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);
		31
		32	###########################################################################
		33
		34	=item Mail::SpamAssassin::ConfStoreDirectory->new($dir, $mode)
		35
		36	Create a new object. The calling process must be allowed to read, overwrite,
		37	and create any files in $dir. New files are created with mode $mode, as
		38	modified by the calling process's umask (if $mode is not specified, 0600 is
		39	used).
		40
		41	Global and default preferences are stored in the files "$dir/@GLOBAL.prefs"
		42	and "$dir/@DEFAULT.prefs".
		43
		44	The recommended setup is a directory owned by the calling process with group
		45	and other permissions zeroed. If users must be able to modify the files by
		46	hand, deny write permissions to the directory, create each user's prefs file
		47	by hand (thus they can edit, but not remove or rename the file), and make
		48	all prefs files readable by the group of the calling process (or make them
		49	world-readable).
		50
		51	=cut
		52
		53	sub new {
		54	my $class = shift;
		55	$class = ref($class) \|\| $class;
		56	my ($dir) = @_;
		57
		58	my $self = {
		59	'dir' => $dir,
		60	};
		61
		62	bless ($self, $class);
		63	$self;
		64	}
65
66
67	###########################################################################
68
69	sub load_modules { # static
70	Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
71	# do any preloading that will speed up operation
72	}
73
74	###########################################################################
75
76	sub get_filename {
77	my ($self, $user)=@_;
78
79	return $self->{'dir'}.'/@GLOBAL.prefs' if($user eq '@GLOBAL');
80	return $self->{'dir'}.'/@DEFAULT.prefs' if($user eq '@DEFAULT');
81	my $filename="${user}.prefs";
82	if($filename=~s/([^a-zA-Z0-9_.\-])/ sprintf("%%%02x", ord($1)) /goe){
83	dbg("Bad characters in username!");
84	}
85	$filename=$self->{'dir'}."/$filename";
86	return $filename;
87	}
88
89	=item $store->save_prefs($user, $prefs)
90
91	Saves the prefs for the specified user to the file $dir/$user.prefs.
92	However, note that unusual characters in the username will be encoded
93	URL-style (at the moment, 'unusual' is 'anything matching the regular
94	expression [^a-zA-Z0-9_.\-]').
95
96	=cut
97
98	sub save_prefs {
99	my ($self, $user, $prefs)=@_;
100	my $fh;
101	my $filename;
102
103	$fh=IO::File->new();
104	$filename=$self->get_filename($user);
105	dbg("Saving prefs for $user to $filename");
106	unless($fh->open(">$filename")){
107	dbg("ConfStoreDirectory: Can't create output file $filename: $!");
108	return ret("EX_CANTCREAT", "Can't create output file: $!");
109	}
110	$fh->printf("%s", $prefs);
111	$fh->close();
112	return ret("EX_OK", "Success");
113	}
114
115	sub get_prefs {
116	my ($self, $user)=@_;
117	my $fh;
118	my $prefs;
119
120	my $filename=$self->get_filename($user);
121	return ret("EX_OK", undef, "No user prefs") unless -r $filename;
122	dbg("Reading prefs for $user from $filename");
123
124	$fh=IO::File->new();
125	unless($fh->open("<$filename")){
126	dbg("ConfStoreDirectory: Can't open input file $filename: $!");
127	return ret("EX_IOERR", "", "Can't open input file: $!");
128	}
129	$prefs=join("", $fh->getlines());
130	$fh->close();
131	return ret("EX_OK", $prefs, "Success");
132	}
133
134	=item $f->get_length($user)
135
136	Note that this method depends on perl's '-s' file test working correctly.
137
138	=cut
139
140	sub get_length {
141	my ($self, $user)=@_;
142	my $f=$self->get_filename($user);
143	return ret("EX_DATAERR", undef, "No user prefs") unless -r $f;
144	my $size=-s $f;
145	return ret("EX_IOERR", undef, $!) unless defined($size);
146	return ret("EX_OK", $size, "Success");
147	}
148
149	###########################################################################
150
151	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
152	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
153	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
154
155	###########################################################################
156
157	1;
158	__END__
159
160	=back
161
162	=head1 SEE ALSO
163
164	C<Mail::SpamAssassin>
165	C<Mail::SpamAssassin::Conf>
166	C<Mail::SpamAssassin::ConfSourceGeneric>
167	C<Mail::SpamAssassin::ConfStoreGeneric>
168	C<spamassassin>
169	C<spamd>
170

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreNull.pm (+93 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreNull - Pretend to store prefs
		4
		5	=head1 DESCRIPTION
		6
		7	This module doesn't actually store any prefs. The main use would be to prevent
		8	the use of any user prefs.
		9
		10	=head1 PUBLIC FUNCTIONS
		11
		12	=over 4
		13
		14	=cut
		15
		16	package Mail::SpamAssassin::ConfStoreNull;
		17
		18	use Carp;
		19	use strict;
		20
		21	use vars qw{
		22	@ISA
		23	};
		24
		25	use Mail::SpamAssassin::ConfStoreGeneric;
		26	@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);
		27
		28	###########################################################################
		29
		30	=item Mail::SpamAssassin::ConfStoreNull->new()
		31
		32	Create a new object.
		33
		34	=cut
		35
		36	sub new {
		37	my $class = shift;
		38	$class = ref($class) \|\| $class;
		39
		40	bless ({}, $class);
		41	}
		42
		43	###########################################################################
		44
		45	sub load_modules { # static
		46	Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
		47	# do any preloading that will speed up operation
		48	}
		49
		50	###########################################################################
		51
		52	=item $f->save_prefs($user, $prefs)
		53
		54	Always returns an EX_UNAVAILABLE failure.
		55
		56	=cut
		57
		58	sub save_prefs {
		59	return ret("EX_UNAVAILABLE", "ConfStoreNull saves no prefs");
		60	}
		61
		62	=item $f->get_prefs($user)
		63
		64	Always returns a "No user prefs" result.
65
66	=cut
67
68	sub get_prefs {
69	return ret("EX_OK", undef, "No user prefs");
70	}
71
72	###########################################################################
73
74	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
75	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
76	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
77
78	###########################################################################
79
80	1;
81	__END__
82
83	=back
84
85	=head1 SEE ALSO
86
87	C<Mail::SpamAssassin>
88	C<Mail::SpamAssassin::Conf>
89	C<Mail::SpamAssassin::ConfSourceGeneric>
90	C<Mail::SpamAssassin::ConfStoreGeneric>
91	C<spamassassin>
92	C<spamd>
93

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreSimple.pm (+119 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreSimple - Store a single set of prefs.
		4
		5	=head1 DESCRIPTION
		6
		7	ConfStoreSimple stores the prefs for a single user at a time. The intended
		8	use is as a store for Mail::SpamAssassin::ConfSourceSpamc when you would
		9	rather have the prefs sent over the wire for every message instead of using
		10	the memory/disk space the other stores require.
		11
		12	=head1 PUBLIC FUNCTIONS
		13
		14	=over 4
		15
		16	=cut
		17
		18	package Mail::SpamAssassin::ConfStoreSimple;
		19
		20	use Carp;
		21	use strict;
		22
		23	use vars qw{
		24	@ISA
		25	};
		26
		27	use Mail::SpamAssassin::ConfStoreGeneric;
		28	@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);
		29
		30	###########################################################################
		31
		32	=item Mail::SpamAssassin::ConfStoreSimple->new()
		33
		34	Create a new object.
		35
		36	=cut
		37
		38	sub new {
		39	my $class = shift;
		40	$class = ref($class) \|\| $class;
		41
		42	my $self = {
		43	'user' => undef,
		44	'prefs' => undef,
		45	};
		46
		47	bless ($self, $class);
		48	$self;
		49	}
		50
		51	###########################################################################
		52
		53	sub load_modules { # static
		54	Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
		55	# do any preloading that will speed up operation
		56	}
		57
		58	###########################################################################
		59
		60	=item $f->save_prefs($user, $prefs)
		61
		62	Save the prefs, forgetting any old prefs for any user.
		63
		64	=cut
65
66	sub save_prefs {
67	my ($self, $user, $prefs)=@_;
68
69	dbg("Saving prefs for $user in a ConfStoreSimple");
70	$self->{'user'}=$user;
71	$self->{'prefs'}=$prefs;
72	return ret("EX_OK", "Success");
73	}
74
75	sub get_prefs {
76	my ($self, $user)=@_;
77
78	dbg("Reading prefs for $user from ConfStoreSimple");
79	return ret("EX_OK", undef, "No user prefs") unless($user eq $self->{'user'});
80	return ret("EX_OK", $self->{'prefs'}, "Success");
81	}
82
83	sub get_length {
84	my ($self, $user)=@_;
85
86	return ret("EX_DATAERR", undef, "No user prefs") unless $user eq $self->{'user'};
87	return ret("EX_OK", length($self->{'prefs'}), "Success");
88	}
89
90	sub get_checksum {
91	my ($self, $user)=@_;
92	my $prefs;
93
94	return ret("EX_DATAERR", undef, "No user prefs") unless $user eq $self->{'user'};
95	return ret("EX_OK", $self->calc_checksum($self->{'prefs'}), "Success");
96	}
97
98	###########################################################################
99
100	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
101	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
102	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
103
104	###########################################################################
105
106	1;
107	__END__
108
109	=back
110
111	=head1 SEE ALSO
112
113	C<Mail::SpamAssassin>
114	C<Mail::SpamAssassin::Conf>
115	C<Mail::SpamAssassin::ConfSourceGeneric>
116	C<Mail::SpamAssassin::ConfStoreGeneric>
117	C<spamassassin>
118	C<spamd>
119

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfSourceCat.pm (+101 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfSourceCat - load prefs from multiple sources
		4
		5	=head1 DESCRIPTION
		6
		7	This is really an 'adapter' class, which loads the prefs from all its
		8	sub-sources and concatentates them.
		9
		10	=head1 PUBLIC FUNCTIONS
		11
		12	=over 4
		13
		14	=cut
		15
		16	package Mail::SpamAssassin::ConfSourceCat;
		17
		18	use Carp;
		19	use strict;
		20
		21	use vars qw{
		22	@ISA
		23	};
		24
		25	use Mail::SpamAssassin::ConfSourceGeneric;
		26	@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);
		27
		28	###########################################################################
		29
		30	=item Mail::SpamAssassin::ConfSourceCat->new($source, ...)
		31
		32	Create a new object. If any of the sources is not a
		33	Mail::SpamAssassin::ConfStoreGeneric subclass, an exception will be thrown.
		34
		35	=cut
		36
		37	sub new {
		38	my $class = shift;
		39	$class = ref($class) \|\| $class;
		40	my $sources = [@_];
		41
		42	for my $s (@$sources){
		43	die "$s is not a Mail::SpamAssassin::ConfStoreGeneric\n" unless UNIVERSAL::isa($s, 'Mail::SpamAssassin::ConfStoreGeneric');
		44	}
		45
		46	my $self = {
		47	'sources' => $sources,
		48	};
		49
		50	bless ($self, $class);
		51	$self;
		52	}
		53
		54	###########################################################################
		55
		56	sub load_modules { # static
		57	Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
		58	# do any preloading that will speed up operation
		59	}
		60
		61	###########################################################################
		62
		63	sub get_prefs {
		64	my ($self, $user)=@_;
65	my $i=0;
66	my $prefs="";
67	my $flag=0;
68
69	for($i=0; $i<@{$self->{'sources'}}; $i++){
70	my ($ret, $p, $err)=$self->{'sources'}->[$i]->get_prefs($user);
71	next unless(defined($p) \|\| $ret ne "EX_OK");
72	($p="# $err")=~s/(\r?\n)/$1# /g unless defined($p);
73	$flag=1;
74	$prefs.="# Source #".($i+1)."\r\n$p\r\n";
75	}
76
77	return ret("EX_OK", undef, "No user prefs") unless $flag;
78	return ret("EX_OK", $prefs, "Success");
79	}
80
81	###########################################################################
82
83	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
84	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
85	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
86
87	###########################################################################
88
89	1;
90	__END__
91
92	=back
93
94	=head1 SEE ALSO
95
96	C<Mail::SpamAssassin>
97	C<Mail::SpamAssassin::Conf>
98	C<Mail::SpamAssassin::ConfSourceGeneric>
99	C<spamassassin>
100	C<spamd>
101

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfSourceGeneric.pm (+224 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfSourceGeneric - base class for SpamAssassin configuration sources.
		4
		5	=head1 DESCRIPTION
		6
		7	This is the base class for SpamAssassin configuration sources. It provides a
		8	few utility functions, and defines the interface sources should implement.
		9
		10	=head1 PUBLIC FUNCTIONS
		11
		12	=over 4
		13
		14	=cut
		15
		16	package Mail::SpamAssassin::ConfSourceGeneric;
		17
		18	use Carp;
		19	use strict;
		20
		21	use vars qw{
		22	@ISA
		23	};
		24
		25	use Mail::SpamAssassin;
		26	@ISA = qw();
		27
		28	###########################################################################
		29
		30	sub new {
		31	sa_die("Cannot create a Mail::SpamAssassin::ConfSourceGeneric");
		32	return undef;
		33	}
		34
		35	###########################################################################
		36
		37	=item Mail::SpamAssassin::ConfSourceGeneric->load_modules()
		38
		39	Preload any modules that may be conditionally loaded later on, for speed.
		40
		41	=cut
		42
		43	sub load_modules { # static
		44	# do any preloading that will speed up operation
		45	}
		46
		47	###########################################################################
		48
		49	=item $source->get_prefs($user)
		50
		51	Retrieve the prefs data. In a scalar context, the prefs data string is
		52	returned. In a list context, a list of the form ("EX_OK", $prefs, "Success")
		53	is returned. If no prefs exist for the specified user, undef or ("EX_OK",
		54	undef, "No user prefs") is returned. If an error occurred, undef or
		55	("EX_...", undef, "... some error message ...") is returned.
		56
		57	Stores are encouraged to recognize the user '@GLOBAL' as a request for
		58	global preferences, and '@DEFAULT' as a request for default preferences (i.e.
		59	preferences in the case there is no named user). Stores must implement this
		60	method.
		61
		62	=cut
		63
		64	sub get_prefs {
65	sa_die("get_prefs was not implemented");
66	}
67
68	=item $source->get_length($user)
69
70	Retrieve the length of the prefs data. In a scalar context, the numeric
71	length is returned. In a list context, a list of the form ("EX_OK", $len,
72	"Success") is returned. If no prefs exist for the specified user, undef or
73	("EX_DATAERR", undef, "No user prefs") is returned. If an error occurred,
74	undef or ("EX_...", undef, "... some error message ...") is returned.
75
76	If a source does not override this method, the length of the return value of
77	$source->get_prefs($user) will be returned (or the error will be passed
78	along).
79
80	=cut
81
82	sub get_length {
83	my ($self, $user)=@_;
84	my ($ret, $prefs, $err)=$self->get_prefs($user);
85	return ret($ret, undef, $err) if($ret ne "EX_OK");
86	return ret("EX_DATAERR", undef, $err) unless defined($prefs);
87	return ($ret, length($prefs), $err);
88	}
89
90	=item $source->get_checksum($user)
91
92	Retrieve the checksum of the prefs data. In a scalar context, the numeric
93	checksum is returned. In a list context, a list of the form ("EX_OK",
94	$checksum, "Success") is returned. If no prefs exist for the specified user,
95	undef or ("EX_DATAERR", undef, "No user prefs") is returned. If an error
96	occurred, undef or ("EX_...", undef, "... some error message ...") is
97	returned.
98
99	If a source does not override this method, the checksum of the return value of
100	$source->get_prefs($user) will be returned (or the error will be passed
101	along).
102
103	=cut
104
105	sub get_checksum {
106	my ($self, $user)=@_;
107
108	my ($ret, $text, $err)=$self->get_prefs($user);
109	return ret($ret, undef, $err) if($ret ne "EX_OK");
110	return ret("EX_DATAERR", undef, $err) unless defined($text);
111	return ret($ret, $self->calc_checksum($text), $err);
112	}
113
114	=item $source->apply_prefs($conf, $user)
115
116	Apply the prefs to the given Mail::SpamAssassin::Conf object. Returns
117	"EX_OK" in a scalar context, ("EX_OK", "Success") in a list context. If an
118	error occurs, "EX_..." or ("EX_...", "... error message ...") is returned.
119	If the user has no preferences, the default preferences should be applied.
120
121	If a source does not override this method, the data returned by
122	$source->get_prefs($user) (or $source->get_prefs('@DEFAULT')) will be passed
123	to $conf->parse_scores_only().
124
125	=cut
126
127	sub apply_prefs {
128	my ($self, $conf, $user)=@_;
129
130	my ($ret, $prefs, $err)=$self->get_prefs($user);
131	if(!defined($prefs)){
132	$prefs=$self->get_prefs('@DEFAULT') if($ret eq "EX_OK");
133	return ret($ret, $err) unless defined($prefs);
134	}
135	$conf->parse_scores_only($prefs);
136	return ret("EX_OK", "Success");
137	}
138
139	###########################################################################
140
141	=back
142
143	=head1 UTILITY FUNCTIONS
144
145	These functions are intended for the use of subclasses only.
146
147	=over 4
148
149	=item Mail::SpamAssassin::ConfSourceGeneric::ret(@data)
150
151	In an array context, returns @data. In a scalar context, returns $data[0] if
152	@data<3, otherwise $data[1]. Use this to get the return values of the various public functions correct. For example:
153
154	=over 6
155
156	return ret("EX_OK", undef, "No user prefs");
157
158	return ret("EX_IOERR", "open failed: $!");
159
160	=back
161
162	=cut
163
164	sub ret {
165	return @_ if wantarray;
166	return $_[0] if scalar(@_)<3;
167	return $_[1];
168	}
169
170	=item $source->calc_checksum($text, [$crc])
171
172	Calculates the checksum of the text. If $crc is not specified, it defaults
173	to 0. For the most part, $crc should not be specified, it's only useful if
174	you intend to calculate the checksum piece-wise.
175
176	=cut
177
178	sub calc_checksum {
179	my $self=shift;
180	my $text=shift;
181	my $len=length($text);
182	my $crc=shift \|\| 0;
183
184	$crc=(~$crc)&0xffffffff;
185	for(my $i=0; $i<$len; $i++){
186	$crc=$crc^ord(substr($text, $i, 1));
187	for(my $j=0; $j<8; $j++){
188	if($crc&1){
189	$crc=0xedb88320^($crc>>1);
190	} else {
191	$crc>>=1;
192	}
193	}
194	}
195	return (~$crc)&0xffffffff;
196	}
197
198	=item Mail::SpamAssassin::ConfSourceGeneric::dbg(@data)
199
200	Forwards the data to Mail::SpamAssassin::dbg().
201
202	=item Mail::SpamAssassin::ConfSourceGeneric::sa_die(@data)
203
204	Calls Mail::SpamAssassin::sa_die(1, @data).
205
206	=cut
207
208	sub dbg { Mail::SpamAssassin::dbg (@_); }
209	sub sa_die { Mail::SpamAssassin::sa_die (1, @_); }
210
211	###########################################################################
212
213	1;
214	__END__
215
216	=back
217
218	=head1 SEE ALSO
219
220	C<Mail::SpamAssassin>
221	C<Mail::SpamAssassin::Conf>
222	C<spamassassin>
223	C<spamd>
224

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfSourceSpamc.pm (+246 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfSourceSpamc - load prefs from the spamc client
		4
		5	=head1 DESCRIPTION
		6
		7	This is really an 'adapter' class, which accepts data from a spamc client
		8	and saves it in an arbitrary Mail::SpamAssassin::ConfStoreGeneric subclass.
		9	The source interface methods similarly just forward to the backend store.
		10
		11	=head1 PUBLIC FUNCTIONS
		12
		13	=over 4
		14
		15	=cut
		16
		17	package Mail::SpamAssassin::ConfSourceSpamc;
		18
		19	use Carp;
		20	use Socket qw(:crlf);
		21	use strict;
		22
		23	use vars qw{
		24	@ISA
		25	};
		26
		27	use Mail::SpamAssassin::ConfSourceGeneric;
		28	@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);
		29
		30	###########################################################################
		31
		32	=item Mail::SpamAssassin::ConfSourceSpamc->new($sink)
		33
		34	Create a new object. If $sink is not a Mail::SpamAssassin::ConfStoreGeneric
		35	subclass, an exception will be thrown.
		36
		37	=cut
		38
		39	sub new {
		40	my $class = shift;
		41	$class = ref($class) \|\| $class;
		42	my ($sink) = @_;
		43	die "\$sink ($sink) is not a Mail::SpamAssassin::ConfStoreGeneric\n" unless UNIVERSAL::isa($sink, 'Mail::SpamAssassin::ConfStoreGeneric');
		44
		45	my $self = {
		46	'sink' => $sink,
		47	};
		48
		49	bless ($self, $class);
		50	$self;
		51	}
		52
		53	###########################################################################
		54
		55	sub load_modules { # static
		56	Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
		57	# do any preloading that will speed up operation
		58	}
		59
		60	###########################################################################
		61
		62	=item $f->handle_protocol($infd, $outfd)
		63
		64	Handle the spamc preference-transfer protocol. In particular, when you
65	receive the preference offer (e.g. "OFFER_PREFS SPAMC/1.3"), you should call
66	this function. $infd is the read file descriptor, $outfd is the write file
67	descriptor. Returns ("EX_OK", "Success"), or ("EX_...", "... error message
68	...") on error. Note that the caller is responsible for sending the final
69	status message to the client.
70
71	See below for details on the protocol.
72
73	=cut
74
75	sub handle_protocol {
76	my ($self, $infd, $outfd) = @_;
77	my ($user, $checksum, $len)=(undef, undef, undef);
78	local $\|=1;
79
80	# Read the rest of the headers
81	while(1){
82	$_=readline($infd);
83	return ("EX_PROTOCOL", "EOF reading headers") unless defined($_);
84	last if /^${CRLF}/o;
85	if(/^User: (.*)${CRLF}/o){
86	$user=$1;
87	}
88	if(/^Checksum: (0x[a-fA-F0-9]+)${CRLF}/o){
89	$checksum=hex($1);
90	}
91	if(/^Checksum: (\d+)${CRLF}/o){
92	$checksum=$1;
93	}
94	if(/^Content-length: (\d+)${CRLF}/oi){
95	$len=$1;
96	}
97	}
98
99	return ("EX_PROTOCOL", "'User' header not found") unless defined($user);
100	return ("EX_PROTOCOL", "'User' may not be '\@GLOBAL'") if($user eq '@GLOBAL');
101	return ("EX_PROTOCOL", "'User' may not be '\@DEFAULT'") if($user eq '@DEFAULT');
102	return ("EX_PROTOCOL", "'Checksum' header not found") unless defined($checksum);
103	return ("EX_PROTOCOL", "'Content-length' header not found") unless defined($len);
104
105	my ($old_len, $old_sum);
106	if(defined($old_len=$self->{'sink'}->get_length($user)) && $old_len==$len &&
107	defined($old_sum=$self->{'sink'}->get_checksum($user)) && $old_sum==$checksum){
108	# Checksum the same, say no thanks
109	printf $outfd "1 No thanks${CRLF}";
110	return ("EX_OK", "Success");
111	}
112
113	dbg("Receiving user prefs for $user from client");
114	printf $outfd "0 Please send${CRLF}";
115
116	# Read the prefs file
117	my $prefs="";
118	my $read_len=0;
119	my $i=0;
120	while($read_len<$len && ($i=read($infd, $prefs, $len-$read_len, $read_len))>0){
121	$read_len+=$i;
122	}
123	return ("EX_IOERR", "Read error: $!") if $i<0;
124	return ("EX_DATAERR", "Expected $len bytes, read $read_len") unless $read_len==$len;
125	$_=readline($infd);
126	return ("EX_DATAERR", "More than $len bytes sent") unless /^${CRLF}/o;
127
128	my @ret=$self->{'sink'}->save_prefs($user, $prefs);
129	return @ret;
130	}
131
132	=item Mail::SpamAssassin::ConfSourceSpamc->reject_protocol($infd, $outfd)
133
134	Just like handle_protocol(), except it always rejects the offer. In other
135	words, it always replies to spamc with "1 No thanks".
136
137	See below for details on the protocol.
138
139	=cut
140
141	sub reject_protocol {
142	my ($class, $infd, $outfd) = @_;
143	local $\|=1;
144
145	# Read the rest of the headers
146	while(1){
147	$_=readline($infd);
148	return ("EX_PROTOCOL", "EOF reading headers") unless defined($_);
149	last if /^${CRLF}/o;
150	}
151
152	printf $outfd "1 No thanks${CRLF}";
153	return ("EX_OK", "Success");
154	}
155
156	###########################################################################
157
158	sub get_prefs {
159	my ($self, $user)=@_;
160	return $self->{'sink'}->get_prefs($user);
161	}
162
163	sub get_length {
164	my ($self, $user)=@_;
165	return $self->{'sink'}->get_length($user);
166	}
167
168	sub get_checksum {
169	my ($self, $user)=@_;
170	return $self->{'sink'}->get_checksum($user);
171	}
172
173	sub apply_prefs {
174	my ($self, $main, $user)=@_;
175	return $self->{'sink'}->apply_prefs($main, $user);
176	}
177
178	###########################################################################
179
180	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
181	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
182	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
183
184	###########################################################################
185
186	1;
187	__END__
188
189	=back
190
191	=head1 PROTOCOL
192
193	All line terminators are expected to be \r\n-style.
194
195	The client first offers the preference file to the server:
196
197	< OFFER_PREFS SPAMC/1.3
198	< User: (.+)
199	< Checksum: (0x[a-zA-Z0-9]+\|\d+)
200	< Content-length: (\d+)
201	<
202
203	handle_protocol() (or reject_protocol()) should be called after the OFFER_PREFS
204	line, it will take care of reading the various variables.
205
206	ConfSoureSpamc may return at this point with an error message ($code, $msg),
207	which should be sent to the client formatted as follows: ($codeval is the
208	sysexit.h numeric value corresponding to $code). The '$code:' portion isn't
209	strictly necessary.
210
211	> SPAMD/1.2 $codeval $code: $msg
212	(goto the "End" portion below)
213
214	Otherwise, ConfSoureSpamc will respond to the client with either '0'
215	(indicating to send the prefs) or '1' (indicating to not send the prefs), and
216	some explanatory text (this entire response shall always be less than 80
217	characters in length). It may then return at this point, again the return
218	message should be written to the client.
219
220	If 0 is sent, the client will then send Content-length bytes, followed by a
221	\r\n sequence. ConfSoureSpamc will then return an error (or success) message
222	which must be forwarded to the client.
223
224	Thus, we may proceed in two ways here:
225
226	> 1 No thanks
227	> SPAMD/1.2 0 EX_OK: Success
228	or
229	> 0 Please send
230	< { content-length bytes }
231	> SPAMD/1.2 $codeval $code: $msg
232
233	("End" here)
234
235	At this point, the client may send another request (e.g. PROCESS), or it may
236	close the connection. If the code was not "EX_OK", the server may also close
237	the connection, otherwise it must await the client's next action.
238
239	=head1 SEE ALSO
240
241	C<Mail::SpamAssassin>
242	C<Mail::SpamAssassin::Conf>
243	C<Mail::SpamAssassin::ConfSourceGeneric>
244	C<spamassassin>
245	C<spamd>
246

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreGeneric.pm (+101 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreGeneric - base class for SpamAssassin configuration stores.
		4
		5	=head1 DESCRIPTION
		6
		7	This is the base class for SpamAssassin configuration stores. A store is
		8	simply a source that can be saved to, and as such this is a subclass of
		9	Mail::SpamAssassin::ConfSoureGeneric.
		10
		11	=head1 PUBLIC FUNCTIONS
		12
		13	All those defined for Mail::SpamAssassin::ConfSoureGeneric, as well as the
		14	following.
		15
		16	=over 4
		17
		18	=cut
		19
		20	package Mail::SpamAssassin::ConfStoreGeneric;
		21
		22	use Carp;
		23	use strict;
		24
		25	use vars qw{
		26	@ISA
		27	};
		28
		29	use Mail::SpamAssassin::ConfSourceGeneric;
		30	@ISA = qw(Mail::SpamAssassin::ConfSourceGeneric);
		31
		32	###########################################################################
		33
		34	sub new {
		35	sa_die("Cannot create a Mail::SpamAssassin::ConfStoreGeneric");
		36	return undef;
		37	}
		38
		39	###########################################################################
		40
		41	sub load_modules { # static
		42	Mail::SpamAssassin::ConfSourceGeneric->load_modules(@_);
		43	# do any preloading that will speed up operation
		44	}
		45
		46	###########################################################################
		47
		48	=item $store->save_prefs($user, $prefs)
		49
		50	Save the prefs to whatever backing store you have, overwriting any old prefs
		51	for that user. It is also permissable to 'forget' other user's prefs, e.g.
		52	in the case of an LRU cache, but this must be documented. In a scalar
		53	contect, return "EX_OK", in a list contect return ("EX_OK", "Success"). If
		54	an error occurs, return "EX_..." or ("EX_...", "... error message ...").
		55
		56	$store->get_prefs() must return these preferences in the same order, however
		57	comments, whitespace, and other 'noise' may be stripped. If the get_prefs()
		58	output is not identical, this should be documented.
		59
		60	$store->get_length() and $store->get_checksum() must return the length and
		61	checksum of the data passed to save_prefs(), NOT that returned by
		62	get_prefs()! The intention is that the caller may check the length and
		63	checksum against those of a cached pref set, and refrain from saving/reading
		64	the prefs if they happen to be the same.
65
66	=cut
67
68	sub save_prefs {
69	sa_die("save_prefs was not implemented");
70	}
71
72	###########################################################################
73
74	=back
75
76	=head UTILITY FUNCTIONS
77
78	Mail::SpamAssassin::ConfStoreGeneric provides versions of the non-method
79	utility functions (the methods, of course, are inherited).
80
81	=cut
82
83	sub ret { Mail::SpamAssassin::ConfSourceGeneric::ret(@_); }
84	sub dbg { Mail::SpamAssassin::ConfSourceGeneric::dbg (@_); }
85	sub sa_die { Mail::SpamAssassin::ConfSourceGeneric::sa_die (@_); }
86
87	###########################################################################
88
89	1;
90	__END__
91
92	=back
93
94	=head1 SEE ALSO
95
96	C<Mail::SpamAssassin>
97	C<Mail::SpamAssassin::Conf>
98	C<Mail::SpamAssassin::ConfSourceGeneric>
99	C<spamassassin>
100	C<spamd>
101

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreHomedir.pm (+236 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreHomedir - Store preferences in a user's home directory.
		4
		5	=head1 DESCRIPTION
		6
		7	This class reads prefs from a prefs file in a user's home directory. It can
		8	also attempt to write the prefs file. Symlinks are followed, so be aware that
		9	this source can be used to read or write any file to which the calling program
		10	has permissions.
		11
		12	=head1 PUBLIC FUNCTIONS
		13
		14	=over 4
		15
		16	=cut
		17
		18	package Mail::SpamAssassin::ConfStoreHomedir;
		19
		20	use IO::File;
		21	use File::Path;
		22	use Carp;
		23	use Config;
		24	use strict;
		25
		26	use vars qw{
		27	@ISA @default_prefs_path @default_userprefs_path
		28	};
		29
		30	use Mail::SpamAssassin::ConfStoreGeneric;
		31	@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);
		32
		33	@default_prefs_path = (
		34	'__local_rules_dir__/user_prefs.template',
		35	'__prefix__/etc/mail/spamassassin/user_prefs.template',
		36	'__prefix__/share/spamassassin/user_prefs.template',
		37	'/etc/spamassassin/user_prefs.template',
		38	'/etc/mail/spamassassin/user_prefs.template',
		39	'/usr/local/share/spamassassin/user_prefs.template',
		40	'/usr/share/spamassassin/user_prefs.template',
		41	);
		42
		43	@default_userprefs_path = (
		44	'~/.spamassassin/user_prefs',
		45	);
		46
		47	sub sed_path {
		48	my ($self, $path) = @_;
		49	return undef if (!defined $path);
		50	$path =~ s/__local_rules_dir__/$self->{LOCAL_RULES_DIR} \|\| ''/ges;
		51	$path =~ s/__def_rules_dir__/$self->{DEF_RULES_DIR} \|\| ''/ges;
		52	$path =~ s/__prefix__/$self->{PREFIX} \|\| $Config{prefix}/gs;
		53	$path =~ s/^\~([^\/]*)/$self->expand_name($1)/es;
		54	$path;
		55	}
		56
		57	sub get_homedir {
		58	my ($self, $user)=@_;
		59	return (getpwnam($user))[7] \|\| undef;
		60	}
		61
		62	###########################################################################
		63
		64	=item Mail::SpamAssassin::ConfStoreHomedir->new($user_paths, $default_paths)
65
66	Return a new Mail::SpamAssassin::ConfStoreHomedir object.
67
68	$user_paths is a listref containing paths to search for the user
69	preferences. A scalar value is taken as the listref containing that scalar.
70	If $user_paths is undef, the values in
71	@Mail::SpamAssassin::ConfStoreHomedir::default_userprefs_path are used
72	instead.
73
74	$default_paths is used for locating the prefs for the @DEFAULT user. If it
75	is undefined, the values in
76	@Mail::SpamAssassin::ConfStoreHomedir::default_prefs_path are used instead.
77
78	When saving, only those paths containing a ~ are attempted (unless the user
79	is @DEFAULT, in which case only values not beginning in '_' are attepmted).
80
81	=cut
82
83	sub new {
84	my $class = shift;
85	$class = ref($class) \|\| $class;
86	my ($dirs, $default)=@_;
87	$dirs=\@Mail::SpamAssassin::ConfStoreHomedir::defaut_userprefs_path unless defined($dirs);
88	$default=\@Mail::SpamAssassin::ConfStoreHomedir::default_prefs_path unless defined($default);
89	$dirs=[$dirs] unless ref($dirs);
90	$default=[$default] unless ref($default);
91
92	my $self = {
93	'paths' => $dirs,
94	'default' => $default,
95	};
96
97	bless ($self, $class);
98	$self;
99	}
100
101
102	###########################################################################
103
104	sub load_modules { # static
105	Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
106	# do any preloading that will speed up operation
107	}
108
109	###########################################################################
110
111	sub get_filehandle {
112	my ($self, $user, $writeflag)=@_;
113	my @failed;
114
115	# No global prefs for Homedir
116	return (undef, "EX_UNAVAILABLE", "No global prefs") if($user eq '@GLOBAL');
117
118	my $homedir=$self->get_homedir($user);
119	my @paths;
120	if($user eq '@DEFAULT'){
121	# Filter _-paths if writing, and then replace replacement vars
122	@paths=map(sed_path, grep {!$writeflag \|\| /^[^_]/o} (@{$self->{'default'}}));
123	} else {
124	# Filter non-~-paths if writing, and ~-paths if no $homedir
125	@paths=map { my $x; ($x=$_)=~s/~/$homedir/go; $x }
126	grep {(!$writeflag \|\| /~/o) &&
127	(defined($homedir) \|\| !/~/o)}
128	@{$self->{'paths'}};
129	}
130	return (undef, "EX_UNAVAILABLE", "No available paths for $user") unless @paths;
131
132	my $fh=IO::File->new();
133	for my $filename (@paths){
134	if($writeflag){
135	# Writing, create the path if necessary
136	my $p=$filename;
137	$p=~s![^/]*$!!o;
138	if(!-d $p){
139	eval { mkpath($p, 0, 0700) \|\| die "$!\n" };
140	if($@){
141	my $err=$@;
142	$err=$1 if $err=~/^mkdir .: (.) at .ConfStoreHomedir. line \d+/o;
143	dbg("Creation of $p failed: $err");
144	@failed=("EX_CANTCREAT", "Prefs dir creation failed: $err") unless @failed;
145	next;
146	}
147	dbg("ConfStoreHomedir created $p for user prefs");
148	}
149
150	# Don't bother if the filename exists and isn't a regular file
151	next if(-e $filename && !-f $filename);
152
153	# Now, see if we can open it for writing
154	unless($fh->open(">$filename")){
155	dbg("Cannot open $filename: $!");
156	@failed=("EX_CANTCREAT", "Can't open prefs file: $!");
157	next;
158	}
159	dbg("Writing prefs for $user to $filename");
160	return ($fh, "EX_OK", "Success");
161	} else {
162	# Reading, just make sure it's a regular file (or a symlink to a
163	# regular file) and that it's readable
164	next unless -f $filename;
165	unless($fh->open("<$filename")){
166	dbg("Cannot read $filename: $!");
167	@failed=("EX_IOERR", "Can't read prefs file: $!");
168	next;
169	}
170	dbg("Reading prefs for $user from $filename");
171	return ($fh, "EX_OK", "Success");
172	}
173	}
174	return (undef, @failed?@failed:("EX_OK", "No user prefs"));
175	}
176
177	sub save_prefs {
178	my ($self, $user, $prefs)=@_;
179
180	return ("EX_UNAVAILABLE", "No global prefs") if($user eq '@GLOBAL');
181	my ($fh, $code, $err)=$self->get_filehandle($user, 1);
182	return ($code, $err) unless $fh;
183	$fh->print($prefs);
184	$fh->close();
185	return ret("EX_OK", "Success");
186	}
187
188	sub get_prefs {
189	my ($self, $user)=@_;
190
191	return ret("EX_UNAVAILABLE", undef, "No global prefs") if($user eq '@GLOBAL');
192	my ($fh, $code, $err)=$self->get_filehandle($user, 0);
193	return ret($code, undef, $err) unless $fh;
194	my $prefs=join("", $fh->getline());
195	$fh->close();
196	return ret("EX_OK", $prefs, "Success");
197	}
198
199	=item $f->get_length($user)
200
201	Note that this method depends on perl's stat getting the correct size.
202
203	=cut
204
205	sub get_length {
206	my ($self, $user)=@_;
207	my ($fh, $code, $err)=$self->get_filehandle($user);
208	return ret($code ne "EX_OK"?$code:"EX_DATAERR", undef, $err) unless $fh;
209	my $size=($fh->stat())[7];
210	$fh->close();
211	return ret("EX_IOERR", undef, $!) unless(defined($size) && $size>=0);
212	return ret("EX_OK", $size, "Success");
213	}
214
215	###########################################################################
216
217	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
218	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
219	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
220
221	###########################################################################
222
223	1;
224	__END__
225
226	=back
227
228	=head1 SEE ALSO
229
230	C<Mail::SpamAssassin>
231	C<Mail::SpamAssassin::Conf>
232	C<Mail::SpamAssassin::ConfSourceGeneric>
233	C<Mail::SpamAssassin::ConfStoreGeneric>
234	C<spamassassin>
235	C<spamd>
236

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreMemory.pm (+316 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreMemory - cache preferences in memory
		4
		5	=head1 DESCRIPTION
		6
		7	This module will cache preferences in memory, for the lifetime of the
		8	object. It works properly across forks. Optionally, it can limit memory
		9	usage via LRU elimination.
		10
		11	For the curious, it forks a process which listens on a random TCP socket and
		12	speaks a simple protocol to store and retrieve the data. The methods connect
		13	to this socket. To prevent arbitrary process from connecting to the cache
		14	process, the cache binds only to localhost. Also, a pipe is kept open from
		15	the parent (and thus, all forked children) to the cache process. All
		16	children wishing to connect first bind a socket on localhost, send the port
		17	number over the pipe, and only then try to connect. The cache thus rejects
		18	connections from any ports it is not told about within the past few seconds
		19	via the pipe.
		20
		21	=head1 PUBLIC FUNCTIONS
		22
		23	=over 4
		24
		25	=cut
		26
		27	package Mail::SpamAssassin::ConfStoreMemory;
		28
		29	use Carp;
		30	use IO::Handle;
		31	use IO::Socket::INET;
		32	use strict;
		33
		34	use vars qw{
		35	@ISA
		36	};
		37
		38	use Mail::SpamAssassin::ConfStoreGeneric;
		39	@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);
		40
		41	###########################################################################
		42
		43	=item Mail::SpamAssassin::ConfStoreMemory->new($maxsize)
		44
		45	Create a new object. This function also forks the cache process. It may
		46	die in various ways. $maxsize, if specified, is the maximim size in 'bytes'
		47	for the cache. If the total size of everything in the cache is greater than
		48	this, the least recently accessed entry will be freed until the total size
		49	falls below.
		50
		51	Note that the size isn't true bytes. It's more or less the length of the
		52	stored data plus an arbitraty allowance for storage overhead.
		53
		54	Note that the cache process is actually a perl "one"-liner exec'ed after the
		55	fork. It saves memory, slightly. Better than relying on copy-on-write,
		56	because even though the cache will not write many of those mapped pages, the
		57	parent probably will and thus those pages will end up duplicated anyway.
		58	Sorry for cluttering up your process listing.
		59
		60	WARNING: This function does not work for Perl 5.005. If you know a way to do
		61	'open(STDOUT, ">&", $fh)' (i.e. dup using a IO::Handle instead of a glob),
		62	let me know.
		63
		64	=cut
65
66	sub do_exec {
67	my ($self, $size)=@_;
68
69	$size=0xffffffff unless defined($size);
70	my $cacher=<<'CACHER' ;
71	use IO::Handle;
72	use IO::Socket::INET;
73
74	$rd=IO::Handle->new_from_fd(fileno(\*STDIN), "r");
75	$rd->blocking(0);
76	$server=IO::Socket::INET->new(Type => SOCK_STREAM, LocalHost => "localhost", Listen => 5, Timeout => 5);
77	die "socket creation: $!\n" unless defined($server);
78	$server->autoflush(1);
79	$\|=1;
80	print $server->sockaddr()."\n";
81	print $server->sockport()."\n";
82
83	%cache=();
84	@cache=();
85	%auth=();
86	$totalsize=0;
87	sub del {
88	my $user=shift;
89	return unless exists($cache{$user});
90	$totalsize-=length($cache{$user}->[1])+20;
91	delete($cache{$user});
92	for(my $i=0; $i<@cache; $i++){
93	splice(@cache,$i--,1) if $cache[$i] eq $user;
94	}
95	}
96	sub touch {
97	my $user=shift;
98	for(my $i=0; $i<@cache; $i++){
99	splice(@cache,$i--,1) if $cache[$i] eq $user;
100	}
101	push @cache, $user;
102	}
103	sub auth {
104	undef($!);
105	while(defined($_=$rd->getline())){
106	chomp;
107	$auth{$_}=time()+60;
108	}
109	exit(0) unless $!{EAGAIN};
110	}
111	do {
112	%auth=();
113	auth();
114	undef($!);
115	for(; $client=$server->accept(); $client->close()){
116	auth();
117	next unless(exists($auth{$client->peerport()}) && $auth{$client->peerport()}>=time());
118	next unless defined($_=$client->getline());
119	chomp;
120	if(/^SAVE (\d+) (.*)$/o){
121	($checksum, $user)=($1, $2);
122	$x=join("", $client->getlines());
123	$client->print("OK\n");
124	del($user);
125	$totalsize+=length($x)+20;
126	del($cache[0]) while(@cache && $totalsize>#!$size!#);
127	$cache{$user}=[0+$checksum, $x];
128	push @cache, $user;
129	} elsif(/^RETR (.*)$/o){
130	if(exists($cache{$1})){
131	touch($1);
132	$client->print("OK\n");
133	$client->print($cache{$1}->[1]);
134	} else {
135	$client->print("ENOENT\n");
136	}
137	} elsif(/^LEN (.*)$/o){
138	if(exists($cache{$1})){
139	touch($1);
140	$client->print(length($cache{$1}->[1])."\n");
141	} else {
142	$client->print("-1\n");
143	}
144	} elsif(/^CSUM (.*)$/o){
145	if(exists($cache{$1})){
146	touch($1);
147	$client->print($cache{$1}->[0]."\n");
148	} else {
149	$client->print("-1\n");
150	}
151	} else {
152	$client->print("Unknown command\n");
153	}
154	}
155	} while($!{ETIMEDOUT} \|\| $!==1);
156	$server->close();
157	CACHER
158
159	$cacher=~s/#!(.*?)!#/ eval $1 /goe;
160	exec($^X, '-e', <<NOTE , '-e', $cacher) \|\| die "exec failed: $!\n";
161	# Mail::SpamAssassin::ConfStoreMemory cache process #
162	# It will exit when the originating perl object is GCed #
163	NOTE
164	}
165
166	sub new {
167	my $class = shift;
168	$class = ref($class) \|\| $class;
169	my ($size)=@_;
170
171	my ($rd1, $wr1)=(IO::Handle->new, IO::Handle->new);
172	my ($rd2, $wr2)=(IO::Handle->new, IO::Handle->new);
173	if(!pipe($rd1, $wr1)){ sa_die("ConfStoreMemory: pipe failed: $!"); }
174	if(!pipe($rd2, $wr2)){ sa_die("ConfStoreMemory: pipe failed: $!"); }
175	$wr1->autoflush(1);
176	$wr2->autoflush(1);
177
178	my $pid=fork();
179	if(!defined($pid)){ sa_die("ConfStoreMemory: couldn't fork: $!"); }
180	if(!$pid){
181	my $pid=fork();
182	if(!defined($pid)){ sa_die("ConfStoreMemory: couldn't fork: $!"); }
183	exit(0) if($pid);
184	open(STDIN, "<&", $rd1) \|\| sa_die("ConfStoreMemory: couldn't dup stdin: $!");
185	open(STDOUT, ">&", $wr2) \|\| sa_die("ConfStoreMemory: couldn't dup stdout: $!");
186	close($rd1);
187	close($rd2);
188	close($wr1);
189	close($wr2);
190	dbg("Execing ConfStoreMemory process");
191	# exec a simple little perl script to conserve memory slightly
192	$class->do_exec($size);
193	}
194	waitpid($pid, 0);
195	close($rd1);
196	close($wr2);
197
198	my $host=<$rd2> \|\| die "Read from ConfStoreMemory process failed\n";
199	my $port=<$rd2> \|\| die "Read from ConfStoreMemory process failed\n";
200	chomp($host);
201	chomp($port);
202	dbg("ConfStoreMemory cache on port $port");
203
204	my $self = {
205	'auth' => $wr1,
206	'host' => $host,
207	'port' => $port,
208	};
209
210	bless ($self, $class);
211	$self;
212	}
213
214	###########################################################################
215
216	sub load_modules { # static
217	Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
218	# do any preloading that will speed up operation
219	}
220
221	###########################################################################
222
223	sub get_key {
224	my ($self, $user)=@_;
225	my $key=$user;
226	if($key=~s/([^a-zA-Z0-9_.\-])/ sprintf("%%%02x", ord($1)) /goe){
227	dbg("Bad characters in username!");
228	}
229	return $key;
230	}
231
232	sub get_sock {
233	my ($self)=@_;
234
235	my $sock=IO::Socket::INET->new(Type => SOCK_STREAM);
236	$sock->bind(0, $self->{'host'}) \|\| return (undef, "bind failed: $!");
237	$self->{'auth'}->print($sock->sockport()."\n");
238	$sock->connect($self->{'port'}, $self->{'host'}) \|\| return (undef, "connect failed: $!");
239	return ($sock, "Success");
240	}
241
242	sub save_prefs {
243	my ($self, $user, $prefs)=@_;
244
245	dbg("Saving prefs for $user to ConfStoreMemory process");
246	my ($sock, $err)=$self->get_sock();
247	return ret("EX_OSERR", $err) unless $sock;
248	$sock->printf("SAVE %u %s\n%s", $self->calc_checksum($prefs), $self->get_key($user), $prefs);
249	$sock->shutdown(1);
250	my $response=$sock->getline();
251	$sock->close();
252	return ret("EX_OK", "Success") if $response=~/^OK/o;
253	return ret("EX_IOERR", "ConfStoreMemory process error: $response");
254	}
255
256	sub get_prefs {
257	my ($self, $user)=@_;
258
259	dbg("Reading prefs for $user from ConfStoreMemory process");
260	my ($sock, $err)=$self->get_sock();
261	return ret("EX_OSERR", undef, $err) unless $sock;
262	$sock->printf("RETR %s\n", $self->get_key($user));
263	my $response=$sock->getline();
264	my $prefs=join("", $sock->getlines());
265	$sock->close();
266	return ret("EX_OK", undef, "No user prefs") if $response=~/^ENOENT/o;
267	chomp $response;
268	return ret("EX_IOERR", undef, $response) unless $response=~/^OK$/o;
269	return ret("EX_OK", $prefs, "Success");
270	}
271
272	sub get_length {
273	my ($self, $user)=@_;
274
275	my ($sock, $err)=$self->get_sock();
276	return ret("EX_OSERR", undef, $err) unless $sock;
277	$sock->printf("LEN %s\n", $self->get_key($user));
278	my $response=$sock->getline();
279	$sock->close();
280	return ret("EX_DATAERR", undef, "No user prefs") if $response=~/^-1/o;
281	return ret("EX_OK", 0+$response, "Success");
282	}
283
284	sub get_checksum {
285	my ($self, $user)=@_;
286
287	my ($sock, $err)=$self->get_sock();
288	return ret("EX_OSERR", undef, $err) unless $sock;
289	$sock->printf("CSUM %s\n", $self->get_key($user));
290	my $response=$sock->getline();
291	return ret("EX_DATAERR", undef, "No user prefs") if $response=~/^-1/o;
292	return ret("EX_OK", 0+$response, "Success");
293	}
294
295	###########################################################################
296
297	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
298	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
299	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
300
301	###########################################################################
302
303	1;
304	__END__
305
306	=back
307
308	=head1 SEE ALSO
309
310	C<Mail::SpamAssassin>
311	C<Mail::SpamAssassin::Conf>
312	C<Mail::SpamAssassin::ConfSourceGeneric>
313	C<Mail::SpamAssassin::ConfStoreGeneric>
314	C<spamassassin>
315	C<spamd>
316

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreSQL.pm (+339 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreSQL - store prefs in an SQL database
		4
		5	=head1 DESCRIPTION
		6
		7	This module uses Perl's DBI module to store prefs in an SQL database. In
		8	particular, it supports any database DBI supports with placeholders.
		9
		10	See below for some table creation commands for various databases.
		11
		12	=head1 PUBLIC FUNCTIONS
		13
		14	=over 4
		15
		16	=cut
		17
		18	package Mail::SpamAssassin::ConfStoreSQL;
		19
		20	use Carp;
		21	use DBI;
		22	use Mail::SpamAssassin::Conf;
		23	use strict;
		24
		25	use vars qw{
		26	@ISA
		27	};
		28
		29	use Mail::SpamAssassin::ConfStoreGeneric;
		30	@ISA = qw(Mail::SpamAssassin::ConfStoreGeneric);
		31
		32	###########################################################################
		33
		34	=item Mail::SpamAssassin::ConfStoreSQL->new($dsn, $username, $password, $tablename)
		35
		36	Create a new object. $dsn is the Perl DBI data source name. $username and
		37	$password are the username and password, respectively. $tablename is the
		38	name of the table to read from. Note that no database connection is
		39	attempted at this time.
		40
		41	=cut
		42
		43	sub new {
		44	my $class = shift;
		45	$class = ref($class) \|\| $class;
		46	my ($dsn, $username, $password, $tablename)=@_;
		47
		48	sa_die("Invalid table name '$tablename'") unless $tablename=~/^[a-zA-Z0-9_]+$/o;
		49	my $self = {
		50	'dsn' => $dsn,
		51	'user' => $username,
		52	'pass' => $password,
		53	'table' => $tablename,
		54	'dbi' => [0, undef],
		55	};
		56
		57	bless ($self, $class);
		58	$self;
		59	}
		60
		61	###########################################################################
		62
		63	=item $store->load_modules()
		64
65	If this is called as shown instead of statically as
66	Mail::SpamAssassin::ConfStoreSQL->load_modules(), a connection will be made
67	to the database, and a true value will be returned if the connect seemed to
68	succeed. This has the side effect of loading the appropriate DBD modules,
69	which cannot be easily determined beforehand.
70
71	=cut
72
73	sub load_modules { # static
74	my ($self)=@_;
75	Mail::SpamAssassin::ConfStoreGeneric->load_modules(@_);
76	eval {
77	$self->do_connect() if ref($self);
78	};
79	dbg($@) if $@;
80	return $@?0:1;
81	# do any preloading that will speed up operation
82	}
83
84	###########################################################################
85
86	=item $f->save_prefs($user, $prefs)
87
88	Note that leading and trailing whitespace and comments are stripped from the
89	saved data. Whitespace within the "lang xx " preference modifier or within
90	the preference itself is collapsed to a single space.
91
92	For those looking at the actual database, two extra pseudo-prefs are
93	inserted with negative line numbers, to store the original length and checksum.
94
95	=cut
96
97	sub do_connect {
98	my ($self)=@_;
99
100	if($self->{'dbi'}->[0]!=$$){
101	# If we have an old dbh from a fork, set InactiveDestroy so we don't
102	# disconnect our parent.
103	$self->{'dbi'}->[1]->{InactiveDestroy}=1 if defined($self->{'dbi'}->[1]);
104	$self->{'dbi'}->[0]=$$;
105	dbg("Connecting to database...");
106	$self->{'dbi'}->[1]=DBI->connect($self->{'dsn'}, $self->{'user'}, $self->{'pass'}, { PrintError => 0, RaiseError => 1, AutoCommit => 0}) or die $DBI::errstr;
107	}
108	die "Our dbh is unsuspectedly undef" unless defined($self->{'dbi'}->[1]);
109	return $self->{'dbi'}->[1];
110	}
111
112	sub save_prefs {
113	my ($self, $user, $prefs)=@_;
114	my $dbh=undef;
115	my $ins=undef;
116
117	dbg("Saving prefs for $user to the SQL database");
118	eval {
119	$dbh=$self->do_connect();
120	my $table=$self->{'table'};
121	# RaiseError is set, so we have no need to check for errors.
122	# AutoCommit is off, so nothing should happen until we $dbh->commit().
123
124	$dbh->do("DELETE FROM $table WHERE username=?", {}, $user);
125	$ins=$dbh->prepare("INSERT INTO $table (username,preference,value,line) VALUES (?,?,?,?)");
126	$ins->execute($user, "saved length", "".length($prefs), -2);
127	$ins->execute($user, "saved checksum", "".$self->calc_checksum($prefs), -1);
128	my ($line, $num, $pref, $value);
129	$num=0;
130	while(defined($line=Mail::SpamAssassin::Conf::extract_line($prefs))){
131	$num++;
132	next unless($line); # skip empty lines
133	$line=~s/^lang\s+(\S+)\s+/lang $1 /o;
134	die "Invalid input at line $num\n" unless $line=~/^((?:lang \S+ )?\S+)\s(.)$/o;
135	($pref, $value)=($1, $2);
136	$ins->execute($user, $pref, $value, $num);
137	}
138	$ins->finish();
139	$dbh->commit();
140	};
141	if($@){
142	my $err=$@;
143	eval {
144	$ins->finish() if $ins;
145	$dbh->rollback() if $dbh;
146	};
147	return ret("EX_IOERR", $err);
148	}
149	return ret("EX_OK", "Success");
150	}
151
152	=item $f->get_prefs($user)
153
154	Note that the return isn't exactly what was given to save_prefs(), see the
155	note there for details.
156
157	=cut
158
159	sub get_prefs {
160	my ($self, $user)=@_;
161	my $prefs=undef;
162
163	dbg("Reading prefs for $user from the SQL database");
164	eval {
165	my $dbh=$self->do_connect();
166	my $table=$self->{'table'};
167	# RaiseError is set, so we have no need to check for errors.
168	# AutoCommit is off, so nothing should happen until we $dbh->commit().
169
170	my $ref=$dbh->selectall_arrayref("SELECT preference, value FROM $table WHERE username=? AND line>=0 ORDER BY line ASC", {}, $user);
171	$prefs=join("\n", map { join(" ", @$_) } @$ref)."\n" if @$ref;
172	};
173	return ret("EX_IOERR", undef, $@) if($@);
174	return ret("EX_OK", undef, "No user prefs") unless defined($prefs);
175	return ret("EX_OK", $prefs, "Success");
176	}
177
178	sub get_length {
179	my ($self, $user)=@_;
180	my $len=undef;
181	my $exists=0;
182
183	eval {
184	my $dbh=$self->do_connect();
185	my $table=$self->{'table'};
186	# RaiseError is set, so we have no need to check for errors.
187	# AutoCommit is off, so nothing should happen until we $dbh->commit().
188
189	$len=$dbh->selectrow_array("SELECT value FROM $table WHERE username=? AND line=-2 AND preference=?", {}, $user, "saved length");
190	$exists=defined($len) \|\| $dbh->selectrow_array("SELECT COUNT(*) FROM $table WHERE username=?", {}, $user);
191	};
192	return ret("EX_IOERR", undef, $@) if($@);
193	return ret("EX_DATAERR", undef, "No user prefs") unless($exists);
194	return ret("EX_OK", $len, "Success") if defined($len);
195	return $self->SUPER::get_length($user);
196	}
197
198	sub get_checksum {
199	my ($self, $user)=@_;
200	my $sum=undef;
201	my $exists=0;
202
203	eval {
204	my $dbh=$self->do_connect();
205	my $table=$self->{'table'};
206	# RaiseError is set, so we have no need to check for errors.
207	# AutoCommit is off, so nothing should happen until we $dbh->commit().
208
209	$sum=$dbh->selectrow_array("SELECT value FROM $table WHERE username=? AND line=-1 AND preference=?", {}, $user, "saved checksum");
210	$exists=defined($sum) \|\| $dbh->selectrow_array("SELECT COUNT(*) FROM $table WHERE username=?", {}, $user);
211	};
212	return ret("EX_IOERR", undef, $@) if($@);
213	return ret("EX_DATAERR", undef, "No user prefs") unless($exists);
214	return ret("EX_OK", $sum, "Success") if defined($sum);
215	return $self->SUPER::get_checksum($user);
216	}
217
218	sub apply_prefs {
219	my ($self, $conf, $user)=@_;
220	my $sth=undef;
221
222	dbg("Applying prefs for $user from the SQL database");
223	eval {
224	my $dbh=$self->do_connect();
225	my $table=$self->{'table'};
226	# RaiseError is set, so we have no need to check for errors.
227	# AutoCommit is off, so nothing should happen until we $dbh->commit().
228
229	my $sth=$dbh->prepare("SELECT preference, value FROM $table WHERE username=? AND line>=0 ORDER BY line ASC");
230	$sth->execute($user);
231	my ($pref, $val);
232	$sth->bind_columns(\$pref, \$val);
233
234	$conf->parse_scores_only("$pref $val") while($sth->fetch);
235	$sth->finish();
236	};
237	if($@){
238	my $err=$@;
239	return ret("EX_IOERR", $err);
240	}
241	return ret("EX_OK", "Success");
242	}
243
244	###########################################################################
245
246	sub ret { Mail::SpamAssassin::ConfStoreGeneric::ret(@_); }
247	sub dbg { Mail::SpamAssassin::ConfStoreGeneric::dbg (@_); }
248	sub sa_die { Mail::SpamAssassin::ConfStoreGeneric::sa_die (@_); }
249
250	###########################################################################
251
252	1;
253	__END__
254
255	=back
256
257	=head1 DATABASE TABLES
258
259	=head2 In general
260
261	The table schema has changed slightly from the ConfSourceSQL version:
262
263	username varchar
264	preference varchar
265	value varchar
266	line integer
267
268	The sizes of the varchars don't matter too much, as long as they're big
269	enough to hold whatever possible values you'll be putting in them. The line
270	column is new, it avoids the problem of ConfSourceSQL where the rows are not
271	guaranteed to be returned in any particular order. Thus, you could end up
272	with your report template all mixed up, or you could end up with
273	clear-report-template after your report lines!
274
275	Selects are performed mainly using username and line, so an appropriate
276	index would be on those two columns. The combination of the two should be
277	unique. This module has little need for an index on preference, and none for
278	an index on value.
279
280	=head2 PostgreSQL
281
282	Table creation:
283
284	CREATE TABLE userpref (
285	username VARCHAR(32) NOT NULL,
286	preference VARCHAR(50) NOT NULL,
287	value VARCHAR(100) NOT NULL,
288	line INTEGER NOT NULL,
289	PRIMARY KEY (username, line)
290	);
291
292	Note that the lengths of the varchars may be adjusted to suit your
293	situation. Note that 'preference' may contain "lang xx pref" as well as just
294	"pref". The primary key setting isn't strictly necessary, but it speeds
295	queries slightly.
296
297	Granting permissions:
298
299	GRANT SELECT, INSERT, UPDATE, DELETE ON userpref TO spamassassin;
300
301	If you only want to use get_prefs, only SELECT is necessary. UPDATE probably
302	isn't necessary for most cases either.
303
304	If you need to copy prefs from an old-style table (without the 'line'
305	column), something like this should do it unless you created the old table
306	without oids:
307
308	INSERT INTO new_userpref SELECT *, oid AS line FROM old_userpref;
309
310	=head2 MySQL
311
312	Table creation:
313
314	CREATE TABLE userpref (
315	username varchar(32) NOT NULL,
316	preference varchar(50) NOT NULL,
317	value varchar(100) NOT NULL,
318	prefid int(11) NOT NULL auto_increment,
319	line int(11) NOT NULL,
320	PRIMARY KEY (prefid),
321	INDEX (username)
322	) TYPE=MyISAM;
323
324	The lines containing 'prefid' are not strictly necessary, i suspect they're
325	there to provide a unique column for the primary key.
326
327	Since I don't use MySQL, I can't give any suggestions for permissions or
328	copying (although, if you have the prefid column in your old table you can
329	copy that to line).
330
331	=head1 SEE ALSO
332
333	C<Mail::SpamAssassin>
334	C<Mail::SpamAssassin::Conf>
335	C<Mail::SpamAssassin::ConfSourceGeneric>
336	C<Mail::SpamAssassin::ConfStoreGeneric>
337	C<spamassassin>
338	C<spamd>
339

Line 0 Link Here

(-)lib-old/Mail/SpamAssassin/ConfStoreVPopmail.pm (+107 lines)
		1	=head1 NAME
		2
		3	Mail::SpamAssassin::ConfStoreVPopmail - Look for users in a vpopmail config
		4
		5	=head1 DESCRIPTION
		6
		7	This is a modification of Mail::SpamAssassin::ConfStoreHomedir which looks up
		8	users by calling vpopmail's vuserinfo instead of using the getpwnam system
		9	call.
		10
		11	=head1 PUBLIC FUNCTIONS
		12
		13	=over 4
		14
		15	=cut
		16
		17	package Mail::SpamAssassin::ConfStoreVPopmail;
		18
		19	use Carp;
		20	use IO::File;
		21	use strict;
		22
		23	use vars qw{
		24	@ISA,
		25	};
		26
		27	use Mail::SpamAssassin::ConfStoreHomedir;
		28	@ISA = qw(Mail::SpamAssassin::ConfStoreHomedir);
		29
		30	sub get_homedir {
		31	my ($self, $user)=@_;
		32	my $dir=$self->{'vpopdir'};
		33
		34	# Taken from perlsec, using backquotes is really insecure
		35	my $fh=IO::File->new();
		36	my $pid=$fh->open("-\|"));
		37	if(!defined($pid)){
		38	dbg("Can't fork: $!");
		39	return undef;
		40	}
		41	if(!$pid){
		42	exec("$dir/bin/vuserinfo", '-d', $user) or die "exec failed: $!\n";
		43	}
		44	$dir=join("", $fh->getlines());
		45	$dir=~s/\n//g;
		46	return undef unless $dir=~/./o; # catch in case exec failed
		47	return $dir;
		48	}
		49
		50	###########################################################################
		51
		52	=item Mail::SpamAssassin::ConfStoreVPopmail->new($vpopuser, $user_paths, $default_paths)
		53
		54	Return a new Mail::SpamAssassin::ConfStoreVPopmail object.
		55
		56	$vpopuser is the userid of the vpopmail user, which is needed to get the
		57	individual user configs.
		58
		59	$user_paths and $default_paths are passed to
		60	Mail::SpamAssassin::ConfStoreHomedir.
		61
		62	=cut
		63
		64	sub new {
65	my $class = shift;
66	$class = ref($class) \|\| $class;
67	my ($vpopuser, $userpath, $default)=@_;
68	my $dir=(getpwnam($vpopuser))[7] or die "User $vpopuser not found: $!";
69
70	my $self = Mail::SpamAssassin::ConfStoreHomedir->new($userpath, $default);
71	$self->{'vpopdir'}=$dir;
72
73	bless ($self, $class);
74	$self;
75	}
76
77
78	###########################################################################
79
80	sub load_modules { # static
81	Mail::SpamAssassin::ConfStoreHomedir->load_modules(@_);
82	# do any preloading that will speed up operation
83	}
84
85	###########################################################################
86
87	sub ret { Mail::SpamAssassin::ConfStoreHomedir::ret(@_); }
88	sub dbg { Mail::SpamAssassin::ConfStoreHomedir::dbg (@_); }
89	sub sa_die { Mail::SpamAssassin::ConfStoreHomedir::sa_die (@_); }
90
91	###########################################################################
92
93	1;
94	__END__
95
96	=back
97
98	=head1 SEE ALSO
99
100	C<Mail::SpamAssassin>
101	C<Mail::SpamAssassin::Conf>
102	C<Mail::SpamAssassin::ConfSourceGeneric>
103	C<Mail::SpamAssassin::ConfStoreGeneric>
104	C<Mail::SpamAssassin::ConfStoreHomedir>
105	C<spamassassin>
106	C<spamd>
107