PKG-SNF-CS-NIX/SNF_CS_Developer_Package.3.0.2_p4/SNF4SA/snf4sa.pm

#
# SpamAssassin SNF4SA Plugin for SNFServer.
#
# This plugin implements a SpamAssassin rule to use SNFServer to test
# whether an email is spam.
#
# Copyright (C) 2009 ARM Research Labs, LLC.
#
# snf4sa.pm
#
# The plugin implements a single evaluation rule, which passes the
# email message through SNFServer.  The communication with SNFServer
# is through XCI and a temporary file on disk which contains the email
# message truncated to the frist 64K bytes.
#

package Snf4sa;
use strict;
use Mail::SpamAssassin;
use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::PerMsgStatus;
use IO::Socket;
use IO::File;

use File::Temp qw/ tempfile tempdir /;
our @ISA = qw(Mail::SpamAssassin::Plugin);

# Convenience variables and pseudo-constants
my $CRLF                   = "\x0d\x0a";
my $DefaultMaxTempFileSize = 64 * 1024;

# translation table for SNF rule codes
my $rule_code_xlat = {
    0  => 'Standard White Rules',
    20 => 'GBUdb Truncate (superblack)',
    40 => 'GBUdb Caution (suspicious)',
    47 => 'Travel',
    48 => 'Insurance',
    49 => 'Antivirus Push',
    50 => 'Media Theft',
    51 => 'Spamware',
    52 => 'Snake Oil',
    53 => 'Scam Patterns',
    54 => 'Porn/Adult',
    55 => 'Malware & Scumware Greetings',
    56 => 'Ink & Toner',
    57 => 'Get Rich',
    58 => 'Debt & Credit',
    59 => 'Casinos & Gambling',
    60 => 'Ungrouped Black Rules',
    61 => 'Experimental Abstract',
    62 => 'Obfuscation Techniques',
    63 => 'Experimental Received [ip]',
};

sub new {
  my ($class, $mailsa) = @_;
  $class = ref($class) || $class;
  my $self = $class->SUPER::new($mailsa);
  bless ($self, $class);

  # Name of evaluation rule.
  $self->register_eval_rule ("snf4sa_sacheck");

  # Use localhost.
  $self->{SNF_Host} = "localhost";

  # Use default port.
  $self->{SNF_Port} = 9001;

  # Timeout.
  $self->{SNF_Timeout} = 1;

  # Directory for files containing emails read by SNFServer.
  $self->{Temp_Dir} = '/tmp/snf4sa';

  # Maximum email message size (including headers).
  $self->{SNF_MaxTempFileSize} = $DefaultMaxTempFileSize;

  return $self;
}

sub snf4sa_sacheck {

 my ($self, $permsgstatus, $fulltext) = @_;

 my $testscore = 0;
 my $response ='';
 my $exitvalue;

 # Make sure we have a temp dir
 unless(-d $self->{Temp_Dir}) {
     mkdir($self->{Temp_Dir});
     chmod(0777, $self->{Temp_Dir});
 };

 # Truncate the message.
 my $mailtext = substr( ${$fulltext}, 0, $self->{SNF_MaxTempFileSize});

 # create our temp file, $filename will contain the full path
 my ($fh, $filename) = tempfile( DIR => $self->{Temp_Dir} );

 # spew our mail into the temp file
 my $SNF_fh = IO::File->new( $filename, "w" ) ||
     die(__PACKAGE__ . ": Unable to create temporary file '" . $filename . "'");
 $SNF_fh->print($mailtext) ||
     $self->cleanup_die($filename,
                 __PACKAGE__ . ": Unable to write to temporary file '" .
                 $filename . "'");
 $SNF_fh->close ||
     $self->cleanup_die($filename,
                 __PACKAGE__ . ": Unable to close temporary file '" .
                 $filename . "'");

 # Change permissions.
 my $cnt = chmod(0666, $filename) ||
     $self->cleanup_die($filename, __PACKAGE__ .
                 ": Unable to change permissions of temporary file '" .
                 $filename . "'");

 # xci_scan connects to SNFServer with XCI to scan the message
 my $SNF_XCI_Return = $self->xci_scan( $filename );

 # Remove the temp file, we are done with it.
 unlink($filename);

 # Check response from SNFServer.
 if (! $SNF_XCI_Return ) {
     die(__PACKAGE__ . ": Internal error");
 }

 # Check for success.
 if (! $SNF_XCI_Return->{"success"}) {
     die(__PACKAGE__ . ":  Error from SNFServer: " .
         $SNF_XCI_Return->{"message"});
 }

 # get the return code and translation
 my ( $rc, $rcx ) = ( $SNF_XCI_Return->{"code"},
                      $rule_code_xlat->{ $SNF_XCI_Return->{"code"} } );

 $rc = -1 unless defined $rc;    # default values
 $rcx = 'Unknown' unless $rcx;
 my $rch = $SNF_XCI_Return->{"header"}; # the SNF header(s)

 # Result code of 0 indicates non-spam.  Any other value indicates
 # spam.
 if ($rc >= 1) {
     $testscore=1;
 } else {
     $testscore=0;
 }

 # Add the header.
 $permsgstatus->set_tag("SNFRESULTTAG", "$rc ($rcx)");

 #all SA cares about is whether a 0 or 1 comes back.  0 = good  1=spam.
 return $testscore;

}

