rspamd/utils/classifier_test.pl

#!/usr/bin/env perl

use warnings;
use strict;
use Pod::Usage;
use Getopt::Long;
use Time::HiRes qw(gettimeofday tv_interval);
use JSON::XS;
use String::ShellQuote;
use FileHandle;
use IPC::Open2;
use Data::Dumper;

my $spam_dir;
my $ham_dir;
my $parallel            = 1;
my $classifier          = "bayes";
my $spam_symbol         = "BAYES_SPAM";
my $ham_symbol          = "BAYES_HAM";
my $timeout             = 10;
my $rspamc              = $ENV{'RSPAMC'} || "rspamc";
my $bogofilter          = $ENV{'BOGOFILTER'} || "bogofilter";
my $dspam               = $ENV{'DSPAM'} || "dspam";
my $train_fraction      = 0.5;
my $use_bogofilter      = 0;
my $use_dspam           = 0;
my $check_only          = 0;
my $rspamc_prob_trigger = 95;
my $man;
my $help;

GetOptions(
    "spam|s=s"           => \$spam_dir,
    "ham|h=s"            => \$ham_dir,
    "spam-symbol=s"      => \$spam_symbol,
    "ham-symbol=s"       => \$ham_symbol,
    "classifier|c=s"     => \$classifier,
    "timeout|t=f"        => \$timeout,
    "parallel|p=i"       => \$parallel,
    "train-fraction|t=f" => \$train_fraction,
    "bogofilter|b"       => \$use_bogofilter,
    "dspam|d"            => \$use_dspam,
    "check-only"         => \$check_only,
    "help|?"             => \$help,
    "man"                => \$man
) or pod2usage(2);

pod2usage(1) if $help;
pod2usage( -exitval => 0, -verbose => 2 ) if $man;

sub read_dir_files {
    my ( $dir, $target ) = @_;
    opendir( my $dh, $dir ) or die "cannot open dir $dir: $!";
    while ( my $file = readdir $dh ) {
        if ( -f "$dir/$file" ) {
            push @{$target}, "$dir/$file";
        }
    }
}

sub shuffle_array {
    my ($ar) = @_;

    for ( my $i = 0 ; $i < scalar @{$ar} ; $i++ ) {
        if ( $i > 1 ) {
            my $sel = int( rand( $i - 1 ) );
            ( @{$ar}[$i], @{$ar}[$sel] ) = ( @{$ar}[$sel], @{$ar}[$i] );
        }
    }
}

sub learn_rspamc {
    my ( $files, $spam ) = @_;
    my $processed = 0;

    my $cmd         = $spam ? "learn_spam" : "learn_ham";
    my $args_quoted = shell_quote @{$files};
    open( my $p, "$rspamc -t $timeout -c $classifier --compact -j -n $parallel $cmd $args_quoted |" )
      or die "cannot spawn $rspamc: $!";

    while (<$p>) {
        my $res = eval('decode_json($_)');
        if ( $res && $res->{'success'} ) {
            $processed++;
        }
    }

    return $processed;
}

sub learn_bogofilter {
    my ( $files, $spam ) = @_;
    my $processed = 0;

    foreach my $f ( @{$files} ) {
        my $args_quoted = shell_quote $f;
        my $fl          = $spam ? "-s" : "-n";
        `$bogofilter  -I $args_quoted $fl`;
        if ( $? == 0 ) {
            $processed++;
        }
    }

    return $processed;
}

sub learn_dspam {
    my ( $files, $spam ) = @_;
    my $processed = 0;

    foreach my $f ( @{$files} ) {
        my $args_quoted = shell_quote $f;
        my $fl          = $spam ? "--class=spam" : "--class=innocent";
        open( my $p, "|$dspam --user nobody --source=corpus --stdout --mode=toe $fl" )
          or die "cannot run $dspam: $!";

        open( my $inp, "< $f" );
        while (<$inp>) {
            print $p $_;
        }
    }

    return $processed;
}

sub learn_samples {
    my ( $ar_ham, $ar_spam ) = @_;
    my $len;
    my $processed = 0;
    my $total     = 0;
    my $learn_func;

    my @files_spam;
    my @files_ham;

    if ($use_dspam) {
        $learn_func = \&learn_dspam;
    }
    elsif ($use_bogofilter) {
        $learn_func = \&learn_bogofilter;
    }
    else {
        $learn_func = \&learn_rspamc;
    }

    $len = int( scalar @{$ar_ham} * $train_fraction );
    my @cur_vec;

    # Shuffle spam and ham samples
    for ( my $i = 0 ; $i < $len ; $i++ ) {
        if ( $i > 0 && ( $i % $parallel == 0 || $i == $len - 1 ) ) {
            push @cur_vec, @{$ar_ham}[$i];
            push @files_ham, [@cur_vec];
            @cur_vec = ();
            $total++;
        }
        else {
            push @cur_vec, @{$ar_ham}[$i];
        }
    }

    $len     = int( scalar @{$ar_spam} * $train_fraction );
    @cur_vec = ();
    for ( my $i = 0 ; $i < $len ; $i++ ) {
        if ( $i > 0 && ( $i % $parallel == 0 || $i == $len - 1 ) ) {
            push @cur_vec, @{$ar_spam}[$i];
            push @files_spam, [@cur_vec];
            @cur_vec = ();
            $total++;
        }
        else {
            push @cur_vec, @{$ar_spam}[$i];
        }
    }

    for ( my $i = 0 ; $i < $total ; $i++ ) {
        my $args;
        my $spam;

        if ( $i % 2 == 0 ) {
            $args = pop @files_spam;

            if ( !$args ) {
                $args = pop @files_ham;
                $spam = 0;
            }
            else {
                $spam = 1;
            }
        }
        else {
            $args = pop @files_ham;
            if ( !$args ) {
                $args = pop @files_spam;
                $spam = 1;
            }
            else {
                $spam = 0;
            }
        }

        my $r = $learn_func->( $args, $spam );
        if ($r) {
            $processed += $r;
        }
    }

    return $processed;
}

