# 掲示板スパム対策 汎用ライブラリ  by.sue445
#
# ▼使い方
# 1.掲示板の投稿処理を行っているファイルを見つける(Web Forumならwf_regi.cgi)
#
# 2. 1.で見つけたファイルと同じ場所にこのファイル(nospam.pl)を設置する
#
# 3. 1.で見つけたファイルの最初の方に
#     require './nospam.pl';
#    と記述する
#    (1行目に書かれている #!/usr/local/bin/perl の後ならどこでもいいですが、
#    なるべくファイルの先頭部がいいです)
#
# 4.投稿処理を行っている関数内で、投稿処理直前(ログに書き出す直前)に
#     &spamcheck($msg, $title, $url);
#   を追加する
#   ただしspamcheckに渡している引数の$msg, $title, $urlはそれぞれ
#   投稿されたメッセージ、タイトル、URLです。
#   これらのデータが格納されている変数名は各掲示板スクリプトによって違うので
#   注意してください。上のコードをそのまま書いても正常に動作しません
#   各掲示板スクリプトの仕様について聞かれても対応しきれないので質問しないでください
#   (ある程度Perlを熟知している人向けなので初心者は諦めてください)
#   引数が省略された場合はその部分についてはスパムチェックは行いません
#   (Web Forumなら $in{'message'}, $in{'sub'}, $in{'url'} です)
#
#   何も分からない場合は
#     &spamcheck;
#   でも構いませんが、禁止ワードチェックとかが使えません


# 設定項目ここから
# ▼禁止ワード
#  → コンマで区切って複数指定する（例）$deny_word = 'アダルト,出会い,カップル';
$deny_word = 'adult,casino,pharmacy,republika,sex,siski.net,insurance,cloud.prohosting.com,white.prohosting.com,pluto.no,narod.ru,loan,viagra,2www.org,cialis,gatech.edu,digmun.info,homepage,hamburg.de,mortgage,bitdom.com,ac.be,onenight-in-paris,diet,poker,naked,nude,ripway.com,[/url],[/URL],ceramics,hotels';

# ▼一度きたスパムのドメインをアクセス禁止にするための設定ファイル(.htaccess)のパス
#  一度きたスパムはドメインごとアク禁にすることができます
#  例) user1.host.comからスパムが送信されたらhost.comごとアク禁になる
#      (user1.host.comはもちろん、user2.host.comやproxy.host.comもアク禁になります)
# ただし .jp をドメインごとアク禁にするといろいろと危険なのでアク禁にはしません
# ↓のコメントアウトを解除すれば設定が有効になります
#$htaccess = '../.htaccess';

# ▼防いだスパムのログを残すファイル
#  酔狂な人用ｗ
#  地味にファイルサイズがでかくなるのでデフォルトでは無効化してます
# ↓のコメントアウトを解除すれば設定が有効になります
#$log_file = "spam.txt";

# 設定項目ここまで


#-------------------------------------------------
#  リモートホストからドメイン(ホストの末尾から国別コードとかを除いた独自の部分まで)を取り出す
#  IPアドレスとかの場合はそのまま返す
#-------------------------------------------------
sub get_domain{
	local($host) = @_;
	local($domain);

	# .jpはアク禁にはしない
	if($host =~ /\.jp$/){
		return '';
	}
	# こんなに長すぎる正規表現はサーバに負荷がかかりそうな気がする(汗
	elsif($host =~ /\.?[^\.]+?(\.(ac|co|go|or|ad|ne|gr|ed|lg))?(\.(af|al|dz|as|ad|ao|ai|aq|ag|ar|am|aw|au|at|az|bs|bh|bd|bb|by|be|bz|bj|bm|bt|bo|ba|bw|bv|br|io|bn|bg|bf|bi|kh|cm|ca|cv|ky|cf|td|cl|cn|cx|cc|co|km|cg|ck|cr|ci|hr|cu|cy|cz|dk|dj|dm|do|tp|ec|eg|sv|gq|er|ee|et|fk|fo|fj|fi|fr|fx|gf|pf|tf|ga|gm|ge|de|gh|gi|gr|gl|gd|gp|gu|gt|gn|gw|gy|ht|hm|hn|hk|hu|is|in|id|ir|iq|ie|il|it|jm|jo|jp|kz|ke|ki|kp|kr|kw|kg|la|lv|lb|ls|lr|ly|li|lt|lu|mo|mk|mg|mw|my|mv|ml|mt|mh|mq|mr|mu|yt|mx|fm|md|mc|mn|me|ms|ma|mz|mm|na|nr|np|nl|an|nc|nz|ni|ne|ng|nu|nf|mp|no|om|pk|pw|pa|pg|py|pe|ph|pn|pl|pt|pr|qa|re|ro|ru|rw|sh|kn|lc|pm|vc|ws|sm|st|sa|sn|sp|sc|sl|sg|sk|si|sb|so|za|gs|es|lk|sd|sr|sj|sz|se|ch|sy|tw|tj|tz|th|tg|tk|to|tt|tn|tr|tm|tc|tv|ug|ua|ae|uk|us|um|uy|uz|vu|va|ve|vn|vg|vi|wf|eh|ye|yu|zr|zm|zw|com|arpa|edu|gov|int|mil|nato|net|org|aero|biz|coop|info|museum|name|pro|jobs|travel|mobi|cat|asia)){1,2}$/)
	{
		$domain = $&;
	}
	else{
		$domain = $host;
	}

	return $domain;
}

