root/tags/FuzzyOcr-3.4.1/FuzzyOcr.pm

# FuzzyOcr plugin, version 3.4
#
# written by Christian Holler (decoder_at_own-hero_dot_net)
#   and Jorge Valdes (jorge_at_joval_dot_info)

package FuzzyOcr;

use strict;
use warnings;
use Mail::SpamAssassin;
use Mail::SpamAssassin::Logger;
use Mail::SpamAssassin::Util;
use Mail::SpamAssassin::Timeout;
use Mail::SpamAssassin::Plugin;

use String::Approx 'adistr';
use MLDBM qw(DB_File Storable);
use FileHandle;
use Fcntl ':flock';

our @ISA = qw (Mail::SpamAssassin::Plugin);

our %App = ();
our %Option = ();
our %Score = ();
our %Threshold = ();
our %words = ();
our $self;
our $pms;
our @scansets;

our @bin_utils = qw/gifsicle giffix giftext gifinter giftopnm 
    jpegtopnm pngtopnm bmptopnm tifftopnm ppmhist pamfile gocr ocrad/;

our @pgm_scores = qw/base add corrupt corrupt_unfixable wrongctype
    autodisable/;

our @pgm_opts = qw/personal_wordlist global_wordlist logfile
    threshold counts_required verbose timeout 
    db_hash db_safe db_max_days path_bin scansets keep_bad_images
    score_ham enable_image_hashing digest_db hashing_learn_scanned/;

our @paths = qw(/usr/local/netpbm/bin /usr/local/bin /usr/bin);

# Default values
$Option{threshold} = 0.3;
$Option{counts_required} = 2;
$Option{verbose} = 1;
$Option{timeout} = 10;
$Option{logfile} = undef;
$Option{enable_image_hashing} = 0;
$Option{hashing_learn_scanned} = 1;
$Option{digest_db} = "/etc/mail/spamassassin/FuzzyOcr.hashdb";
$Option{global_wordlist} = "/etc/mail/spamassassin/FuzzyOcr.words";
$Option{personal_wordlist} = ".spamassassin/fuzzyocr.words";
$Option{db_hash} = "/etc/mail/spamassassin/FuzzyOcr.db";
$Option{db_safe} = "/etc/mail/spamassassin/FuzzyOcr.safe.db";
$Option{db_max_days} = 35;
$Option{keep_bad_images} = 0;
$Option{score_ham} = 0;

# Default scores
$Score{base} = 4;
$Score{add} = 1;
$Score{corrupt} = 2.5;
$Score{corrupt_unfixable} = 5;
$Score{wrongctype} = 1.5;
$Score{autodisable} = 10;

# Default thresolds
$Threshold{s}  =
$Threshold{h}  = 
$Threshold{w}  =
$Threshold{cn} = 0.01;
$Threshold{c}  = 5;
$Threshold{max_hash} = 5;

# constructor: register the eval rule
sub new {
    my ( $class, $mailsa ) = @_;
    $class = ref($class) || $class;
    my $self = $class->SUPER::new($mailsa);
    bless( $self, $class );
    $self->register_eval_rule("fuzzyocr_check");
    $self->register_eval_rule("dummy_check");
    return $self;
}

sub parse_config {
    my ( $self, $opts ) = @_;
    if ( $opts->{key} =~ /^focr_bin_/i ) {
        my $p = lc $opts->{key};
        $p =~ s/focr_bin_//;
        if (grep {m/$p/} @bin_utils) {
            $App{$p} = $opts->{value};
            debuglog("App{$p} => $App{$p}");
        } else {
            debuglog("unknown App: $opts->{key}");
        }
    }
    elsif ( $opts->{key} =~ m/_score$/i ) {
        my $o = lc $opts->{key};
        $o =~ s/focr_//;
        $o =~ s/_score//;
        if (grep {m/$o/} @pgm_scores) {
            $Score{$o} = $opts->{value};
            debuglog("Score{$o} = $Score{$o}");
        } else {
            debuglog("unknown Score: $opts->{key}");
        }
    }
    else {
        my $o = lc $opts->{key};
        $o =~ s/focr_//;
        if (grep {m/$o/} @pgm_opts) {
            if ($o eq 'scansets') {
                @scansets = (); # remove
                foreach my $s (split(',',$opts->{value})) {
                    $s =~ s/^\s*//; $s =~ s/\s*$//;
                    push @scansets,$s;
                    debuglog("Found scan: $s");
                }
            } elsif ($o eq 'path_bin') {
                @paths = (); # remove
                foreach my $p (split(':',$opts->{value})) {
                    next unless -d $p;
                    push @paths,$p;
                    debuglog("Valid search path: $p");
                }
            } else {
                $Option{$o} = $opts->{value};
                debuglog("Option $o = $Option{$o}");
            }
        } else {
            debuglog("unknown Option: $opts->{key}");
        }
    }
    1;
}

