#! /usr/local/bin/perl
#
#ゆいちゃっとPro(Secure版)(pref.cgi)
#
#pref.cgiは、chat.cgiとenter.cgiで、共通して使われるサブルーチン集です。
sub init{ #初期設定など
$rank_file='./rank.dat';#発言ランキング記録
$sanka_file = './sanka.dat'; #参加記録ファイル
$chat_file = './chat.dat'; #チャットログ(ファイル名は必ず変更しておくこと。)
$cgidir = 'http://www.big.or.jp/~vampire/ProS/';
$method = 'POST';#POSTにするしかないわね。
#退室後のページは、他のＨＰにも変えられます。
$endpage= 'http://www.big.or.jp/~vampire/ProS/chat.cgi?window=50&reload=150&mode=checked';
$title = 'ゆいちゃっとPro(Secure版)';
$body='';
$max = 50;#ログの最大行数
$metacode = '';#SJIS認識させる
#$host = $ENV{'REMOTE_HOST'};if($host=~/bmc/){$host='ppp753.master.ad.jp';}
$host=$ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'};
$host = $ENV{'HTTP_X_FORWARDED_FOR'} if($ENV{'HTTP_X_FORWARDED_FOR'});
####アクセス制限を使用する。
$kill_file = './kill.dat';#アクセス制限用
open(DB,"$kill_file") || die "Cannot Open Log File $kill_file: $!";
@lines2 = ; close(DB);
foreach $line (@lines2) {
next if(length($line)<4); chop $line;
if( $host=~/$line/ ){
print "Set-Cookie: apachs=14532168795; expires=Wednesday, 09-Nov-1999 00:00:00 GMT\n" unless($ENV{'HTTP_COOKIE'}=~/apachs=14532168795/);
print "Content-type: text/html\n\n";
exit; }
}#foreach
#プロキシーサーバをとことん排除するなら、#を消す
#unless($ENV{'HTTP_X_FORWARDED_FOR'}){
#exit if($ENV{'HTTP_CACHE_CONTROL'});
#exit if($ENV{'HTTP_VIA'});
#exit if($ENV{'HTTP_PROXY_CONNECTION'});
#exit if($ENV{'HTTP_USER_AGENT'}=~/via/);
#}
####アクセス制限ここまで
#ロックファイルを使用するなら、#を消す。
#$lockfile = './lock/lock-file.lock';
#$retry = 5;
#while (!symlink(".", $lockfile)) {
#if (--$retry <= 0) { print "Status: 204\n\n"; unlink($lockfile); exit; }
#sleep(1);
#}
#ロックファイルここまで
exit if($ENV{'HTTP_COOKIE'}=~/apachs=14532168795/);
}#init END
sub ended{ #unlinkとexitを行うためだけのもの。
# unlink($lockfile);#ロックファイルを使用するなら、#を消す。
print "Content-type: text/plain\n\n $_[0] \n"if($_[0]);#この行は削除可です。
exit;
}#ended END
sub decode{ #一般的なデコード＆変数への代入
if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
else { $buffer = $ENV{'QUERY_STRING'};$buffer=~s/chat=//ig; }
#GETメソッドによる書き込みを禁止
@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/;
close(LOG);
$flag=1;
foreach $line (@sanka) {
($timerec, $handle, $host2,$dmy) = split(/\t/, $line);
if( $times-60 > $timerec){$line = ''; next;}
if(($host2 eq $host) && $flag){#ホスト名が同一の場合、時間と名前を最新のものにする。
$line = "$times\t$name\t$host\td\n";
$flag =0;$handle = $name; $handle =~ s/☆/★/g;
}
push (@sanka3, "$handle☆") ;
}#foreach
if($flag){ #新しい参加者は、加える
push(@sanka,"$times\t$name\t$host\td\n");
$name =~ s/☆/★/g;
push (@sanka3, "$name☆") ;
}
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にログを読み込む
open(DB,"$chat_file") || &ended('$chat_file open error');
seek(DB,0,0); @lines = ; close(DB);
}#readlog END
sub writelog{ #$valueを@linesに加えたのち、書き込む
return unless( ($ENV{'HTTP_REFERER'} eq '') || ($ENV{'HTTP_REFERER'} =~/$cgidir/));#外部サイトからの書き込み禁止
return if ((index(@lines[0],$chat) > 0) && (index(@lines[0],$host) > 0));#同一内容連続書き込み禁止
(@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生成時に共有される部分を一つにまとめる。
$hidden =<<"_HIDE_";
_HIDE_
$logw =<<"_HIDE_";
_HIDE_
$kao =<<'_HIDE_';
今のきもち:
_HIDE_
#顔文字は、最初の6個は残してね。
}#hide END
1; # RETURN TRUE
__END__