#!/usr/local/bin/perl

## LimeCounter v2.1
## Copyright (c) KentWeb

# 外部ファイル取り込み
require './init.pl';

# 外部データ受け取り
$buf = $ENV{'QUERY_STRING'};
$buf =~ s/\W//g;

# IPアドレス取得
$addr = $ENV{'REMOTE_ADDR'};
$type = 2;
# ファイル定義
#$datafile = "$datadir/$buf.dat";
$datafile = "./data/$buf.dat";
#$lockfile = "$lockdir/$buf.lock";
$lockfile = "./lock/$addr.lock";
#&lock;
if ($skipflag) {goto E;}
###################アクセス者IPの全記録（開始）####################
# ログファイル
$logfile = "../dayx/dayx.dat";

# 記録ファイルから読み込み
open(INLOG,"$logfile") || &error("Open Error: $logfile");
flock(INLOG,1);
$datalog = <INLOG>;
flock(INLOG,8);
close(INLOG);

# 記録ファイルを分解
($key,$yes,$today,$countlog,$youbi,$iplog,$click,$allip,$proxcnt,$td_newip,$td_newprox,$td_oldip,$td_oldprox) = split(/<>/, $datalog);

# lime.logから読み込み
$f=0;
open(IN,"$idxfile");
flock(IN,1);
while (<IN>) {
##########項目追加↓
	($id,$sub,$link,$oldname,$file) = split(/<>/);
##########項目追加↑
	if ($buf eq $id) { $f++; last; }
}
flock(IN,8);
close(IN);

# 日時を取得
$ENV{'TZ'} = "JST-9";
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
@week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
$year += 1900;
$mon++;
$thisday = $week[$wday];
if ($hour < 10) { $hour = "0$hour"; }
if ($min < 10) { $min = "0$min"; }
if ($sec < 10) { $sec = "0$sec"; }
if ($mon < 10) { $mon = "0$mon"; }
$date = "$year\/$mon";
if ($mday < 10) { $mday = "0$mday"; }
$year_last2 = substr($year, 2);
$month = "NAM$year_last2\P$year$mon$mday\($thisday\)";
$year_y = $year;
$mon_y = $mon;
if (($mday eq "01") && ($mon eq "01")) {
	$year_y = $year - 1;
	$mon_y = 12; 
} elsif ($mday eq "01") {
 	$mon_y = $mon - 1;
}
$monthy = "NAM$year_last2\P$year_y$mon_y$key\($youbi\)";

# ファイル定義
$megfile = "../lime_PLIST/$month.htm";
$megfiley = "../lime_PLIST/$monthy.htm";
$listfile = "$month.htm";
$meglist = "../lime_PLIST/NAM$year_last2\PLIST.htm";
$yearlist = "../lime_PLIST/NAMYEARPLIST.htm";
$todip = "../dayx/todip.dat";
$lockfile = "../dayx/lock/dayx.lock";
$ipfile = "../lime/namvlz/$addr.htm";

$host = gethostbyaddr(pack("C4",split(/\./,$ENV{'REMOTE_ADDR'})),2);

$software = $ENV{'SERVER_SOFTWARE'};
$docroot = $ENV{'DOCUMENT_ROOT'};
$gatewayi = $ENV{'GATEWAY_INTERFACE'};
$rmethod = $ENV{'REQUEST_METHOD'};
$ruser = $ENV{'REMOTE_USER'};
$path = $ENV{'PATH'};
$vsname = $ENV{'VSERVER_NAME'};
$tz = $ENV{'TZ'};
$con = $ENV{'HTTP_CONNECTION'};
$accept = $ENV{'HTTP_ACCEPT'};
$acceptl = $ENV{'HTTP_ACCEPT_LANGUAGE'};
$authtype = $ENV{'AUTH_TYPE'};
$accepte = $ENV{'HTTP_ACCEPT_ENCODING'};
$scrfname = $ENV{'SCRIPT_FILENAME'};
$scname = $ENV{'SCRIPT_NAME'};
$sname = $ENV{'SERVER_NAME'};
$requri = $ENV{'REQUEST_URI'};
$sport = $ENV{'SERVER_PORT'};
$clength = $ENV{'CONTENT_LENGTH'};
$httphost = $ENV{'HTTP_HOST'};
$sadmin = $ENV{'SERVER_ADMIN'};
$referer = $ENV{'HTTP_REFERER'};
$uagent = $ENV{'HTTP_USER_AGENT'};
$acceptc = $ENV{'HTTP_ACCEPT_CHARSET'};
$rport = $ENV{'REMOTE_PORT'};

