#! /usr/bin/perl
#うまく動かない時は↑を
#! /usr/local/bin/perl
#ってするといいかも・・・
#
#かえでちゃっとCute(ゆいちゃっとNT:pref.cgi)	Ver.1.0
#	Japanese	version--sjis表示専用
#	Copyright(c)	1997	yui@cup.com
#
#	Maintained by Yui Suzuki <yui@cup.com>
#	http://www.cup.com/yui/
#
#	Modified By Kaede Otogiri <kaede@ikoi.to>
#	http://otogiri.pos.to/
##
#pref.cgiは、chat.cgiとenter.cgiで、共通して使われるサブルーチン集です。

sub init{	#初期設定など
#=====基本設定=====
#退室後のページは、他のＨＰにも変えられます。
$endpage= 'http://otogiri.pos.to/';#退室後のＵＲＬ
$title = 'かえでちゃっとCute';	#チャットのタイトル
$ctxt = 'BLACK';	#文字の色（標準）
$clink = 'RED';	#文字の色（リンク）
$cbg = '#ffeeee';	#背景色
$ibg = '';	#壁紙のＵＲＬ（空のときは壁紙無し）
#入・退室のアナウンサーの画像
$adminimg = 'gif/biguru.gif';
#入・退室のアナウンサーの名前
$adminname = '管理人';
#入・退室のアナウンサーの色
$admicolor = 'blue';
#入室メッセージ
$inmessage = 'さん、おいでやすぅ。';
#退室メッセージ
$outmessage = 'さん、またきておくれやすぅ。';
#入・退室メッセージの文字色
$iocolor = 'red';
#電報メッセージ(Ver.3.0)
$secretms = '<from>さんから<to>さんへの電報です。';
#電報メッセージの色(Ver.3.0)
$secretcl = 'darkviolet';
#ロムの人数表示（0：非表示、1：表示）(Ver.3.1)
$romnprn = 1;
#ホスト情報や発言時間の色(Ver.3.0から基本設定)
$hostcol = '#888888';
#発言ログの形式(Ver.3.0から基本設定)
#		0=ＨＮと発言と時間
#		1=ＨＮと発言と時間とホスト名（推奨）
#		2=ＨＮと発言と時間とコメント化したホスト名
#		3=ＨＮと発言と時間とＩＰアドレス
#		4=ＨＮと発言と時間とコメント化したＩＰアドレス
#		5=ＨＮと発言と時間とコメント化したＩＰアドレスとホスト名
#		6=ＨＮと発言と時間とホスト名とコメント化したＩＰアドレス
$logform = 1;
#画像の幅（ピクセル数）
$imgwdt=48;
#画像リスト（""で囲んでね）
@imglst = ("gif/tgsit.gif","gif/usakof.gif","gif/usapyonf.gif","gif/otosigo.gif","gif/oiradrg.gif","gif/hebi.gif","gif/nana.gif","gif/kana.gif");
#=====基本設定終わり=====

#=====初級設定=====
#発言窓最上段のリンク先リスト（ＨＰタイトルとＵＲＬは”=”で区切ってまとめて""で囲んでね）
#	注：文字化けする場合は化けた文字の直前に”\”を一文字入れて下さい。
@links = ("乙霧楓。’ｓるぅむ=http://otogiri.pos.to/","ゆいのホームページ=http://www.cup.com/yui/");

#データの入るフォルダ（ログファイルや発ラン、アクセス制限などのファイルは全部この中に入ります）
#	注：安全のため他の名前に変更しておいて下さい。（半角英数文字しか使えません）
#	※電報が覗かれる危険があります。
$folder='log';

#文字色のリスト（色の表示名と名前（又はＲＧＢ値）は”=”で区切ってまとめて""で囲んでね）
@ctxts = ("黄=yellow","レモン=lemonchiffon","薄黄色=khaki","緑=green","若葉=springgreen","深緑=darkgreen","ライム=lime","黄緑=lawngreen","ライムグリーン=limegreen","薄黄緑=palegreen","オリーブ=olive","青=blue","紺=darkblue","薄青=royalblue","薄青=dodgerblue","暗薄青=lightseagreen","鉄青色=steelblue","薄エメラルド=turquoise","スカイブルー=skyblue","暗水色=darkcyan","暗スカイブルー=deepskyblue","水色=aqua","アクアマリン=aquamarine","エメラルド色=darkturquoise","紫=purple","深マジェンタ=darkmagenta","深紫=darkviolet","深桃=deeppink","薄紫=violet","マジェンタ=magenta","ピンク=pink","薄桃=hotpink","赤紫=mediumorchid","青紫=mediumslateblue","薄紅=mediumvioletred","赤=red","紅=crimson","オレンジ=orange","柿=orangered","薄柿=peachpuff","白=white","灰=darkgray","暗灰=dimgray","暗灰=darkslategray","薄灰=gray","黒=black","茶=brown","チョコレート=chocolate","薄赤茶=palevioletred","薄赤茶=lightsalmon","赤茶=salmon","暗茶=sienna","薄黄土=darkkhaki","黄土=peru","薄茶=lightcoral","暗金=darkgoldenrod","金=gold","暗柿=indianred","暗紫=indigo","ラベンダー=lavender","銀=silver","マロン=maroon","灰=slategray");

#顔文字のリスト（顔文字を""で囲んでね。"を顔文字に含める時は\"ってするといいよ）
@kaolist = ("(＾＾)","(＾＾；)","(=＾＾=)","(；；)","(＠＠；)","(-_-)zzz","＼(~o~)／","m(__)m","(^_-)-☆","φ(.. )　めもめも","(;_;)/~~~","(^^)/~~~","(+_+)","((((((^_^;)","(^-^;","(?_?)え?");
#顔文字は、最初の6個は残してね。
#ロックファイルを使用するなら、#を消す。（ログファイルが壊れにくくなります）
#	一部のサーバーではロックファイルを使用できません。
#$lock = 'lock';
#=====初級設定終わり=====

#=====中級設定=====
#アクセス制限用、アクセス制限を使用するなら、ファイル名をセット。
$kill_file = '';
#$kill_file = 'kill.dat';

#任意の発言をクリアする管理者向けコマンド設定。（$admincomが空の時はコマンド無効）
$admincom = 'cmd';

$rank_file = 'rank.dat';	#発言ランキング記録（発言ランキングがいらなければファイル名を空に）
$sanka_file = 'sanka.dat';	#参加記録ファイル
$chat_file = 'chat.dat';	#チャットログ(電報機能を使う場合ファイル名を変更したほうが安全です)
$max = 50;	#ログの最大行数
$denpo = 1;	#電報を使う時「1」、使わない時「0」にする。(Ver.3.1)

#連続発言禁止（0：許可、1以上：設定数以内の行数に同一発言が有れば発言キャンセル）(Ver.3.0)
$repavoid = 1;
#発言間隔設定（0：制限なし、1以上：設定数以内の秒数の同一ホストからの発言をキャンセル）(Ver.3.0)
#　但し一部の携帯端末やブラウザの場合は0に設定した場合、強制的に発言許可間隔が５秒以上になります
$secavoid = 0;

#e-mail未設定時のタグ禁止（0：タグ許可、1：タグ禁止）(Ver.3.0)
$tgeml = 0;
#=====中級設定終わり=====

#=====上級設定=====
#ランキングファイルをクリアするコマンド設定。（$rankresetが空の時はコマンド無効）
#	注：通常はセットしないで下さい。
$rankreset = '';

#禁止タグリスト（リストが空の時はタグ禁止）
@denytags = ("<pre","<meta","<body","<html","<applet","<script","<.*width","<noscript","<embed","<.*hight","<title","<!--","<.*mailbox:","<plain","<.*font-size","<form","<server","<.*cols","<.*rows","<.*mailto:","<input","<object","<select","<textarea","<img.*cgi","<img.*JavaScript:","<bgsound","style=","<style","/con");
#@denytags = ();

#書き込み許可ＵＲＬリスト（コンマ区切りで、先頭の”http://”は省略すること。空のときは簡易制限）
$refurllist='';
#クッキーチェック（0：OFF、1:ON）(Ver.2.0)
#	注：ONの方がセキュリティは強力ですがブラウザがクッキーオフの設定だと発言できません。
#		（ブラウザがネットスケープ又はインターネットエクスプローラの場合）
$cookiechk = 0;
#=====上級設定終わり=====

#----------------ここから下は修正しないで！----------------
$method = 'GET';#やっぱり、GETよねぇ〜
if($rank_file){$rank_file = $folder . "/" . $rank_file;}
if($sanka_file){$sanka_file = $folder . "/" . $sanka_file;}
if($chat_file){$chat_file = $folder . "/" . $chat_file;}
if($gyakutan){$gyakutan = $folder . "/" . $gyakutan;}
$body="<BODY BGCOLOR=\"$cbg\" TEXT=\"$ctxt\" LINK=\"$clink\" VLINK=\"$clink\" ALINK=\"$clink" ;
if($ibg){
	$body = $body . '" background="' . $ibg. '">';
	}
else{
	$body = $body . '">';
	}
$metacode = '<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=x-sjis">';#SJIS認識させる
####アクセス制限ここから
#$host = &gethost;if($host=~/bmc/){$host="ppp753.master.ad.jp";}
#$host=$ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'};
@host1= &gethost;
$host = $host1[0];
$hostip = $host1[1];
$hostip2 = $ENV{'REMOTE_ADDR'};
if($kill_file){
	$kill_file = $folder . "/" . $kill_file;
	if(-f $kill_file){
		open(DB,"$kill_file") || die "Cannot Open Log File $kill_file: $!";
			@lines2 = <DB>;	close(DB);
		foreach $line (@lines2) {
			next if(length($line)<4);	chop $line;
			if( $host=~/$line/ ){print "Status: 404\n\n";exit;}
			if( $hostip=~/$line/ ){print "Status: 404\n\n";exit;}
			if( $hostip2=~/$line/ ){print "Status: 404\n\n";exit;}
			@lines3 = split(/\*/,$line);
			$killc = @lines3;
			$killf = 0;
			foreach $lines4 (@lines3) {
				if($host=~/$lines4/){++$killf;}
				}
			if( $killf == $killc ){print "Status: 404\n\n";exit;}
			}
		}
	else {open(DB,">$kill_file");close(DB);}
	}
####アクセス制限ここまで
#ロックファイル
if($lock){
	$lockfile = $lock . '/lock-file.lock';
	$retry = 5;
	while (!symlink(".", $lockfile)) {
	if (--$retry <= 0) { print "Status: 204\n\n"; unlink($lockfile); exit; }
	sleep(1);
		}
	}
#ロックファイルここまで
}#init END

