#! /usr/bin/perl # # jkchat.cgi # 1.005 : 10/17/07 : カンマの処理を修正 # 1.004 : 11/22/06 : 表示時間を修正 # 1.003 : 11/2/06 : 実況入力後テキストボックスにカーソルがフォーカスするよう修正 # 1.002 : 11/1/06 : 実況入力画面をリロードしないように修正 # 1.001 : 10/16/06 : Cookieを修正 # 1.0 : 10/1/06 : Created # # http://www.hidekik.com # # $Id: jkchat.cgi,v 1.8 2007/10/17 02:19:36 Hideki Kanayama Exp $ # Copyright(c) 1998-2006, 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 = "jkchat_setup.pl"; my $version="1.005"; my $lastupdateyear = "2007"; #このスクリプト my $script = basename($0); my $method = 'post'; my $admin_link = "$script?mode=admin"; my $lang = 0; #### 環境設定 ###### ここから ############ ####################### ### 実況ページ設定 #### ####################### our $jkchatfile = "jkdata.dat"; our $jkperson = "jkperson.dat"; #タイトルロゴ 1:使用 0:非使用 our $title = '実況チャット'; # シンプルウィンドウ 1:on, 0:off our $jksimple_en = 1; our $jksimple_title = 'シンプル'; # シンプル２ウィンドウ 1:on, 0:off our $jksimple2_en = 1; our $jksimple2_title = 'シンプル２'; # スプリットウィンドウ 1:on, 0:off our $jksplit_en = 1; our $jksplit_title = '分割'; # バックグランドカラー our $jkentry_bgcolor = '#ffffff'; our $jkwrite_bgcolor = '#ffffff'; our $jkshow_bgcolor = '#ffffff'; # フォントカラー our $jkname_color = 'darkblue'; our $jkmain_color = 'black'; our $jktime_color = 'gray'; # Cookie name our $jkcookie_name = 'jkchat_cookie'; #更新間隔のオプション our $jkint10 = 'on'; our $jkint20 = 'on'; our $jkint30 = 'on'; our $jkint40 = 'on'; our $jkint50 = 'on'; our $jkint60 = 'on'; #表示行数のオプション our $jkline10 = 'on'; our $jkline30 = 'on'; our $jkline50 = 'on'; #保存最大行数 our $jkmax = 100; #実況放棄までの実況者の無発言時間 our $jkexpire = 180; ########################### ### チャットページ設定 #### ########################### our $chatfile = "chatdata.dat"; our $joinlist = "join.lst"; # チャットタイトル our $chattitle = 'チャットページ'; our $toplink_en = 1; our $toplink_link = '..'; our $toplink_title = '【トップへ】'; our $admin_link_en = 1; our $admin_title = '【管理用】'; #参加者表示 our $attendee_en = 1; #トップと管理用のリンク先のターゲットウィンドウ our $top_target = '_top'; # 待機ウィンドウ 1:on, 0:off our $wait_en = 1; # 待機ウィンドウ 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 = 'chat_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; #GMTからのオフセット 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) = gmtime($now + $offset * 3600); my $date_now = sprintf("%02d月%02d日 %02d時%02d分%02d秒",$mon+1,$mday,$hour,$min,$sec); if ($in{mode} eq 'admin'){ &admin; } elsif ($in{mode} eq 'setup'){ &setup; } elsif ($in{mode} eq 'wrsetup'){ &wrsetup; } 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 'simplewin'){ &simplewin; } elsif ($in{mode} eq 'upsidedown'){ &upsidedown; } elsif ($in{mode} eq 'exitchat'){ &exitchat; } elsif ($in{mode} eq 'jkexitchat'){ &jkexitchat; } elsif ($in{mode} eq 'jktop'){ &jktop; } elsif ($in{mode} eq 'jkshow'){ &jkshow; } elsif ($in{mode} eq 'jkentry'){ &jkentry; } elsif ($in{mode} eq 'jkwrform'){ &jkwrform; } elsif ($in{mode} eq 'jkframe'){ &jkframe; } elsif ($in{mode} eq 'jkupsidedown'){ &jkupsidedown; } elsif ($in{mode} eq 'chatframe'){ &chatframe; } else { if (! -e "$admindat"){ &admin; } &topframe; } ###### トップフレーム ######################### sub topframe { &htmlhead("$title"); print < END } sub chatframe { &htmlhead("$title"); print < END } sub jkframe { &htmlhead("$title"); print < END } sub jkupsidedown { &htmlhead("$title"); print < END } ###### シンプルフレーム ######################### sub simplewin { &htmlhead("$title"); print < END } ###### 書き込み下フレーム ######################### sub upsidedown { &htmlhead("$title"); print < END } ###### チャットエントリー ######################### sub entry { &htmlhead("$chattitle"); print "\n"; print "\n\n\n
\n"; print "$chattitle"; print "\n\n"; my $target; if ("$in{style}" eq 'split'){ $target = 'sepwrwin'; } else { $target = 'write'; } print "
\n"; 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); &htmltail; } sub someoptions { my ($defint,$defline) = @_; my @intlist = (); my @linelist = (); if ($in{mode} eq 'jkentry' or $in{mode} eq 'jkwrform' or $in{mode} eq 'jktop'){ if ($jkint10 eq 'on'){@intlist = (10);} if ($jkint20 eq 'on'){@intlist = (@intlist,20);} if ($jkint30 eq 'on'){@intlist = (@intlist,30);} if ($jkint40 eq 'on'){@intlist = (@intlist,40);} if ($jkint50 eq 'on'){@intlist = (@intlist,50);} if ($jkint60 eq 'on'){@intlist = (@intlist,60);} if ($jkline10 eq 'on'){@linelist = (10);} if ($jkline30 eq 'on'){@linelist = (@linelist,30);} if ($jkline50 eq 'on'){@linelist = (@linelist,50);} } else { 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);} 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("$chattitle"); 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 "
"; print "
"; &optionbuttons; print ""; print "

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

