#!/usr/bin/perl #****************************************************************************** #lchat.cgi - Light Chat Ver.2.16 # #Version :2.16 #modified :2001/06/28 #Copyright :The Room #E-Mail :dream@lib.net #URL :http://dream.lib.net/room/ # #これはフリー素材です。 #転載・商用目的の利用の際には、メールをお願いします。 # #****************************************************************************** #1行目のperlのディレクトリ指定は、サーバによって異なります。 #詳しくは、管理者にお聞きください。 #****************************************************************************** #「〜なら1を設定」と書いてある物は、0 にするとその機能が無効になります。 #ファイルのパスは、指定が無い限り相対パスで指定してください。 #****************************************************************************** # jcode.plのパス $jcode = './jcode.pl'; # ログファイルのパス $logfile = './log.dat'; # 入室者チェックファイルのパス $menfile = './men.dat'; # アクセス拒否ファイルのパス $denyfile = './deny.dat'; #***************************************************************************** #管理人パスワード $adminpass = 'TWI32010'; #管理人の表示色 $admin_color = 'skyblue'; #管理人の名前 $admin_name = '管理局長'; #入室時及び退室時の挨拶 # NAME のところに挨拶する相手の名前が自動的に入ります。 $admin_entermsg = 'NAMEさん、いらっしゃい〜☆'; $admin_byemsg = 'NAMEさん、また来てね〜☆'; #****************************************************************************** #こっそり入室を可能にするなら 1 を設定 $cossori = 1; #こっそり入室に失敗する確率を設定(0〜100) $cossori_miss = 75; #こっそり入室失敗時のメッセージ $admin_cossori = 'NAMEさんは隠密活動に失敗しました'; #****************************************************************************** # ROM禁止なら 1 を設定 $romdeny = 0; # 入室制限をするなら、制限人数を設定。 # しないなら 0 を設定 $limitenter = 0; # 入室者表示の区切り記号 $delimita = '☆'; # ROMメンバーも表示するなら 1 を設定 $indicate_rom = 1; # ROM禁止の時の、ROMに対しての表示 # 0 なら何も表示せず # 1 なら入室者人数を表示 # 2 なら入室者人数と入室者名のリストを表示 $indicate_in_member = 2; # 個人会話機能を使用するなら 1 を。 $secrettalk = 1; #***************************************************************************** # IP をソースに表示するなら 1 を設定 $ipindicate = 1; #ログの最大保存行数 $logmax = 500; #使用を許可するタグ @permittag = ('b','i','font'); #URLが書かれたら自動的にリンクを貼る場合は 1 を。 $autolink = 0; #書きこみの最大文字数 $maxwrite = 800; # 時間の表示色 $data_color = '#8080ff'; sub timeset{ my @weekday = qw (Sun Mon Tue Wed Thr Fri Sat); my ($sec,$min,$hour,$day,$month,$year,$wday) = gmtime(time()+$areatime); $year+=1900;$month++; $min = "0$min" if $min < 10; #時間表示の設定 # $year/$month/$day $hour:$min:$sec # 各々、年月日 時分秒をあらわします。 return "$month/$day $hour:$min:$sec"; } #グリニッジ標準時からのずれ（秒単位） # 初期設定は 32400秒 = 9時間の日本時間設定です。 $areatime = 32160; #***************************************************************************** #ホームページURL（「Back to Homepage」のリンク先） $homeurl = 'http://www.aya.or.jp/~twi/Dolphan/menu.html'; #リンクのターゲット（フレーム化環境で使うときは _parent などの指定） $linktarget = '_top'; #テーブルの色1（「お名前」などの背景色） $table_color_1 = '#000000'; #テーブルの色2（名前入力欄などの背景色） $table_color_2 = '#000000'; #タイトル $title = 'Dolphan会議室'; #BODYタグ $body = ''; #ページ上部に表示する題名 $pagetop = '
Dolphan会議室
'; #スタイルシート # .input が入力ボックス、 .button がボタンの設定です。 # NN4.7以前では、設定しても表示に反映されません。 $stylesheet = < EOD #****************************************************************************** #色 # $sel_color にカラーコードを、$sel_colorname に色の名前を。 # # 増やしたい場合は、$sel_color[9] のように、[]内の数値を増やして # 追加してください。 $sel_color[0] = '#ff0000';$sel_colorname[0]='赤'; $sel_color[1] = '#008000';$sel_colorname[1]='緑'; $sel_color[2] = '#0000ff';$sel_colorname[2]='青'; $sel_color[3] = '#c0c020';$sel_colorname[3]='黄'; $sel_color[4] = '#000000';$sel_colorname[4]='黒'; $sel_color[5] = '#ff00ff';$sel_colorname[5]='ピンク'; $sel_color[6] = '#00c0c0';$sel_colorname[6]='水色'; $sel_color[7] = '#900090';$sel_colorname[7]='紫'; $sel_color[8] = '#804040';$sel_colorname[8]='茶色'; # #表示行数（行） $indicate_lines[0] = '10'; $indicate_lines[1] = '20'; $indicate_lines[2] = '50'; $indicate_lines[3] = '75'; $indicate_lines[4] = '100'; $indicate_lines[5] = '200';#9999に設定すると、全部のログを表示します。 # #リロード時間（秒） $reload_time[0] = '20'; $reload_time[1] = '30'; $reload_time[2] = '45'; $reload_time[3] = '60'; $reload_time[4] = '90'; $reload_time[5] = '120'; $reload_time[6] = '9999';#9999にすると、手動更新になります。 #各々の初期設定の番号 # 番号は [0] などのカッコ内の数字を指定します。 $new_sel_color = 0;#色 $new_indicate_lines = 1;#表示行数 $new_reload_time = 1;#リロード時間 #****************************************************************************** #jcode.plの読みこみ require $jcode; if ($romdeny == 1){$indicate_rom = 0;} #データ受け取り $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]); $ename = $text if $key eq 'name'; $text =~ s/\+/ /g; $text =~ s/%(..)/pack("c",hex($1))/ge; $text =~ s/\r\n/\n/g; $text =~ s/\n//g; &jcode'convert(*text,'sjis'); $act = $text if $key eq 'act'; $act2 = $text if $key eq 'act2'; $act3 = $text if $key eq 'act3'; $act4 = $text if $key eq 'act4'; $name = $text if $key eq 'name'; $address = $text if $key eq 'address'; $color = $text if $key eq 'color'; $lines = $text if $key eq 'lines'; $reloadtime = $text if $key eq 'reloadtime'; $hrindi = $text if $key eq 'hrindi'; $msg = $text if $key eq 'msg'; $admsg = $text if $key eq 'admsg'; $secret_target = $text if $key eq 'secret_target'; $pass = $text if $key eq 'pass'; $entcossori = $text if $key eq 'entcossori'; } $ip = $ENV{'REMOTE_ADDR'}; $host = gethostbyaddr(pack("C4", split(/\./, $ip)), 2); $host ||= $ENV{'REMOTE_HOST'}; $host ||= $ip; &member_check; if (($act eq "") || ($act eq "enterform") || ($act eq "enterframe")){ #初期表示時のみクッキー読みこみ for $a1 (split(/; */, $ENV{'HTTP_COOKIE'})) { ($a2, $a3) = split(/=/, $a1); $a3 =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg; $cookie{$a2} = $a3; } $name = $cookie{'name'} if $name eq ""; $name = $ip if $name eq ""; $color = $cookie{'color'} if $color eq ""; $color = $new_sel_color if $sel_color[$color] eq "" || $color eq ""; $lines = $cookie{'lines'} if $lines eq ""; $lines = $new_indicate_lines if $indicate_lines[$lines] eq "" || $lines eq ""; $reloadtime = $cookie{'reloadtime'} if $reloadtime eq ""; $reloadtime = $new_reload_time if $reload_time[$reloadtime] eq "" || $reloadtime eq ""; $hrindi = $cookie{'hrindi'} if $hrindi eq ""; $hrindi = 0 if $hrindi != 0 && $hrindi != 1; $address = $cookie{'address'} if $address eq ""; } elsif (($act eq "mainframe") || ($act eq "changeframe")){ #入室時・変更時のみクッキー書きこみ $name = $ip if $name eq ""; $color = $new_sel_color if $sel_color[$color] eq "" || $color eq ""; $lines = $new_indicate_lines if $indicate_lines[$lines] eq "" || $lines eq ""; $reloadtime = $new_reload_time if $reload_time[$reloadtime] eq "" || $reloadtime eq ""; $hrindi = 0 if $hrindi != 0 && $hrindi != 1; 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:reloadtime=$reloadtime;expires=Thu, 1-Jan-2030 00:00:00 GMT;\n"; print "Set-Cookie:hrindi=$hrindi;expires=Thu, 1-Jan-2030 00:00:00 GMT;\n"; print "Set-Cookie:address=$address;expires=Thu, 1-Jan-2030 00:00:00 GMT;\n"; } $flag = 0; open (IO,"+<$denyfile"); eval{flock(IO,2)}; while(){ chomp; @y2=split(/<>/,$_); if (($act2 eq "deny") && ($act3 eq $y2[1]) && ($msg eq $y2[0]) && ($act4 == 1)){ $admsg = "「$msg」を拒否リストから削除しました。"; $flag = 1; next; } elsif ($y2[1] eq "IP"){ push(@ipdeny,$y2[0]); if ($ip =~ /$y2[0]/i){&error("あなたのアクセスは拒否されました。");} } elsif ($y2[1] eq "HOST"){ push(@hostdeny,$y2[0]); if ($host =~ /$y2[0]/i){&error("あなたのアクセスは拒否されました。");} } elsif ($y2[1] eq "REF"){ push(@refdeny,$y2[0]); if ($ENV{'HTTP_REFERER'} =~ /$y2[0]/i){&error("あなたのアクセスは拒否されました。");} } elsif ($y2[1] eq "NAME"){ push(@namedeny,$y2[0]); if ($name eq $y2[0]){&error("あなたのアクセスは拒否されました。");} } } if (($act2 eq "deny") && ($msg ne "") && ($act4 == 0) && ($flag == 0)){ if ($act3 eq "IP"){push(@ipdeny,$msg);$flag=1;} elsif ($act3 eq "HOST"){push(@hostdeny,$msg);$flag=1;} elsif ($act3 eq "REF"){push(@refdeny,$msg);$flag=1;} elsif ($act3 eq "NAME"){push(@namedeny,$msg);$flag=1;} if ($flag){ $admsg="「$msg」を追加しました。"; }else{ $admsg="指定が不正です。"; } } if($flag){ truncate(IO,0); seek(IO,0,0); foreach(@ipdeny){print IO "$_<>IP<>\n";} foreach(@hostdeny){print IO "$_<>HOST<>\n";} foreach(@refdeny){print IO "$_<>REF<>\n";} foreach(@namedeny){print IO "$_<>NAME<>\n";} } close (IO); if (($act =~ /admin/) && ($pass ne $adminpass)){&error("パスワードが間違っています。");} if (($act eq "saymsg") && ($msg eq "")){$act="reload";} if ($act eq ""){&enterframe;} elsif ($act eq "mainframe"){&mainframe;} elsif ($act eq "changeframe"){&changeframe;} elsif ($act eq "byeframe"){&byeframe;} elsif ($act eq "adminframe"){&adminframe;} elsif ($act eq "adminform"){&adminform;} elsif ($act eq "adminreload"){&adminreload;} elsif ($act eq "enterform"){&enterform;} elsif ($act eq "sayform"){&sayform;} elsif ($act eq "byeform"){&byeform;} elsif ($act eq "romdeny"){&romdeny;} elsif ($act eq "saymsg"){&saymsg;} elsif ($act eq "entergreet"){&entergreet;} elsif ($act eq "byemsg"){&byemsg;} elsif ($act eq "reload"){&reload;} elsif ($act eq "deleteme"){&deleteme;} &error("不正なコマンドが送信されました($act)。"); #****************************************************************************** sub byeform{ #退室フォーム &hphead(); print <
ご利用ありがとうございました。また、いらして下さいね。

