#! c:/perl/bin/perl # # mgchat.cgi # Ver 2.037 : 10/16/06 : Cookieを修正 # Ver 2.036 : 7/30/06 : stylesheetのデフォルトを修正、POSIXを削除 # Ver 2.035 : 10/2/05 : Copyrightにリンクを追加 # Ver 2.034 : 9/25/05 : cryptを修正 # Ver 2.033 : 9/6/05 : jcode.plを削除 # Ver 2.032 : 2/21/05 : 管理用セットアップのパスワード認証でまれにミスするバグを修正 # Ver 2.031 : 2/7/05 : Location:の後にスペースを追加。AnHTTPD対応。 # Ver 2.03 : 4/6/03 : 更新間隔、表示行数設定のオプションを追加 # ヘッダーに好きな構文を挿入できるオプション追加 # 待機画面が自動更新されないバグを修正 # Ver 2.02 : 4/3/03 : スタイルシート設定を追加 # Ver 2.01 : 3/24/03 : パスワード作成失敗処理を追加 # Ver 2.0 : 3/8/03 # Ver 1.0から移行 # 設置が簡単になるようにファイルを一つにまとめた # セットアップページ作成 # # http://www.hidekik.com # # $Id: mgchat.cgi,v 1.13 2006/10/15 21:22:12 Hideki Kanayama Exp $ # Copyright(c) 1998-2006, Hideki Kanayama, All rights reserved. #管理人パスワードファイル $admindat = "adminpwd.dat"; #セットアップファイル $setupfile = "mgchat_setup.pl"; $version="2.037"; $lastupdateyear = "2006"; #このスクリプト $program = $0; $program =~ s/^.+[\/\\]([^\/\\]+)$/$1/; $script = "$program"; $method = 'post'; $admin_link = "$script?mode=admin"; $lang = 0; #### 環境設定 ###### ここから ############ $chatdir = "../chat"; $chatfile = "$chatdir/chatdata.dat"; #$cgibin = "../cgi-bin"; $joinlist = "$chatdir/join.lst"; #タイトルロゴ 1:使用 0:非使用 $title_logo_en = 0; $title_logo = ''; $title = 'チャット'; $title_color = '#0000ff'; $toplink_en = 1; $toplink_link = '../mgchat.html'; $toplink_title = '【トップへ】'; $admin_link_en = 1; $admin_title = '【管理用】'; #トップと管理用のリンク先のターゲットウィンドウ $top_target = '_top'; # 待機ウィンドウ 1:on, 0:off $wait_en = 1; $wait_title = '待機'; # シンプルウィンドウ 1:on, 0:off $simple_en = 1; $simple_title = 'シンプル'; # シンプル２ウィンドウ 1:on, 0:off $simple2_en = 1; $simple2_title = 'シンプル２'; # スプリットウィンドウ 1:on, 0:off $split_en = 1; $split_title = '分割'; # バックグランドカラー $entry_bgcolor = '#ffffff'; $write_bgcolor = '#ffffff'; $show_bgcolor = '#ffffff'; # フォントカラー $name_color = 'darkblue'; $main_color = 'black'; $time_color = 'gray'; #cookie name $cookie_name = 'mgchat_cookie'; #更新間隔のオプション $int10 = 'on'; $int20 = 'on'; $int30 = 'on'; $int40 = 'on'; $int50 = 'on'; $int60 = 'on'; #表示行数のオプション $line10 = 'on'; $line30 = 'on'; $line50 = 'on'; #保存最大行数 $max = 100; #GMTからのオフセット $offset = 9; #自動退室までの時間 $limit=600; #〜内に挿入できる構文 1:on, 0:off $head_insert_en = 0; $head_insert = ''; #スタイルシート 1:on 0:off $style_sheet_en = 1; $style_sheet = ' A:link {text-decoration: none} A:visited {text-decoration: none} A:active {text-decoration: none} '; #使い方の説明 $usage = ' '; #### 環境設定 ###### ここまで ############ if (-e "$setupfile"){ require "$setupfile"; } if ($ENV{"REQUEST_METHOD"} eq "POST"){ read(STDIN,$data,$ENV{"CONTENT_LENGTH"}); } else { $data = $ENV{"QUERY_STRING"}; } %all=&mbdecode($data); $now=time; ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + 3600 * $offset); $date_now = sprintf("%02d月%02d日 %02d時%02d分%02d秒",$mon+1,$mday,$hour,$min,$sec); if ($all{mode} eq 'admin'){ &admin; } elsif ($all{mode} eq 'setup'){ &setup; } elsif ($all{mode} eq 'wrsetup'){ &wrsetup; } elsif ($all{mode} eq 'showchat'){ &showchat; } elsif ($all{mode} eq 'entry'){ &entry; } elsif ($all{mode} eq 'wrform'){ &wrform; } elsif ($all{mode} eq 'wradminpwd'){ &wradminpwd; } elsif ($all{mode} eq 'setup'){ &setup; } elsif ($all{mode} eq 'wrsetup'){ &wrsetup; } elsif ($all{mode} eq 'chatwait'){ &chatwait; } elsif ($all{mode} eq 'upsidedown'){ &upsidedown; } elsif ($all{mode} eq 'exitchat'){ &exitchat; } else { if (! -e "$admindat"){ &admin; } &topframe; } ###### トップフレーム ######################### sub topframe { &header("$title"); print < END } ###### 書き込み下フレーム ######################### sub upsidedown { &header("$title"); print < END } ###### チャットエントリー ######################### sub entry { print "Content-type: text/html\n\n"; print "\n"; &headauther; &setjavascript; print "$title\n"; print "\n"; print "\n\n\n
\n
"; if ($title_logo_en == 1){ print "\"$title\"\n"; } else { print "$title"; } print "
\n
\n"; if ("$all{style}" eq 'split'){ $target = 'sepwrwin'; } else { $target = 'write'; } print "
\n"; print "\n"; if ("$all{style}" eq 'split'){ print "\n"; } &optionbuttons; print "
\n"; ($cookname,$cookint,$cookline,$cookjoin)=&getcookie; if ($cookint == 0){$cookint = 30;} if ($cookline == 0) {$cookline = 30;} print "名前 "; print "\n"; print "