\n"; &someoptions($in{interval},$in{maxline}); print "参加表\\示：\n"; print "$usage"; } my %attendee; 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 "
"; my %attendee; print "参加者：" if ($attendee_en); if(open(JOIN,"<$joinlist")){ while(){ chomp; my ($joinname,$jointime)=split(/,/); if ($now < $jointime+$limit){ $attendee{"$jointime"}=$joinname; if ($attendee_en) { if ("$attendee{$jointime}" ne "$in{chatname}"){ print "$joinname、"; } } } } close(JOIN); } if ($attendee_en) { 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 "" if ($attendee_en); # print "\n"; # printf("現在時刻：%02d月%02d日 %02d時%02d分%02d秒
\n",$mon+1,$mday,$hour,$min,$sec); print "

\n" if ($attendee_en); 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(1); } sub copyright{ my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "
jkchat.cgi Ver. $version
\n"; print "
Copyright(C) 1998-$lastupdateyear, hidekik.com
\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}; $chatline =~ s/,/,/g; push(@lines,"$date_now\,$in{chatname}\,$chatline\,$in{email}\,$host\n"); if (!open(DB,">$chatfile")) { &error('チャットファイルへ記録できません.'); } print DB @lines; close(DB); } sub jkwrite { my @lines; if (open(DB,"< $jkchatfile")) { @lines = ; close(DB); } my $host = $ENV{'REMOTE_HOST'}; my $addr = $ENV{'REMOTE_ADDR'}; $host ||= $addr; my $axs = $#lines; if ($axs >= $jkmax) { shift(@lines); } my $chatline = $in{jkchat}; $chatline =~ s/,/,/g; push(@lines,"$date_now\,$in{jkchatname}\,$chatline\,$in{email}\,$host\n"); if (!open(DB,"> $jkchatfile")) { &error('チャットファイルへ記録できません.'); } print DB @lines; close(DB); open(JOIN,">$jkperson"); print JOIN "$in{jkchatname},$now,$in{jktitle}\n"; close(JOIN); } ###### チャット退室 ######################### sub exitchat { my %attendee; 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 jkexitchat { unlink $jkperson; if ("$in{style}" eq 'jksplit'){ print "Location: $script?mode=jkentry&style=jksplit\n\n"; } else { print "Location: $script?mode=jkentry\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)=gmtime($now + 3600 * $offset); 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)=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 @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 @jksimple_en_check; my @jksimple2_en_check; my @jksplit_en_check; my @style_sheet_check; my @head_insert_check; my @attendee_check; $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'; $jksimple_en_check[$jksimple_en] = 'checked'; $jksimple2_en_check[$jksimple2_en] = 'checked'; $jksplit_en_check[$jksplit_en] = 'checked'; $style_sheet_check[$style_sheet_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; $attendee_check[$attendee_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';} my $jkint10_checked; my $jkint20_checked; my $jkint30_checked; my $jkint40_checked; my $jkint50_checked; my $jkint60_checked; my $jkline10_checked; my $jkline30_checked; my $jkline50_checked; if ($jkint10 eq 'on') {$jkint10_checked = 'checked';} if ($jkint20 eq 'on') {$jkint20_checked = 'checked';} if ($jkint30 eq 'on') {$jkint30_checked = 'checked';} if ($jkint40 eq 'on') {$jkint40_checked = 'checked';} if ($jkint50 eq 'on') {$jkint50_checked = 'checked';} if ($jkint60 eq 'on') {$jkint60_checked = 'checked';} if ($jkline10 eq 'on') {$jkline10_checked = 'checked';} if ($jkline30 eq 'on') {$jkline30_checked = 'checked';} if ($jkline50 eq 'on') {$jkline50_checked = 'checked';} print <
  • ディレクトリの設定は、$scriptから見た相対パス、又は絶対パスで指定してください。バックグランドファイルやロゴファイルはhttp://からのリンクの指定も可能\\です。
  • 管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。
  • これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。
  • $admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。
  • 管理用リンク表\\示をオフにしてる場合にこのページに入るには、$script?mode=adminからパスワードを入力して入って下さい。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
実況ページ設定
タイトル ブラウザのタイトルバーに表\示されるタイトル
実況データファイル名
実況者ファイル名
シンプルウィンドウ 有り 無し ボタン名
シンプル２ウィンドウ 有り 無し ボタン名
分割ウィンドウ 有り 無し ボタン名
バックグランドカラー 入り口
書き込み
表\\示
フォントカラー 名前
本文
時間
クッキー名
更新間隔オプション 10秒 20秒 30秒 40秒 50秒 60秒
表\\示行数オプション 10行 30行 50行
保存最大行数
自動実況放棄までの秒数 （180秒=3分）
チャットページ設定
チャットタイトル
チャットデータファイル名
参加者ファイル名
トップへのリンク 有り 無し
リンク名
リンク先
管理用へのリンク 有り 無し
リンク名
参加者表\示 有り 無し
ターゲットウィンドウ 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 &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}'; #### 環境設定 ###### ここまで ############ 1; END close(FILE); print "Location: $script\n\n"; } ###### java script ######################### sub setjavascript { print "\n"; } sub jksetjavascript { 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 jkoptionbuttons { if ($jksimple_en == 1){ print ""; } if ($jksimple2_en == 1){ print ""; } if ($jksplit_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; } if ($in{mode} eq 'jkshow' or $in{mode} eq 'jktop' or $in{mode} eq 'jkentry' or $in{mode} eq 'jkwrform' or $in{mode} eq 'jkoccupied'){ &jksetjavascript; } print <$localtitle END2 } ###### フッター ######################### sub htmltail { ©right if ($_[0]); 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 %in){ $value =~ s//>/g; my $br; 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/,/&\#44;/g; } $in{"$key"}=$value; } return(%all); } ###### ゲットクッキー ######################### sub getcookie { my $jk = shift; my $cookies; if ($jk ne ''){ $cookies = $q->cookie($jkcookie_name); } else { $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 $local_cookie_name; if ($in{mode} eq 'jkshow' or $in{mode} eq 'jkwrform'){ $local_cookie_name = $jkcookie_name; } else { $local_cookie_name = $cookie_name; } my $cookie = $q->cookie(-name => "$local_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); } } sub jkshow { my $wr="notdone"; my @forcook; my $status; 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("$jkperson"); my ($cookname,$cookint,$cookline,$cookjoin)=&getcookie('jk'); my ($jkname,$posted,$jktitle) = &announcer; if ($in{'jkchat'} ne '' && $in{'jkchatname'} ne '') { if ($d_mtime + $jkexpire >= $now){ &jkwrite; $wr="done"; } } if ($in{jkchatname} ne "" && $in{interval} ne "" && $in{maxline}){ @forcook=($in{jkchatname},$in{interval},$in{maxline}); $status = "form"; if ($d_mtime + $jkexpire >= $now){ open(JOIN,"> $jkperson"); print JOIN "$in{jkchatname},$now,$in{jktitle}\n"; close(JOIN); } } else { 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=jkshow&style=jksplit"; } else { $script2 = "$script?mode=jkshow"; } if (-e $jkperson){ $jktitle = "$jktitle を実況中"; } else { $jktitle = "$title"; } &htmlhead($jktitle,'refresh',$forcook[1],$script2); if ($status eq 'form'){ print "\n"; } else { print "\n"; } # printf("最終更新：%02d月%02d日 %02d時%02d分%02d秒
\n",$mon+1,$mday,$hour,$min,$sec); my @DATA; if (open(IN,"$jkchatfile")) { @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"; } } &htmltail; } sub jkentry { &htmlhead("$title"); print "\n"; print "\n\n\n
\n"; print "$title"; print "\n
\n"; print "\n"; my $target; if ("$in{style}" eq 'jksplit'){ $target = 'jksepwrwin'; } else { $target = 'jktop'; } print "
\n"; print "\n"; print "\n"; if ("$in{style}" eq 'jksplit'){ print "\n"; } print "
\n"; my ($cookname,$cookint,$cookline,$cookjoin)=&getcookie('jk'); if ($cookint == 0){$cookint = 30;} if ($cookline == 0) {$cookline = 30;} print "実況タイトル"; print "
\n"; print "実況者名 "; print "\n"; print "

\n"; &someoptions($cookint,$cookline); print "\n"; &htmltail; } sub jktop { if (-e "$jkperson"){ 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("$jkperson"); my ($cookname,$cookint,$cookline,$cookjoin)=&getcookie('jk'); my ($jkname,$posted,$jktitle) = &announcer; if ($d_mtime + $jkexpire >= $now){ if ($cookname eq $jkname){ $in{'jkchatname'} = $cookname; $in{'jktitle'} = $jktitle; $in{'interval'} = $cookint; $in{'maxline'} = $cookline; $in{'mode'} = 'jkwrform'; &jkwrform; } else { &jkoccupied; } } else { unlink $jkperson; &jkentry; } } else { &jkentry; } } sub jkwrform { my @forcook=($in{jkchatname},$in{interval},$in{maxline}); my $target; if ("$in{style}" eq 'jksplit'){ $target = 'jksepshowwin'; } else { $target = 'jkshow'; } if ($in{'jkchatname'} eq '') { print "Location: $script?mode=jkentry\n\n"; }else { &setcookie(@forcook); my $target; if ("$in{style}" eq 'jksplit'){ # &htmlhead("$title",'refresh',30,"$script?mode=jktop&style=jksplit"); &htmlhead("$title"); $target = 'jksepshowwin'; } else { # &htmlhead("$title",'refresh',30,"$script?mode=jktop"); &htmlhead("$title"); $target = 'jkshow'; } print "\n"; print "

\n"; if ("$in{style}" eq 'jksplit'){ print "\n"; } print "\n"; print "
"; &jkoptionbuttons; print ""; print "
\n"; print "$in{jktitle} の実況中
"; print "
\n"; print "\n"; print "\n"; print "$in{'jkchatname'} >

\n"; &someoptions($in{interval},$in{maxline}); } print "

\n"; if ($in{jkperson} eq 'write'){ open(JOIN,">$jkperson"); print JOIN "$in{jkchatname},$now,$in{jktitle}\n"; close(JOIN); } &htmltail; } sub jkoccupied { my ($jkname,$posted,$jktitle) = &announcer; &htmlhead('','refresh',30,"$script?mode=jktop"); print "
\n"; print "
\n"; print "$jkname が $jktitle を実況中です。

\n"; print "実況者が3分間無発言だと放棄と見なされ自動退室となります。
"; print "

\n"; print "\n"; print "\n"; print "
\n"; print "
\n"; &htmltail; } sub announcer { my $jktmp; open(FILE, "< $jkperson"); $jktmp = ; close(FILE); chomp($jktmp); my ($jkname,$posted,$jktitle) = split /,/, $jktmp; return ($jkname,$posted,$jktitle); }