#! /usr/bin/perl # # mgchat2.cgi # 2.205 : 2/19/07 : postprocessを修正 # 2.204 : 12/19/06 : postprocessを修正 # 2.203 : 11/15/06 : ローカルタイムのオプションを追加 # 2.202 : 10/16/06 : Cookieを修正 # 2.201 : 10/1/06 : 退室時のエラーを修正 # 2.2 : 7/30/06 : Modified from mgchat.cgi # # http://www.hidekik.com # # $Id: mgchat2.cgi,v 1.6 2007/02/18 22:02:47 Hideki Kanayama Exp $ # Copyright(c) 1998-2007, Hideki Kanayama, All rights reserved. use strict; use CGI::Carp qw(fatalsToBrowser); use CGI qw(:cgi-bin); use File::Basename; #管理人パスワードファイル my $admindat = "adminpwd.dat"; #セットアップファイル my $setupfile = "mgchat_setup.pl"; my $version="2.205"; my $lastupdateyear = "2007"; #このスクリプト my $script = basename($0); my $method = 'post'; my $admin_link = "$script?mode=admin"; my $lang = 0; #### 環境設定 ###### ここから ############ our $chatfile = "chatdata.dat"; our $joinlist = "join.lst"; #タイトルロゴ 1:使用 0:非使用 our $title_logo_en = 0; our $title_logo = ''; our $title = 'チャット２'; our $title_color = '#0000ff'; our $toplink_en = 1; our $toplink_link = '..'; our $toplink_title = '【トップへ】'; our $admin_link_en = 1; our $admin_title = '【管理用】'; #トップと管理用のリンク先のターゲットウィンドウ our $top_target = '_top'; # 待機ウィンドウ 1:on, 0:off our $wait_en = 1; our $wait_title = '待機'; # シンプルウィンドウ 1:on, 0:off our $simple_en = 1; our $simple_title = 'シンプル'; # シンプル２ウィンドウ 1:on, 0:off our $simple2_en = 1; our $simple2_title = 'シンプル２'; # スプリットウィンドウ 1:on, 0:off our $split_en = 1; our $split_title = '分割'; # バックグランドカラー our $entry_bgcolor = '#ffffff'; our $write_bgcolor = '#ffffff'; our $show_bgcolor = '#ffffff'; # フォントカラー our $name_color = 'darkblue'; our $main_color = 'black'; our $time_color = 'gray'; #cookie name our $cookie_name = 'mgchat_cookie'; #更新間隔のオプション our $int10 = 'on'; our $int20 = 'on'; our $int30 = 'on'; our $int40 = 'on'; our $int50 = 'on'; our $int60 = 'on'; #表示行数のオプション our $line10 = 'on'; our $line30 = 'on'; our $line50 = 'on'; #保存最大行数 our $max = 100; # 時間設定 our $localtime_en = 1; our $offset = 9; #自動退室までの時間 our $limit=600; #〜内に挿入できる構文 1:on, 0:off our $head_insert_en = 0; our $head_insert = ''; #スタイルシート 1:on 0:off our $style_sheet_en = 1; our $style_sheet = ' A:link {text-decoration: none} A:visited {text-decoration: none} A:active {text-decoration: none} '; #使い方の説明 our $usage = ' '; #### 環境設定 ###### ここまで ############ if (-e "$setupfile"){ require "$setupfile"; } my $q = new CGI; my $cgierror = $q->cgi_error; &error($cgierror) if ($cgierror); my %in = $q->Vars; %in = &postprocess(%in); my $now=time; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = $localtime_en ? localtime($now) : gmtime($now + $offset * 3600); my $date_now = sprintf("%02d月%02d日 %02d時%02d分%02d秒",$mon+1,$mday,$hour,$min,$sec); my %attendee; if ($in{mode} eq 'admin'){ &admin; } elsif ($in{mode} eq 'showchat'){ &showchat; } elsif ($in{mode} eq 'entry'){ &entry; } elsif ($in{mode} eq 'wrform'){ &wrform; } elsif ($in{mode} eq 'wradminpwd'){ &wradminpwd; } elsif ($in{mode} eq 'setup'){ &setup; } elsif ($in{mode} eq 'wrsetup'){ &wrsetup; } elsif ($in{mode} eq 'chatwait'){ &chatwait; } elsif ($in{mode} eq 'upsidedown'){ &upsidedown; } elsif ($in{mode} eq 'exitchat'){ &exitchat; } else { if (! -e "$admindat"){ &admin; } &topframe; } ###### トップフレーム ######################### sub topframe { &htmlhead("$title"); print < END } ###### 書き込み下フレーム ######################### sub upsidedown { &htmlhead("$title"); print < END } ###### チャットエントリー ######################### sub entry { &htmlhead("$title"); print "\n"; print "\n\n\n
\n
"; if ($title_logo_en == 1){ print "\"$title\"\n"; } else { print "$title"; } print "
\n
\n"; my $target; if ("$in{style}" eq 'split'){ $target = 'sepwrwin'; } else { $target = 'write'; } print "
\n"; print "\n"; if ("$in{style}" eq 'split'){ print "\n"; } &optionbuttons; print "
\n"; my ($cookname,$cookint,$cookline,$cookjoin)=&getcookie; if ($cookint == 0){$cookint = 30;} if ($cookline == 0) {$cookline = 30;} print "名前 "; print "\n"; print "