<<Back to Home

EOD &hpfoot; } #****************************************************************************** sub adminform{ #管理フォーム my ($a1,$a2,$a3,$a4)=&sel_box; &hphead(); print < 管理モード <<戻る
▽ 表\示行数 $a2 リロード $a3
ログ削除
△
▽		 という を
拒否設定
△ という を

現在の拒否リスト
IP拒否
 ホスト名拒否
 リンク元拒否
 名前拒否
EOD &hpfoot; } #****************************************************************************** sub sayform{ #発言フォーム my ($a1,$a2,$a3)=&sel_box; my $a5 = " checked" if $hrindi == 1; &hphead(); print < $pagetop
EOD if ($secrettalk == 1){ print < EOD } print <
▽ お名前 $name
  コメント
  個人会話 ＊メッセージを送る相手の名前を入力
  JavaScriptによる自動消去を行う
△ Mail/URL
▽ 色 $a1 表\示行数 $a2 リロード $a3
  区切り線を表\示しない

△
 
EOD &hpfoot; } #****************************************************************************** sub enterform{ #入室フォーム my ($a1,$a2,$a3)=&sel_box; my ($a5,$a6); $a5 = " checked" if $hrindi == 1; if ($limitenter != 0){ if ($limitenter > $member_num){ $a6="入室制限まであと" . ($limitenter-$member_num) . "人です。
"; }else{ &maxenter; } } &hphead(); print < $pagetop
$a6
▽ お名前 Mail/URL
  色 $a1 表\示行数 $a2 リロード $a3
  EOD print "こっそり入室\n" if $cossori; print <区切り線を表\示しない
