# Blosxom Plugin: rbl_spamblock
# Author:         t0c@iwatama.com
# Version:        0.1
# Date:           2007.02.11

package rbl_spamblock;

use strict;
use CGI qw/:standard/;

# --- Configurable variables -----------
# RBL list(based on IP)
# IPベースのRBLサーバのリスト
my @IP_RBLS = ("all.rbl.jp", "list.dsbl.org");

# RBL list(based on URI)
# URIベースのRBLサーバのリスト
my @URI_RBLS = ("multi.surbl.org", "multi.uribl.com", "url.rbl.jp");

# maximum uris in message
# 内容中に書き込めるURIの最大数
my $max_uri_count = 3;

# parameters to check
# 内容をチェックするパラメータの名前
my @params_to_check = ("comment");

# send mail when spam is blocked by IP rbl (0:no/1:yes)
# IP RBLでスパム判定された場合にメール通知するか(0:しない/1:する)
my $mail_ip_rbl_blocked = 0;

# send mail when spam is blocked by URI rbl (0:no/1:yes)
# URI RBLでスパム判定された場合にメール通知するか(0:しない/1:する)
my $mail_uri_rbl_blocked = 0;

# send mail when spam is blocked by many URI (0:no/1:yes)
# URI最大数を超えてスパム判定された場合にメール通知するか(0:しない/1:する)
my $mail_many_uri_blocked = 1;

# From address
# メールを送る場合のFromアドレス
my $from = $blosxom::writeback_from;

# To address
# メールを送る場合の送信先
my $to = $blosxom::writeback_to;

# path to sendmail
# sendmailのパス
my $sendmail = $blosxom::writeback_sendmail;

# writeback plugin name
# writebackプラグインの名前
my $plugin_name = "writeback";

# --------------------------------------

my $msg = "";

sub start {
    if($ENV{"REQUEST_METHOD"} eq "POST" and (param("plugin") =~ /$plugin_name/)) {
        if(&check_ip_rbl($ENV{"REMOTE_ADDR"}) == 1) {
            if($mail_ip_rbl_blocked == 1) {
                &send_email();
            }
            &reject_spam();
        }

        foreach my $key (@params_to_check) {
            my @uri_list = (param($key) =~ m!s?https?://[-_\.\!=*\'a-zA-Z0-9;:@&=+$,%]*!goi);
            if(&check_uri_rbl(@uri_list) == 1) {
                if($mail_uri_rbl_blocked == 1) {
                    &send_email();
                }
                &reject_spam();
            }
            elsif($#uri_list >= $max_uri_count) {
                if($mail_many_uri_blocked == 1) {
                    $msg = "too many uris.";
                    &send_email();
                }
                &reject_spam();
            }
        }
    }
    return 1;
}

#************************************************************
# check RBL
#
# $rbls:	referene to array of RBL servers
# $item:	item to check
# return:	0:not spam / 1:spam
#************************************************************
sub check_rbl {
    my ($rbls, $item) = @_;

    foreach my $rbl (@$rbls) {
        my $ret = gethostbyname($item . "." . $rbl);
        my @result = unpack("C4", $ret);

        if ($result[0] == 127 && $result[1] >= 0 &&
            $result[2] >= 0 &&
            $result[3] > 0) {

            $msg = $item . " is found in " . $rbl;

            return 1;
        }
    }
    return 0;
}

#************************************************************
# check spam by IP
#
# $ip:	IP address to check
# return:	0:not spam / 1:spam
#************************************************************
sub check_ip_rbl {
    my($ip) = @_;

    my @a = split(/\./, $ip);

    if(check_rbl(\@IP_RBLS, $a[3] . "." . $a[2] . "." . $a[1] . "." . $a[0]) == 1) {
        return 1;
    }

    return 0;
}

#************************************************************
# check spam by URI
#
# @uri_list:	list of uris to check
# return:	0:not spam / 1:spam
#************************************************************
sub check_uri_rbl {
    my @uri_list = @_;

    foreach my $uri (@uri_list) {
        $uri =~ m!s?https?://(.*)!goi;
        my $hostname = $1;
        my @elements = split(/\./, $hostname);
        my $domain = pop(@elements);
        $domain = pop(@elements) . ".$domain";

        if(check_rbl(\@URI_RBLS, $domain) == 1) {
            return 1;
        }
    }

    return 0;
}

#************************************************************
# block and exit
#************************************************************
sub reject_spam {
    print header(-status => "403 Forbidden");
    exit;
}

#************************************************************
# send email
#************************************************************
sub send_email {
    if (open(MAIL, "| $sendmail -t")) {
        my $body = "";
        foreach my $key (param()) {
            $body .= $key . ":" . param($key) . "\r\n";
        }

        my $path = path_info();
        my $addr = $ENV{"REMOTE_ADDR"};
        print MAIL <<EOF;
From: $from
To: $to
Subject: Spam Blocked for $blosxom::url
Content-Type: text/plain; charset=utf-8

Reason: $msg
Page: $blosxom::url$path
IP: $addr

$body
EOF
        close(MAIL);
    }

}

1;

__END__