#!/usr/bin/perl

#┌─────────────────────────────────
#│ MBS PRO (bbs.cgi) v5.3 (2005/11/20)
#│ Copyright (c) KentWeb
#│ webmaster@kent-web.com
#│ http://www.kent-web.com/
#└─────────────────────────────────
$ver = 'MBS PRO - bbs v5.3';
#┌─────────────────────────────────
#│ [注意事項]
#│ 1. このスクリプトはシェアウェアです。30日間の試用期間を超えて
#│    継続試用する場合は規定の料金を支払う必要があります。
#│ 2. このスクリプトを使用したいかなる損害に対して作者は一切の
#│    責任を負いません。
#│ 3. 設置に関する質問はサポート掲示板にお願いいたします。
#│    直接メールによる質問は一切お受けいたしておりません。
#└─────────────────────────────────

#============#
#  設定項目  #
#============#

# 文字コードライブラリ取込
require './jcode.pl';

# スクリプトURL
$script = './bbs.cgi';

# ログディレクトリ
$logdir = './user/';

# ロックディレクトリ
$lockdir = './lock/';

# ファイルロック形式
#  0 : なし
#  1 : symlink関数式
#  2 : mkdir関数式
$lockkey = 0;

# sendmailパス（メール通知する時）
$sendmail = '/usr/sbin/sendmail';

# 他サイトから投稿排除する場合 (http://から書く)
$base_url = "";

# タグ広告挿入オプション
#   → <!-- 上部 --> <!-- 下部 --> の代わりに「広告タグ」を挿入する。
#   → 広告タグ以外に、MIDIタグ や LimeCounter等のタグにも使用可能。
$banner1 = '<!-- 上部 -->';  # 掲示板上部に挿入
$banner2 = '<!-- 下部 -->';  # 掲示板下部に挿入

# ホスト取得方法
# 0 : gethostbyaddr関数を使わない
# 1 : gethostbyaddr関数を使う
$gethostbyaddr = 0;

# １回当りの最大投稿サイズ (bytes)
$maxData = 51200;

#============#
#  設定完了  #
#============#

&decode;
&setfile;
if ($mode eq "howto") { &howto; }
elsif ($mode eq "find") { &find; }
elsif ($mode eq "usr_del") { &usr_del; }
elsif ($mode eq "regist") { &regist; }
&html_log;


#--------------------#
#  設定ファイル認識  #
#--------------------#
sub setfile {
	local($file, $flag, $type, $deny, $acol);

	# ファイル定義
	$logfile  = "$logdir$room\.log";
	$setfile  = "$logdir$room\.dat";
	$lockfile = "$lockdir$room\.lock";

	# 設定ファイル読み込み
	if (-e $setfile) {
		open(IN,"$setfile") || &error("Open Error : $setfile");
		$file = <IN>;
		close(IN);
	} else {
		&error("この作品の感想は受け付けておりません。");
	}

	($type,$title,$t_size,$t_color,$t_face,$t_gif,$home,$b_gif,$bgcol,$text,$link,$vlink,$alink,$max,$mail,$pass,$sub_col,$acol,$deny,$plog) = split(/<>/, $file);
	if (!$plog) { $plog=10; }

	# 掲示板タイプチェック
	if ($type ne "A") { &error("掲示板タイプが違います"); }

	# アクセス拒否
	&get_host;
	if ($deny) {
		$flag=0;
		foreach ( split(/\s+/, $deny) ) {
			s/\./\\\./g;
			if ($host =~ /$_/i) { $flag=1; last; }
		}
		if ($flag) { &error("現在アクセスできません"); }
	}
}