sub check_rspamc {
    my ( $files, $spam, $fp_cnt, $fn_cnt, $detected_cnt ) = @_;

    my $args_quoted = shell_quote @{$files};
    my $processed   = 0;

    open(
        my $p,
"$rspamc -t $timeout -n $parallel --header=\"Settings: {symbols_enabled=[BAYES_SPAM]}\" --compact -j $args_quoted |"
    ) or die "cannot spawn $rspamc: $!";

    while (<$p>) {
        my $res = eval('decode_json($_)');
        if ( $res && $res->{'default'} ) {
            $processed++;

            if ($spam) {
                if ( $res->{'default'}->{$ham_symbol} ) {
                    my $m = $res->{'default'}->{$ham_symbol}->{'options'}->[0];
                    if ( $m && $m =~ /^(\d+(?:\.\d+)?)%$/ ) {
                        my $percentage = int($1);
                        if ( $percentage >= $rspamc_prob_trigger ) {
                            $$fp_cnt++;
                        }
                    }
                    else {
                        $$fp_cnt++;
                    }
                }
                elsif ( !$res->{'default'}->{$spam_symbol} ) {
                    $$fn_cnt++;
                }
                else {
                    $$detected_cnt++;
                }
            }
            else {
                if ( $res->{'default'}->{$spam_symbol} ) {
                    my $m = $res->{'default'}->{$spam_symbol}->{'options'}->[0];
                    if ( $m && $m =~ /^(\d+(?:\.\d+)?)%$/ ) {

                        my $percentage = int($1);
                        if ( $percentage >= $rspamc_prob_trigger ) {
                            $$fp_cnt++;
                        }
                    }
                    else {
                        $$fp_cnt++;
                    }
                }
                elsif ( !$res->{'default'}->{$ham_symbol} ) {
                    $$fn_cnt++;
                }
                else {
                    $$detected_cnt++;
                }
            }
        }
    }

    return $processed;
}

sub check_bogofilter {
    my ( $files, $spam, $fp_cnt, $fn_cnt, $detected_cnt ) = @_;
    my $processed = 0;

    foreach my $f ( @{$files} ) {
        my $args_quoted = shell_quote $f;

        open( my $p, "$bogofilter -t -I $args_quoted |" )
          or die "cannot spawn $bogofilter: $!";

        while (<$p>) {
            if ( $_ =~ /^([SHU])\s+.*$/ ) {
                $processed++;

                if ($spam) {
                    if ( $1 eq 'H' ) {
                        $$fp_cnt++;
                    }
                    elsif ( $1 eq 'U' ) {
                        $$fn_cnt++;
                    }
                    else {
                        $$detected_cnt++;
                    }
                }
                else {
                    if ( $1 eq 'S' ) {
                        $$fp_cnt++;
                    }
                    elsif ( $1 eq 'U' ) {
                        $$fn_cnt++;
                    }
                    else {
                        $$detected_cnt++;
                    }
                }
            }
        }
    }

    return $processed;
}

sub check_dspam {
    my ( $files, $spam, $fp_cnt, $fn_cnt, $detected_cnt ) = @_;
    my $processed = 0;

    foreach my $f ( @{$files} ) {
        my $args_quoted = shell_quote $f;

        my $pid = open2( *Reader, *Writer, "$dspam --user nobody --classify --stdout --mode=notrain" );
        open( my $inp, "< $f" );
        while (<$inp>) {
            print Writer $_;
        }
        close Writer;

        while (<Reader>) {
            if ( $_ =~ qr(^X-DSPAM-Result: nobody; result="([^"]+)"; class="[^"]+"; probability=(\d+(?:\.\d+)?).*$) ) {
                $processed++;
                my $percentage = int( $2 * 100.0 );

                if ($spam) {
                    if ( $1 eq 'Innocent' ) {
                        if ( $percentage <= ( 100 - $rspamc_prob_trigger ) ) {
                            $$fp_cnt++;
                        }
                    }
                    elsif ( $1 ne 'Spam' ) {
                        $$fn_cnt++;
                    }
                    else {
                        $$detected_cnt++;
                    }
                }
                else {
                    if ( $1 eq 'Spam' ) {
                        if ( $percentage >= $rspamc_prob_trigger ) {
                            $$fp_cnt++;
                        }
                    }
                    elsif ( $1 ne 'Innocent' ) {
                        $$fn_cnt++;
                    }
                    else {
                        $$detected_cnt++;
                    }
                }
            }
        }
        close Reader;
        waitpid( $pid, 0 );
    }

    return $processed;
}

