#!/usr/bin/perl

#┌─────────────────────────────────
#│ Aska BBS
#│ aska.cgi - 2008/01/04
#│ Copyright (c) KentWeb
#│ webmaster@kent-web.com
#│ http://www.kent-web.com/
#└─────────────────────────────────

# 外部ファイル取り込み
require './init.cgi';
require $jcode;

&decode;
&axscheck;
if ($in{'usrdel'}) { &usrdel; }
elsif ($mode eq 'regist') { &regist; }
elsif ($mode eq 'find') { &find; }
elsif ($mode eq 'howto') { &howto; }
elsif ($mode eq 'admin') { &admin; }
elsif ($mode eq 'check') { ✓ }
&html_log;

#-------------------------------------------------
#  アクセス制限
#-------------------------------------------------
sub axscheck {
	# IP&ホスト取得
	$host = $ENV{'REMOTE_HOST'};
	$addr = $ENV{'REMOTE_ADDR'};
	if ($gethostbyaddr && ($host eq "" || $host eq $addr)) {
		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
	}

	# IPチェック
	my $flg;
	foreach ( split(/\s+/, $deny_addr) ) {
		s/\./\\\./g;
		s/\*/\.\*/g;

		if ($addr =~ /^$_/i) {
			$flg = 1;
			last;
		}
	}
	if ($flg) {
		&error("アクセスを許可されていません");
	}

	# ホストチェック
	foreach ( split(/\s+/, $deny_host) ) {
		s/\./\\\./g;
		s/\*/\.\*/g;

		if ($host =~ /$_$/i) {
			$flg = 1;
			last;
		}
	}
	if ($flg) {
		&error("アクセスを許可されていません");
	}
	if ($host eq "") { $host = $addr; }
}