$cachec = $ENV{'HTTP_CACHE_CONTROL'};
$cachei = $ENV{'HTTP_CACHE_INFO'};
$cachep = $ENV{'HTTP_CACHE_IP'};
$client = $ENV{'HTTP_CLIENT_IP'};
$cookie = $ENV{'HTTP_COOKIE'};
$forw = $ENV{'HTTP_FORWARDED'};
$pragma = $ENV{'HTTP_PRAGMA'};
$proxy = $ENV{'HTTP_PROXY'};
$pcon = $ENV{'HTTP_PROXY_CONNECTION'};
$ppass = $ENV{'HTTP_PROXY_PASS'};
$puser = $ENV{'HTTP_PROXY_USER'};
$sphost = $ENV{'HTTP_SP_HOST'};
$te = $ENV{'HTTP_TE'};
$via = $ENV{'HTTP_VIA'};
$xon = $ENV{'HTTP_XONNECTION'};
$xforw = $ENV{'HTTP_X_FORWARDED_FOR'};
$xlocking = $ENV{'HTTP_X_LOCKING'};
$xcon = $ENV{'HTTP_XROXY_CONNECTION'};

$from = $ENV{'HTTP_FROM'};
$modify = $ENV{'HTTP_IF_MODIFIED_SINCE'};
$sprtcl = $ENV{'SERVER_PROTOCOL'};
$pathi = $ENV{'PATH_INFO'};
$patht = $ENV{'PATH_TRANSLATED'};
$querys = $ENV{'QUERY_STRING'};
$autht = $ENV{'AUTH_TYPE'};
$rid = $ENV{'REMOTE_IDENT'};
$ctype = $ENV{'CONTENT_TYPE'};

#----------------#
#  日次カウント  #
#----------------#
# 同じ日付の処理
unless (-e $megfile) { 
	open(DB,">>$megfile") || &error("Write(Add) Error: $megfile");
	flock(DB,2);
	print DB "<html>\n<head>\n<META HTTP-EQUIV='Content-type' CONTENT='text\/html; charset=Shift_JIS'>\n<title>$year\年$mon\月$mday\日($thisday\)<\/title>\n<\/head>\n<body BGCOLOR='#00FF93'>\n<table frame='border' border='2'>\n<TR><TH align='right'>年月日\(HH:MM:SS\)<\/TH><TH>host<\/TH><TH>addr\(≠P\)<\/TH><TH>閲覧<\/TH><TH>cookie<\/TH><TH>from<\/TH><TH>referer<\/TH><TH>autht<\/TH><TH>clength<\/TH><TH>ctype<\/TH><TH>docroot<\/TH><TH>gatewayi<\/TH><TH>accept<\/TH><TH>acceptc<\/TH><TH>accepte<\/TH><TH>acceptl<\/TH><TH>cachep<\/TH><TH>con<\/TH><TH>httphost<\/TH><TH>modify<\/TH><TH>uagent<\/TH><TH>path<\/TH><TH>pathi<\/TH><TH>patht<\/TH><TH>querys<\/TH><TH>rid<\/TH><TH>rport\(≠P\)<\/TH><TH>ruser<\/TH><TH>rmethod<\/TH><TH>requri<\/TH><TH>scrfname<\/TH><TH>scname<\/TH><TH>sadmin<\/TH><TH>sname<\/TH><TH>sport<\/TH><TH>sprtcl<\/TH><TH>sprotoc<\/TH><TH>software<\/TH><TH>vsname<\/TH><TH>tz<\/TH><TH>cachec\(P\)<\/TH><TH>cachei\(P\)<\/TH><TH>client\(P\)<\/TH><TH>forw\(P\)<\/TH><TH>pragma\(P\)<\/TH><TH>proxy\(P\)<\/TH><TH>pcon\(P\)<\/TH><TH>ppass\(P\)<\/TH><TH>puser\(P\)<\/TH><TH>sphost\(P\)<\/TH><TH>te\(P\)<\/TH><TH>via\(P\)<\/TH><TH>xforw\(P\)<\/TH><TH>xlocking\(P\)<\/TH><TH>xon\(P\)<\/TH><TH>xcon\(P\)<\/TH><\/TR>\n";
	flock(DB,8);
	close(DB);
}
open(DB,">>$megfile") || &error("Open Error: $megfile");
flock(DB,2);
print DB "<TR><TD>$year\年$mon\月$mday\日($thisday\) ($hour\：$min\：$sec\)</TD><TD>$host</TD><TD><A HREF='${ipfile}' target='_blank'>$addr</A></TD><TD><A HREF='http://192.168.11.3/lime_SMPL/limelog.htm' target='_blank'>$sub</A></TD><TD>$cookie</TD><TD>$from</TD><TD>$referer</TD><TD>$autht</TD><TD>$clength</TD><TD>$ctype</TD><TD>$docroot</TD><TD>$gatewayi</TD><TD>$accept<BR>$datalog</TD><TD>$acceptc</TD><TD>$accepte</TD><TD>$acceptl</TD><TD>$cachep</TD><TD>$con</TD><TD>$httphost</TD><TD>$modify</TD><TD>$uagent</TD><TD>$path</TD><TD>$pathi</TD><TD>$patht</TD><TD>$querys</TD><TD>$rid</TD><TD>$rport</TD><TD>$ruser</TD><TD>$rmethod</TD><TD>$requri</TD><TD>$scrfname</TD><TD>$scname</TD><TD>$sadmin</TD><TD>$sname</TD><TD>$sport</TD><TD>$sprtcl</TD><TD>$sprotoc</TD><TD>$software</TD><TD>$vsname</TD><TD>$tz</TD><TD>$cachec</TD><TD>$cachei</TD><TD>$client</TD><TD>$forw</TD><TD>$pragma</TD><TD>$proxy</TD><TD>$pcon</TD><TD>$ppass</TD><TD>$puser</TD><TD>$sphost</TD><TD>$te</TD><TD>$via</TD><TD>$xforw</TD><TD>$xlocking</TD><TD>$xon</TD><TD>$xcon</TD></TR>\n";
flock(DB,8);
close(DB);
#######################################IP毎のアクセス記録処理　開始
unless (-e $ipfile) { 
	open(IPF,">>$ipfile") || &error("Write(Add) Error: $ipfile");
	flock(IPF,2);
	print IPF "<html>\n<head>\n<META HTTP-EQUIV='Content-type' CONTENT='text/html; charset=Shift_JIS'>\n<title>$addr\($host\)</title>\n</head>\n<body BGCOLOR='#00FF93'>\n<PRE>\n";
	print IPF "$host\n\n";
} else {
	open(IPF,">>$ipfile") || &error("Write(Add) Error: $ipfile");
	flock(IPF,2);
}
print IPF "$year\年$mon\月$mday\日($thisday\) ($hour\：$min\：$sec\)：$sub\n";
flock(IPF,8);
close(IPF);