#--------------#
#  記事表示部  #
#--------------#
sub html_log {
	local($no,$ymd,$nam,$eml,$sub,$com,$url,$hos,$pw);

	# クッキーを取得
	($cnam,$ceml,$curl,$cpwd) = &get_cookie;

	&header;
	print "$banner1<P>\n" if ($banner1 ne "<!-- 上部 -->");

	if ($t_gif) {
		print "<img src=\"$t_gif\" alt=\"$title\">\n";
	} else {
		print "<b>$title</b>\n";
	}

	# レス処理
	$resub="";
	$recom="";
	if ($in{'res'}) {
		# ログを読みこみ
		open(IN,"$logfile") || &error("Open Error : $logfile");
		while (<IN>) {
			($no,$ymd,$nam,$eml,$sub,$com) = split(/<>/);
			last if ($in{'res'} == $no);
		}
		close(IN);

		# 返信用に題名とコメントを定義
		$sub =~ s/^Re\://;
		$resub = "Re[$no]: $sub";
		$com =~ s/<br>/\r&gt; /g;
		$recom  = "&gt; $com";
	}

	print <<"EOM";
<hr>
[<a href="$home" target="_top">トップ</a>]
EOM
	# ログを展開
	$i=0;
	open(IN,"$logfile") || &error("Open Error : $logfile");
	while (<IN>) {
		$i++;
		next if ($i < $page + 1);
		last if ($i > $page + $plog);

		($no,$ymd,$nam,$eml,$sub,$com,$url,$hos,$pw) = split(/<>/);
		if ($eml) { $nam = "<a href=\"mailto:$eml\">$nam</a>"; }
		if ($url) { $com .= "<P><a href=\"http://$url\" target=\"_blank\">http://$url</a>"; }

		print "<hr>",
		"$no ) $nam<br>",
		"[$ymd]",
		"<br>$com<br>\n";
	}
	close(IN);
	print "<hr>\n";
	print <<"EOM";
<form method="POST" action="$script">
<input type=hidden name=mode value="regist">
<input type=hidden name=room value="$room">
おなまえ<br>
<input type=text name=name size=24 value="$cnam"><br>
コメント<br>
<textarea cols=18 rows=6 name=comment wrap="soft">$recom</textarea><br>
<input type=submit value="投稿する">
</form>
EOM
	# 改頁処理
	$next = $page + $plog;
	$back = $page - $plog;

	# 前頁処理
	if ($back >= 0) {
		print "<form method=\"POST\" action=\"$script\">\n",
		"<input type=hidden name=page value=\"$back\">\n",
		"<input type=hidden name=room value=\"$room\">\n",
		"<input type=submit value=\"前の$plog件\"></form>\n";
	}
	# 次頁処理
	if ($next < $i) {
		print "<form method=\"POST\" action=\"$script\">\n",
		"<input type=hidden name=page value=\"$next\">\n",
		"<input type=hidden name=room value=\"$room\">\n",
		"<input type=submit value=\"次の$plog件\"></form>\n";
	}

	# ユーザ記事削除フォーム
	print <<"EOM";
$banner2
<hr><center>
総合ﾃｷｽﾄ投稿＆無料HP作成<br>
(C)<a href="http://chaos-file.jp">ｶｵｽﾌｧｲﾙ</a></center>
</body>
</html>
EOM
	exit;
}

