#!/usr/bin/perl

#┌─────────────────────────────────
#│ [ YY-BOARD ]
#│ regist.cgi - 2006/10/09
#│ Copyright (c) KentWeb
#│ webmaster@kent-web.com
#│ http://www.kent-web.com/
#└─────────────────────────────────

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

# メイン処理
&decode;
&axsCheck;
if ($mode eq "dele") { &dele; }
elsif ($mode eq "edit") { &edit; }
elsif ($mode eq "regist") { &regist; }
elsif ($mode eq "past") { &past; }
&error("不明な処理です");

#-------------------------------------------------
#  記事登録
#-------------------------------------------------
sub regist {
	# 時間取得
	&get_time;

	# フォーム入力チェック
	&formCheck;
	if ($in{'sub'} eq "") { $in{'sub'} = "無題"; }

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

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

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

	# ログを開く
	open(DAT,"+< $logfile") || &error("Open Error: $logfile");
	eval "flock(DAT, 2);";
	my $top = <DAT>;

	# 記事NO処理
	local($no,$ip,$tim) = split(/<>/, $top);
	$no++;

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

	# 禁止ワードチェック
	if ($deny_word) {
		&deny_word($in{'name'});
		&deny_word($in{'comment'});
	}

	# URL自動リンク
	if ($autolink) { &auto_link($in{'comment'}); }

	# 重複チェック
	$flg = 0;
	while (<DAT>) {
		my ($no2,$re,$dat,$nam,$eml,$sub,$com) = split(/<>/);

		if ($in{'name'} eq $nam && $in{'comment'} eq $com) {
			$flg = 1;
			last;
		}
	}
	if ($flg) {
		close(DAT);
		&error("重複投稿のため処理を中断しました");
	}

	# 巻き戻し
	seek(DAT, 0, 0);
	$top = <DAT>;

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

	# 親記事の場合
	if ($in{'reno'} eq "") {

		my $i = 0;
		my $stop = 0;
		while (<DAT>) {
			my ($no2,$reno2) = split(/<>/);
			$i++;
			if ($i > $max-1 && $reno2 eq "") { $stop = 1; }
			if (!$stop) { push(@new,$_); }
			elsif ($stop && $pastkey) { push(@data,$_); }
		}
		unshift(@new,"$no<><>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$host<>$pwd<>$col[$in{'color'}]<>$in{'icon'}<>\n");
		unshift(@new,"$no<>$addr<>$times<>\n");

		# 過去ログ更新
		if (@data > 0) { &pastlog(@data); }

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

	# レス記事の場合：トップソートあり
	} elsif ($in{'reno'} && $topsort) {

		my ($f,$oyaChk,$match,@new,@tmp);
		while (<DAT>) {
			my ($no2,$reno2) = split(/<>/);

			if ($in{'reno'} == $no2) {
				if ($reno2) { $f++; last; }
				$oyaChk++;
				$match=1;
				push(@new,$_);

			} elsif ($in{'reno'} == $reno2) {
				push(@new,$_);

			} elsif ($match == 1 && $in{'reno'} != $reno2) {
				$match=2;
				push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$host<>$pwd<>$col[$in{'color'}]<>$in{'icon'}<>\n");
				push(@tmp,$_);

			} else { push(@tmp,$_); }
		}
		if ($f) {
			close(DAT);
			close(DAT);&error("不正な返信要求です");
		}
		if (!$oyaChk) {
			close(DAT);
			&error("親記事が存在しません");
		}

		if ($match == 1) {
			push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$host<>$pwd<>$col[$in{'color'}]<>$in{'icon'}<>\n");
		}
		push(@new,@tmp);

		# 更新
		unshift(@new,"$no<>$addr<>$times<>\n");
		seek(DAT, 0, 0);
		print DAT @new;
		truncate(DAT, tell(DAT));
		close(DAT);

	# レス記事の場合：トップソートなし
	} else {

		my ($f,$oyaChk,$match,@new);
		while (<DAT>) {
			my ($no2,$reno2) = split(/<>/);

			if ($in{'reno'} == $no2) { $oyaChk++; }
			if ($match == 0 && $in{'reno'} == $no2) {
				if ($reno2) { $f++; last; }
				$match = 1;

			} elsif ($match == 1 && $in{'reno'} != $reno2) {
				$match = 2;
				push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$host<>$pwd<>$col[$in{'color'}]<>$in{'icon'}<>\n");
			}
			push(@new,$_);
		}
		if ($f) {
			close(DAT);
			&error("不正な返信要求です");
		}
		if (!$oyaChk) {
			close(DAT);
			&error("親記事が存在しません");
		}

		if ($match == 1) {
			push(@new,"$no<>$in{'reno'}<>$date<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$host<>$pwd<>$col[$in{'color'}]<>$in{'icon'}<>\n");
		}

		# 更新
		unshift(@new,"$no<>$addr<>$times<>\n");
		seek(DAT, 0, 0);
		print DAT @new;
		truncate(DAT, tell(DAT));
		close(DAT);
	}

	# クッキー発行
	&set_cookie($in{'name'},$in{'email'},$in{'url'},$in{'pwd'},$in{'icon'},$in{'color'});

	# メール処理
	if ($mailing == 1 && $in{'email'} ne $mailto) { &mail_to; }
	elsif ($mailing == 2) { &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?list=$in{'list'}\n\n";
		exit;

	} else {
		&message('投稿は正常に処理されました');
	}
}