sub finish_parsing_end {
    unless (@paths) {
        foreach my $p ( '/usr/local/netpbm/bin', '/usr/local/bin', '/usr/bin' ) {
            if (-d $p) {
                push @paths, $p;
                debuglog("Searching in: $p");
            }
        }
    }
    foreach my $a (@bin_utils) {
        if (defined $App{$a} and ! -x $App{$a}) {
            debuglog("cannot exec $a, removing...");
            delete $App{$a};
        } 
        foreach my $p (@paths) {
            my $f = "$p/$a";
            if (! defined $App{$a} and -x $f) {
                $App{$a} = $f;
                last;
            }
        }
        if (defined $App{$a}) {
            debuglog("Using $a => $App{$a}");
        } else {
            debuglog("Cannot find executable for $a");
        }
    }
    if ($Option{enable_image_hashing} == 2 and -r $Option{digest_db}) {
        my %DB; my $dbm; my $err = 0;
        my $now = time - ($Option{db_max_days}*86400);
        tie %DB, 'MLDBM', $Option{db_hash} or $err++;
        if ($err) {
            debuglog("Could not open \"$Option{db_hash}\"");
        } else {
            my $hash = 0;
            debuglog("Expiring records prior to: ".scalar(localtime($now)));
            foreach my $k (keys %DB) {
                my $db = $DB{$k};
                if ($db->{check} < $now) {
                    debuglog("Expire: <$k> Reason: $db->{check} < $now");
                    delete $DB{$k}; $hash++;
                }
            }
            debuglog("Expired <$hash> Image Hashes after $Option{db_max_days} day(s)")
                if ($hash>0);
            $hash = 0;
            open HASH, $Option{digest_db};
            while (<HASH>) {
                chomp;
                my($score,$basic,$key) = split('::',$_,3);
                next if (defined $DB{$key});
                $dbm = $DB{$key};
                $dbm->{score} = $score;
                $dbm->{basic} = $basic;
                $dbm->{input} =
                $dbm->{check} = time;
                $dbm->{match} = 1;
                $DB{$key} = $dbm;
                $hash++;
            }
            close HASH;
            debuglog("Imported <$hash> Image Hashes from \"$Option{digest_db}\"")
                if ($hash>0);
            $hash = scalar(keys %DB);
            debuglog("<$hash> Known BAD Image Hashes Available");
        }
        untie %DB; $err = 0;
        tie %DB, 'MLDBM', $Option{db_safe} or $err++;
        if ($err) {
            debuglog("Could not open \"$Option{db_safe}\"");
        } else {
            my $hash = 0;
            foreach my $k (keys %DB) {
                my $db = $DB{$k};
                if ($db->{check} < $now) {
                    debuglog("Expire: <$k> Reason: $db->{check} < $now");
                    delete $DB{$k}; $hash++;
                }
            }
            debuglog("Expired <$hash> Image Hashes after $Option{db_max_days} day(s)")
                if ($hash>0);
            $hash = scalar(keys %DB);
            debuglog("<$hash> Known GOOD Image Hashes Available");
        }
        untie %DB;
    }
    load_global_words( $Option{global_wordlist} );

    unless (@scansets) {
        @scansets = ( '$gocr -i $pfile', '$gocr -l 180 -d 2 -i $pfile');
    }
    foreach (@scansets) {
        debuglog("Using scan: $_");
    }
}

