File Coverage

blib/lib/WWW/StopForumSpam.pm

Criterion	Covered	Total	%
statement	25	27	92.5
branch			n/a
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	34	36	94.4

package WWW::StopForumSpam;

use 5.010;
use strict;
use warnings;
use autodie;
use Carp qw(croak);
use URI::Escape;
use Digest::MD5 qw(md5_hex);
use Socket;
use WWW::Curl::Easy;
use JSON qw(decode_json);

our $VERSION = '0.02';

sub new {
    my $class = shift;
    my $self = bless({}, $class);

    # parse params
    while(@_) {
        my $attr = shift;
        my $value = shift;

        if($attr eq "timeout") {
            $self->{timeout} = 0 + $value;
        } elsif($attr eq "api_key") {
            $self->{api_key} = "$value";
        } elsif($attr eq "api_url") {
            $self->{api_url} = "$value";
        } elsif($attr eq "dnsbl") {
            $self->{dnsbl} = "$value";
        } elsif($attr eq "treshold") {
            $self->{treshold} = 0 + $value;
        }
    }

    # validate / set defaults
    $self->{api_url} = "http://www.stopforumspam.com/api" unless exists $self->{api_url};
    $self->{dnsbl} = "sfs.dnsbl.st." unless exists $self->{dnsbl};
    $self->{timeout} = 4 unless exists $self->{timeout};
    $self->{connect_timeout} = $self->_ceil($self->{timeout} / 2);
    $self->{treshold} = 65 unless exists $self->{treshold};
    return $self;
}

sub check {
    my $self = shift;
    my @request_params = ();

    while(@_) {
        my $attr = shift;
        my $value = shift;

        if ($attr eq "ip" or $attr eq "email" or $attr eq "username") {
            push(@request_params, $attr . "=" . uri_escape($value));
        }
    }

    # add default params
    push(@request_params, "f=json");

    my ($http_code, $buffer) = $self->_query_api(join("&", @request_params));

    # if the api is not working, we don't want to allow potential spammers
    # signing up, so rather force the developers to check their logs...
    if (not defined $buffer) {
        return 1;
    }

    my $decoded_json = decode_json($buffer);
    if(not defined $decoded_json->{'success'}) {
        warn "unable to read json";
        return 1;
    } elsif($decoded_json->{'success'} == 0) {
        warn $decoded_json->{'error'};
        return 1;
    }

    if($self->_get_avg_confidence($decoded_json) > $self->{treshold}) {
        return 1;
    }

    return 0;
}

sub dns_check {
    my $self = shift;

    my $packed_ip;
    my $ip_address;

    while(@_) {
        my $attr = shift;
        my $value = shift;

        if ($attr eq "ip") {
            $packed_ip = gethostbyname(join('.', reverse split(/\./, $value)) . "." . $self->{dnsbl});
            if (not defined $packed_ip) {
                next;
            }

            $ip_address = inet_ntoa($packed_ip);
            if ($ip_address eq "127.0.0.2") {
                return 1;
            }

        } elsif ($attr eq "email") {
            $packed_ip = gethostbyname(md5_hex($value) . "." . $self->{dnsbl});
            if (not defined $packed_ip) {
                next;
            }

            $ip_address = inet_ntoa($packed_ip);
            if ($ip_address eq "127.0.0.3") {
                return 1;
            }
        }
    }

    return 0;
}

sub report {
    my $self = shift;
    my @request_params = ();

    if(not defined $self->{api_key}) {
        croak "apikey required.";
    }

    while(@_) {
        my $attr = shift;
        my $value = shift;

        if ($attr eq "username" or $attr eq "ip_addr" or $attr eq "evidence" or $attr eq "email") {
            if (length($value) > 0) {
                push(@request_params, $attr . "=" . uri_escape($value));
            }
        }
    }

    # add default params
    push(@request_params, "api_key=" . $self->{api_key});

    my ($http_code, $buffer) = $self->_query_api(join("&", @request_params), 1);

    if (not defined $buffer) {
        return 0;
    }

    if ($http_code == 200) {
        return 1;
    } else {
        warn $self->_strip_tags($buffer);
        return 0;
    }
}

sub _query_api {
    my ($self, $data, $is_submit) = @_;

    if (not defined $is_submit) {
        $is_submit = 0;
    }

    my $buffer = "";
    my $curl = WWW::Curl::Easy->new();

    if ($is_submit) {
        $curl->setopt(CURLOPT_URL, "http://www.stopforumspam.com/add.php");
        $curl->setopt(CURLOPT_POST, 1);
        $curl->setopt(CURLOPT_POSTFIELDS, $data);
    } else {
        $curl->setopt(CURLOPT_URL, $self->{api_url} . "?" . $data);
    }

    $curl->setopt(CURLOPT_USERAGENT, "Mozilla/5.0 (compatible; WWW::StopForumSpam/0.1; +http://www.perlhipster.com/bot.html)");
    $curl->setopt(CURLOPT_ENCODING, "");
    $curl->setopt(CURLOPT_NOPROGRESS, 1);
    $curl->setopt(CURLOPT_FAILONERROR, 0);
    $curl->setopt(CURLOPT_TIMEOUT, $self->{timeout});
    $curl->setopt(CURLOPT_WRITEFUNCTION, sub {
        $buffer .= $_[0];
        return length($_[0]);
    });

    my $retcode = $curl->perform();

    if($retcode != 0) {
        warn $curl->errbuf;
        return;
    }

    return ($curl->getinfo(CURLINFO_HTTP_CODE), $buffer);
}

sub _get_avg_confidence {
    my ($self, $decoded_json) = @_;
    my $confidence_total = 0;
    my $confidence_num = 0;

    if(defined $decoded_json->{'username'}) {
        if (defined $decoded_json->{'username'}{'confidence'}) {
            $confidence_total += $decoded_json->{'username'}{'confidence'};
        }
        $confidence_num++;
    }
    if(defined $decoded_json->{'email'}) {
        if (defined $decoded_json->{'email'}{'confidence'}) {
            $confidence_total += $decoded_json->{'email'}{'confidence'};
        }
        $confidence_num++;
    }
    if(defined $decoded_json->{'ip'}) {
        if (defined $decoded_json->{'ip'}{'confidence'}) {
            $confidence_total += $decoded_json->{'ip'}{'confidence'};
        }
        $confidence_num++;
    }

    return $confidence_total / $confidence_num;
}

sub _ceil {
    my ($self, $num) = @_;
    return int($num) + ($num > int($num));
}

sub _strip_tags {
    my ($self, $string) = @_;
    while ($string =~ s/<\S[^<>]*(?:>|$)//gs) {};
    return $string;
}

1;
__END__