#-------------------------------------------------
#  記事削除
#-------------------------------------------------
sub dele {
	# POST限定
	if ($postonly && !$post_flag) { &error("不正なアクセスです"); }

	if ($in{'no'} eq '' || $in{'pwd'} eq '')
		{ &error("記事Noまたは暗証キーが入力モレです"); }

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

		if ($in{'no'} == $no) {
			$flg++;
			$pw2 = $pw;
			next;
		} elsif ($in{'no'} == $reno) {
			next;
		}
		push(@new,$_);
	}

	if (!$flg) {
		close(DAT);
		&error("該当の記事が見当たりません");
	}
	if ($pw2 eq "") {
		close(DAT);
		&error("暗証キーが設定されていません");
	}
	if (&decrypt($in{'pwd'}, $pw2) != 1) {
		close(DAT);
		&error("暗証キーが違います");
	}

	# 更新
	unshift(@new,$top);
	seek(DAT, 0, 0);
	print DAT @new;
	truncate(DAT, tell(DAT));
	close(DAT);

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

#-------------------------------------------------
#  記事修正
#-------------------------------------------------
sub edit {
	if ($in{'no'} eq '' || $in{'pwd'} eq '') {
		&error("記事Noまたは暗証キーが入力モレです");
	}

	# 修正実行
	if ($in{'job'} eq "edit") {

		# フォーム入力チェック
		&formCheck('edit');
		if ($in{'sub'} eq "") { $in{'sub'} = "無題"; }

		# 禁止ワードチェック
		if ($deny_word) {
			&deny_word($in{'name'});
			&deny_word($in{'comment'});
		}

		if ($autolink) { &auto_link($in{'comment'}); }

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

			if ($in{'no'} == $no) {
				$flg++;
				$pw2 = $pw;
				$_ = "$no<>$reno<>$dat<>$in{'name'}<>$in{'email'}<>$in{'sub'}<>$in{'comment'}<>$in{'url'}<>$hos<>$pw<>$col[$in{'color'}]<>$in{'icon'}<>\n";
			}
			push(@new,$_);
		}

		if (!$flg) {
			close(DAT);
			&error("該当の記事が見当たりません");
		}
		if ($pw2 eq "") {
			close(DAT);
			&error("暗証キーが設定されていません");
		}

		if (&decrypt($in{'pwd'}, $pw2) != 1) {
			close(DAT);
			&error("暗証キーが違います");
		}

		# 更新
		unshift(@new,$top);
		seek(DAT, 0, 0);
		print DAT @new;
		truncate(DAT, tell(DAT));
		close(DAT);

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

	my ($no,$reno,$dat,$nam,$eml,$sub,$com,$url,$hos,$pw,$col,$ico);
	my ($flg,$pw2);
	open(IN,"$logfile") || &error("Open Error: $logfile");
	my $top = <IN>;
	while (<IN>) {
		($no,$reno,$dat,$nam,$eml,$sub,$com,$url,$hos,$pw,$col,$ico) = split(/<>/);
		if ($in{'no'} == $no) {
			$pw2 = $pw;
			$flg = 1;
			last;
		}
	}
	close(IN);

	if (!$flg) { &error("該当の記事が見当たりません"); }
	if ($pw2 eq "") { &error("暗証キーが設定されていません"); }

	if (&decrypt($in{'pwd'}, $pw2) != 1) { &error("暗証キーが違います"); }

	$com =~ s/<br>/\n/g;
	my $pattern = 'https?\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%]+';
	$com =~ s/<a href="$pattern" target="_blank">($pattern)<\/a>/$1/go;

	if ($ImageView == 1) { &header('ImageUp'); }
	else { &header; }

	print <<EOM;
<form>
<input type="button" value="前画面に戻る" onclick="history.back()">
</form>
▽変更する部分のみ修正して送信ボタンを押して下さい。
<p>
<form action="$registcgi" method="post">
<input type="hidden" name="list" value="$in{'list'}">
<input type="hidden" name="mode" value="edit">
<input type="hidden" name="job" value="edit">
<input type="hidden" name="pwd" value="$in{'pwd'}">
<input type="hidden" name="no" value="$in{'no'}">
EOM

	require $formpl;
	&form($nam,$eml,$url,'??',$ico,$col,$sub,$com);

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

#-------------------------------------------------
#  完了文言
#-------------------------------------------------
sub message {
	my $msg = shift;

	&header;
	print <<EOM;
<div align="center">
<hr width="400">
<h3>$msg</h3>
<hr width="400">
<p>
<form action="$bbscgi">
<input type="hidden" name="list" value="$in{'list'}">
<input type="submit" value="掲示板に戻る">
</form>
</div>
</body>
</html>
EOM
	exit;
}

#-------------------------------------------------
#  入力確認
#-------------------------------------------------
sub formCheck {
	local($task) = @_;
	local($ref);

	# POST限定
	if ($postonly && !$post_flag) { &error("不正なアクセスです"); }

	# 他サイトからのアクセス排除
	if ($task ne 'edit' && $baseUrl) {
		$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("不正なアクセスです"); }
	}

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

	if ($iconMode) {
		@ico1 = split(/\s+/, $ico1);
		@ico2 = split(/\s+/, $ico2);
		if ($my_icon) { push(@ico1,$my_gif); }
		if ($in{'icon'} =~ /\D/ || $in{'icon'} < 0 || $in{'icon'} > @ico1) {
			&error("アイコン情報が不正です");
		}
		$in{'icon'} = $ico1[$in{'icon'}];

		# 管理アイコンチェック
		if ($my_icon && $in{'icon'} eq $my_gif && $in{'pwd'} ne $pass) {
			&error("管理用アイコンは管理者専用です");
		}
	}

	@col = split(/\s+/, $color);
	if ($in{'color'} =~ /\D/ || $in{'color'} < 0 || $in{'color'} > @col) {
		&error("文字色情報が不正です");
	}

	# URL
	if ($in{'url'} eq "http://") { $in{'url'} = ""; }
}