#----------------#
#  書き込み処理  #
#----------------#
sub regist {
	local($no,$ymd2,$nam2,$eml2,$sub2,$com2,$pwd,@file);

	# 他サイトからのアクセスを排除
	if ($base_url) {
		$baseUrl =~ s/(\W)/\\$1/g;

		$ref = $ENV{'HTTP_REFERER'};
		$ref =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;
		if ($ref && $ref !~ /$base_url/i) { &error("不正なアクセスです"); }
	}

	# 名前とコメントは必須
	if ($in{'name'} eq "") { &error("名前が入力されていません"); }
	if ($in{'comment'} eq "") { &error("コメントが入力されていません"); }
	if ($in{'email'} && $in{'email'} !~ /^[\w\.\-]+\@[\w\.\-]+\.[a-zA-Z]{2,6}$/) {
		&error("Ｅメールの入力内容が正しくありません");
	}
	$in{'url'} =~ s/^http\:\/\///g;
	if ($in{'sub'} eq "") { $in{'sub'} = '無題'; }

	# ロック開始
	&lock if ($lockkey);

	# ログを開く
	open(IN,"$logfile") || &error("Open Error : $logfile");
	@file = <IN>;
	close(IN);

	# 二重投稿の禁止
	($no,$ymd2,$nam2,$eml2,$sub2,$com2) = split(/<>/,$file[0]);
	if ($in{'name'} eq $nam2 && $in{'comment'} eq $com2) {
		&error("二重投稿は禁止です");
	}

	# 記事Noカウント、日時取得、削除キーを暗号化
	$no++;
	$date = &get_time;
	if ($in{'pwd'} ne "") { $pwd = &encrypt($in{'pwd'}); }

	# ログを更新
	while ($max <= @file) { pop(@file); }
	unshift (@file,"$no<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$host<>$pwd<>\n");
	open(OUT,">$logfile") || &error("Write Error : $logfile");
	print OUT @file;
	close(OUT);

	# ロック解除
	&unlock if ($lockkey);

	# クッキーを格納
	&set_cookie;

	# メール処理
	if ($mail) { &mailto; }

	# 完了メッセージ
	&header;
	print <<"EOM";
投稿を受け付けました。
<br><a href="$script?room=$room">掲示板に戻る</a>
</body>
</html>
EOM
	exit;
}

#----------------#
#  デコード処理  #
#----------------#
sub decode {
	local($buf, $key, $val);

	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		$post_flag=1;
		if ($ENV{'CONTENT_LENGTH'} > $maxData) {
			&error("投稿量が大きすぎます");
		}
		read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
	} else {
		$post_flag=0;
		$buf = $ENV{'QUERY_STRING'};
	}
	undef(%in);
	foreach ( split(/&/, $buf) ) {
		($key, $val) = split(/=/);
		$val =~ tr/+/ /;
		$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;

		# S-JISコード変換
		&jcode'convert(*val, "sjis", "", "z");

		# タグ処理
		$val =~ s/&/&amp;/g;
		$val =~ s/"/&quot;/g;
		$val =~ s/</&lt;/g;
		$val =~ s/>/&gt;/g;
		$val =~ s/\0//g;
		$val =~ s/\r\n/<br>/g;
		$val =~ s/\r/<br>/g;
		$val =~ s/\n/<br>/g;

		$in{$key} = $val;
	}
	$mode = $in{'mode'};
	$page = $in{'page'};
	$room = $in{'room'};
	$room =~ s/\W//g;
	$headflag=0;
}

#--------------------#
#  使い方メッセージ  #
#--------------------#
sub howto {
	&header;
	print <<"HTML";
[<a href="$script?room=$room">戻る</a>]
<table width="100%">
<tr><th bgcolor="#0080C0">
<font color="#FFFFFF">掲示板の利用上の注意</font>
</th></tr></table>
<P><blockquote>
<OL>
<LI>この掲示板は<b>クッキー対応</b>です。１度記事を投稿いただくと、おなまえ、Ｅメール、ＵＲＬ、削除キーの情報は２回目以降は自動入力されます。（ただし利用者のブラウザがクッキー対応の場合）<P>
<LI>投稿内容には、<b>タグは一切使用できません。</b><P>
<LI>記事を投稿する上での必須入力項目は<b>「おなまえ」</b>と<b>「メッセージ」</b>です。Ｅメール、ＵＲＬ、題名、削除キーは任意です。<P>
<LI>記事には、<b>半角カナは一切使用しないで下さい。</b>文字化けの原因となります。<P>
<LI>記事の投稿時に<b>「削除キー」</b>にパスワード（英数字で8文字以内）を入れておくと、その記事は次回<b>削除キー</b>によって削除することができます。<P>
<LI>記事の保持件数は<b>最大 $max件</b>です。それを超えると古い順に自動削除されます。<P>
<LI>既存の記事に<b>「返信」</b>することができます。各記事にある<b>「返信」ボタン</b>を押すと返信用フォームとなります。<P>
<LI>過去の投稿記事から<b>「キーワード」によって簡易検索ができます。</b>トップメニューの「ワード検索」のリンクをクリックすると検索モードとなります。<P>
<LI>管理者が著しく不利益と判断する記事や他人を誹謗中傷する記事は\予\告\なく削除することがあります。
</OL>
</blockquote><hr>
</body>
</html>
HTML
	exit;
}