sub dummy_check {
    return 0;
}

sub load_global_words {
    unless ( -r $_[0] ) {
        debuglog("Cannot read Global wordlist: \"$_[0]\"\n Please check file path and permissions are correct.");
        return;
    }
    my $cnt = 0;
    open WORDLIST, "<$_[0]";
    while(my $w = <WORDLIST>) {
        chomp($w);
        $w =~ s/\s*//;
        $w =~ s/#(.*)//;
        next unless $w;
        my $wt = $Option{threshold};
        if ($w =~ /^(.*?)::(0(\.\d+){0,1})/) {
            ($w, $wt) = (lc($1), $2);
            $wt = $Option{threshold} unless ($wt =~ m/[\d\.]+/);
        }
        $words{$w} = $wt; $cnt++;
    }
    close WORDLIST;
    debuglog("Loaded <$cnt> words from \"$_[0]\"");
}

sub load_personal_words {
    unless ( -e $_[0] ) {
        #debuglog("Personal wordlist <$_[0]> not found, skipping...");
        return;
    }
    unless ( -r $_[0] ) {
        debuglog("Cannot read from wordlist \"$_[0]\"\n Please make sure that permissions are correct."
        );
        return;
    }
    my $cnt = 0;
    open WORDLIST, "<$_[0]";
    while(my $w = <WORDLIST>) {
        chomp($w);
        $w =~ s/\s*//;
        $w =~ s/#(.*)//;
        next unless $w;
        my $wt = $Option{threshold};
        if ($w =~ /^(.*?)::(0(\.\d+){0,1})/) {
            ($w, $wt) = ($1, $2);
            $wt = $Option{threshold} unless ($wt =~ m/[\d\.]+/);
        }
        $words{$w} = $wt; $cnt++;
    }
    close WORDLIST;
    debuglog("Updated Word List with $cnt words from $_[0]");
}

sub max {
    unless ( defined( $_[0] ) and defined( $_[1] ) ) { return 0 }
    unless ( defined( $_[0] ) ) { return $_[1] }
    unless ( defined( $_[1] ) ) { return $_[0] }
    if     ( $_[0] < $_[1] )    { return $_[1] }
    else                        { return $_[0] }
}

sub within_threshold {
    my $digest = shift;
    my $record = shift;

    my ($dimg,$dkey) = split('::',$digest);
    my ($rimg,$rkey) = split('::',$record);
    my ($ds, $dh, $dw, $dcn) = split(':',$dimg);
    my ($rs, $rh, $rw, $rcn) = split(':',$rimg);
    return(0) unless $rs;
    return(0) unless $rh;
    return(0) unless $rw;
    return(0) unless $rcn;
    return(0) unless $rkey;
    return(0) if ((abs($ds  - $rs ) / $rs ) > $Threshold{s});
    return(0) if ((abs($dh  - $rh ) / $rh ) > $Threshold{h});
    return(0) if ((abs($dw  - $rw ) / $rw ) > $Threshold{w});
    return(0) if ((abs($dcn - $rcn) / $rcn) > $Threshold{cn}); 
            
    my @rcf = split('::',$rkey);
    my @dcf = split('::',$dkey);

    my (@dcfs, @rcfs);
    foreach (@dcf) { push @dcfs,split(':',$_); }
    foreach (@rcf) { push @rcfs,split(':',$_); }

    my $total = scalar(@rcfs);
    if ($total == scalar(@dcfs)) {
        my $match = 0;
        foreach (0 .. ($total-1)) {
            $match++ if (abs($dcfs[$_] - $rcfs[$_]) <= $Threshold{c});
        }
        debuglog("image matched <$match> of <$total> colors");
        return(1) if ($match == $total);
    }
    return(0);
}