\n"; &someoptions($cookint,$cookline); if(open(JOIN,"< $joinlist")){ while(){ chomp; my ($joinname,$jointime)=split(/,/); $attendee{$jointime}=$joinname; } close(JOIN); } &htmltail; } sub someoptions { my ($defint,$defline) = @_; my @intlist = (); if ($int10 eq 'on'){@intlist = (10);} if ($int20 eq 'on'){@intlist = (@intlist,20);} if ($int30 eq 'on'){@intlist = (@intlist,30);} if ($int40 eq 'on'){@intlist = (@intlist,40);} if ($int50 eq 'on'){@intlist = (@intlist,50);} if ($int60 eq 'on'){@intlist = (@intlist,60);} my @linelist = (); if ($line10 eq 'on'){@linelist = (10);} if ($line30 eq 'on'){@linelist = (@linelist,30);} if ($line50 eq 'on'){@linelist = (@linelist,50);} print "更新間隔：　"; print "表\\示行数：\n"; } ###### チャット書き込みフォーム ######################### sub wrform { my @forcook=($in{chatname},$in{interval},$in{maxline},$in{join}); if ($in{'chatname'} eq '') { print "Location: $script?mode=entry\n\n"; }else { &setcookie(@forcook); &htmlhead("$title"); print "\n"; my $target; if ("$in{style}" eq 'split'){ $target = 'sepshowwin'; } else { $target = 'show'; } print "\n"; if ("$in{style}" eq 'split'){ print "\n"; } print "\n"; print ""; print "
"; if ($title_logo_en == 1){ print "\n"; } else { print "$title"; } print "
"; &optionbuttons; print ""; print "

"; print "\n"; print "$in{'chatname'} >

\n"; &someoptions($in{interval},$in{maxline}); print "参加表\\示：\n"; print "$usage"; } if(open(JOIN,"<$joinlist")){ while(){ chomp; my ($joinname,$jointime)=split(/,/); if ($now < $jointime+$limit){ $attendee{$jointime}=$joinname; } } close(JOIN); } open(JOIN,">$joinlist"); foreach my $key (keys(%attendee)){ if ($attendee{$key} ne $in{chatname}){ print JOIN "$attendee{$key},$key\n"; } } print JOIN "$in{chatname},$now\n"; close(JOIN); &htmltail; } ###### チャット表示 ######################### sub showchat { my $wr="notdone"; my @forcook; my $status; if ($in{'chat'} ne '' && $in{'chatname'} ne '') { &write; $wr="done";} if ($in{chatname} ne "" && $in{interval} ne "" && $in{maxline} ne "" && $in{join} ne ""){ @forcook=($in{chatname},$in{interval},$in{maxline},$in{join}); $status = "form"; } else { my ($cookname,$cookint,$cookline,$cookjoin)=&getcookie(); if ($cookint == 0){$cookint = 30;} if ($cookline == 0) {$cookline = 30;} @forcook=($cookname,$cookint,$cookline,$cookjoin); $status = "noform"; } &setcookie(@forcook); my $script2; if ("$in{style}" eq 'split'){ $script2 = "$script?mode=showchat&style=split"; } else { $script2 = "$script?mode=showchat"; } &htmlhead($title,'refresh',$forcook[1],$script2); if ($status eq 'form'){ print "\n"; } else { print "\n"; } print "
参加者："; if(open(JOIN,"<$joinlist")){ while(){ chomp; my ($joinname,$jointime)=split(/,/); if ($now < $jointime+$limit){ $attendee{"$jointime"}=$joinname; if ("$attendee{$jointime}" ne "$in{chatname}"){ print "$joinname、"; } } } close(JOIN); } if (($in{join} eq "yes") || ($wr eq "done")){ print "$in{chatname}"; } if ($status eq 'form'){ open(JOIN,">$joinlist"); foreach my $key (keys(%attendee)){ if ($attendee{$key} ne $in{chatname}){ print JOIN "$attendee{$key},$key\n"; } } if (($in{join} eq "yes") || ($wr eq "done")){ print JOIN "$in{chatname},$now\n"; } close(JOIN); } print "\n"; printf("現在時刻：%02d月%02d日 %02d時%02d分%02d秒
\n",$mon+1,$mday,$hour,$min,$sec); print "

