#!/usr/local/bin/perl

#-------- 基本データ所得 ---------------
require 'jcode.pl';                     # jcode.plのパス 644

$usrdir    = 'userdata/';               # ユーザデータを格納するフォルダ
$dat       = 'dat';                     # ユーザーデータの拡張子(通常dat)
$admpas    = 'bbs0000';                 # 管理者パスワード

$recordcgi = 'record.cgi';              # このファイルのファイル名(755|705)
$bbsdat    = 'bbs.cgi';                 # 掲示板ログファイル名    (666|606)
$bbsbak    = 'bbsbak.cgi';              # 掲示板過去ログファイル名

$htitle    = 'BBS / myrecord : SoS II'; # ヘッダタイトル
$tblwth    = '100%';                    # テーブルの横幅
$fntsze    = '12';                      # フォントサイズ
$bgcolor   = '#33CC66';                 # テーブル背景色

#-------- コメントデコレーション -------
@deckey    = (':S:',':I:');             # ←を入力すると↓に変換する
@decwrd    = ('<font color=brown><b>SALE!</b></font>','<font color=brown><b>告知!</b></font>');

#-------- LOCK FILE --------------------
$lockkey   = 1;                         # ファイルのロック(Mkdir = 1,Symlink=2,No = 0)
$lockfile  = './sos.lock';              # ロックファイル名＆パス
$method = 'POST';                       # アクションメソッド (POST Only)

#-------- メイン動作実行 ---------------
&decode;
&header;
&lock;

if    ($Fm{'mode'} eq 'my_record') { &my_record; }
elsif ($Fm{'mode'} eq 'BBS')       { &bbs; }
elsif ($Fm{'mode'} eq 'write')     { &write; }
else                               { &bbslogin; }

&unlock;
&footer;
exit;


#=======《 Sub My Record 》===============================================#
sub my_record {
	@rcdlines = &get_user("$Fm{'id'}");
	if ($ps ne $Fm{'ps'}) { &error("パスワードが違います"); }
	if (!@rcdlines) { print qq|あなたの記録は白紙です<HR>\n|; }
	else { print qq|<B>$nmの記録</B><HR>\n|; }
	foreach $line (@rcdlines) { print qq|$line<BR><HR>\n|; }
	$ct = 0;
	&userout;
}


#=======《 Sub BBS login 》===============================================#
sub bbslogin {
	&cookie_get;
	print qq|
<TABLE border=0 bgcolor=$bgcolor width=$tblwth><TR>
	<FORM method="$method" action="$recordcgi">
	<TD>
		$htitle へようこそ
		<CENTER>
		<HR>
		<TABLE border=0 bgcolor=$bgcolor width=$tblwth><TR>
			<TD>
				利用規約：この掲示板をご利用になる際は、下記の点を厳守願います。
				<HR>
				<UL>
					<LI>誹謗中傷、名誉毀損、プライバシーの侵害は禁止致します。
					<LI>この掲示板で知りえた情報を第三者に漏洩する事は禁止致します。
					<LI>管理者・投稿者の両者の許可無く投稿内容を転載する事を禁止致します。
					<LI>営利目的の書き込みを禁止致します。
					<LI>荒らし行為は禁止致します。
					<LI>営利・非営利に関わらず、１８禁・販売・マルチビジネスなどに関する書き込みを禁止致します。
					<LI>管理者の許可がある場合においては、許可された目的範囲に限り、限定的に上記の規約を逸脱する事を認める場合があります。<BR><BR>
					<LI>何れかの規則の一つにでも違反された場合には、会員登録の抹消・過去に遡っての使用ＩＰ情報の公開等を行います。
					<LI>日本国の法律に違反する内容の書き込みが行われた場合、および公的な司法・行政機関からの要請があり、かつ必要であり合法であると認められる場合には、当方の保有する会員情報・ＩＰ情報の提供をする場合があります。<BR><BR>
					<LI>予\告無く掲示板サービスを停止する事があります。また、掲示板のログを消去する事があります。
					<LI>予\告無く掲示板規約を改正する事があります。<BR><BR>
					<LI>掲示板のご利用には、当方で運営しているブラウザゲーム Script of SAGA II への登録が必要です。
					<LI>表\示されなくなったログは一定期間保管してありますが、削除しない事を約束する物ではありません。また、ログを公開する事を約束する物ではありません。
					<LI>連続書き込みは出来ません。凡そ１０分に１回程度が上限です。
					<LI>１００件を越えると、古いものから順に表\示されなくなります。
					<LI>タグは使えません。 :#000000: という形式で、色だけは指定可能\です。				</UL>
				<HR>
			</TD>
		</TR></TABLE>
		<INPUT type="hidden" name="mode" value="BBS">
		user-ID:<INPUT type="text" name="id" size="4" value="$c_id">
		password:<INPUT type="password" name="ps" size="8" value="$c_pass">
		<INPUT type="submit" value="Login">
		<HR>
		</CENTER>
	</TD>
	</FORM>
</TR></TABLE>
|;
}