sub fmt_time {
    my $when = time - $_[0];
    my $ret;

    if ($when>86400) {
        my $d = int($when/86400);
        $when -= $d*86400;
        $ret = "$d days,";
    }
    if ($when>3600) {
        my $h = int($when/3600);
        $when -= $h*3600;
        $ret .= " $h hours";
    }
    if ($when>60) {
        my $m = int($when/60);
        $when -= $m*60;
        $ret .= " $m minutes";
    }
    if ($when>0) {
        $ret .= " $when seconds";
    }
    $ret .= " ago";
    return $ret;
}

sub gif_info {
    my ($giffile, $t) = @_;
    
    my $fd = new IO::Handle;
    
    my @stdout_data;
    my @stderr_data;

    my $retcode = $t->run_and_catch(sub {
        @stdout_data = qx($App{gifsicle} --info $giffile);
    });

    if ($retcode) {
        #FIXME: WARN HERE
    }

    my $output = join("", @stdout_data);
    
    my ($globalinfo, @frameinfo)
        = split /^ \s+ \+ \s+ (?=image \s+ \#\d+)/mx, $output;

    my %info = ( 'loop' => 0,
                 'loop_count' => 0,
                 'delays' => [],
                 'has_local_color_table' => 0 );

    if ($globalinfo =~ /^ \s* loop \s+ (forever|count \s+ (\d+))/mx) {
        $info{'loop'} = 1;
        $info{'loop_count'} = $2 ? ($2 + 0) : 0;
    }

    my $frameno = 0;
    foreach my $info (@frameinfo) {
        # We could just match the delays, but we'll also check the image#'s
        # as a sanity check.
        my ($n, $delay) = $info =~ m{ image \s+ \#(\d+)
                                      (?: .* \b delay \s+ (\d+(?:\.\d+)?) s)?
                                      }sx;
        #FIXME: Handle this error
        $n == $frameno
            or debuglog ( "Trouble parsing 'gifsicle --info' output.\n"
                     . "  Expected 'image \#$frameno', found 'image \#$n'" );

        $info{'delays'}->[$frameno++] = $delay ? $delay + 0.0 : 0.0;
        $info{'has_local_color_table'} ||= $output =~ /local\s+color\s+table/;
    }

    return \%info;
}

sub find_dominant_image ($) {
    my ($info) = @_;
    my ($loop, $loop_count, $delays) = @$info{qw(loop loop_count delays)};

    # Pick out the frame with the longest delay.
    my $maxdelay = -1e6;
    my $maxn = @$delays - 1;
    for (my $n = 0; $n < @$delays; $n++) {
        $delays->[$n] > $maxdelay
            and ($maxn, $maxdelay) = ($n, $delays->[$n]);
    }

    if ($maxdelay < 15.0 && !$loop) {
        # In non-looped (or finitely-looped) images, the last frame
        # gets displayed forever at the end of the animation.
        # Therefore the last frame is the dominant frame.
        return @$delays - 1;
    }
    return $maxn;
}



sub check_image_hash_db {
    my $digest = $_[0];
    my $dbfile = $_[1] || $Option{db_hash};
    my $fname  = $_[2];
    my $ctype  = $_[3];
    my ($img, $key) = split('::', $digest,2);
    return (0,'') unless defined $key;
    my $hash = $digest;
    my $ret = 0; my $txt = 'Exact';
    my $dinfo;
    my %DB = (); my $dbm;

    if ($Option{enable_image_hashing} == 2) {
        tie %DB, 'MLDBM', $dbfile, O_RDWR or $ret++;
        if ($ret>0) {
            debuglog("No Image Hash database found at \"$dbfile\", or permissions wrong.");
            return (0,'');
        }
        if (defined $DB{$key}) {
            $dbm = $DB{$key};
            if ($img eq $dbm->{basic}) {
                $ret = $dbm->{score} || 0.001;
                $dinfo = $dbm->{dinfo} || '';
                $dbm->{fname} = $fname;
                $dbm->{ctype} = $ctype;
                debuglog("Updating $txt info File:'$fname' Type:'$ctype'");
                $DB{$key} = $dbm;
            }
        }
        if ($ret == 0) {
            my $now = time - ($Option{db_max_days}*86400);
            foreach my $k (keys %DB) {
                $dbm  = $DB{$k};
                $hash = $dbm->{basic} ? $dbm->{basic} : "0:0:0:0::$k";
                if (within_threshold($digest,$hash)) {
                    $ret  = $dbfile eq $Option{db_hash} ? $dbm->{score} : $dbm->{match};
                    $txt  = 'Approx'; $dinfo = $dbm->{dinfo} || '';
                    debuglog("Found in: <$dbfile>");
                    last;
                }
                # Has the record expired??
                $dbm->{check} = $now - 1 unless defined $dbm->{check};
                if ($dbm->{check} < $now) {
                    debuglog("Expiring <$k> older than $Option{db_max_days} days");
                    delete $DB{$k};
                }
            }
        }
        if ($ret>0) {
            $dbm->{match}++;
            if ($dbfile eq $Option{db_hash}) {
                $ret = sprintf("%0.3f",$dbm->{score});
                debuglog("Found Score <$ret> for $txt Image Hash");
            }
            debuglog("Matched [$dbm->{match}] time(s). Prev match: ".fmt_time($dbm->{check}));
            $dbm->{check} = time;
            $DB{$key} = $dbm;
        }
        untie %DB;
        return ($ret,$dinfo);
    } elsif ($Option{enable_image_hashing} == 1) {
        $ret = open HASH, $Option{digest_db};
        unless($ret) {
            debuglog("No Image Hash database found at \"$Option{digest_db}\", or permissions wrong.");
            return (0,'');
        }
        while (<HASH>) {
            chomp;
            ($ret,$hash) = split('::',$_,2);
            if (within_threshold($digest,$hash)) {
                debuglog("Found Score <$ret> for Hash <$hash>");
                return ($ret,'');
            }
        }
        close HASH;
        return (0,'');
    }
}
            
sub add_image_hash_db {
    my $digest = $_[0];
    my $score  = $_[1];
    my $ret = 0;

    if ($Option{enable_image_hashing} == 2) {
        my $dbfile = $_[2] || $Option{db_hash};
        my %DB = ();
        tie %DB, 'MLDBM', $dbfile or $ret++;
        if ($ret>0) {
            debuglog("Unable to open/create Image Hash database at \"$dbfile\", check permissions.");
            return;
        }
        debuglog("Adding Hash to \"$dbfile\"");

        my ($img,$key) = split('::',$digest,2);
        if (defined $key) {
            my $dbm = $DB{$key};
            $dbm->{fname} = $_[3];
            $dbm->{ctype} = $_[4];
            $dbm->{dinfo} = $_[5];
            $dbm->{basic} = $img;
            $dbm->{score} = $score;
            $dbm->{input} = 
            $dbm->{check} = time;
            $dbm->{match} = $dbfile eq $Option{db_hash} ? 0 : 1;
            $DB{$key} = $dbm;
        }
        untie %DB;
    } elsif ($Option{enable_image_hashing} == 1) {
        if (-e $Option{digest_db}) {
            $ret = open DB, ">>$Option{digest_db}";
        } else {
            $ret = open DB,  ">$Option{digest_db}";
        }
        unless ($ret) {
            debuglog("Unable to open/create Image Hash database at \"$Option{digest_db}\", check permissions.");
            return;
        }
        debuglog("Adding Hash to \"$Option{digest_db}\"");
        flock( DB, LOCK_EX );
        seek( DB, 0, 2 );
        print DB "${score}::${digest}\n";
        flock( DB, LOCK_UN );
        close(DB);
    }
    debuglog("Digest: $digest");
}

sub calc_image_hash {
    my $pfile = $_[0];
    my ($rcode, $hash);

    foreach my $a (qw/pamfile ppmhist/) {
        unless (defined $App{$a}) {
            info("FuzzyOcr: calc_image_hash cannot exec $a");
            return (1, '');
        }
    }
    
    unless (-r $pfile) {
        debuglog("Cannot read $pfile");
        return(1,'');
    }

    my @stdout_data;
    my ($w,$h,$s,$t) = (0,0,0,0);
    $t = Mail::SpamAssassin::Timeout->new({ secs => $Option{timeout} });
    $rcode = $t->run_and_catch(sub {
        @stdout_data = qx($App{pamfile} $pfile 2>/dev/null);
    });
    if ($rcode) {
        chomp $rcode;
        debuglog("$App{pamfile}: Timed out [$rcode], skipping...");
        return (1, '');
    }
    if ($stdout_data[0] =~ m/(\d+) by (\d+)/) {
        $w = $1; $h = $2;
        $s = (stat($pfile))[7];
    }

    $rcode = $t->run_and_catch(sub {
        @stdout_data = qx($App{ppmhist} -noheader $pfile 2>/dev/null);
    });
    if ($rcode) {
        chomp $rcode;
        debuglog("$App{ppmhist}: Timed out [$rcode], skipping...");
        return (1, '');
    }
    my $cnt = 0;
    my $c = scalar(@stdout_data);
    $hash = sprintf "%d:%d:%d:%d",$s,$h,$w,$c;
    if ($Threshold{max_hash}) {
        foreach (@stdout_data) {
            $_ =~ s/ +/ /g;
            my(@d) = split(' ', $_);
            $hash .= sprintf("::%d:%d:%d:%d:%d",@d);
            if ($cnt++ ge $Threshold{max_hash}) {
                last;
            }
        }
    }
    debuglog("Got: <$hash>");
    return(0, $hash);
}

sub logfile { 
    my $logtext = $_[0]; 
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time); 
    my $time = sprintf( 
        "%4d-%02d-%02d %02d:%02d:%02d", 
        $year + 1900, 
        $mon + 1, $mday, $hour, $min, $sec 
    ); 
    $logtext =~ s/\n/\n                      /g; 

    unless ( open LOGFILE, ">>", $Option{logfile} ) { 
        warn "Can't open $Option{logfile} for writing, check permissions"; 
    } 
    flock( LOGFILE, LOCK_EX ); 
    seek( LOGFILE, 0, 2 ); 
    print LOGFILE "$time [$$] $logtext\n"; 
    flock( LOGFILE, LOCK_UN ); 
    close LOGFILE; 
}