\n"; my @DATA; if (open(IN,"$chatfile")) { @DATA = ; close(IN); } my $maxline; my $dataline=$#DATA+1; if ($forcook[2] > $dataline){ $maxline=$dataline; } else { $maxline=$forcook[2]; } splice(@DATA,0,$dataline-$maxline); @DATA = reverse(@DATA); my $date; my $name; my $chat; my $email; my $host; foreach my $data (@DATA) { if ($data =~ /(.*)\,(.*)\,(.*)\,(.*)\,(.*)/) { $date = $1; $name = $2; $chat = $3; $email = $4; $host = $5; }else { next; } chomp($email) if $email =~ /\n$/; $chat =~ s/\0/\,/g; if ($email =~ /(.*)\@(.*)\.(.*)/) { print "$name > $chat ($date)
\n"; }else { print "$name > $chat ($date)
\n"; } } print "
\n"; if ($toplink_en == 1){ print "$toplink_title"; } print "　"; if ($admin_link_en == 1){ print "$admin_title"; } &htmltail; } sub copyright{ my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "
mgchat2.cgi Ver. $version
\n"; print "
Copyright(C) 1998-$lastupdateyear, hidekik.com
\n"; print "\n"; } ###### チャット書き込み ######################### sub write { my @lines; if (open(DB,"$chatfile")) { @lines = ; close(DB); } my $host = $ENV{'REMOTE_HOST'}; my $addr = $ENV{'REMOTE_ADDR'}; if ($host eq $addr) { $host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr; } my $axs = @lines; if ($axs >= $max) { shift(@lines); } my $chatline = $in{chat}; my $chatname = $in{chatname}; $chatline =~ s/,/&\#44;/g; $chatname =~ s/,/&\#44;/g; push(@lines,"$date_now\,$in{chatname}\,$chatline\,$in{email}\,$host\n"); if (!open(DB,">$chatfile")) { &error('チャットファイルへ記録できません.'); } print DB @lines; close(DB); } ###### チャット退室 ######################### sub exitchat { my ($joinname,$jointime); if(open(JOIN,"<$joinlist")){ while(){ chomp; ($joinname,$jointime)=split(/,/); $attendee{"$jointime"}=$joinname; } close(JOIN); } open(JOIN,">$joinlist"); foreach my $key (keys(%attendee)){ if ($attendee{$key} ne $in{chatname}){ print JOIN "$attendee{$key},$key\n"; } } close(JOIN); print "Location: $script?mode=entry\n\n"; } ###### チャット待機 ######################### sub chatwait { &htmlhead('チャット待機','refresh',60,"$script?mode=chatwait"); print "\n"; print "\n"; print "\n"; print "\n"; print " END ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= $localtime_en ? localtime($now) : gmtime($now + $offset * 3600); print "\n"; print "
参加者　："; if(open(JOIN,"< $joinlist")){ while(){ chomp; my ($joinname,$jointime)=split(/,/); if ($now < $jointime+$limit){ print "$joinname、"; } } close(JOIN); } my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$chatfile"); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)= $localtime_en ? localtime($d_mtime) : gmtime($d_mtime + $offset * 3600); my $date_str = sprintf("%02d月%02d日 %02d時%02d分%02d秒",$mon+1,$mday,$hour,$min,$sec); print <
最終更新： $date_str
現在時刻："; printf("%02d月%02d日%02d時%02d分%02d秒\n",$mon+1,$mday,$hour,$min,$sec); print <
END2 &htmltail; } ###### セットアップフォーム ######################### sub setup { open(ADMIN,"< $admindat"); my $adminpwd = ; close(ADMIN); if (! &checkcrypt($in{pwd},"$adminpwd")){ &error('パスワードが違います。'); } &htmlhead("セットアップ"); print "\n"; my @title_logo_en_check; my @toplink_en_check; my @admin_link_en_check; my @wait_en_check; my @simple_en_check; my @simple2_en_check; my @split_en_check; my @style_sheet_check; my @head_insert_check; my @localtime_check; $title_logo_en_check[$title_logo_en] = 'checked'; $toplink_en_check[$toplink_en] = 'checked'; $admin_link_en_check[$admin_link_en] = 'checked'; $wait_en_check[$wait_en] = 'checked'; $simple_en_check[$simple_en] = 'checked'; $simple2_en_check[$simple2_en] = 'checked'; $split_en_check[$split_en] = 'checked'; $style_sheet_check[$style_sheet_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; $localtime_check[$localtime_en] = "checked"; my $int10_checked; my $int20_checked; my $int30_checked; my $int40_checked; my $int50_checked; my $int60_checked; my $line10_checked; my $line30_checked; my $line50_checked; if ($int10 eq 'on') {$int10_checked = 'checked';} if ($int20 eq 'on') {$int20_checked = 'checked';} if ($int30 eq 'on') {$int30_checked = 'checked';} if ($int40 eq 'on') {$int40_checked = 'checked';} if ($int50 eq 'on') {$int50_checked = 'checked';} if ($int60 eq 'on') {$int60_checked = 'checked';} if ($line10 eq 'on') {$line10_checked = 'checked';} if ($line30 eq 'on') {$line30_checked = 'checked';} if ($line50 eq 'on') {$line50_checked = 'checked';} print <
  • ディレクトリの設定は、$scriptから見た相対パス、又は絶対パスで指定してください。バックグランドファイルやロゴファイルはhttp://からのリンクの指定も可能\\です。
  • 管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。
  • これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。
  • $admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。
  • 管理用リンク表\\示をオフにしてる場合にこのページに入るには、$script?mode=adminからパスワードを入力して入って下さい。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