\n"; &someoptions($cookint,$cookline); print "\n\n"; if(open(JOIN,"< $joinlist")){ while(){ chop; ($joinname,$jointime)=split(/,/); $attendee{$jointime}=$joinname; } close(JOIN); } } sub someoptions { local($defint,$defline) = @_; @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);} @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 { @forcook=($all{name},$all{interval},$all{maxline},$all{join}); if ($all{'name'} eq '') { print "Location: $script?mode=entry\n\n"; }else { &setcookie(@forcook); print "Content-type: text/html\n\n"; print "\n"; &headauther; &setjavascript; print "$title\n"; print "\n"; if ("$all{style}" eq 'split'){ $target = 'sepshowwin'; } else { $target = 'show'; } print "

\n"; if ("$all{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 "$all{'name'} >

\n"; &someoptions($all{interval},$all{maxline}); print "参加表\\示：\n"; print "$usage"; print "

\n"; } if(open(JOIN,"<$joinlist")){ while(){ chop; ($joinname,$jointime)=split(/,/); if ($now < $jointime+$limit){ $attendee{$jointime}=$joinname; } } close(JOIN); } open(JOIN,">$joinlist"); foreach $key (keys(%attendee)){ if ($attendee{$key} ne $all{name}){ print JOIN "$attendee{$key},$key\n"; } } print JOIN "$all{name},$now\n"; close(JOIN); } ###### チャット表示 ######################### sub showchat { $wr="notdone"; if ($all{'chat'} ne '' && $all{'name'} ne '') { &write; $wr="done";} if ($all{name} ne "" && $all{interval} ne "" && $all{maxline} ne "" && $all{join} ne ""){ @forcook=($all{name},$all{interval},$all{maxline},$all{join}); $status = "form"; } else { ($cookname,$cookint,$cookline,$cookjoin)=&getcookie(); if ($cookint == 0){$cookint = 30;} if ($cookline == 0) {$cookline = 30;} @forcook=($cookname,$cookint,$cookline,$cookjoin); $status = "noform"; } &setcookie(@forcook); print "Content-type: text/html\n\n"; print "\n"; &headauther; &setjavascript; if ("$all{style}" eq 'split'){ $script2 = "$script?mode=showchat&style=split"; } else { $script2 = "$script?mode=showchat"; } print "$title\n"; if ($status eq form){ print "\n"; } else { print "\n"; } print "
参加者："; if(open(JOIN,"<$joinlist")){ while(){ chop; ($joinname,$jointime)=split(/,/); if ($now < $jointime+$limit){ $attendee{"$jointime"}=$joinname; if ("$attendee{$jointime}" ne "$all{name}"){ print "$joinname、"; } } } close(JOIN); } if (($all{join} eq "yes") || ($wr eq "done")){ print "$all{name}"; } if ($status eq form){ open(JOIN,">$joinlist"); foreach $key (keys(%attendee)){ if ($attendee{$key} ne $all{name}){ print JOIN "$attendee{$key},$key\n"; } } if (($all{join} eq "yes") || ($wr eq "done")){ print JOIN "$all{name},$now\n"; } close(JOIN); } print "\n"; printf("現在時刻：%02d月%02d日 %02d時%02d分%02d秒
\n",$mon+1,$mday,$hour,$min,$sec); print "
\n"; if (open(IN,"$chatfile")) { @DATA = ; close(IN); } $dataline=$#DATA+1; if ($forcook[2] > $dataline){ $maxline=$dataline; } else { $maxline=$forcook[2]; } splice(@DATA,0,$dataline-$maxline); @DATA = reverse(@DATA); foreach $data (@DATA) { if ($data =~ /(.*)\,(.*)\,(.*)\,(.*)\,(.*)/) { $date = $1; $name = $2; $chat = $3; $email = $4; $host = $5; }else { next; } chop($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"; } #($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime(time + 3600 * $offset); #$year = $year + 1900; #if ($year > 1998){ # $year = "1998-$year"; #} my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "
mgchat.cgi Ver. $version
\n"; print "
Copyright(C) 1998-$lastupdateyear, hidekik.com
\n"; print "\n"; exit; } ###### チャット書き込み ######################### sub write { if (open(DB,"$chatfile")) { @lines = ; close(DB); } $host = $ENV{'REMOTE_HOST'}; $addr = $ENV{'REMOTE_ADDR'}; if ($host eq $addr) { $host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr; } $axs = @lines; if ($axs >= $max) { shift(@lines); } $chatline = $all{chat}; push(@lines,"$date_now\,$all{name}\,$chatline\,$all{email}\,$host\n"); if (!open(DB,">$chatfile")) { &error('チャットファイルへ記録できません.'); } print DB @lines; close(DB); } ###### チャット退室 ######################### sub exitchat { if(open(JOIN,"<$joinlist")){ while(){ chop; ($joinname,$jointime)=split(/,/); $attendee{"$jointime"}=$joinname; } close(JOIN); } open(JOIN,">$joinlist"); foreach $key (keys(%attendee)){ if ($attendee{$key} ne $all{name}){ print JOIN "$attendee{$key},$key\n"; } } close(JOIN); print "Location: $script?mode=entry\n\n"; } ###### チャット待機 ######################### sub chatwait { &header('チャット待機','refresh',60,"$script?mode=chatwait"); print "\n"; print "\n"; print "\n"; print "\n"; print " END ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime(time + 3600 * $offset); print "\n"; print "
参加者　："; if(open(JOIN,"< $joinlist")){ while(){ chop; ($joinname,$jointime)=split(/,/); if ($now < $jointime+$limit){ print "$joinname、"; } } close(JOIN); } ($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"); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime($d_mtime + $offset * 3600); $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 &footer; } ###### セットアップフォーム ######################### sub setup { open(ADMIN,"< $admindat"); $adminpwd = ; close(ADMIN); if (! &checkcrypt($all{pwd},"$adminpwd")){ &error('パスワードが違います。'); } print "Content-Type: text/html\n\n"; print "\n"; &headauther; print "\n"; print "\n"; $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"; 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より時間（日本：+9）
<head>内挿入文 有効 無効
HTML書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。
スタイルシート 有効 無効
<style ...></style>は除いて内容だけを記述
使い方の説明 HTML書式
 