#-------------------------------------------------
#  記事表示
#-------------------------------------------------
sub html_log {
	# 繰越ページ
	my $page = 0;
	foreach ( keys(%in) ) {
		if (/^page:(\d+)$/) {
			$page = $1;
			last;
		}
	}

	# クッキー取得
	my ($cnam, $ceml, $curl, $cpwd) = &get_cookie;
	if (!$curl) { $curl = 'http://'; }

	# レス処理
	$in{'res'} =~ s/\D//g;
	my ($r_sub, $r_com);
	if ($in{'res'}) {
		my ($flg, $no, $dat, $nam, $eml, $sub, $com);

		open(IN,"$logfile");
		while (<IN>) {
			($no,$dat,$nam,$eml,$sub,$com) = split(/<>/);

			if ($in{'res'} == $no) {
				$flg = 1;
				last;
			}
		}
		close(IN);

		if (!$flg) { &error("該当記事が見つかりません"); }

		$sub =~ s/^Re://g;
		$sub =~ s/\[\d+\]\s?//g;
		$r_sub = "Re:[$no] $sub";
		$r_com = "&gt; $com";
		$r_com =~ s/<br>/\n&gt; /ig;
	}

	&header;
	print qq|<div align="center">\n|;
	print "<p>$banner1</p>\n" if ($banner1 ne "<!-- 上部 -->");

	# タイトル
	if ($ImgT) {
		print "<img src=\"$ImgT\" width=\"$ImgW\" height=\"$ImgH\" alt=\"$title\">\n";
	} else {
		print "<b style=\"font-size:$tSize; color:$tCol;\">$title</b>\n";
	}

	print <<EOM;
<hr width="90%">
[<a href="$home" target="_top">トップに戻る</a>]
[<a href="$script?mode=howto">留意事項</a>]
[<a href="$script?mode=find">ワード検索</a>]
[<a href="$script?mode=admin">管理用</a>]
<hr width="90%"></div>
<blockquote>
<form action="$script" method="post">
<input type="hidden" name="mode" value="regist">
<table cellpadding="1" cellspacing="1">
<tr>
  <td nowrap><b>おなまえ</b></td>
  <td><input type="text" name="name" size="28" value="$cnam"></td>
</tr>
<tr>
  <td nowrap><b>Ｅメール</b></td>
  <td><input type="text" name="email" size="28" value="$ceml"></td>
</tr>
<tr>
  <td nowrap><b>タイトル</b></td>
  <td>
    <input type="text" name="sub" size="36" value="$r_sub">
    <input type="submit" value="送信する"><input type="reset" value="リセット">
  </td>
</tr>
<tr>
  <td colspan="2" nowrap>
    <b>メッセージ</b><br>
    <textarea name="comment" cols="56" rows="7">$r_com</textarea>
  </td>
</tr>
<tr>
  <td nowrap><b>参照先</b></td>
  <td><input type="text" name="url" size="50" value="$curl"></td>
</tr>
<tr>
  <td nowrap><b>削除キー</b></td>
  <td>
    <input type="password" name="pwd" size="8" maxlength="8" value="$cpwd">
	<small>(英数字で8文字以内)</small>
  </td>
</tr>
EOM

	# 投稿キー
	if ($regist_key) {
		require $regkeypl;
		my ($str_plain, $str_crypt) = &pcp_makekey;

		print qq|<tr><td nowrap><b>投稿キー</b></td>|;
		print qq|<td><input type="text" name="regikey" size="6" style="ime-mode:inactive" value="">\n|;
		print qq|（投稿時 <img src="$registkeycgi?$str_crypt" align="absmiddle" alt="投稿キー"> を入力してください）</td></tr>\n|;
		print qq|<input type="hidden" name="str_crypt" value="$str_crypt">\n|;
	}

	print <<EOM;
<tr>
  <td></td>
  <td><input type="checkbox" name="cook" value="on" checked>
	<small>クッキー情報保存</small>
  </td>
</tr>
</table>
</form>
</blockquote>
<dl>
EOM

	my $i = 0;
	open(IN,"$logfile") || &error("Open Error: $logfile");
	while (<IN>) {
		$i++;
		next if ($i < $page + 1);
		next if ($i > $page + $pageLog);

		my ($no,$date,$nam,$eml,$sub,$com,$url) = split(/<>/);

		if ($eml) { $nam = "<a href=\"mailto:$eml\">$nam</a>"; }
		if ($autolink) { &auto_link($com); }
		if ($refCol) { $com =~ s/([\>]|^)(&gt;[^<]*)/$1<font color="$refCol">$2<\/font>/g; }

		print qq|<dt><hr>[<b>$no</b>] <b style="color:$subCol">$sub</b>\n|;
		print qq|投稿者：<b>$nam</b> 投稿日：$date\n|;
		print qq|[<a href="$script?res=$no">返信</a>]<br><br>\n|;
		print qq|<dd>$com\n|;
		print qq|<p><a href="$url" target="_blank">$url</a></p>| if ($url);
		print qq|<br><br>\n|;
	}
	close(IN);

	print <<EOM;
<dt><hr>
</dl>
<form action="$script" method="post">
EOM

	# ページ繰り越し
	my $next = $page + $pageLog;
	my $back = $page - $pageLog;

	if ($back >= 0) {
		print "<input type=\"submit\" name=\"page:$back\" value=\"前の$pageLog件\">\n";
	}
	if ($next < $i) {
		print "<input type=\"submit\" name=\"page:$next\" value=\"次の$pageLog件\">\n";
	}

	# 著作権表示（削除禁止）
	print <<EOM;
<div align="right">
記事No<input type="text" name="no" size="3">
削除キー<input type="password" name="pwd" size="4" maxlength="8">
<input type="submit" name="usrdel" value="削除">
</form>
</div>
<div align="center">
<p>$banner2</p>
<span style="font-size:10px; font-family:Verdana,Helvetica,Arial">
- <a href="http://www.kent-web.com/" target="_top">ASKA BBS</a> -
<!-- $ver --></span>
</div>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  記事書込
#-------------------------------------------------
sub regist {
	# 投稿チェック
	if ($postonly && !$post_flag) { &error("不正なアクセスです"); }
	if ($baseUrl) { &refCheck; }

	# チェック
	if ($no_wd) { &no_wd; }
	if ($jp_wd) { &jp_wd; }
	if ($urlnum > 0) { &urlnum; }

	# 投稿キーチェック
	if ($regist_key) {
		require $regkeypl;

		if ($in{'regikey'} !~ /^\d{4}$/) {
			&error("投稿キーが入力不備です。<br>投稿フォームに戻って再読込み後、指定の数字を入力してください");
		}

		# 投稿キーチェック
		# -1 : キー不一致
		#  0 : 制限時間オーバー
		#  1 : キー一致
		local($chk) = &registkey_chk($in{'regikey'}, $in{'str_crypt'});
		if ($chk == 0) {
			&error("投稿キーが制限時間を超過しました。<br>投稿フォームに戻って再読込み後、指定の数字を再入力してください");
		} elsif ($chk == -1) {
			&error("投稿キーが不正です。<br>投稿フォームに戻って再読込み後、指定の数字を入力してください");
		}
	}

	# フォーム内容をチェック
	local($err);
	if ($in{'name'} eq "") { $err .= "名前が入力されていません<br>"; }
	if ($in{'comment'} eq "") { $err .= "コメントが入力されていません<br>"; }
	if ($in{'email'} && $in{'email'}!~ /^[\w\.\-]+\@[\w\.\-]+\.[a-zA-Z]{2,6}$/) {
		$err .= "Ｅメールの入力内容が不正です<br>";
	}
	if ($err) { &error($err); }

	if ($in{'url'} eq "http://") { $in{'url'} = ""; }
	if ($in{'sub'} eq "") { $in{'sub'} = "無題"; }

	# 先頭記事読み取り
	open(DAT,"+< $logfile") || &error("Open Error: $logfile");
	eval 'flock(DAT, 2);';
	my $top = <DAT>;

	# 重複投稿チェック
	my ($no,$dat,$nam,$eml,$sub,$com,$url,$hos,$pw,$tim) = split(/<>/, $top);
	if ($in{'name'} eq $nam && $in{'comment'} eq $com) {
		close(DAT);
		&error("二重投稿は禁止です");
	}

	# 連続投稿チェック
	my $time = time;
	my $flg;
	if ($regCtl == 1) {
		if ($host eq $hos && $time - $tim < $wait) { $flg = 1; }
	} elsif ($regCtl == 2) {
		if ($time - $tim < $wait) { $flg = 1; }
	}
	if ($flg) {
		close(DAT);
		&error("現在投稿制限中です。もうしばらくたってから投稿をお願いします");
	}

	# 記事No採番
	$no++;

	# 削除キー暗号化
	my $pwd;
	if ($in{'pwd'} ne "") { $pwd = &encrypt($in{'pwd'}); }

	# 時間取得
	my ($min,$hour,$mday,$mon,$year,$wday) = (localtime($time))[1..6];
	my @wk = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	my $date = sprintf("%04d/%02d/%02d(%s) %02d:%02d",
				$year+1900,$mon+1,$mday,$wk[$wday],$hour,$min);

	# 記事数調整
	my @data = ($top);
	my $i = 0;
	while (<DAT>) {
		$i++;
		push(@data,$_);

		last if ($i >= $max-1);
	}

	# 更新
	seek(DAT, 0, 0);
	print DAT "$no<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$host<>$pwd<>$time<>\n";
	print DAT @data;
	truncate(DAT, tell(DAT));
	close(DAT);

	# クッキーを記憶
	if ($in{'cook'} eq 'on') {
		&set_cookie($in{'name'}, $in{'email'}, $in{'url'}, $in{'pwd'});
	}

	# メール通知処理
	if ($mailing == 1 || ($mailing == 2 && $in{'email'} ne $mailto)) { &mail_to; }

	# リロード
	if ($location) {
		if ($ENV{'PERLXS'} eq "PerlIS") {
			print "HTTP/1.0 302 Temporary Redirection\r\n";
			print "Content-type: text/html\n";
		}
		print "Location: $location?\n\n";
		exit;
	} else {
		&message("投稿は正常に受理されました");
	}
}

#-------------------------------------------------
#  ワード検索
#-------------------------------------------------
sub find {
	&header;
	print <<EOM;
<form action="$script">
<input type="submit" value="&lt; 掲示板">
</form>
<ul>
<li>キーワードを入力し、検索ボタンを押してください。
<li>キーワードはスペースで区切って複数指定することができます。
<form action="$script" method="post">
<input type="hidden" name="mode" value="find">
キーワード <input type="text" name="word" size="38" value="$in{'word'}">
条件 <select name="cond">
EOM

	foreach ("AND", "OR") {
		if ($in{'cond'} eq $_) {
			print "<option value=\"$_\" selected>$_\n";
		} else {
			print "<option value=\"$_\">$_\n";
		}
	}
	print "</select> 表\示 <select name=\"view\">\n";
	foreach (10,15,20,25,30) {
		if ($in{'view'} == $_) {
			print "<option value=\"$_\" selected>$_件\n";
		} else {
			print "<option value=\"$_\">$_件\n";
		}
	}

	print <<EOM;
</select>
<input type="submit" value=" 検索 ">
</ul>
EOM

	# ワード検索の実行と結果表示
	if ($in{'word'} ne "") {

		# 繰越ページ
		my $page = 0;
		foreach ( keys(%in) ) {
			if (/^page:(\d+)$/) {
				$page = $1;
				llast;
			}
		}

		# 入力内容を整理
		$in{'word'} =~ s/\x81\x40/ /g;
		my @wd = split(/\s+/, $in{'word'});

		# 検索
		print "<dl>\n";
		my $i = 0;
		my @find;
		open(IN,"$logfile") || &error("Open Error: $logfile");
		while (<IN>) {
			my ($no,$dat,$nam,$eml,$sub,$com,$url) = split(/<>/);

			my $flg;
			foreach $wd (@wd) {
				if (index("$no $nam $eml $sub $com $url",$wd) >= 0) {
					$flg = 1;
					if ($in{'cond'} eq 'OR') { last; }
				} else {
					if ($in{'cond'} eq 'AND') {
						$flg = 0;
						last;
					}
				}
			}
			if ($flg) {
				$i++;
				next if ($i < $page + 1);
				next if ($i > $page + $in{'view'});

				push(@find,$_);
			}
		}
		close(IN);

		print "<dt>▽ <b>$in{'word'}</b> に関連する記事は<b>$i</b>件見つかりました。\n";

		foreach (@find) {
			my ($no,$ymd,$nam,$eml,$sub,$com,$url) = split(/<>/);

			if ($eml) { $nam = "<a href=\"mailto:$eml\">$nam</a>"; }
			if ($url) { $com .= "<p><a href=\"$url\" target=\"_blank\">$url</a></p>"; }

			print "<dt><hr>[<b>$no</b>] <b style=\"color:$subCol\">$sub</b> ";
			print "投稿者：<b>$nam</b> 投稿日：$ymd<br><br>\n";
			print "<dd>$com<br><br>\n";
		}

		print "<dt><hr></dl>\n";

		my $next = $page + $in{'view'};
		my $back = $page - $in{'view'};

		if ($back >= 0) {
			print "<input type=\"submit\" name=\"page:$back\" value=\"前の$in{'view'}件\">\n";
		}
		if ($next < $i) {
			print "<input type=\"submit\" name=\"page:$next\" value=\"次の$in{'view'}件\">\n";
		}
	}

	print <<EOM;
</form>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  管理モード
#-------------------------------------------------
sub admin {
	# 認証
	if ($in{'pass'} eq "") { &enter_form; }
	elsif ($in{'pass'} ne $pass) { &error("パスワードが違います"); }

	# 削除処理
	if ($in{'job'} eq "dele" && $in{'no'}) {

		# 削除情報
		my %del;
		foreach ( split(/\0/, $in{'no'}) ) {
			$del{$_}++;
		}

		# 削除情報をマッチング
		my @data;
		open(DAT,"+< $logfile") || &error("Open Error: $logfile");
		eval 'flock(DAT, 2);';
		while (<DAT>) {
			my ($no,$dat,$nam,$eml,$sub,$com,$url) = split(/<>/);

			if (!defined($del{$no})) {
				push(@data,$_);
			}
		}

		# 更新
		seek(DAT, 0, 0);
		print DAT @data;
		truncate(DAT, tell(DAT));
		close(DAT);

	# 修正画面
	} elsif ($in{'job'} eq "edit" && $in{'no'}) {

		if ($in{'no'} =~ /\0/) {
			&error("修正の場合選択する記事は１つのみです");
		}

		# 記事抽出
		local($no,$dat,$nam,$eml,$sub,$com,$url);

		open(IN,"$logfile") || &error("Open Error: $logfile");
		while (<IN>) {
			($no,$dat,$nam,$eml,$sub,$com,$url) = split(/<>/);

			last if ($in{'no'} == $no);
		}
		close(IN);

		# 修正フォームへ
		&edit_form;

	# 修正実行
	} elsif ($in{'job'} eq "edit2") {

		if ($in{'url'} eq "http://") { $in{'url'} = ""; }
		if ($in{'sub'} eq "") { $in{'sub'} = "無題"; }

		# 読み出し
		my @data;
		open(DAT,"+< $logfile") || &error("Open Error: $logfile");
		eval 'flock(DAT, 2);';
		while (<DAT>) {
			my ($no,$dat,$nam,$eml,$sub,$com,$url,$hos,$pwd,$tim) = split(/<>/);

			if ($in{'no'} == $no) {
				$_ = "$no<>$dat<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$hos<>$pwd<>$tim<>\n";
			}
			push(@data,$_);
		}

		# 更新
		seek(DAT, 0, 0);
		print DAT @data;
		truncate(DAT, tell(DAT));
		close(DAT);

		# 完了メッセージ
		&message("記事を修正しました");
	}

	# 削除画面を表示
	&header;
	print <<EOM;
<form action="$script">
<input type="submit" value="&lt; 掲示板">
</form>
<ul>
<li>処理を選択して送信ボタンを押してください。
</ul>
<form action="$script" method="post">
<input type="hidden" name="mode" value="admin">
<input type="hidden" name="pass" value="$in{'pass'}">
処理：
<select name="job">
<option value="edit">修正
<option value="dele">削除
</select>
<input type="submit" value="送信する">
<dl>
EOM

	# 記事を展開
	open(IN,"$logfile") || &error("Open Error: $logfile");
	while (<IN>) {
		my ($no,$dat,$nam,$eml,$sub,$com,$url,$hos) = split(/<>/);

		if ($eml) { $nam="<a href=\"mailto:$eml\">$nam</a>"; }
		$com =~ s/<[^>]*(>|$)//g;
		if (length($com) > 60) {
			$com = substr($com,0,60) . '...';
		}

		print qq|<dt><hr><input type="checkbox" name="no" value="$no">|;
		print qq|[$no] <b style="color:$subCol">$sub</b> $nam - $dat\n|;
		print qq|<font color="$subCol">【$hos】</font>\n|;
		print qq|<dd><span style="font-size:80%">$com</span>\n|;
	}
	close(IN);

	print <<EOM;
<dt><hr>
</dl>
</form>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  修正フォーム
#-------------------------------------------------
sub edit_form {
	$com =~ s/<br>/\n/g;
	if (!$url) { $url = "http://"; }

	&header;
	print <<EOM;
<form action="$script" method="post">
<input type="hidden" name="mode" value="admin">
<input type="hidden" name="pass" value="$in{'pass'}">
<input type="submit" value="&lt; 前画面へ">
</form>
<ul>
<li>変更する部分のみ修正して送信ボタンを押してください。
</ul>
<form action="$script" method="post">
<input type="hidden" name="mode" value="admin">
<input type="hidden" name="job" value="edit2">
<input type="hidden" name="no" value="$in{'no'}">
<input type="hidden" name="pass" value="$in{'pass'}">
<table cellpadding="1" cellspacing="1">
<tr>
  <td><b>おなまえ</b></td>
  <td><input type="text" name="name" size="28" value="$nam"></td>
</tr>
<tr>
  <td><b>Ｅメール</b></td>
  <td><input type="text" name="email" size="28" value="$eml"></td>
</tr>
<tr>
  <td><b>タイトル</b></td>
  <td><input type="text" name="sub" size="36" value="$sub"></td>
</tr>
<tr>
  <td><b>参照先</b></td>
  <td><input type="text" name="url" size="50" value="$url"></td>
</tr>

<tr>
  <td colspan="2">
    <b>メッセージ</b><br>
    <textarea name="comment" cols="56" rows="7">$com</textarea><br>
	<input type="submit" value="送信する"><input type="reset" value="リセット">
  </td>
</tr>
</table>
</form>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  留意事項
#-------------------------------------------------
sub howto {
	&header;
	print <<EOM;
<div align="center">
<table border="1" cellpadding="10" width="75%">
<tr><td class="tbl">
<h3 align="center">留意事項</h3>
<ol>
<li>この掲示板は<b>クッキー対応</b>です。一度記事を投稿いただくと、おなまえ、Ｅメール、ＵＲＬ、削除キーの情報は2回目以降は自動入力されます。（ただし利用者のブラウザがクッキー対応の場合）<br><br>
<li>投稿記事には、<b>タグは一切使用できません。</b><br><br>
<li>記事を投稿する上での必須入力項目は<b>「おなまえ」</b>と<b>「メッセージ」</b>です。Ｅメール、ＵＲＬ、題名、削除キーは任意です。<br><br>
<li>記事には、<b>半角カナは一切使用しないで下さい。</b>文字化けの原因となります。<br><br>
<li>記事の投稿時に<b>「削除キー」</b>にパスワード（英数字で8文字以内）を入れておくと、その記事は次回<b>削除キー</b>によって削除することができます。<br><br>
<li>記事の保持件数は<b>最大$max件</b>です。それを超えると古い順に自動削除されます。<br><br>
<li>既存の記事に簡単に<b>「返信」</b>することができます。各記事にある<b>「返信」</b>のリンク部を押すと投稿フォームが返信用となります。<br><br>
<li>過去の投稿記事から<b>「キーワード」によって簡易検索ができます。</b>トップメニューの<a href="$script?mode=find">「ワード検索」</a>のリンクをクリックすると検索モードとなります。<br><br>
<li>管理者が著しく不利益と判断する記事や他人を誹謗中傷する記事は予\告なく削除することがあります。
</ol>
</td></tr>
</table>
<br><br>
<form>
<input type="button" value="掲示板に戻る" onclick="history.back()">
</form>
</div>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  ユーザ記事削除
#-------------------------------------------------
sub usrdel {
	# 投稿チェック
	if ($postonly && !$post_flag) { &error("不正なアクセスです"); }
	if ($baseUrl) { &refCheck; }
	if ($in{'no'} eq '' || $in{'pwd'} eq '') {
		&error("削除Noまたは削除キーが入力モレです");
	}

	my ($flg, @data);
	open(DAT,"+< $logfile") || &error("Open Error: $logfile");
	eval 'flock(DAT, 2);';
	while (<DAT>) {
		my ($no,$dat,$nam,$eml,$sub,$com,$url,$hos,$pw) = split(/<>/);

		if ($in{'no'} == $no) {
			$flg = 1;

			# 削除キーなし
			if (!$pw) {
				$flg = -1;
				last;

			# 削除キー不一致
			} elsif (&decrypt($in{'pwd'}, $pw) != 1) {
				$flg = -2;
				last;
			}
			next;
		}
		push(@data,$_);
	}

	# 判定
	if ($flg == -1) {
		close(DAT);
		&error("この記事は削除キーが設定されていません");
	} elsif (!$flg || $flg == -2) {
		close(DAT);
		&error("該当キーが認証できません");
	}

	# ログを更新
	seek(DAT, 0, 0);
	print DAT @data;
	truncate(DAT, tell(DAT));
	close(DAT);

	# 完了メッセージ
	&message("記事を削除しました");
}

#-------------------------------------------------
#  フォームデコード
#-------------------------------------------------
sub decode {
	my $buf;
	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) ) {
		my ($key, $val) = split(/=/);
		$key =~ tr/+/ /;
		$key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;
		$val =~ tr/+/ /;
		$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;

		# S-JISコード変換
		&jcode::convert(\$val, "euc", "", "z");

		# エスケープ
		$val =~ s/&/&amp;/g;
		$val =~ s/"/&quot;/g;
		$val =~ s/</&lt;/g;
		$val =~ s/>/&gt;/g;
		$val =~ s/\r\n/<br>/g;
		$val =~ s/\r/<br>/g;
		$val =~ s/\n/<br>/g;

		$in{$key} .= "\0" if (defined($in{$key}));
		$in{$key} .= $val;
	}
	$mode = $in{'mode'};

	# タイムゾーン設定
	$ENV{'TZ'} = "JST-9";

	$headflag = 0;
}

#-------------------------------------------------
#  HTMLヘッダ
#-------------------------------------------------
sub header {
	if ($headflag) { return; }

	print "Content-type: text/html\n\n";
	print <<"EOM";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<head>
<meta http-equiv="content-type" content="text/html; charset=EUC_JP">
<meta http-equiv="content-style-type" content="text/css">
<style type="text/css">
<!--
body,td,th { font-size:$bSize; font-family:$bFace }
.tbl { background-color:#ffffff; color:#000000; }
-->
</style>
<title>$title</title>
</head>
$body
EOM
	$headflag = 1;
}

#-------------------------------------------------
#  エラー処理
#-------------------------------------------------
sub error {
	my $msg = shift;

	&header;
	print <<EOM;
<div align="center">
<hr width="400">
<h3>ERROR !</h3>
<font color="#dd0000">$msg</font>
<br>
<form>
<input type="button" value="前画面に戻る" onclick="history.back()">
</form>
<hr width="400">
</div>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  クッキー発行
#-------------------------------------------------
sub set_cookie {
	my @cook = @_;

	my @t = gmtime(time + 60*24*60*60);
	my @m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	my @w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');

	# 国際標準時を定義
	my $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]);

	# URLエンコード
	my $cook;
	foreach (@cook) {
		s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
		$cook .= "$_<>";
	}

	# 格納
	print "Set-Cookie: ASKA_BBS=$cook; expires=$gmt\n";
}

#-------------------------------------------------
#  クッキー取得
#-------------------------------------------------
sub get_cookie {
	# クッキーを取得
	my $cook = $ENV{'HTTP_COOKIE'};

	# 該当IDを取り出す
	my %cook;
	foreach ( split(/;/, $cook) ) {
		my ($key, $val) = split(/=/);
		$key =~ s/\s//g;
		$cook{$key} = $val;
	}

	# データをURLデコードして復元
	my @cook;
	foreach ( split(/<>/, $cook{'ASKA_BBS'}) ) {
		s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("H2", $1)/eg;

		push(@cook,$_);
	}
	return @cook;
}

#-------------------------------------------------
#  crypt暗号
#-------------------------------------------------
sub encrypt {
	my $in = shift;

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

#-------------------------------------------------
#  crypt照合
#-------------------------------------------------
sub decrypt {
	my ($in, $dec) = @_;

	my $salt = $dec =~ /^\$1\$(.*)\$/ && $1 || substr($dec, 0, 2);
	if (crypt($in, $salt) eq $dec || crypt($in, '$1$' . $salt) eq $dec) {
		return 1;
	} else {
		return 0;
	}
}

#-------------------------------------------------
#  メール送信
#-------------------------------------------------
sub mail_to {
	# メールタイトル
	my $msub = "[$title : $no] $in{'sub'}";
	$msub = &base64($msub);

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

	my $mbody = "$titleに以下の投稿がありました。\n\n";
	$mbody .= "Date : $date\n";
	$mbody .= "Host : $host\n";
	$mbody .= "Agent: $ENV{'HTTP_USER_AGENT'}\n\n";
	$mbody .= "名前 : $in{'name'}\n";
	$mbody .= "email: $in{'email'}\n";
	$mbody .= "題名 : $in{'sub'}\n";
	$mbody .= "参照 : $in{'url'}\n" if ($in{'url'});
	$mbody .= "\n$mcom\n";

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

	# sendmail送信
	open(MAIL,"| $sendmail -t -i") || &error("メール送信失敗");
	print MAIL "To: $mailto\n";
	print MAIL "From: $email\n";
	print MAIL "Subject: $msub\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/, $mbody) ) {
		&jcode::convert(\$_, 'jis', 'euc');
		print MAIL $_, "\n";
	}
	close(MAIL);
}

#-------------------------------------------------
#  自動リンク
#-------------------------------------------------
sub auto_link {
	$_[0] =~ s/([^=^\"]|^)(https?\:[\w\.\~\-\/\?\&\=\@\;\#\:\%]+)/$1<a href=\"$2\" target=\"_blank\">$2<\/a>/g;
}

#-------------------------------------------------
#  REFチェック
#-------------------------------------------------
sub refCheck {
	my $ref = $ENV{'HTTP_REFERER'};
	$ref =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;
	$baseUrl =~ s/(\W)/\\$1/g;
	if ($ref && $ref !~ /$baseUrl/i) { &error("不正なアクセスです"); }
}

#-------------------------------------------------
#  BASE64変換
#-------------------------------------------------
#	とほほのWWW入門で公開されているルーチンを参考にしました。
#	http://www.tohoho-web.com/
sub base64 {
	my $sub = shift;
	&jcode::convert(\$sub, 'jis', 'euc');

	$sub =~ s/\x1b\x28\x42/\x1b\x28\x4a/g;
	"=?iso-2022-jp?B?" . &b64enc($sub) . "?=";
}
sub b64enc {
	my $ch = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
	my ($x, $y, $z);
	$x = unpack("B*", $_[0]);
	for ( my $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 enter_form {
	&header;
	print <<EOM;
<div align="center">
<h4>パスワードを入力して下さい</h4>
<form action="$script" method="post">
<input type="hidden" name="mode" value="admin">
<input type="password" name="pass" size="12">
<input type="submit" value=" 認証 "></form>
</div>
<script language="javascript">
<!--
self.document.forms[0].pass.focus();
//-->
</script>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  メッセージ表示
#-------------------------------------------------
sub message {
	my $msg = shift;

	&header;
	print <<EOM;
<div align="center">
<p><font size="+1">$msg</font></p>
<form action="$script" method="post">
EOM

	if ($in{'pass'} ne "") {
		print qq|<input type="hidden" name="pass" value="$in{'pass'}">\n|;
		print qq|<input type="hidden" name="mode" value="admin">\n|;
	}

	print <<EOM;
<input type="submit" value="初期画面へ戻る">
</form>
</div>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  禁止ワードチェック
#-------------------------------------------------
sub no_wd {
	my $flg;
	foreach ( split(/,/, $no_wd) ) {
		if (index("$in{'name'} $in{'comment'}",$_) >= 0) {
			$flg = 1;
			last;
		}
	}
	if ($flg) { &error("禁止ワードが含まれています"); }
}

#-------------------------------------------------
#  日本語チェック
#-------------------------------------------------
sub jp_wd {
	if ($in{'comment'} !~ /[\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC]/) {
		&error("コメントに日本語が含まれていません");
	}
}

#-------------------------------------------------
#  URL個数チェック
#-------------------------------------------------
sub urlnum {
	my $com = $in{'comment'};
	my $num = ($com =~ s|(https?://)|$1|ig);
	if ($num > $urlnum) {
		&error("コメント中のURLアドレスは最大$urlnum個までです");
	}
}

#-------------------------------------------------
#  チェックモード
#-------------------------------------------------
sub check {
	&header;
	print <<EOM;
<h2>Check Mode</h2>
<ul>
EOM

	# ログファイル
	if (-e $logfile) {
		print "<li>LOGパス：OK\n";
		if (-r $logfile && -w $logfile) {
			print "<li>LOGパーミッション：OK\n";
		} else {
			print "<li>LOGパーミッションが不正です。\n";
		}
	} else {
		print "<li>LOGのパスが不正です：NG → $logfile\n";
	}

	print <<EOM;
</ul>
</body>
</html>
EOM
	exit;
}