データファイル データファイルの名前
参加者ファイル データファイルの名前
タイトル ロゴ使用 ロゴ非使用
ロゴのファイル名
タイトル名
その色
トップへのリンク 有り 無し
リンク名
リンク先
管理用へのリンク 有り 無し
リンク名
ターゲットウィンドウ target=
トップと管理用のリンクのターゲットウィンドウ(トップ:_top、他フレーム名を指定可)
待機ウィンドウ 有り 無し ボタン名
シンプルウィンドウ 有り 無し ボタン名
シンプル２ウィンドウ 有り 無し ボタン名
分割ウィンドウ 有り 無し ボタン名
バックグランドカラー 入り口
書き込み
表\\示
フォントカラー 名前
本文
時間
クッキー名
更新間隔オプション 10秒 20秒 30秒 40秒 50秒 60秒
表\\示行数オプション 10行 30行 50行
保存最大行数
自動退室までの秒数 （600秒=10分）
時間設定 GMTからのオフセット ローカルタイム
GMTからのオフセットに設定した場合、GMTより時間(日本：+9時間)
<head>内挿入文 有効 無効
HTML書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。
スタイルシート 有効 無効
<style ...></style>は除いて内容だけを記述
使い方の説明 HTML書式
 
END &htmltail; } ###### セットアップファイル作成 ######################### sub wrsetup { my $filepwd; my $inpwd; if (open(FILE,"< $admindat")){ $filepwd = ; close(FILE); $inpwd = crypt("$in{pwd}",$filepwd); } else { &error('パスワードファイルが存在しません。'); } if ("$inpwd" ne "$filepwd"){ &error('パスワードが違います。'); } foreach ('usage','head_insert','style_sheet'){ $in{$_} =~ s/
/\n/g; $in{$_} =~ s/,/,/g; $in{$_} =~ s/<//g; } open(FILE,"> $setupfile"); print FILE <〜内に挿入できる構文 1:on, 0:off \$head_insert_en = $in{head_insert_en}; \$head_insert = '$in{head_insert}'; #スタイルシート 1:on 0:off \$style_sheet_en = $in{style_sheet_en}; \$style_sheet = '$in{style_sheet}'; #使い方の説明 \$usage = '$in{usage}'; #### 環境設定 ###### ここまで ############ END close(FILE); print "Location: $script\n\n"; } ###### java script ######################### sub setjavascript { print "\n"; } ###### オプションボタン ######################### sub optionbuttons { if ($wait_en == 1){ print ""; } if ($simple_en == 1){ print ""; } if ($simple2_en == 1){ print ""; } if ($split_en == 1){ print ""; } } ###### ヘッダー ######################### sub htmlhead { # parameter # $localtitle : Page title # $refresh : If refresh on => refresh # off => ''(blank) # $interval : When refresh on, interval time of refreshing # $url : Refresh URL my ($localtitle,$refresh,$interval,$url) = @_; print "Content-Type: text/html\n\n"; print "\n\n"; print "\n"; if ($head_insert_en == 1){ print "$head_insert\n"; } if ($style_sheet_en == 1){ print "\n"; } if ("$refresh" eq 'refresh'){ print "\n"; } if ($in{mode} eq 'showchat' or $in{mode} eq 'entry' or $in{mode} eq 'wrform'){ &setjavascript; } print <$localtitle END2 } ###### フッター ######################### sub htmltail { ©right; print ""; print ""; exit; } ###### 管理人パスワード設定 ######################### sub admin { &htmlhead('$title'); print "
\n"; if (-e "$admindat"){ print "
管理者用パスワードを入力してください。
\n"; print "\n"; print "\n"; print "\n"; } else { print "
管理者用パスワードを設定してください。
\n"; print "\n"; print "\n"; print "\n"; } print "
\n"; &htmltail; } ###### 管理人パスワード登録 ######################### sub wradminpwd { my $passwd = &makecrypt($in{pwd}); if (open(FILE,"> $admindat")){ print FILE "$passwd"; close(FILE); } else { &error('パスワードファイル作成に失敗しました'); } print "Location: $script\n\n"; } ###### デコード ######################### sub postprocess { my (%all) = @_; while (my ($key,$value)=each %all){ $value =~ s//>/g; my $br; if ($key eq 'usage' || $key eq 'style_sheet' || $key eq 'head_insert'){ $br = "
"; } else { $br = ""; } $value =~ s/\r\n/$br/g; $value =~ s/\n/$br/g; $value =~ s/\r/$br/g; $value =~ s/,/&\#44;/g; $all{"$key"}="$value"; } return(%all); } ###### ゲットクッキー ######################### sub getcookie { my $cookies = $q->cookie($cookie_name); my @pairs = split(/,/,$cookies); my %COOKIE; foreach my $pair (@pairs) { my ($name, $value) = split(/:/, $pair); $COOKIE{$name} = &cookie_decode($value); } my @opts=($COOKIE{chatname},$COOKIE{interval},$COOKIE{maxline},$COOKIE{join}); return(@opts); } ###### セットクッキー ######################### sub setcookie { my ($chatname,$chatint,$chatline,$chatjoin)=@_; my $cook="chatname:" . &cookie_encode($chatname) . "\,interval:$chatint\,maxline:$chatline\,join:$chatjoin"; my $cookie = $q->cookie(-name => "$cookie_name", -value => "$cook", -expires => "+1y"); $cookie = &cookie_path_fix($cookie); print "Set-Cookie: $cookie\n"; } sub makecrypt { my $plain = shift; my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$'); return $result; } sub checkcrypt { my ($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd" or checkadmin($pwd)); } ###### エラー ######################### sub error { &htmlhead("$_[0]"); print "
$_[0]
\n"; &htmltail; } sub cookie_encode { my $a = shift; $a =~ s/([\W])/sprintf("%%%02X", ord($1))/eg; return $a; } sub cookie_path_fix { my $a = shift; $a =~ s/path\s*=\s*[^;]*;//i; return $a; } sub cookie_decode { my $a = shift; $a =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg; return $a; } sub checkadmin { my $pwd = shift; $pwd ||= $in{pwd}; if (open(FILE,"< $admindat")){ my $filepwd = ; close(FILE); my $inpwd = crypt($pwd,$filepwd); return ("$inpwd" eq "$filepwd"); } else { my $message = ('パスワードファイルが存在しません','Cannot find password file.')[$lang]; &error($message); } }