#!/usr/bin/perl

#******************************************************************************
#linebbs.cgi - One Line BBS Ver.1.22
#
#Version   	:1.22
#modified  	:2001/05/22
#Copyright 	:The Room
#E-Mail		:dream@lib.net
#URL		:http://dream.lib.net/room/
#
#これはフリー素材です。
#転載・商用目的の利用の際には、メールをお願いします。
#
#******************************************************************************
#1行目のperlのディレクトリ指定は、サーバによって異なります。
#詳しくは、管理者にお聞きください。
#******************************************************************************
#
#画面設定
#
#タイトル
$bbstitle = '【初心者】オンラインダイス【虎の穴】';
#
#ページ上部に表示する題名
$pagetop = '<div align=center><font color=#6060ff size=6>【初心者】オンラインダイス【虎の穴】</font></div>';
#
#ホームページURL
#＊Back to Homeのリンクで戻るところ。
#＊設定しないとリンクは表示されません)
$backhome = 'http://www12.atwiki.jp/sssct/';
#
#BODYタグ設定
$bodytag = '<body onLoad="document.form1.msg.focus()" text=#9090ff bgcolor=#ffffff link=#a0a0ff vlink=#a0a0ff alink=#2020ff>';
#
#******************************************************************************
#
#内部設定
#乱数初期化
srand();
#
#ログのファイル名（パス含む）
$logfile = "./log.dat";
#
#ログ保存の最大行数
$maxline = 200;
#
#初期設定の名前
$newname = "No Name";
#
#初期設定の色
$newcolor = "black";
#
#初期設定の表示行数
$newlines = 16;
#
#時刻表示の色
$timecl = "#9090e0";
#
sub timeset{$timeword = "$mon/$day($week) $hour:$min";}
#            	         ~~~~~~~~~~~~~~~~~~~~
#			#２つの " の間に時刻表示のフォーマットを書きます
#			#以下の変数を書くと、表示されるときに
#			#その値が表示されます
#
#			# $year 年
#			# $mon　月
#			# $day	日
#			# $hour	時
#			# $min	分
#			# $sec	秒
#		        # $week 曜日

#時刻表示のゼロ補完の有無
# 10以下を表示するときは 04 のように頭に 0 を追加します。
# この機能を使う場合は 1 を、使わない場合は 0 を。
$spzero[0] = 0;#月の補完
$spzero[1] = 0;#日の補完
$spzero[2] = 0;#時の補完
$spzero[3] = 1;#分の補完
$spzero[4] = 0;#秒の補完

#グリニッジ標準時からのズレ（秒単位）
$areatime = 32400;

#曜日の設定
# 日〜土の順番です。
@weekday = ('日','月','火','水','木','金','土');

#******************************************************************************
#
#その他の設定
#
#jcode.plの位置
$jcode="./jcode.pl";
#
#メールアドレスの入力・表示を行うなら1を。
$mailadon = 0;
#
#IPアドレス/ホスト名をソースに表示するなら1を。
$ipindicate = 1;
#
@permittag = ('strong');#使用を許可するタグを書きます。
#			#完全に不許可にするには、
#			# @permittag = ();
#			#としてください。
#
@denyhost = ();		#アクセス拒否をするホスト名を入力します。
#			#@denyhost = ("anonymizer","cache*.*",……);
#			#このように入力していきます。
#			#例のように、ワイルドカードも使用できます。
#
#URLが書かれたときに自動的にリンクを貼るなら1を設定。
$autolink = 0;
#
#二重投稿を禁止するなら1を。
$double = 0;
#
#別のページからのアクセスを禁止するなら1を。
$anaccess = 0;
#
#書きこみ字数制限（半角での文字数）
#＊制限したくない場合は、99999 など大きな数値をいれてください。
$maxwrite = 400;
#
#******************************************************************************
#
#スタイルシート設定
#
#使用するスタイルシート
#＊「$stylesheet = <<EOD;」〜「EOD」の間の行にスタイルシートを書きます
#＊inputは入力するボックス、buttonはSubmitなどのボタンを表します。
#＊使わない場合は、削除してください。
$stylesheet = <<EOD;
<style type = "text/css">
<!--
BODY,TD,TH{font-size: 10pt;}
.input 	{border-color:a0a0ff;
		border-style:dotted dotted dotted dotted;
		background-color: f0f0ff;
		}
.button	{border-color:6060ff;
		border-style:dotted dotted dotted dotted;
		background-color: b0b0ff;
		color: 0000ff;
		}