#-------------------------------------------------
#  ドメインごとにソートするためのソート関数
#-------------------------------------------------
sub sortfunc{
	local($i, $length1, $length2, @host1, @host2);
	local($a_) = $a;
	local($b_) = $b;

	$a_ =~ s/^deny from //;
	$b_ =~ s/^deny from //;

	# IPアドレスどうしは数字の小さい順にソート
	if($a_ =~ /^\d+\.\d+\.\d+\.\d+$/ && $b_ =~ /^\d+\.\d+\.\d+\.\d+$/){
		@host1 = split(/\./, $a_);
		@host2 = split(/\./, $b_);
		for($i = 0; $i < 4; $i++){
			if($host1[$i] != $host2[$i]){ return $host1[$i] <=> $host2[$i]; }
		}
		return 0;
	}
	# IPアドレスとリモートホストではIPアドレスが先
	elsif($a_ =~ /^\d+\.\d+\.\d+\.\d+$/){
		return -1;
	}
	elsif($b_ =~ /^\d+\.\d+\.\d+\.\d+$/){
		return 1;
	}

	# ソートの優先順位は、ホストを . で区切った後ろのブロックが高い
	@host1 = reverse (split(/\./, $a_));
	@host2 = reverse (split(/\./, $b_));
	$length1 = @host1;
	$length2 = @host2;
	$i = 0;

	for($i = 0; $i < $length1 || $i < $length2; $i++){
		if($i < $length1 && $i < $length2){
			if($host1[$i] ne $host2[$i]){ return $host1[$i] cmp $host2[$i]; }
		}
		# ブロック数の少ない方を先にする
		elsif($i < $length1){ return -1; }
		else{ return 1; }
	}

	return 0;
}

#-------------------------------------------------
#  .htaccessに追加
#-------------------------------------------------
sub add_htaccess{
	if(! $htaccess){ return; }

	local($host, $domain, $ip, $file, @list, @header);

	# ホスト情報の取得
	$host = $ENV{ 'REMOTE_HOST' };
	$ip   = $ENV{ 'REMOTE_ADDR' };
	if ( $host eq '' ) { $host = $ip; }
	if ( $host eq $ip ) { $host = gethostbyaddr( pack( 'CCCC', split( /\./, $host ) ), 2 ) || $ip; }
	$domain = &get_domain($host);
	if($domain eq ''){ return; }

	# 現在のリストを読み込む
	open(IN, "$htaccess");
	@list = <IN>;
	close(IN);

	open(OUT, ">$htaccess");
	flock (OUT,2);

	# リストの中身がない時(初回実行時)の初期化
	if(@list==0){
		push(@list, "order allow,deny\n");
		push(@list, "allow from all\n");
		push(@list, "\n");
	}

	# 新しいスパムを追加する
	push(@list, "deny from $domain\n");

	# ファイルの最初の方にある deny from以外の行はヘッダとみなし、ソートはしない
	while($list[0] !~ /^deny from /){
		push(@header, shift(@list));
	}
	@list = sort sortfunc @list;
	@list = (@header, @list);

	print OUT @list;
	flock (OUT,8);
	close(OUT);
}

#-------------------------------------------------
#  防いだスパムのログをとる(酔狂な人専用ｗ)
#-------------------------------------------------
sub logout{
	if(! $log_file){ return; }

	local($log_file, $local_time);
	local($host, $ip);
	local($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime;

	$host = $ENV{ 'REMOTE_HOST' };
	$ip   = $ENV{ 'REMOTE_ADDR' };
	if ( $host eq '' ) { $host = $ip; }
	if ( $host eq $ip ) { $host = gethostbyaddr( pack( 'CCCC', split( /\./, $host ) ), 2 ) || $ip; }

	$mon++;
	$year += 1900;
	$local_time = sprintf("%04d/%02d/%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);

	open(OUT,">>$log_file");
	print OUT "$local_time $host\n";
	close(OUT);
}

#-------------------------------------------------
#  エラーを表示してCGIスクリプトを中断する
#-------------------------------------------------
sub spamerror {
	local($msg) = @_;

	&logout;
	&add_htaccess;

	print "Content-type: text/html\n\n";
	print "<html><head>\n";
	print "<title>Error</title>\n";
	print "</head>\n";
	print "<body>\n";
	print "$msg\n";
	print "</body></html>\n";

	exit;
}

#-------------------------------------------------
#  禁止ワード
#-------------------------------------------------
sub deny_word {
	local($word) = @_;

	if($word eq ''){ return; }

#	$word = lc $word;
	
	local($flg);
	foreach ( split(/,+/, $deny_word) ) {
		if (index(lc $word,$_) >= 0) { $flg=1; last; }
	}
	if ($flg) {
		&spamerror("NGワードが含まれています！");
	}
}

#-------------------------------------------------
#  スパムチェック
#-------------------------------------------------
sub spamcheck {
	local($msg,$title,$url) = @_;
	local($title2);

	$url =~ s/\?/\\?/;
	$url =~ s/\(/\\(/;
	$url =~ s/\)/\\)/;
	$url =~ s/\[/\\[/;
	$url =~ s/\]/\\]/;
	if($url ne '' && $msg =~ /$url/o) {
		&spamerror('本文中に「URL」と同じ文字列を含まないでください');
	}

	$title2 = $title;
	$title2 =~ tr/+/ /;
	$title2 =~ tr/%2D/-/;
	$title2 =~ s/^$//;
	if($title2 ne '' && $msg eq $title2) {
		&spamerror('「本文」と「題名」を同じ内容にしないでください');
	}

	# 禁止ワードチェック
	if ($deny_word) {
		&deny_word($title);
		&deny_word($msg);
	}

	if(!exists($ENV{'HTTP_ACCEPT_LANGUAGE'}) || $ENV{'HTTP_ACCEPT_LANGUAGE'} eq $ENV{'HTTP_ACCEPT'}) {
		&spamerror('HTTP_ACCEPT_LANGUAGEがおかしいです。ブラウザの言語設定を確認してください');
	}
}

1;