sub cross_validate {
    my ($hr)          = @_;
    my $args          = "";
    my $processed     = 0;
    my $fp_spam       = 0;
    my $fn_spam       = 0;
    my $fp_ham        = 0;
    my $fn_ham        = 0;
    my $total_spam    = 0;
    my $total_ham     = 0;
    my $detected_spam = 0;
    my $detected_ham  = 0;
    my $i             = 0;
    my $len           = scalar keys %{$hr};
    my @files_spam;
    my @files_ham;
    my @cur_spam;
    my @cur_ham;
    my $check_func;

    if ($use_dspam) {
        $check_func = \&check_dspam;
    }
    elsif ($use_bogofilter) {
        $check_func = \&check_bogofilter;
    }
    else {
        $check_func = \&check_rspamc;
    }

    while ( my ( $fn, $spam ) = each( %{$hr} ) ) {
        if ($spam) {
            if ( scalar @cur_spam >= $parallel || $i == $len - 1 ) {
                push @cur_spam, $fn;
                push @files_spam, [@cur_spam];
                @cur_spam = ();
            }
            else {
                push @cur_spam, $fn;
            }
        }
        else {
            if ( scalar @cur_ham >= $parallel || $i == $len - 1 ) {
                push @cur_ham, $fn;
                push @files_ham, [@cur_ham];
                @cur_ham = ();
            }
            else {
                push @cur_ham, $fn;
            }
        }
    }

    shuffle_array( \@files_spam );

    foreach my $fn (@files_spam) {
        my $r = $check_func->( $fn, 1, \$fp_ham, \$fn_spam, \$detected_spam );
        $total_spam += $r;
        $processed  += $r;
    }

    shuffle_array( \@files_ham );

    foreach my $fn (@files_ham) {
        my $r = $check_func->( $fn, 0, \$fp_spam, \$fn_ham, \$detected_ham );
        $total_ham += $r;
        $processed += $r;
    }

    printf "Scanned %d messages
%d spam messages (%d detected)
%d ham messages (%d detected)\n", $processed, $total_spam, $detected_spam, $total_ham, $detected_ham;

    printf "\nHam FP rate: %.2f%% (%d messages)
Ham FN rate: %.2f%% (%d messages)\n", $fp_ham / $total_ham * 100.0, $fp_ham, $fn_ham / $total_ham * 100.0, $fn_ham;

    printf "\nSpam FP rate: %.2f%% (%d messages)
Spam FN rate: %.2f%% (%d messages)\n",
      $fp_spam / $total_spam * 100.0, $fp_spam,
      $fn_spam / $total_spam * 100.0, $fn_spam;
}

if ( !$spam_dir || !$ham_dir ) {
    die "spam or/and ham directories are not specified";
}

my @spam_samples;
my @ham_samples;

read_dir_files( $spam_dir, \@spam_samples );
read_dir_files( $ham_dir,  \@ham_samples );
shuffle_array( \@spam_samples );
shuffle_array( \@ham_samples );

if ( !$check_only ) {
    my $learned = 0;
    my $t0      = [gettimeofday];
    $learned = learn_samples( \@ham_samples, \@spam_samples );
    my $t1 = [gettimeofday];

    printf "Learned classifier, %d items processed, %.2f seconds elapsed\n", $learned, tv_interval( $t0, $t1 );
}

my %validation_set;
my $len = int( scalar @spam_samples * $train_fraction );
for ( my $i = $len ; $i < scalar @spam_samples ; $i++ ) {
    $validation_set{ $spam_samples[$i] } = 1;
}

$len = int( scalar @ham_samples * $train_fraction );
for ( my $i = $len ; $i < scalar @spam_samples ; $i++ ) {
    $validation_set{ $ham_samples[$i] } = 0;
}

cross_validate( \%validation_set );

__END__

=head1 NAME

classifier_test.pl - test various parameters for a classifier

=head1 SYNOPSIS

classifier_test.pl [options]

 Options:
   --spam                 Directory with spam files
   --ham                  Directory with ham files
   --spam-symbol          Symbol for spam (default: BAYES_SPAM)
   --ham-symbol           Symbol for ham (default: BAYES_HAM)
   --classifier           Classifier to test (default: bayes)
   --timeout              Timeout for rspamc (default: 10)
   --parallel             Parallel execution (default: 1)
   --help                 Brief help message
   --man                  Full documentation

=head1 OPTIONS

=over 8

=item B<--spam>

Directory with spam files.

=item B<--ham>

Directory with ham files.

=item B<--classifier>

Specifies classifier name to test.

=item B<--help>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=back

=head1 DESCRIPTION

B<classifier_test.pl> is intended to test Rspamd classifier for false positives, false negatives and other parameters.
It uses half of the corpus for training and half for cross-validation.

=cut