sub debuglog {
    my @lines = split('\n',$_[0]);
    my $limit = $_[1];
    $limit = 1 unless defined $limit;
    foreach (@lines) { dbg ("FuzzyOcr: $_"); }
    if ( $Option{verbose} > $limit ) {
        logfile($_[0]) if defined $Option{logfile};
    }
}

sub wrong_ctype {
    my ( $format, $ctype ) = @_;
    if ($Score{wrongctype}) {
        my $debuginfo = "";
        if ( $Option{verbose} > 0 ) {
            $debuginfo =
              ("Image has format \"$format\" but content-type is \"$ctype\"");
        }
        debuglog($debuginfo);
        for my $set ( 0 .. 3 ) {
            $pms->{conf}->{scoreset}->[$set]->{"FUZZY_OCR_WRONG_CTYPE"} =
              sprintf( "%0.3f", $Score{wrongctype} );
        }
        $pms->_handle_hit( "FUZZY_OCR_WRONG_CTYPE", $Score{wrongctype}, "BODY: ",
            $pms->{conf}->{descriptions}->{FUZZY_OCR_WRONG_CTYPE} . "\n$debuginfo" );
    }
}

sub corrupt_img {
    my ($score, $err) = @_;
    if ($score>0) {
        my $debuginfo = "";
        if ( $Option{verbose} > 0 ) {
            chomp($err);
            $debuginfo = ("Corrupt image: $err");
        }
        debuglog($debuginfo);
        for my $set ( 0 .. 3 ) {
            $pms->{conf}->{scoreset}->[$set]->{"FUZZY_OCR_CORRUPT_IMG"} =
              sprintf( "%0.3f", $score );
        }
        $pms->_handle_hit( "FUZZY_OCR_CORRUPT_IMG", $score, "BODY: ",
            $pms->{conf}->{descriptions}->{FUZZY_OCR_CORRUPT_IMG} . "\n$debuginfo" );
    }
}