#=======《 Sub BBS 》=====================================================#
sub bbs {
	if (!$Fm{'page'}) { $Fm{'page'} = 1 }
	if ($Fm{'mode'} ne 'write') {
		if ($Fm{'id'} ne 'ADMIN' || $Fm{'ps'} ne $admpas) {
				@rcdlines = &get_user("$Fm{'id'}");
		} else {
			$nm = '管理者'; $id = $Fm{'id'}; $ps = $Fm{'ps'};
		}
		open(IN,"$bbsdat") || &error("$bbsdat　 読みこみエラー");
		@bbslines = <IN>;
		close(IN);
	}
	($no_lt) = $bbslines[0] =~ /No.(\d+):/;
	($no_st) = $bbslines[$Fm{'page'}-1] =~ /No.(\d+):/;
	$no_ed = $no_st - 14;
	if ($no_ed < 1) { $no_ed = 1; }
	print qq|
<TABLE border=0 bgcolor=$bgcolor width=$tblwth><TR>
	<TD>$htitle</TD>
</TR></TABLE>
<TABLE border=0 bgcolor=$bgcolor width=$tblwth><TR>
	<TD>
		<TABLE border=0 bgcolor=$bgcolor width=$tblwth><TR>
			<FORM method="$method" action="$recordcgi">
			<TD>
			<CENTER>
				No. $no_ed 〜 $no_st 表\示中|;
	if ($#bbslines > 14) { print qq| ： <SELECT name="page">|;
		$start = $no_lt; $end = $start - 14; if ($end < 1) { $end = 1; }
		$page = 1;
		while ($start > 1) {
			print qq|<OPTION value="$page">$end 〜 $start|;
			$start -= 15; $end -= 15; if ($end < 1) { $end = 1; }
			$page += 15;
		}
		print qq|
			</SELECT>
			<INPUT type="hidden" name="mode" value="BBS">
			<INPUT type="hidden" name="id" value="$id">
			<INPUT type="hidden" name="ps" value="$ps">
			<INPUT type="submit" value="ページを切り替える">|;
	}
	print qq|
			</CENTER>
			</TD>
			</FORM>
		</TR></TABLE>
		<TABLE border=0 bgcolor=$bgcolor width=$tblwth><TR>
			<TD>
				<DIV align="right"><A href="$recordcgi">利用規約</A></DIV>
|;
	if (!@bbslines) { print qq|
				<CENTER>掲示板の記録は白紙です</CENTER><HR>| }
	foreach $count ($Fm{'page'} - 1 .. $Fm{'page'} + 12) {
		if (!$bbslines[$count + 1]) { $temp = $count; last; }
		$temp = $count + 1;
		$bbs = $bbslines[$count];
		foreach (0 .. $#deckey) { $bbs =~ s/$deckey[$_]/$decwrd[$_]/g }
		($date,$log) = split(/<>/,$bbs,2);
		$date = "<FONT color=green>$date</FONT>";
		print qq|$date$log<HR>| }
		$bbs = $bbslines[$temp];
		($date,$log) = split(/<>/,$bbs,2);
		$date = "<FONT color=green>$date</FONT>";
		print qq|$date$log
			</TD>
		</TR></TABLE>
		<TABLE border=0 bgcolor=$bgcolor width=$tblwth><TR>
			<FORM method="$method" action="$recordcgi">
			<TD>
			<CENTER>
				<TEXTAREA name="write" rows=3 cols=80></TEXTAREA>
				<INPUT type="hidden" name="mode" value="write">
				<INPUT type="hidden" name="id" value="$id">
				<INPUT type="hidden" name="ps" value="$ps">
				<INPUT type="submit" value="新規投稿">
			</CENTER>
			</TD>
			</FORM>
		</TR></TABLE>
	</TD>
</TR></TABLE>
|;
}


#=======《 Sub BBS Write 》===============================================#
sub write {
#	if ($l) { require $logcgi; &log('BBS'); }
	if ($Fm{'id'} ne 'ADMIN' || $Fm{'ps'} ne $admpas) {
		@rcdlines = &get_user("$Fm{'id'}");
	} else {
		$nm = '管理者'; $id = $Fm{'id'}; $ps = $Fm{'ps'};
	}
	open(IN,"$bbsdat") || &error("$bbsdat　 読みこみエラー");
	@bbslines = <IN>;
	close(IN);
	if ($Fm{'write'} =~ /:#(\w\w\w\w\w\w):/i) {
		$set  = $Fm{'write'} =~ s/:(#\w\w\w\w\w\w):/<FONT color=$1>/g;
		foreach (1 .. $set) {
			$Fm{'write'} .= '</FONT>';
		}
	}
	($no) = $bbslines[0] =~ /No.(\d+):/;
	$no++;
	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
	@week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	$mon++;
	$year -= 100;
	$date = sprintf("%02d/%02d/%02d(%s) %02d:%02d:%02d",$year,$mon,$mday,$week[$wday],$hour,$min,$sec);
	$temp = substr($date,0,17);
	if ($Fm{'id'} ne 'ADMIN' || $Fm{'ps'} ne $admpas) {
		if ($bbslines[0] =~ /$temp/ && $bbslines[0] =~ /\[$id:$nm\]/)
			{ print qq|<FONT color=red><B>連続投稿は出来ません。１０分程度間隔を空けて下さい</B></FONT><BR>|; return }
		$temp = unshift(@bbslines,"No.$no:$date \[$id:$nm\]<>： $Fm{'write'}\n");
	}
	else {
		$temp = unshift(@bbslines,"No.$no:<FONT color=red>$date \[$id:$nm\]</FONT><>： $Fm{'write'}\n"); }
	if ($temp > 100) {
		$temp = pop @bbslines;
		open(OUT,">>$bbsbak") || &error("$bbsbak　 書き込みエラー");
		print OUT $temp;
		close(OUT); }
	open(OUT,">$bbsdat") || &error("$bbsdat　 書き込みエラー");
	print OUT @bbslines;
	close(OUT);
	&bbs;
}


#=======《 Sub Get User 》================================================#
sub get_user {
	open(IN,"$usrdir$_[0]\.$dat") || &error("ID $_[0]は存在しません");
	@_ = <IN>;
	close(IN);
	if (!@_) { &error("読みこみエラー") }
	($id,$nm,$ps,$jb,$ig,$sp,$bp,$bn,$ak,$dd,$hp,$xp,$ab,$db,$av,$wn,$lz,$dt
	,$mn,$bg,$xi,$tm,$lf,$fe,$cm,$is,$ht,$fg,$rw,$kl,$dr,$rt,$cr,$ft,$lv,$ex
	,$sl,$jf,$js,$re,$ct,$co,$tw,$hm,$pt,$cd,$ci) = split(/<>/,$_[0]);
	&error("パスワードが違います") if $Fm{'ps'} ne $ps && $Fm{'ps'} !~ /$admpas/;
	$userline = shift(@_);
	return @_;
}


#=======《 Sub User Out 》================================================#
sub userout {
	$line = join('<>',$id,$nm,$ps,$jb,$ig,$sp,$bp,$bn,$ak,$dd,$hp,$xp,$ab
	,$db,$av,$wn,$lz,$dt,$mn,$bg,$xi,$tm,$lf,$fe,$cm,$is,$ht,$fg,$rw,$kl
	,$dr,$rt,$cr,$ft,$lv,$ex,$sl,$jf,$js,$re,$ct,$co,$tw,$hm,$pt,$cd,$ci,"\n");
	unshift (@rcdlines,$line);
	open(OUT,">$usrdir$id\.$dat") || &error("Write Error : $id\.cgi");
	print OUT @rcdlines;
	close(OUT);
}


#=======《 Sub Lock 》====================================================#
sub lock {
	return if !$lockkey;
	local($flag) = 3;
	if	($lockkey == 1) {
		rmdir($lockfile) if (time - (stat($lockfile))[9] > 60);
		while (!mkdir($lockfile,0755)) {
			--$flag or &error('現在、サーバが混み合っています',1);
			sleep(3);
		}
	}
	elsif ($lockkey == 2) {
		unlink($lockfile) if (time - (stat($lockfile))[9] > 60);
		while (!symlink(".",$lockfile)) {
			--$flag or &error('現在、サーバが混み合っています',1);
			sleep(3);
		}
	}
}


#=======《 Sub Unlock 》==================================================#
sub unlock {
	if	($lockkey == 1) { rmdir($lockfile)  }
	elsif ($lockkey == 2) { unlink($lockfile) }
}


#=======《 Sub Decode 》==================================================#
sub decode {
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		$post = 1;
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
		@pairs = split(/&/, $buffer);
	} else { @pairs = split(/&/, $ENV{'QUERY_STRING'}); }

	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		&jcode'convert(*value,'sjis');

		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/"/&quot;/g;
		$value =~ s/\,/，/g;
		$value =~ s/△/▲/g;
		$value =~ s/\r\n/<br>/g;
		$value =~ s/\r/<br>/g;
		$value =~ s/\n/<br>/g;

		$Fm{$name} = $value;
	}
}