#--------------#
#  ワード検索  #
#--------------#
sub find {
	&header;
	print <<"EOM";
[<a href="$script?room=$room">戻る</a>]
<UL>
<LI>検索したい<b>キーワード</b>を入力し、検索領域を選択して「検索ボタン」を押してください。
<LI>キーワードを「半角スペース」で区切って複数指定することができます。
<P>
<form action="$script" method="POST">
<input type=hidden name=mode value="find">
<input type=hidden name=room value="$room">
キーワード <input type=text name=word size=30 value="$in{'word'}">
検索条件 <select name=op>
EOM
	foreach ("AND", "OR") {
		if ($in{'op'} eq $_) {
			print "<option value=\"$_\" selected>$_\n";
		} else {
			print "<option value=\"$_\">$_\n";
		}
	}
	print "</select> <input type=submit value=\"検索する\"></form></UL>\n";

	# ワード検索の実行と結果表示
	if ($in{'word'} ne "") {
		$in{'word'} =~ s/\x81\x40/ /g;
		@wd = split(/\s+/, $in{'word'});

		# 検索開始
		print "<DL>\n";
		$i=0;
		open(IN,"$logfile") || &error("Open Error : $logfile");
		while (<IN>) {
			$flag=0;
			foreach $wd (@wd){
				if (index($_,$wd) >= 0) {
					$flag=1;
					if ($in{'op'} eq 'OR') { last; }
				} else {
					if ($in{'op'} eq 'AND') { $flag=0; last; }
				}
			}
			if ($flag) {
				$i++;
				($no,$ymd,$nam,$eml,$sub,$com,$url) = split(/<>/);
				if ($eml) { $nam = "<a href=\"mailto:$eml\">$nam</a>"; }
				if ($url) { $com .= "<P><a href=\"http://$url\" target=\"_blank\">http://$url</a>"; }

				print "<DT><hr>[<b>$no</b>] ",
				"<font color=\"$sub_col\"><b>$sub</b></font> ",
				"投稿者：<b>$nam</b> - $ymd<br><br>\n",
				"<DD>$com<br><br>\n";
			}
		}
		close(IN);
		print "<DT><hr>検索結果：<b>$i</b>件</DL>\n";
	}
	print "</body></html>\n";
	exit;
}

#------------------#
#  クッキーの発行  #
#------------------#
sub set_cookie {
	local($gmt, $cook, @t, @m, @w);
	@t = gmtime(time + 60*24*60*60);
	@m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	@w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');

	$gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
			$w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);

	$cook = "$in{'name'}<>$in{'email'}<>$in{'url'}<>$in{'pwd'}";
	print "Set-Cookie: MBSPRO=$cook; expires=$gmt\n";
}

#------------------#
#  クッキーを取得  #
#------------------#
sub get_cookie {
	local($key, $val, *ck);

	$ck = $ENV{'HTTP_COOKIE'};
	foreach (split(/;/, $ck)) {
		($key, $val) = split(/=/);
		$key =~ s/\s//g;
		$ck{$key} = $val;
	}
	@ck = split(/<>/, $ck{'MBSPRO'});
	return (@ck);
}