sub known_img_hash {
    my $score = $_[0] || $Score{base};
    my $dinfo = $_[1] ? "\n$_[1]" : '';
    for my $set ( 0 .. 3 ) {
        $pms->{conf}->{scoreset}->[$set]->{"FUZZY_OCR_KNOWN_HASH"} =
        sprintf( "%0.3f", $score );
    }
    $pms->_handle_hit( "FUZZY_OCR_KNOWN_HASH", $score, "BODY: ",
        $pms->{conf}->{descriptions}->{FUZZY_OCR_KNOWN_HASH} . $dinfo );
}

sub removedir {
    my $dir = $_[0];
    return unless -d $dir;
    opendir D, $dir;
    my @files = readdir D;
    closedir D;
    foreach my $f (@files) {
        next if $f eq '.';
        next if $f eq '..';
        my $ff = Mail::SpamAssassin::Util::untaint_file_path("$dir/$f");
        unless (unlink $ff) {
            debuglog("Cannot remove: $ff");
        }
    }
    debuglog("Remove DIR: $dir");
    unless(rmdir $dir) {
        debuglog("Cannot remove DIR: $dir");
    }
}

sub fuzzyocr_check {
    ( $self, $pms ) = @_;
    if ( $pms->get_score() > $Score{autodisable} ) {
        debuglog("Scan canceled, message has already more than $Score{autodisable} points.");
        return 0;
    }

    my $imgdir;
    my %imgfiles = ();
    my @found    = ();
    my @hashes   = ();
    my $cnt      = 0;
    my $imgerr   = 0;

    #debuglog("Starting FuzzyOcr...");
    #debuglog("Attempting to load personal wordlist...");
    if ($Option{personal_wordlist} =~ m/^\//) {
        load_personal_words( $Option{personal_wordlist} );
    } else {
        my $homedir  = (getpwuid($<))[7];
        if ($homedir) {
            load_personal_words( $homedir . "/$Option{personal_wordlist}" );
        } elsif (defined($ENV{HOME})) {
            load_personal_words( $ENV{HOME} . "/$Option{personal_wordlist}" );
        } else {
            debuglog("Variable \$ENV{HOME} not defined and getpwuid failed, personal wordlist function not available...");
        }
    }

    foreach my $p (
        $pms->{msg}->find_parts(qr(^image\b)i),
        $pms->{msg}->find_parts(qr(Application/Octet-Stream)i)
    ) {
        my $ctype = $p->{'type'};
        my $fname = $p->{'name'} || 'unknown';
        if (($fname eq 'unknown') and
            (defined $p->{'headers'}->{'content-id'})
            ){
            $fname = join('',@{$p->{'headers'}->{'content-id'}});
            $fname =~ s/[<>]//g;
            $fname =~ tr/\@\$\%\&/_/s;
        }
        my $test  = 0;
        $test++ if ($ctype =~ /image/i);
        $test++ if ($fname =~ /(gif|jpg|jpeg|png|bmp|tiff)$/i);

        if ($test == 0) {
            debuglog("Skipping file with content-type=\"$ctype\" name=\"$fname\"");
            next;
        }

        $imgdir = Mail::SpamAssassin::Util::secure_tmpdir() unless ($imgdir);
        unless ($imgdir) {
            debuglog("Scan canceled, cannot create Image TMPDIR.");
            return 0;
        }
        #keep raw email for debugging later
        my $imgfilename = $imgdir . "/raw.eml";
        unless (-e $imgfilename) {
            if (open RAW, ">$imgfilename") {
                print RAW $pms->{msg}->get_pristine();
                close RAW;
                debuglog("Saved: $imgfilename");
            }
        }

        $fname =~ tr{a-zA-Z0-9\.}{_}cs;
        $imgfilename = Mail::SpamAssassin::Util::untaint_file_path(
            $imgdir . "/" . $fname
        );
        my $unique = 0;
        while (-e $imgfilename) {
            $imgfilename = Mail::SpamAssassin::Util::untaint_file_path(
                $imgdir . "/" . chr(65+$unique) . <