#!/usr/bin/perl # #↑プロバイダの定めるPerlへのパス。詳しくはプロバイダにお聞きください。 ######################################################### #宝探し用CGI Ver.0.2 # # Script by みさお(http://www.nmt.ne.jp) # # 2001/1/4作成 # ######################################################### #------------初期設定----------------- $kanri = "あなたの名前"; #管理者名 $email = "xxxx\@xxx.ne.jp"; #管理者メールアドレス(@の前には必ず\をつけること。) $home = '../index.html'; #戻り先アドレス http://〜から始まるURLまたはCGIからの相対パスで。 $codename = "宝物"; #アクセスコードの名称 $datafile = "takarafile.dat"; #コード設定&カウント書き込みファイル。このファイルを見られると、コードも隠したURLもばれてしまうので、必ず変更する。 $logfile = "accesslog.dat"; #アクセスログファイル。 #-----次の$message[n]は、アクセス不可の理由メッセージ。 #starttimeは開始時刻に、endtimeは終了時刻に、limit_countは制限されたアクセス数に #それぞれ設定ファイルを元に置き換えられます。 #宝探しらしく、メッセージを直してください。改行は
で。タグ有効です。 $message[0] = 'まだここへのリンクは許可はしていません!ここへのリンクが許可できるのはstarttimeからです。'; #アクセス開始時刻前のアクセスに対して。 $message[1] = 'もうこちらへのリンクは終了しました!

ここへのリンク許可はendtimeまででした。

またのチャンスをお待ちください。'; #アクセス終了時刻後のアクセスに対して。 $message[2] = 'ここへは本日既に
limit_count人の人が到達しましたので、
本日分のリンクを終了しました。'; #一日のアクセス制限数を超えた場合のアクセスに対して。 $message[3] = 'このリンクは既にlimit_count人の人が到達しましたので、
リンクを終了しました。'; #アクセス制限数を超えた場合のアクセスに対して。 $message[4] = 'さきほどアクセスしてくださった方と同じ方では・・・?

人数制限がありますので、他の方のために何度もクリックするのはおやめくださいね。'; #先にアクセスした人と同じホストとブラウザだった場合。 #-------以下は特に変更の必要なし。 $body = ''; #エラーメッセージのBODYタグ。画像などのファイル指定はhttp://〜から始まるURLまたはCGIからの相対パスで。 $lockdir = "temp_t"; #Lockディレクトリ $ad_lockdir = "temp_ad"; #管理用Lockディレクトリ $logwrite = "on"; #アクセスデータファイルにアクセスデータを書き込むかどうか。書き込むときはon。書き込まないときはoff $messagehtml = "gomenne.html"; #ごめんねページ。 #以下は作成者のHPへのリンクです。ページ右下隅に表示されます。不用なら削除。 $credit = '宝探し用CGI Ver.0.2'; #------------初期設定は以上。----- ########メイン処理############### &lock_check; #ロックチェック &file_lock; #ロック &decode; #デコード &open_datafile; #データファイルを開く &get_userdata; #表示可となった人のデータを取得。 &match_data; #データファイルとの照合。 &updata_file; #データファイルの書き換え &location; #宝物へlocation($flag=1の場合) &view; #報告($flag=0の場合)($msgがメッセージ) &unlock; exit; #############サブルーチン####### sub lock_check{ if(-C "$lockdir">0.0004){ &unlock; } if(-e "$ad_lockdir"){ &error(0, "すいません、管理人が作業中です。
しばらくお待ちください。

再度同じメッセージが出たときはエラーの可能\性もあります。
$kanriまでご連絡ください。"); } return; } sub file_lock{ $lockflag=0; if (mkdir($lockdir, 0755)) {return;} for ($i = 0; $i <= 5; $i++) { if (mkdir($lockdir, 0755)) { $lockflag=1; last; } else { sleep(1); } } if ($lockflag==0) { &error(0,"他の方がアクセス中です。もう少し待ってからお願いします。

このメッセージがいつまでも出るようでしたら、エラーの可能性があります。