sub abort
{
    my ( $self, $message ) = @_;
}

# xci_scan( $file )
# returns hashref:
#   success : true/false
#   code    : response code from SNF
#   message : scalar message (if any)
sub xci_scan
{
    my ( $self, $file ) = @_;
    return undef unless $self and $file;

    my $ret_hash = {
        success => undef,
        code    => undef,
        message => undef,
        header  => undef,
        xml     => undef
    };

    my $xci = $self->connect_socket( $self->{SNF_Host}, $self->{SNF_Port} )
      or return $self->err_hash("cannot connect to socket ($!)");

    $xci->print("<snf><xci><scanner><scan file='$file' xhdr='yes' /></scanner></xci></snf>\n");
    my $rc = $ret_hash->{xml} = $self->socket_response($xci, $file);
    $xci->close;


    if ( $rc =~ /^<snf><xci><scanner><result code='(\d*)'>/ ) {
        $ret_hash->{success} = 1;
        $ret_hash->{code}    = $1;
        $rc =~ /<xhdr>(.*)<\/xhdr>/s and $ret_hash->{header} = $1;
    } elsif ( $rc =~ /^<snf><xci><error message='(.*)'/ ) {
        $ret_hash->{message} = $1;
    } else {
        $ret_hash->{message} = "unknown XCI response: $rc";
    }

    return $ret_hash;
}

# connect_socket( $host, $port )
# returns IO::Socket handle
sub connect_socket
{
    my ( $self, $host, $port ) = @_;
    return undef unless $self and $host and $port;
    my $protoname = 'tcp';    # Proto should default to tcp but it's not expensive to specify

    $self->{XCI_Socket} = IO::Socket::INET->new(
        PeerAddr => $host,
        PeerPort => $port,
        Proto    => $protoname,
        Timeout  => $self->{SNF_Timeout} ) or return undef;

    $self->{XCI_Socket}->autoflush(1);    # make sure autoflush is on -- legacy
    return $self->{XCI_Socket};           # return the socket handle
}

# socket_response( $socket_handle )
# returns scalar string
sub socket_response
{
    my ( $self, $rs, $file ) = @_;
    my $buf = '';    # buffer for response

    # blocking timeout for servers who accept but don't answer
    eval {
        local $SIG{ALRM} = sub { die "timeout\n" };    # set up the interrupt
        alarm $self->{SNF_Timeout};                    # set up the alarm

        while (<$rs>) {                                # read the socket
            $buf .= $_;
        }

        alarm 0;                                       # reset the alarm
    };

    # report a blocking timeout
    if ( $@ eq "timeout\n" ) {
        $self->cleanup_die($file,
            __PACKAGE__ . ": Timeout waiting for response from SNFServer");
    } elsif ( $@ =~ /alarm.*unimplemented/ ) {         # no signals on Win32
        while (<$rs>) {                                # get whatever's left
                                                       # in the socket.
            $buf .= $_;
        }
    }
    return $buf;
}

# return an error message for xci_scan
sub err_hash
{
    my ( $self, $message ) = @_;

    return {
        success => undef,
        code    => undef,
        message => $message
    };
}

sub cleanup_die
{
    my ( $self, $file, $message ) = @_;

    unlink($file);
    die($message);
}
1;