#--------------#
#  エラー処理  #
#--------------#
sub error {
	if ($lockflag) { &unlock; }
	&header;
	print "<center><hr width=400><h3>もうしわけございません。</h3>\n";
	print "<font color='#dd0000'>$_[0]</font>\n";
	print "<br><br><a href=\"http://chaos-file.jp/?z=o2&oid=$room&topSrh=1&\">作品に戻る</a><br>\n";
	print "<a href=\"http://chaos-file.jp\">ｶｵｽﾌｧｲﾙに戻る</a>\n";
	print "<P><hr width=400></center>\n</body>\n</html>\n";
	exit;
}

#------------#
#  記事削除  #
#------------#
sub usr_del {
	local($no,$ymd,$nam,$eml,$sub,$com,$url,$hos,$pw);

	if ($in{'no'} eq "" || $in{'pw'} eq "") {
		&error("削除No又は削除キーが入力されていません");
	}

	# ロック開始
	&lock if ($lockkey);

	# ログを読み込む
	@new=();
	$flag=0;
	open(IN,"$logfile") || &error("Open Error : $logfile");
	while (<IN>) {
		($no,$ymd,$nam,$eml,$sub,$com,$url,$hos,$pw) = split(/<>/);
		if ($in{'no'} == $no) {
			if ($pw eq "") { $flag=2; }
			$flag=1;
			$chk = &decrypt($in{'pw'}, $pw);
			if ($chk ne "yes") { $flag=3; last; }
			else { next; }
		}
		push(@new,$_);
	}
	close(IN);

	if (!$flag) { &error("該当記事は存在しません"); }
	elsif ($flag == 2) { &error("削除キーが設定されていません"); }
	elsif ($flag == 3) { &error("削除キーが違います"); }

	# ログを更新
	open(OUT,">$logfile") || &error("Write Error : $logfile");
	print OUT @new;
	close(OUT);

	# ロック解除
	&unlock if ($lockkey);

	# 完了メッセージ
	&header;
	print <<"EOM";
<div align="center">
<h3>削除は正常に完了しました</h3>
<form action="$script" method="POST">
<input type=hidden name=room value="$room">
<input type=submit value=" 掲示板に戻る "></form>
</div>
</body>
</html>
EOM
	exit;
}

#--------------#
#  ロック処理  #
#--------------#
sub lock {
	local($retry)=5;

	# 1分以上古いロックは削除する
	if (-e $lockfile) {
		local($mtime) = (stat($lockfile))[9];
		if ($mtime < time - 60) { &unlock; }
	}
	# symlink関数式ロック
	if ($lockkey == 1) {
		while (!symlink(".", $lockfile)) {
			if (--$retry <= 0) { &error('LOCK is BUSY'); }
			sleep(1);
		}
	# mkdir関数式ロック
	} elsif ($lockkey == 2) {
		while (!mkdir($lockfile, 0755)) {
			if (--$retry <= 0) { &error('LOCK is BUSY'); }
			sleep(1);
		}
	}
	$lockflag=1;
}

#--------------#
#  ロック解除  #
#--------------#
sub unlock {
	if ($lockkey == 1) { unlink($lockfile); }
	elsif ($lockkey == 2) { rmdir($lockfile); }
	$lockflag=0;
}