$kanriに連絡してください。");} $SIG{'TERM'} = $SIG{'PIPE'} = $SIG{'HUP'} = "sigexit"; sub sigexit { rmdir($lockdir); exit(1); } } sub decode{ if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } $buffer =~ tr/+/ /; #$buffer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $buffer =~ s/\t//g; $buffer =~ s/\r\n//g; $buffer =~ s/\r//g; $buffer =~ s/\cM//g; $buffer =~ s/\n//g; #$buffer =~ s/^( |\s)+//; # 先頭のスペースを削除 #$buffer =~ s/( |\s)+$//; # 末尾のスペースを削除 $buffer; $takaracode = $buffer; $flag =0; $today_flag=0; $find_flag=0; } sub open_datafile{ open (IN,"$datafile") || &error(1, "データファイルが開けません。"); @datas = ; close (IN); } sub get_userdata{ $username = $ENV{'REMOTE_USER'}; $host = $ENV{'REMOTE_HOST'}; $add = $ENV{'REMOTE_ADDR'}; if ($host eq "" ){$host = $add;} if ($host eq $add) { $host = ((gethostbyaddr(pack('C4',split(/\./,$add)),2))[0]);} if ($host eq "" ){$host = $add;} $brawza = $ENV{'HTTP_USER_AGENT'}; $ref = $ENV{'HTTP_REFERER'}; } sub match_data{ unless($takaracode){&error(1,"$codenameを入力してください!");} foreach $data(@datas){ ($code,$day,$count,$time_start,$time_end,$limit_count,$limit_type,$url,$lasthost,$lastbrawza) = split("\t", $data); if ($code eq $takaracode){$find_flag=1;last;} } if ($find_flag==0){&error(1,"その$codenameは違いますよ!");} if ($code ne $takaracode){ &error(1,"$codenameが違います。");} chomp $lastbrawza; $today = &getday($^T); $starttime = &gettime($time_start); $endtime = &gettime($time_end); for ($i=0;$i<=3;$i++){ $message[$i] =~ s/starttime/$starttime/g; $message[$i] =~ s/endtime/$endtime/g; $message[$i] =~ s/limit_count/$limit_count/g; } $msg2=0; if ($day ne $today){$today_flag=1;} if ($time_start!=0 && $time_start > $^T){ $flag=0;$msg = $message[0]; return; } if ($time_end!=0 && $time_end< $^T){ $flag=0; $msg=$message[1]; return; } if ($lasthost eq $host && $lastbrawza eq $brawza){ $flag=0;$msg=$message[4]; return; } if ($limit_count!=0 && $limit_count <= $count){ if($limit_type eq "day"){ if ($today_flag==0){ $kigenday = &getday($ime_end); if ($time_end==0 || $today ne $kigenday){ $msg2="

また明日いらっしゃってね。";} $flag=0;$msg=$message[2].$msg2; return; } else { $flag=1;return; } } else { $flag=0;$msg=$message[3]; return; } } $flag=1; } sub updata_file{ $c = 0; foreach $data(@datas){ ($d_code,$d_day,$d_count,$d_time_start,$d_time_end,$d_limit_count,$d_limit_type,$d_url,$lasthost,$lastbrawza) = split("\t", $data); if ($d_code eq $takaracode){ if ($today_flag){ $d_day=$today; if ($d_limit_type eq "day"){$d_count=0;} } if ($flag){ $d_count++; $lasthost=$host; $lastbrawza=$brawza; } $c=$d_count; $lastbrawza =~ s/\n//; $data = "$d_code\t$d_day\t$d_count\t$d_time_start\t$d_time_end\t$d_limit_count\t$d_limit_type\t$d_url\t$lasthost\t$lastbrawza\n"; } push (@newdatas,"$data"); } open (LINES,">$datafile") || &error(1, "データファイルが開けません。"); eval 'flock(LINES,2);'; seek (LINES,0,0); print LINES (@newdatas); eval 'flock(LINES,8);'; close (LINES); if ($logwrite eq "on"){ open (LINES,">>$logfile") || &error(1, "アクセスログ記録ファイルが開けません。"); eval 'flock(LINES,2);'; seek (LINES,0,0); print LINES ("$takaracode\t$today\t$^T\t$flag\t$c\t$username\t$host\t$brawza\t$ref\n"); eval 'flock(LINES,8);'; close (LINES); } } sub location{ if ($flag==1){ print "Location: $url\n"; print "\n"; } } sub view{ if ($flag==0){ open (IN,"$messagehtml") || &error(1, "ごめんねページが開けません。"); @html = ; close (IN); print "Content-type: text/html\n\n"; foreach $html(@html){ $html =~ s/msg/$msg/; $html =~ s/credit/$credit/; print "$html"; } } } sub unlock{ return rmdir($lockdir); } ############################ #秒数を年月日に変換 sub gettime{ local($time) = @_; ($sec,$min,$hour,$dy,$mon,$year,$wday,$yday,$isdst) = localtime($time); $year += 1900 ; $mon = $mon + 1; @week = ('日','月','火','水','木','金','土'); if($hour<10){$hour = "0$hour";} if($min<10){$min = "0$min";} $time = "$year年$mon月$dy日\($week[$wday]\)$hour:$min"; return $time; } #日付取得 sub getday{ local($time) = @_; ($sec,$min,$hour,$dy,$mon,$year,$wday,$yday,$isdst) = localtime($time); $year += 1900 ; $mon = $mon + 1; if($hour<10){$hour = "0$hour";} if($min<10){$min = "0$min";} $time = "$year/$mon/$dy"; return $time; } #エラーメッセージ #----------&error($id, "$msg")の形で渡される。$idは数字、$msgはメッセージ sub error{ &unlock; local ($id,$msg) = @_; $title = "お知らせ"; $fmsg[0] = "Backを押して戻ってください。"; $fmsg[1] = "$kanriに連絡してください。"; print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "$title\n"; print "\n"; print "

$msg

\n"; print "$fmsg[$id]\n"; print "


もどる\n"; print "

$credit

\n"; print "\n"; exit; }