#=======《 Sub Header 》==================================================#
sub header {
print << "END_of_HD";
Content-type: text/html

<HTML>
<HEAD>
	<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
	<TITLE>$htitle</TITLE>
	<STYLE TYPE="text/css">
	<!--
		A:link        {text-decoration: none}
		A:visited     {text-decoration: none}
		A:hover       {text-decoration: none}
		body,tr,td,th {font-size      : $fntsze}
	-->
	</STYLE>
</HEAD>
$body
<CENTER>
END_of_HD
}


#=======《 Sub Footer 》==================================================#
sub footer {
print << "END_of_CP";
</CENTER>
<!-- vvv 著作権表示部 vvv 削除・改変禁止 vvv -->
<CENTER>
SoS II &copy;
<A href="http://www.area-s.com/"  target="_blank"><B>MISSINGLINK</B></A>
 &
<A href="http://www.fayreal.com/" target="_blank"><B>Fayreal</B></A><BR>
BBS & myrecord for Script of SAGA II<BR>
<B><A href="mailto:sion_jam\@hotmail.com" target="_blank">SION</A>
/
<A href="http://www.sionjam.net/" target="_blank">SION jam</A></B>
<BR>
<!-- ^^^ 著作権表示部 ^^^ 削除・改変禁止 ^^^ -->
END_of_CP
	foreach (@editor) { print qq|<BR>$_|; }
	print qq|</CENTER>\n</BODY>\n</HTML>\n|;
}


#=======《 Sub Error 》===================================================#
sub error {
	print << "END_of_ERR";
<CENTER>
	<HR width=80%>
	<B><FONT color=#FF0000>$_[0]</FONT></B>
	<HR width=80%>
</CENTER>
END_of_ERR
	&footer;
	exit;
}


#=======《 Sub Get Cookie 》==============================================#
sub cookie_get {
	@pairs = split(/;/,$ENV{'HTTP_COOKIE'});
	foreach $pair (@pairs) {
		local($name, $value) = split(/=/, $pair);
		$name =~ s/ //g;
		$DUMMY{$name} = $value;
	}
	@pairs = split(/,/,$DUMMY{'SOS2'});
	foreach $pair (@pairs) {
		local($name, $value) = split(/:/, $pair);
		$COOKIE{$name} = $value;
	}
	$c_name  = $COOKIE{'name'};
	$c_pass  = $COOKIE{'pass'};
	$c_id	= $COOKIE{'id'};
}