<<Back to Home
△

EOD &hpfoot; } #****************************************************************************** sub deleteme{ #自分の発言消去 open (IO,"+<$logfile"); eval{flock(IO,2)}; while (){ if ($_ =~ /<>$ip/){ @y2=split(/<>/,$_); if ($y2[6] ne $ip){ push(@log,$_); } }else{ push(@log,$_); } } truncate(IO,0); seek(IO,0,0); print IO @log; close (IO); &reload2; } #****************************************************************************** sub saymsg{ #発言 my $a1 = ×et; my $a2; #荒らし対策：書きこみ文字数制限 $msg = substr($msg,0,$maxwrite); #荒らし対策：許可タグ以外を無効化 $msg =~ s/[\t\a]//g; $msg =~ s/&/&/g; $msg =~ s//\a/g; foreach (@permittag){ $msg =~ s/\t(\/?$_)\a/<$1>/ig; $msg =~ s/\t$_ ([^\a]*)\a/<$_ $1>/ig; } $msg =~ s/\t/</g; $msg =~ s/\a/>/g; foreach (@permittag){ if (($msg =~ /<$_/i) && ($msg !~ /<\/$_/i)){$msg .="<\/$_>";} } if (($msg !~ /$1<\/A>/g; } if ($secret_target ne ""){ if ($secret_ip ne ""){ $msg="[個人 $name＞$secret_target] $msg"; $a2=$secret_ip; }else{ $msg="[個人 （指定名無効）] $msg"; $a2="999.999.999.999"; } } open (IO,"+<$logfile"); eval{flock(IO,2)}; @log=; unshift(@log,"$name<>$color<><>$address<>$a1<>$msg<>$ip<>$a2<>\n"); pop(@log) if $#log >= $logmax; truncate(IO,0); seek(IO,0,0); print IO @log; close (IO); &reload2; } #****************************************************************************** sub entergreet{ #入室時挨拶 my $a1 = ×et; open (IO,"+<$logfile"); eval{flock(IO,2)}; @log=; if (($cossori == 0) || ($entcossori == 0)){ $admin_entermsg =~ s/NAME/$name<\/font>/; unshift(@log,"$admin_name<>9999<>9999<><>$a1<>$admin_entermsg<>SYSTEM-MESSAGE<><>\n"); pop(@log) if $#log >= $logmax; } elsif (rand(100) < $cossori_miss){ $admin_cossori =~ s/NAME/$name<\/font>/; unshift(@log,"$admin_name<>9999<>9999<><>$a1<>$admin_cossori<>SYSTEM-MESSAGE<><>\n"); pop(@log) if $#log >= $logmax; } truncate(IO,0); seek(IO,0,0); print IO @log; close (IO); &reload2; } #****************************************************************************** sub byemsg{ #退室時挨拶 my $a1 = ×et; $admin_byemsg =~ s/NAME/$name<\/font>/; open (IO,"+<$logfile"); eval{flock(IO,2)}; @log=; unshift(@log,"$admin_name<>9999<>9999<><>$a1<>$admin_byemsg<>SYSTEM-MESSAGE<><>\n"); pop(@log) if $#log >= $logmax; truncate(IO,0); seek(IO,0,0); print IO @log; close (IO); $ename = $name = ""; &romdeny if $romdeny == 1; &reload2; } #****************************************************************************** sub reload{ #データ読みこみ open (IN,"$logfile"); eval{flock(IN,1)}; @log=; close (IN); &reload2; } #****************************************************************************** sub adminreload{ #データ読みこみ my ($a1,$ct)=($admsg,0); open (IO,"+<$logfile"); eval{flock(IO,2)}; if ($act2 eq "delete"){ if ($msg eq ""){ @log=; $admsg = "対象を設定してください。"; } elsif (($act3 < 0) || ($act3 > 2)){ @log=; $admsg = "削除指定が不正です。"; }else{ while(){ @y2=split(/<>/,$_); if (($act3 == 0) && ($y2[0] eq $msg)){$ct++;} elsif (($act3 == 1) && ($y2[6] eq $msg)){$ct++;} elsif (($act3 == 2) && (index($_,$msg) != -1)){$ct++;} else{push(@log,$_);} } } } else{ @log=; } if ($ct != 0){ truncate(IO,0); seek(IO,0,0); print IO @log; } close (IO); if (($act2 eq "delete") && ($admsg eq "")){ if ($act3 == 0){$admsg = "という名前からの投稿を";} elsif ($act3 == 1){$admsg = "というIPからの投稿を";} elsif ($act3 == 2){$admsg = "という文字を含む投稿を";} $admsg="「$msg」$admsg $ct行 削除しました。"; } $admsg = $a1 if $a1 ne ""; $admsg ="
$admsg" if $admsg ne ""; &reload2; } #****************************************************************************** sub reload2{ #ログ表示 if (($romdeny == 1) && ($name eq "") && ($act ne "adminreload")){&romdeny;} my ($a1,$a2,$a3,$a4,@y1); if ($act eq "adminreload"){ $a4="./lchat.cgi?act=adminreload&pass=$pass&lines=$lines&reloadtime=$reloadtime"; $hrindi=1; }else{ $a4="./lchat.cgi?act=reload&name=$ename&color=$color&lines=$lines&reloadtime=$reloadtime&hrindi=$hrindi"; } if ($reload_time[$reloadtime] != 9999){ &hphead(""); }else{ &hphead(); } if ($indicate_lines[$lines] == 9999){ $a1 = "全部"; }else{ $a1 = $indicate_lines[$lines] . "行"; } if ($reload_time[$reloadtime] == 9999){ $a2 = "手動更新"; }else{ $a2 = $reload_time[$reloadtime] . "秒"; } if (($indicate_rom == 1) && ($rom_num > 0)){ $a3 = "ROM：$rom_num人 "; } print < [リロード] $a3参加者($member_num)：$member_name 行数：$a1 リロード：$a2 EOD print $admsg; print "
\n" if $hrindi == 1; print ""; $a1 = -1; $sel_color[9999]=$admin_color; for (0 .. $#log){ $a1++; if ($a1 >= $indicate_lines[$lines]){last;} next if $log[$_] eq ""; @y1=split(/<>/,$log[$_]); if (($y1[7] ne "") && (($ip ne $y1[6]) && ($ip ne $y1[7])) && ($act ne "adminreload")){$a1--;next;} print "\n" if $hrindi == 0; print ""; print "\n"; } print "
"; if ($y1[3] =~ /\@/){print "$y1[0] ";} elsif ($y1[3] ne ""){print "$y1[0] ";} else {print "$y1[0] ";} print "> $y1[5] ($y1[4])"; print "\n" if $ipindicate == 1; print "($y1[6])\n" if $act eq "adminreload"; print "
"; &hpfoot; } #****************************************************************************** sub byeframe{ #退室フレーム print "Content-type:text/html; charset=shift_jis\n\n"; print < $title EOD exit; } #****************************************************************************** sub adminframe{ #管理フレーム my $a1; $a1="&admsg=$admsg" if $admsg ne ""; print "Content-type:text/html; charset=shift_jis\n\n"; print < $title EOD exit; } #****************************************************************************** sub changeframe{ #変更フレーム print "Content-type:text/html; charset=shift_jis\n\n"; print < $title EOD exit; } #****************************************************************************** sub mainframe{ #発言フレーム print "Content-type:text/html; charset=shift_jis\n\n"; print < $title EOD exit; } #****************************************************************************** sub enterframe{ #入室フレーム print "Content-type:text/html; charset=shift_jis\n\n"; print < $title EOD if ($romdeny == 0){ print "\n"; }else{ print "\n"; } print "\n"; exit; } #****************************************************************************** sub romdeny{ #ROM不許可表示 my $a1 = "このチャットはROMが不許可になっています。"; if ($indicate_in_member == 1){ $a1.="

現在の参加者 $member_num人
"; } elsif ($indicate_in_member == 2){ $a1.="

参加者($member_num)：$member_name
"; } &error($a1); } #****************************************************************************** sub sel_box{ #選択ボックス my ($a1,$a2,$a3,@y1); for (0 .. $#sel_color){ if (($_ == $color) || (($_ == $#sel_color) && ($a1 == 0))){ $a1 = 1; $a2 = " selected"; }else{ $a2 = ""; } $y1[0].="