HR{	color:#a0a0ff;}
-->
</style>
EOD
#
#******************************************************************************

#jcode.plの読みこみ
require $jcode;

#データ受け取り
$cl = $ENV{"CONTENT_LENGTH"};
if( $cl > 0 ){
	read(STDIN, $qs, $cl );
}else{
	$qs = $ENV{"QUERY_STRING"};
}

@contents = split(/&/,$qs);
foreach $i (0 .. $#contents) {
	local($key,$text)= split(/=/,$contents[$i]);
	$text =~ s/\+/ /g;
	$text =~ s/%(..)/pack("c",hex($1))/ge;
	$text =~ s/\r\n/\n/g;
	$text =~ s/\n//g;
	&jcode'convert(*text,'sjis');
	$name = $text if $key eq 'name';
	$color = $text if $key eq 'color';
	$lines = $text if $key eq 'lines';
	$msg = $text if $key eq 'msg';
	$mailad = $text if $key eq 'mailad';
}

#環境変数取得
$ip = $ENV{'REMOTE_ADDR'};
$host = gethostbyaddr(pack("C4", split(/\./, $ip)), 2);
$host ||= $ENV{'REMOTE_HOST'};
$host ||= $ip;
$referer=$ENV{'HTTP_REFERER'};
$script=$ENV{'SCRIPT_NAME'};

#アクセス拒否チェック
for ($i=0;$i<=$#denyhost;$i++){
	if ($host =~ /$denyhost/i){&error("あなたの使用しているホストからのアクセスは認められていません。");}
	}

#クッキー取得
for $xx (split(/; */, $ENV{'HTTP_COOKIE'})) {
	($chname, $value) = split(/=/, $xx);
	$value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
	$cookie{$chname} = $value;
	}
$name||=$cookie{'name'};
$color||=$cookie{'color'};
$lines||=$cookie{'lines'};
$mailad||=$cookie{'mailad'};

$name||=$newname;
$color="black";
$lines=45;

#クッキー設定
print "Set-Cookie:name=$name; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n";
print "Set-Cookie:color=$color; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n";
print "Set-Cookie:lines=$lines; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n";
print "Set-Cookie:mailad=$mailad; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n" if ($mailadon);

#ダイス処理

$msg =~ s/<strong>//;
$msg =~ s/<\/strong>//;
$msg =~ s/\+/@/g;
while($msg =~ /(\d*@?\d*d\d+@?\d*)/){
	$msg = &dice_roll($msg);
}
$msg =~ s/@/\+/g;
$msg =~ s/ＤＤＤ/d/g;

if ($msg eq ""){
	open (IN,"$logfile");
	eval{flock(IN,1);};
	for (1 .. $lines){
		push(@log,<IN>);
		}
	close (IN);
	}else{
	&tagcheck;
	open (IO,"+<$logfile");
	eval{flock(IO,2)};
	@log=<IO>;
	@y2=split(/<>/,$log[0]);
	if (($y2[4] eq $msg) && ($double)){
		close(IO);
		&error("二重投稿は禁止されています。");
		}
	unshift(@log,time() . "<>$name<>$color<>$mailad<>$msg<>$ip/$host<>\n");
	if ($#log >= $maxline){pop(@log);}
	truncate(IO,0);
	seek(IO,0,0);
	print IO @log;
	close (IO);
	}

&hphead;

#メッセージ入力欄の表示
print <<EOD;
<form method="post" action="linebbs.cgi" name="form1">
<b>ハンドル</b><input type="text" class="input" name="name" size="20" value="$name">
EOD

print " / <b>Mail</b><input type=\"text\" class=\"input\" name=\"mailad\" size=\"10\" value=\"$mailad\">" if ($mailadon);
print <<EOD;
 / <b>アクション</b> <input type="text" class="input" name="msg" size="64">
<input type="submit" class="button" value="どりゃ！">
</form>
<hr>
EOD

#メッセージ表示
for ($i=$lines-1;$i>=0;$i--){
	next if $log[$i] eq "";
	@y2=split(/<>/,$log[$i]);
	($sec,$min,$hour,$day,$mon,$year,$week) = gmtime($y2[0]+$areatime);
	$mon++;
	$year += 1900;
	if (($spzero[4]) && ($sec < 10)){$sec="0$sec";}
	if (($spzero[3]) && ($min < 10)){$min="0$min";}
	if (($spzero[2]) && ($hour < 10)){$hour="0$hour";}
	if (($spzero[1]) && ($mon < 10)){$mon ="0$mon";}
	if (($spzero[0]) && ($day < 10)){$day ="0$day";}
	$week=$weekday[$week];
	&timeset;
	if (($y2[3] ne "") && ($mailadon)){
		$a1=" <a href=\"mailto:$y2[3]\">&gt;</a> ";
		}else{
		$a1=" &gt; ";
		}
	if ($ipindicate){
		$a2 ="\n<!--$y2[5]-->";
		}else{
		$a2="";
		}
	print "<font color=$y2[2]>$y2[1]</font>$a1<font color=$y2[2]>$y2[4]</font> <font color=$timecl><small>[$timeword]</small></font><br>$a2\n";
	}

&hpfoot;

#******************************************************************************
sub tagcheck{
#メッセージ成形

#荒らし対策：別ページからのアクセス禁止
if (($anaccess) && ($referer !~ /$script/i)){
	&referererror;
	}

#荒らし対策：書きこみ文字数制限
#$msg = substr($msg,0,$maxwrite);

if(length($msg) > $maxwrite){
	$msg = "エラー：処理結果が100文字を越えてしまいました。";
}

#荒らし対策：許可タグ以外を無効化
$msg =~ s/[\t\a]//g;
$msg =~ s/&/&amp;/g;
$msg =~ s/</\t/g;
$msg =~ s/>/\a/g;
foreach (@permittag){
	$msg =~ s/\t(\/?$_)\a/<$1>/ig;
	$msg =~ s/\t$_ ([^\a]*)\a/<$_ $1>/ig;
	}
$msg =~ s/\t/&lt;/g;
$msg =~ s/\a/&gt;/g;
$msg =~ s/&amp;/&/g;

foreach (@permittag){
	if (($msg =~ /<$_/i) && ($msg !~ /<\/$_/i)){$msg .="<\/$_>";}
	}

if (($msg !~ /<img/i) && ($autolink)){
	#URLには自動的にリンクを行う
	$msg =~ s/(http:\/\/[a-zA-Z0-9\.\/\-+#_?~&%=^\@:;]+)/<A HREF="$1">$1<\/A>/g;
	}
}
#******************************************************************************
sub error{
#エラー表示
&hphead;
print <<EOD;
<div align=center>
<br><br><br>
<b>$_[0]</b><br>
<br><br><br>
ブラウザのボタンで前のページに戻ってください。<br>
<br><br><br><br>
</div>
EOD
&hpfoot;
}
#******************************************************************************
sub hphead{
#ヘッダ表示
print "Content-type: text/html; charset=shift_jis\n\n";
print <<EOD;
<html lang="ja">
<head>
<meta http-equiv="content-type" content="text/html; charset=shift_jis">
<meta http-equiv="pragma" content="no-cache">
<title>$bbstitle</title>
$stylesheet
</head>
$bodytag
$pagetop
<hr>
EOD
}
#******************************************************************************
sub hpfoot{
#フッタ表示
#
#著作権表示を消すことを禁じます。
print <<EOD;
<hr>
<div align="center">
<a href="http://dream.lib.net/room/" target="_blank">One Line BBS by The Room</a></div><br>
</body></html>
EOD
exit;
}
#******************************************************************************
sub dice_roll{

	local($msg)=@_;
	local($w,$x,$y,$z,$d,$roll,$tot);

	$msg =~ /(\d*@?\d*d\d+@?\d*)/;
	$dcode=$1;

	$x = $1 if $dcode =~ /(\d+)d/;
	$x = 1  if $dcode !~ /(\d+)d/;

	$dcode =~ /d(\d+)/;
	$y = $1;

	$z = 0;
	$z = $1 if $dcode =~ /@(\d+)$/;

	$w = 0;
	$w = $1 if $dcode =~ /^(\d+)@[d\d]/;

	$roll = $dcode." <strong>=";
	$roll .= " ".$w." @" if $w != 0;
	$roll .= " \[";
	$roll =~ s/d/ＤＤＤ/;
	$tot = 0;

	if($x<=100){
		for(1..$x){
			$d = int(rand()*$y+1);
			$roll .= " ".$d if $tot == 0;
			$roll .= " @ ".$d if $tot != 0;
			$tot += $d;
		}

		$roll .= " \]";
		$roll .= " @ ".$z if $z != 0;
		
		$tot += $w;
		$tot += $z;
		$roll .= " = $tot<\/strong>";

		$msg =~ s/(\d*@?\d*d\d+@?\d*)/$roll/;
	}else{
		$msg="エラー：１００個以上のダイスを振ることはできません";
	}

	return($msg);
}