#######################################IP毎のアクセス記録処理　終了
# チェックモード
if (!$buf || $buf eq "check") { &check; }

# データが存在しない場合は終了
unless (-e $datafile) { &error("Not Exist: $datafile"); }

# データ読み取り
open(IN,"$datafile") || &error("Open Error: $datafile");
flock(IN,1);
$data = <IN>;
flock(IN,8);
close(IN);

# カウントアップ
($count,$ip) = split(/:/, $data);
if (!$ip_chk || ($ip_chk && $addr ne $ip)) {
	$count++;

	open(OUT,">$datafile") || &error("Write Error: $datafile");
	flock(OUT,2);
	print OUT "$count:$addr";
	flock(OUT,8);
	close(OUT);
}

# ページカウンタ
if ($type == 1) {

	# ダミーGIF画像
	local(@gif) = (
		"47","49","46","38","39","61","02","00","02","00","80","00",
		"00","00","00","00","ff","ff","ff","21","f9","04","01","00",
		"00","01","00","2c","00","00","00","00","02","00","02","00",
		"00","02","02","8c","53","00","3b");

	# ダミー画像を表示
	print "Content-type: image/gif\n\n";
	foreach (@gif) {
		print pack('C*',hex($_));
	}

# ダウンロードカウンタ
} else {

	if (!$f) { &error("IDが不正です"); }

	# Locationヘッダ
	if ($type == 2) {

		# IISサーバ (PerlIS) 対応
		if ($ENV{'PERLXS'} eq "PerlIS") {
			print "HTTP/1.0 302 Temporary Redirection\r\n";
			print "Content-type: text/html\n";
		}

		# ファイルへジャンプ
		print "Location: $file\n\n";

	# metaタグ
	} else {

		&header("<META HTTP-EQUIV=\"refresh\" CONTENT=\"1; URL=$file\">");
		print "<div align=center>自動でダウンロードできない場合は\n";
		print "<a href=\"$file\">ここ</a> をクリックしてください。<br>\n";
		print "<form><input type=button value='閉じる' onClick='top.close();'>\n";
		print "</form></div>\n</body></html>\n";
	}
}
E:
exit;

