#!/usr/local/bin/perl
#
# WebACCESS Type 2 for SSIを使わない特殊なバージョン (c)rescue.ne.jp
# (アクセスカンタ付き)
#
# 設置の例(biglobeの場合)
#
# public_html
# |
# |-- index.html # フレームを利用してindex.cgiへアクセスする為のファイル.
# |-- index.dat # 実際のホームページ用HTMLはindex.datに記録します.
# |-- index.cgi (755) # 処理ＣＧＩ
# |
# |-- log/ (777)
# |
# |-- bar.gif # グラフ用画像
# |-- count.dat (666) # 累計カウント数
# |-- count_day.dat (666) # 本日のカウント数
# |-- count_dmy.dat (666) # 日付
# |-- count_reg.dat (666) # 昨日のカウント数
# |-- webaxs2.cgi (755) # 解析結果表示ＣＧＩ
# 上記の構成で設置する場合は、★印の部分だけ自分用に設定するだけです.
# ★あなたのホームページＵＲＬ
$reload = 'http://www.host.jp/~user/';
# ホームページＨＴＭＬ(index.dat)のパス
$index = './index.dat';
# ★index.datが読み込めない場合に表示するページのＵＲＬ
$backup = 'http://www.host.jp/~user/backup.html';
# 作業ファイル
# logというディレクトリ(パーミッション777)を作成し、
# count.dat count_day.dat count_dmy.dat count_reg.dat を置く.
# count_dmy.datには設置する日(15日なら15)を、その他のファイルには0を入れておく.
$file = "./log/count.dat";
$file_day = "./log/count_day.dat";
$file_dmy = "./log/count_dmy.dat";
$file_reg = "./log/count_reg.dat";
$base_dir = "./log/";
# ロックファイル(このファイルは用意する必要はありません)
$lockfile = "./log/count.lock";
# ロック機構を使うかどうかの設定
# 正常に設置できているとして、「カウント数」の場所に常にBUSYと表示される場合は
# $lock_key = 0; と設定してください.
$lock_key = 1;
# 集計に含めないＵＲＬを指定（この文字列を含むデータを記録しない）
# .の前には\を書く
@mine = (
"http://www\.host\.jp/~user/",
"",
"",
"",
);
# アクセスを拒否するリモートホスト名を指定
# .の前には\を書く
@deny_host = (
"xxx\.or\.jp",
"",
"",
"",
);
#------------------------------------------------------------------------------------
#時刻関係は、外国サーバを利用の方は当サイトのＦＡＱを読んで時差調整してください.
#２日前のログを削除
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time - 48*60*60);
$del_log = sprintf("%02d%02d%02d",$year,$mon +1,$mday);
$del_log = $base_dir . "$del_log\.csv";
unlink("$del_log");
#本日の時刻取得
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$log = sprintf("%02d%02d%02d",$year,$mon +1,$mday);
$log = $base_dir . "$log\.csv";
#ホスト名取得
$host = $ENV{'REMOTE_HOST'};
$addr = $ENV{'REMOTE_ADDR'};
if ($host eq '') { $host = $addr; }
if ($host eq $addr) { $host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr; }
$ref = $ENV{'HTTP_REFERER'};
$ref =~ s/\%7E/\~/ig;
($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg,$ydayg,$isdstg) = gmtime(time + 24*60*60);
$y0="Sunday"; $y1="Monday"; $y2="Tuesday"; $y3="Wednesday"; $y4="Thursday"; $y5="Friday"; $y6="Saturday";
$m0="Jan"; $m1="Feb"; $m2="Mar"; $m3="Apr"; $m4="May"; $m5="Jun"; $m6="Jul"; $m7="Aug"; $m8="Sep"; $m9="Oct"; $m10="Nov"; $m11="Dec";
@youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6);
@monthg = ($m0,$m1,$m2,$m3,$m4,$m5,$m6,$m7,$m8,$m9,$m10,$m11);
$date_gmt = sprintf("%s\, %02d\-%s\-%04d %02d:%02d:%02d GMT",$youbi[$wdayg],$mdayg,$monthg[$mong],$yearg +1900,$hourg,$ming,$secg);
@pairs = split(/;/,$ENV{'HTTP_COOKIE'});
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ s/ //g;
$COOKIE{$name} = $value;
}
$CC = $COOKIE{$reload};
if ($CC eq '' || $CC != $mday) {
print "Set-Cookie: $reload=$mday; expires=$date_gmt\n";
$CCX = 1; #初回訪問
}
else { $CCX = 0; }
foreach $i (@deny_host) { if ($i ne '' && $host =~ /$i/i) { $DENY = 1; last; } }
if ($DENY) {
#アクセス拒否メッセージ
print "Content-type: text/html\n\n";
print <<'EOF';
File Not Found
EOF
exit;
}
else {
&gdcount;
if (!open(DATA,"$file_reg")) { $LAST = 'ERROR'; }
else { $LAST = ; close(DATA); }
if (!open(DATA,"$index")) { &error_msg; }
@HOMEPAGE = ;
close(DATA);
print "Content-type: text/html\n\n";
foreach (@HOMEPAGE) {
$_ =~ s//$count/g;
$_ =~ s//$count2/g;
$_ =~ s//$LAST/g;
print;
}
}
exit;
sub gdcount {
#２重起動防止処理開始 ------------------------------------------------------------------
if ($lock_key == 1) {
local($retry) = 3;
while (!symlink(".", $lockfile)) {
if (--$retry <= 0) { $count = $count2 = 'BUSY'; unlink($lockfile); return; }
sleep(2);
}
}
elsif ($lock_key == 0) {
$c = 0;
while(-f "$lockfile") {
$c++;
if ($c >= 3) { $count = $count2 = 'BUSY'; unlink($lockfile); return; }
sleep(1);
}
open(LOCK,">$lockfile");
close(LOCK);
}
if (!open(DATA,"$file_dmy")) {
unlink($lockfile);
return;
}
$_ = ;
close(DATA);
if ($_ != $mday) {
if (!open(DATA,"$file_day")) {
unlink($lockfile);
return;
}
$count2 = ;
close(DATA);
if (!open(DATA,">$file_day")) {
unlink($lockfile);
return;
}
print DATA "0";
close(DATA);
if (!open(DATA,"$file")) {
unlink($lockfile);
return;
}
$count = ;
close(DATA);
if (!open(DATA,">$file_reg")) {
unlink($lockfile);
return;
}
print DATA "$count2";
close(DATA);
if (!open(DATA,">$file_dmy")) {
unlink($lockfile);
return;
}
print DATA "$mday";
close(DATA);
}
if (!open(DATA,"$file")) {
unlink($lockfile);
return;
}
$count = ;
close(DATA);
if ($CCX) {
$count++;
if (!open(DATA,">$file")) {
unlink($lockfile);
return;
}
print DATA "$count";
close(DATA);
}
if (!open(DATA,"$file_day")) {
unlink($lockfile);
return;
}
$count2 = ;
close(DATA);
if ($CCX) {
$count2++;
if (!open(DATA,">$file_day")) {
unlink($lockfile);
return;
}
print DATA "$count2";
close(DATA);
}
if ($hour < 10) { $hour = "0$hour"; }
# ブラウザ名の取得
# Mozilla/3.0 (Windows 95; I) の場合 -> Mozilla/3
# Mozilla/2.0 (compatible; MSIE 3.01; Windows 95) の場合 -> MSIE/3 (Mozilla compatible)
$HTTP_USER_AGENT = $ENV{'HTTP_USER_AGENT'};
$HTTP_USER_AGENT =~ s//>/g;
($hua,$vers) = split('/',$HTTP_USER_AGENT);
if ($vers =~ /MSIE/) {
($hua1,$dummy1) = split(/MSIE /,$vers);
($hua2,$dummy2) = split(/\;/,$dummy1);
($hua3,$dummy3) = split(/\./,$hua2);
($hua4,$dummy4) = split(/\(/,$vers);
($hua5,$dummy5) = split(/\./,$hua4);
$hua ="MSIE\/$hua3 (Mozilla/$hua5 compatible)";
}
elsif ($hua eq "Mozilla") {
($hua4,$dummy4) = split(/\(/,$vers);
($hua5,$dummy5) = split(/\./,$hua4);
$hua ="Mozilla\/$hua5";
}
# リモートホスト名の判定
if ($host =~ /(.*)\.(\d+)$/) { ; }
elsif ($host =~ /(.*)\.(.*)\.(.*)\.(.*)$/) { $host = "\*\.$2\.$3\.$4"; }
elsif ($host =~ /(.*)\.(.*)\.(.*)$/) { $host = "\*\.$2\.$3"; }
# リンク元の取得
if ($ref =~ /file:/i) { $ref = ""; }
foreach $i (@mine) { if ($i ne '' && $ref =~ /$i/i) { $ref = ""; last; } }
if (!open(DB,">> $log")) {
unlink($lockfile);
return;
}
if ($CCX) { print DB "$hour\,$ref\,$host\,$hua\,$CCX\,\n"; }
else { print DB "\,\,\,\,$CCX\,\n"; }
close(DB);
#２重起動防止処理解除 ------------------------------------------------------------------
if (-e $lockfile) { unlink($lockfile) };
}
sub error_msg { print "Location: $backup\n\n"; exit; }