#!/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 = また明日いらっしゃってね。";}
$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 = $msg \n";
print "$fmsg[$id]\n";
print " $credit
もどる\n";
print "