sub ended{	#unlinkとexitを行うためだけのもの。
if($lock){unlink($lockfile);}#ロックファイルを使用するなら..。
print "Content-type: text/plain\n\n $_[0] \n"if($_[0]);#この行は削除可です。
	exit;
}#ended END

sub refchk{	#書き込み許可ＵＲＬ以外の書き込み対策
	$mozilla = $ENV{'HTTP_USER_AGENT'};
	$refer = $ENV{'HTTP_REFERER'};
	$cookie = $ENV{'HTTP_COOKIE'};
#携帯端末対策(強制的に発言許可間隔を５秒以上に設定)
	if((($mozilla =~ m!Mozilla/1.!) || ($mozilla =~ m!Mozilla/2.!) || ($mozilla =~ m!Mozilla/3.!) || (($mozilla =~ /Mozilla/)==NULL)) && ($refer eq '')){$refcnt++;if($secavoid == 0){$secavoid = 5;}}
#携帯端末対策終わり
	if($refurllist eq ''){$refurl[0]='';}
	else {@refurl = split(/,/,$refurllist);}
	if($entf == 1){$urlopt='';}
	else{$urlopt='.*email=.*&reload=';}
	foreach $refurl (@refurl) {
		if($refer =~ m!^http://$refurl$urlopt!){$refcnt++;}
		if($refer =~ m!^http%3A//$refurl$urlopt!){$refcnt++;}
		if($refer =~ m!^http%3a//$refurl$urlopt!){$refcnt++;}
		if($refer =~ m!^$refurl$urlopt!){$refcnt++;}
		}
	if(($cookiechk == 1) && ($entf != 1) && ($mozilla =~ /Mozilla/) && (($cookie =~ /yuidata=/)==NULL)){$refcnt=0;}
	if(($mozilla eq "") && (($host = /.*skyweb.*ne.jp.*/) == NULL)){$refcnt=0;}
	if($refcnt<1){$chat = '';if($refer ne ''){$name = $host;}}
}#refchk END

sub decode{	#一般的なデコード＆変数への代入
$buffer = $ENV{'QUERY_STRING'};
@pairs = split(/&/,$buffer);
	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/\t/ /g;$value =~ s/</\t/g;$value =~ s/\n//g;
		$FORM{$name} = $value;
	}
$name = $FORM{'name'};#	$name =~ s/ //g; $name =~ s/　//g;
$name =~ s/\t/&lt;/g;	$name = $host if (!$name);
$color = $FORM{'color'};	$color='red' if(!$color);
@color3 = split(/"/,$color);$color = $color3[0];
$mode = $FORM{'mode'};	$reload = $FORM{'reload'};
$email = $FORM{'email'};	$window =$FORM{'window'};
$fcimg = $FORM{'fcimg'};$cute = $FORM{'cute'};
}#decode END

sub jikan{#$dateに時刻を代入します。
	$times = time;#18時間時差があるなら、$times = time+18*60*60とする。
	($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($times);
	$min = "0$min" if ($min < 10);	$month++;
	$youbi = ('日','月','火','水','木','金','土') [$wday];
	$date = "$month/$mday($youbi)$hour:$min";
}#jikan END

sub sanka{#ここで、アクセス記録をとる。
if(-f $sanka_file){
	open(LOG,"$sanka_file") || &ended('$sanka_file open error');
	seek(LOG,0,0);	@sanka=<LOG>;
	close(LOG);
	}
$romnum=0;
$flag=1;
foreach $line (@sanka) {
	($timerec, $handle, $host2, $nmcl,$dmy) = split(/\t/, $line);
	if( $times-60 > $timerec){$line = '';	next;}
		if(($handle eq $name) && ($host2 eq $host) && $flag){#ホスト名が同一の場合、時間と名前を最新のものにする。
			$line = "$times\t$name\t$host\t$color\td\n";
			$flag =0;$handle = $name;$nmcl = $color;
		}
	if($handle ne $host2){push (@sanka3, "<FONT color=\"$nmcl\">$handle</FONT>☆");}
	else{$romnum++;}
	}#foreach

	if($flag){	#新しい参加者は、加える
		push(@sanka,"$times\t$name\t$host\t$color\td\n");
		if($name ne $host){push (@sanka3, "<FONT color=\"$color\">$name</FONT>☆");}
		else{$romnum++;}
	}

undef(@sanka) if($chat eq 'sanka');
open(LOG,">$sanka_file")  || &ended('$sanka_file write error');
	eval 'flock(LOG,2);';
	seek(LOG,0,0);	print LOG @sanka;
	eval 'flock(LOG,8);';
close(LOG);
}#sanka END

sub readlog{	#配列@linesにログを読み込む
if(-f $chat_file){
	open(DB,"$chat_file") || &ended('$chat_file open error');
		seek(DB,0,0);  @lines = <DB>;   close(DB);
	}
}#readlog END

sub writelog{	#$valueを@linesに加えたのち、書き込む
	(@lines < $max-1) || (@lines = @lines[0 .. $max - 2]);
	unshift( @lines,$value);
	open(DB,">$chat_file") || &ended('$chat_file write error');
		eval 'flock(DB,2);';
		seek(DB,0,0);	print DB @lines;
		eval 'flock(DB,8);';
	close(DB);
}#writelog END
sub hide{	#HTML生成時に共有される部分を一つにまとめる。
$kao = "今のきもち:<SELECT NAME=\"emoji\" SIZE=\"1\"><OPTION VALUE=\"\" selected>なし";
foreach $kaodata (@kaolist) {
	$kao = $kao . "<OPTION VALUE=\"$kaodata\">$kaodata";
	}
$kao = $kao . "</SELECT>";
$lmojicolor = "文字色:<SELECT NAME=\"mojicolor\" SIZE=\"1\"><OPTION VALUE=\"0\" selected>標準";
foreach $ctxts0 (@ctxts) {
	@ctxts1 = split(/=/,$ctxts0);
	$lmojicolor = $lmojicolor . "<OPTION VALUE=\"$ctxts1[1]\">$ctxts1[0]";
	}
$lmojicolor = $lmojicolor . "</SELECT>";
$hidden =<<"_HIDE_";
<INPUT TYPE=hidden NAME="email" VALUE="$email">
<INPUT TYPE=hidden NAME="reload" VALUE="$reload">
<INPUT TYPE=hidden NAME="color" VALUE="$color">
<INPUT TYPE=hidden NAME="name" VALUE="$name">
<INPUT TYPE=hidden NAME="fcimg" VALUE="$fcimg">
_HIDE_
$logw =<<"_HIDE_";
<SELECT NAME="window" SIZE="1">
<OPTION selected>$window
<OPTION>$max<OPTION>40<OPTION>30 
<OPTION>20<OPTION>10</SELECT>
_HIDE_
$mojisize =<<'_HIDE_';
Size:<SELECT NAME="mojisize" SIZE="1">
<OPTION VALUE="1">1<OPTION VALUE="2">2
<OPTION VALUE="0" selected>普通<OPTION VALUE="4">4<OPTION VALUE="5">5
</SELECT>
_HIDE_
#デフォルトはVALUE=0にしています。
}#hide END

sub gethost{
@ghost=($ENV{'REMOTE_HOST'},$ENV{'REMOTE_ADDR'});
$ghost[0]=$ghost[1] if($ghost[0] eq "");
$ghost2="";
$ghost2=$ENV{'HTTP_VIA'} if( $ENV{'HTTP_VIA'}=~s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/ );
$ghost2=$ENV{'HTTP_X_FORWARDED_FOR'} if( 
$ENV{'HTTP_X_FORWARDED_FOR'}=~s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/ );
$ghost2=$ENV{'HTTP_FORWARDED'} if( 
$ENV{'HTTP_FORWARDED'}=~s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/ );
$ghost[1]=$ghost2 if($ghost2);
return @ghost;
}#gethost END

sub encode {
    $_[0] =~ s/([^0-9A-Za-z_ ])/'%'.unpack('H2',$1)/ge;
    $_[0] =~ s/\s/+/g;
    $_[0];
}#encode END
1;  # RETURN TRUE
__END__