#-------------------------------------------------
#  時間取得
#-------------------------------------------------
sub get_time {
	$ENV{'TZ'} = "JST-9";
	$times = time;
	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($times);
	my @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);
}

#-------------------------------------------------
#  メール送信
#-------------------------------------------------
sub mail_to {
	local($msub,$mbody,$email,$ptn);

	# 記事の改行・タグを復元
	$com  = $in{'comment'};
	$com =~ s/<br>/\n/g;
	$ptn = 'https?\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%]+';
	$com =~ s/<a href="$ptn" target="_blank">($ptn)<\/a>/$1/go;
	$com =~ s/&lt;/＜/g;
	$com =~ s/&gt;/＞/g;
	$com =~ s/&quot;/”/g;
	$com =~ s/&amp;/＆/g;

	# メール本文を定義
	$mbody = <<EOM;
投稿日時：$date
ホスト名：$host
ブラウザ：$ENV{'HTTP_USER_AGENT'}

投稿者名：$in{'name'}
Ｅメール：$in{'email'}
参照先  ：$in{'url'}
タイトル：$in{'sub'}

$com
EOM

	# 題名をBASE64化
	$msub = &base64("$title (No.$no)");

	# コード変換
	&jcode::convert(\$mbody, 'jis', 'sjis');

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

	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";
	print MAIL "--------------------------------------------------------\n";
	print MAIL "$mbody\n";
	print MAIL "--------------------------------------------------------\n";
	close(MAIL);
}

#-------------------------------------------------
#  BASE64変換
#-------------------------------------------------
#		とほほのWWW入門で公開されているルーチンを
#		参考にしました。( http://tohoho.wakusei.ne.jp/ )
sub base64 {
	my $sub = shift;
	&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 pastlog {
	local(@data) = @_;

	# 過去ログNoファイル
	open(NO,"+< $nofile") || &error("Open Error: $nofile");
	eval "flock(NO, 2)";
	my $count = <NO>;

	# 過去ログ定義
	my $pastfile = sprintf("%s/%04d.cgi", $pastdir,$count);

	# 過去ログオープン
	my $i = 0;
	my ($flg, @past);
	open(PF,"+< $pastfile") || &error("Open Error: $pastfile");
	eval "flock(PF, 2)";
	while (<PF>) {
		$i++;
		push(@past,$_);
		if ($i >= $pastmax) { $flg++; last; }
	}

	# 規定の行数をオーバーすると次ファイルを自動生成
	if ($flg) {

		# カウントファイル更新
		seek(NO, 0, 0);
		print NO ++$count;
		truncate(NO, tell(NO));

		close(PF);

		# 新過去ログ
		$pastfile = sprintf("%s/%04d.cgi", $pastdir,$count);
		@past = @data;

		open(PF,"> $pastfile") || &error("Open Error: $pastfile");
		print PF @past;
		close(PF);

	} else {
		unshift(@past,@data);

		# 過去ログ更新
		seek(PF, 0, 0);
		print PF @past;
		truncate(PF, tell(PF));
		close(PF);
	}

	close(NO);

	# 新規生成の場合パーミッション変更
	if ($flg) { chmod(0666, $pastfile); }
}

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

	my $flg;
	foreach ( split(/,+/, $deny_word) ) {
		if (index($word,$_) >= 0) { $flg = 1; last; }
	}
	if ($flg) { &error("不適切な投稿のため受理できません"); }
}

#-------------------------------------------------
#  クッキー発行
#-------------------------------------------------
sub set_cookie {
	local(@cook) = @_;
	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]);

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

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

#-------------------------------------------------
#  crypt暗号
#-------------------------------------------------
sub encrypt {
	local($inpw) = @_;
	local(@char, $salt, $encrypt);

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

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

	local $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;
	}
}