#######################################サブルーチン追加　開始
#--------------#
#  ロック処理  #
#--------------#
sub lock {
	local($retry) = 5;
	$skipflag = 0;
	# （演算子　ファイル名）　-e : ファイルが存在する
	if (-e $lockfile) {
		local($mtime) = (stat($lockfile))[9];
		if ($mtime < time - 60) {
			utime time, time, $lockfile;
			$skipflag = 1;
		} else {
			$lockflag=1;
			&wait1;
		}
	} else {
		while (!mkdir($lockfile, 0755)) {
			if (--$retry <= 0) { &error; }
			sleep(1);
		}
	}
#	while (!mkdir($lockfile, 0755)) {
#			if (--$retry <= 0) { &error; }
#			sleep(1);
#	}
	$lockflag=1;
}

#--------------#
#  ロック解除  #
#--------------#
sub unlock {
	rmdir($lockfile);
	$lockflag=0;
}

#----------------#
#  桁区きり処理  #
#----------------#
sub filler {
	local($_) = $_[0];
	# "." は、「\n以外の任意の1文字」。"*" は、「適合文字列0個以上」の意味
	# \d+は「数字1文字
	# $1は月で、$2は日
	1 while s/(.*\d)(\d\d\d)/$1,$2/;
	$_;
}

#--------------#
#  エラー処理  #
#--------------#
sub error {
	# ロック中の時は解除
	if ($lockflag) { &unlock; }
	&header();
	print "<h3>エラー</h3>$_[0]\n";
	print "</body></html>\n";
	exit;
}

#--------------#
#  wait表示処理  #
#--------------#
sub wait1 {
	# ロック中の時は解除
	if ($lockflag) { &unlock; }
	&header();
	print "<h3>エラー</h3>$_[0]\n";
	print "</body></html>\n";
	exit;

}

#######################################サブルーチン追加　終了
#--------------#
#  HTMLヘッダ  #
#--------------#
sub header {
	local($meta) = @_;

	print "Content-type: text/html\n\n";
	print <<EOM;
<html>
<head>
<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=Shift_JIS">
$meta
<title>$ver</title></head>
<body>
EOM
}

#------------------#
#  チェックモード  #
#------------------#
sub check {
	&header();
	print <<EOM;
<h3>Check Mode</h3>
<ul>
EOM

	# indexのパス確認
	# （演算子　ファイル名）　-e : ファイルが存在する
	if (-e $idxfile) {
		print "<li>インデックスファイルのパス: OK!\n";

		# パーミッション
		# （演算子　ファイル名）　-r : 実効uid/gidでファイルが読める
		if (-r $idxfile && -w $idxfile) {
			print "<li>インデックスファイルのパーミッション: OK!\n";
		} else {
			print "<li>インデックスファイルのパーミッション: NG → $idxfile\n";
		}
	} else {
		print "<li>インデックスファイルのパス: NG → $idxfile\n";
	}

	# データディレクトリ
	# （演算子　ファイル名）　-d : ディレクトリかどうか
	if (-d $datadir) {
		print "<li>データディレクトリのパス: OK!\n";

		# （演算子　ファイル名）　-r : 実効uid/gidでファイルが読める
		if (-r $datadir && -w $datadir && -x $datadir) {
			print "<li>データディレクトリのパーミッション: OK!\n";
		} else {
			print "<li>データディレクトリのパーミッション: NG → $datadir\n";
		}
	} else {
		print "<li>データディレクトリのパス: NG → $datadir\n";
	}

	# ロックディレクトリ
	print "<li>ロック形式: ";
	if ($lockkey == 0) { print "ロック設定なし\n"; }
	else {
		if ($lockkey == 1) { print "symlink\n"; }
		else { print "mkdir\n"; }
		print "<li>ロックディレクトリ: $lockdir\n";

		# （演算子　ファイル名）　-d : ディレクトリかどうか
		if (-d $lockdir) {
			print "<li>ロックディレクトリのパス: OK!\n";
			# （演算子　ファイル名）　-r : 実効uid/gidでファイルが読める
			if (-r $lockdir && -w $lockdir && -x $lockdir) {
				print "<li>ロックディレクトリのパーミッション: OK!\n";
			} else {
				print "<li>ロックディレクトリのパーミッション: NG → $lockdir\n";
			}
		} else {
			print "<li>ロックディレクトリのパス: NG → $lockdir\n";
		}
	}

	# 著作権表示：削除禁止
	print <<EOM;
<li>バージョン: <a href="http://www.kent-web.com/">$ver</a>
</ul>
</body>
</html>
EOM
	exit;
}

__END__