END &footer; } ###### セットアップファイル作成 ######################### sub wrsetup { if (open(FILE,"< $admindat")){; $filepwd = ; close(FILE); $inpwd = crypt("$all{pwd}",$filepwd); } else { print "Content-type:text/html\n\n"; print ""; print "パスワードファイルが存在しません。"; print ""; exit; } if ("$inpwd" ne "$filepwd"){ &error('パスワードが違います。'); } #print "Content-Type: text/html\n\n"; foreach (usage,head_insert,style_sheet){ $all{$_} =~ s/
/\n/g; $all{$_} =~ s/,/,/g; $all{$_} =~ s/<//g; } open(FILE,"> $setupfile"); print FILE <〜内に挿入できる構文 1:on, 0:off \$head_insert_en = $all{head_insert_en}; \$head_insert = '$all{head_insert}'; #スタイルシート 1:on 0:off \$style_sheet_en = $all{style_sheet_en}; \$style_sheet = '$all{style_sheet}'; #使い方の説明 \$usage = '$all{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 header { # parameter # $localtitle : Page title # $refresh : If refresh on => refresh # off => ''(blank) # $interval : When refresh on, interval time of refreshing # $url : Refresh URL local($localtitle,$refresh,$interval,$url) = @_; print "Content-Type: text/html\n\n"; print "\n\n"; &headauther; if ("$refresh" eq 'refresh'){ print "\n"; } print <$localtitle END2 } sub headauther { print "\n"; print "\n"; if ($head_insert_en == 1){ print "$head_insert\n"; } if ($style_sheet_en == 1){ print "\n"; } } ###### フッター ######################### sub footer { print ""; print ""; } ###### 管理人パスワード設定 ######################### sub admin { print "Content-type:text/html\n\n"; print "\n"; &headauther; print "\n"; print "
\n"; if (-e "$admindat"){ print "
管理者用パスワードを入力してください。
\n"; print "\n"; print "\n"; print "\n"; } else { print "
管理者用パスワードを設定してください。
\n"; print "\n"; print "\n"; print "\n"; } print "
\n"; print "\n"; exit; } ###### 管理人パスワード登録 ######################### sub wradminpwd { $passwd = &makecrypt($all{pwd}); if (open(FILE,"> $admindat")){ print FILE "$passwd"; close(FILE); } else { print "Content-type:text/html\n\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "パスワードファイル作成に失敗しました\n"; print "\n"; print "\n"; print "パスワードファイル作成に失敗しました。"; print "\n"; exit; } print "Location: $script\n\n"; } ###### デコード ######################### sub mbdecode { local($data) = @_; local(%all); @tmparry=split(/&/,$data); foreach $string (@tmparry){ ($key,$value)=split(/=/,$string); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s//>/g; if ($key eq usage || $key eq style_sheet || $key eq head_insert){ $br = "
"; } else { $br = ""; } if ($value =~ /\r\n/) { $value =~ s/\r\n/$br/g; } if ($value =~ /\n/) { $value =~ s/\n/$br/g; } if ($value =~ /\r/) { $value =~ s/\r/$br/g; } if ($value =~ /,/) { $value =~ s/,/,/g; } $all{"$key"}=$value; } return(%all); } ###### ゲットクッキー ######################### sub getcookie { $cookies = $ENV{'HTTP_COOKIE'}; @pairs = split(/;/,$cookies); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $name =~ s/ //g; $DUMMY{$name} = $value; } @pairs = split(/,/,$DUMMY{$cookie_name}); foreach $pair (@pairs) { ($name, $value) = split(/:/, $pair); $COOKIE{$name} = &cookie_decode($value); } @opts=($COOKIE{name},$COOKIE{interval},$COOKIE{maxline},$COOKIE{join}); return(@opts); } ###### セットクッキー ######################### sub setcookie { local($chatname,$chatint,$chatline,$chatjoin)=@_; ($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg,$ydayg,$isdstg) = gmtime(time + 365*24*60*60); $yearg = $yearg + 1900; if ($yearg < 10) { $yearg = "0$yearg"; } if ($secg < 10) { $secg = "0$secg"; } if ($ming < 10) { $ming = "0$ming"; } if ($hourg < 10) { $hourg = "0$hourg"; } if ($mdayg < 10) { $mdayg = "0$mdayg"; } $y0="Sunday"; $y1="Monday"; $y2="Tuesday"; $y3="Wednesday"; $y4="Thursday"; $y5="Friday"; $y6="Saturday"; $youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6) [$wdayg]; $m0="Jan"; $m1="Feb"; $m2="Mar"; $m3="Apr"; $m4="May"; $m5="Jun"; $m6="Jul"; $m7="Aug"; $m8="Sep"; $m9="Oct"; $m10="Nov"; $m11="Dec"; $month = ($m0,$m1,$m2,$m3,$m4,$m5,$m6,$m7,$m8,$m9,$m10,$m11) [$mong]; $date_gmt = "$youbi, $mdayg\-$month\-$yearg $hourg:$ming:$secg GMT"; $cook= "name:" . &cookie_encode($chatname) . "\,interval:$chatint\,maxline:$chatline\,join:$chatjoin"; print "Set-Cookie: $cookie_name=$cook; expires=$date_gmt\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 { local($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd"); } ###### エラー ######################### sub error { print "Content-type: text/html\n\n"; print "$_[0]\n"; print "
$_[0]
\n"; print "\n"; exit; } sub cookie_encode { my $a = shift; $a =~ s/([\W])/sprintf("%%%02X", ord($1))/eg; 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; }