#--------------#
#  メール送信  #
#--------------#
sub mailto {
	local($mail_sub, $mail_body, $m_com, $email);

	# メールタイトルを定義
	$mail_sub = "[$title : $no] $in{'sub'}";

	# 本文の改行・タグを復元
	$m_com = $in{'comment'};
	$m_com =~ s/<br>/\n/g;
	$m_com =~ s/&lt;/</g;
	$m_com =~ s/&gt;/>/g;
	$m_com =~ s/&quot;/"/g;
	$m_com =~ s/&amp;/&/g;

	$mail_body = <<"EOM";
--------------------------------------------------------
$titleに以下の投稿がありました。

投稿日時：$date
ホスト名：$host
ブラウザ：$ENV{'HTTP_USER_AGENT'}

おなまえ：$in{'name'}
Ｅメール：$in{'email'}
タイトル：$in{'sub'}
ＵＲＬ  ：http://$in{'url'}
コメント：

$m_com
--------------------------------------------------------
EOM

	# メールアドレスがない場合は管理者アドレスに置き換え
	if ($in{'email'} eq "") { $email = $mail; }
	else { $email = $in{'email'}; }

	# 題名をBASE64化
	$mail_sub = &base64($mail_sub);

	# sendmail送信
	open(MAIL,"| $sendmail -t") || &error("メール送信失敗");
	print MAIL "To: $mail\n";
	print MAIL "From: $email\n";
	print MAIL "Subject: $mail_sub\n";
	print MAIL "MIME-Version: 1.0\n";
	print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
	print MAIL "Content-Transfer-Encoding: 7bit\n";
	print MAIL "X-Mailer: $ver\n\n";
	foreach ( split(/\n/, $mail_body) ) {
		&jcode'convert(*_, 'jis', 'sjis');
		print MAIL $_, "\n";
	}
	close(MAIL);
}

#--------------#
#  BASE64変換  # とほほのWWW入門で公開されているルーチンを
#--------------# 参考にしました。( http://tohoho.wakusei.ne.jp/ )
sub base64 {
	local($sub) = @_;
	&jcode'convert(*sub, 'jis', 'sjis');

	$sub =~ s/\x1b\x28\x42/\x1b\x28\x4a/g;
	$sub = "=?iso-2022-jp?B?" . &b64enc($sub) . "?=";
	$sub;
}
sub b64enc {
	local($ch)="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
	local($x, $y, $z, $i);
	$x = unpack("B*", $_[0]);
	for ($i=0; $y=substr($x,$i,6); $i+=6) {
		$z .= substr($ch, ord(pack("B*", "00" . $y)), 1);
		if (length($y) == 2) {
			$z .= "==";
		} elsif (length($y) == 4) {
			$z .= "=";
		}
	}
	$z;
}

#----------------------#
#  パスワード暗号処理  #
#----------------------#
sub encrypt {
	local($inpw) = $_[0];
	local($salt, $encrypt, @s);

	@s = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
	srand;
	$salt = $s[int(rand(@s))] . $s[int(rand(@s))];
	$encrypt = crypt($inpw, $salt) || crypt ($inpw, '$1$' . $salt);
	return $encrypt;
}

#----------------------#
#  パスワード照合処理  #
#----------------------#
sub decrypt {
	local($inpw, $logpw) = @_;
	local($salt, $key, $check);

	$salt = $logpw =~ /^\$1\$(.*)\$/ && $1 || substr($logpw, 0, 2);
	$check = "no";
	if (crypt($inpw, $salt) eq $logpw || crypt($inpw, '$1$' . $salt) eq $logpw)
		{ $check = "yes"; }
	return $check;
}

#----------------#
#  ホスト名取得  #
#----------------#
sub get_host {
	$host = $ENV{'REMOTE_HOST'};
	$addr = $ENV{'REMOTE_ADDR'};

	if ($gethostbyaddr && ($host eq "" || $host eq $addr)) {
		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
	}
}

#------------#
#  日時取得  #
#------------#
sub get_time {
	# 日時の取得
	$ENV{'TZ'} = "JST-9";
	($min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[1..6];
	@week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');

	$date = sprintf("%04d/%02d/%02d(%s) %02d:%02d",
			$year+1900,$mon+1,$mday,$week[$wday],$hour,$min);
	$date;
}

#------------------#
#  HTMLのヘッダー  #
#------------------#
sub header {
	if ($headflag) { return; }
	print "Content-type: text/html\n\n";
	print <<"EOM";
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=Shift_JIS">
<meta http-equiv="pragma" content="no-cache">
<meta http-equiv="Cache-Control" content="no-cache">
<title>$title</title>
</head>
EOM
	# bodyタグ
	if ($b_gif) {
		print "<body>\n";
	} else {
		print "<body>\n";
	}
	$headflag=1;
}

__END__