#!/usr/bin/perl
#
# count+x: Access Counter CGI
#  file: countx.cgi
#
#  Copyright (C) 2001-2002 KOMORIYA Takeru
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# See "http://www.paken.org:8080/aaf/download/GPL" for more details.
#
# Contact to author:
#   KOMORIYA Takeru, AAF Sendai Lab., Japan
#   E-mail: komoriya@paken.org
#      URL: http://www.paken.org:8080/
#
#-----------------------------------------------------------------------
# Ver 1.23(2/26, 2002): Fixed handling of "cache:"
# Ver 1.22(2/24, 2002): Changed (?:$searchdelim) --> [\?\&](?:$searchdelim) 
#                       ,and deleted "?"/"&" in $searchdelim
# Ver 1.21(2/22, 2002): Added '?as_q=' to search engine finder.
# Ver 1.20(2/22, 2002): Added 'Kiri-ban' function.
#                       (emphasize figure when count number is like 
#                        '10000' or '5555')
#                       Added support for image search.
# Ver 1.10(2/21, 2002): Used Jcode.pm for UTF-8 support.
#                       Eliminated and colorized keyword of search engine.
#                       Added "Show Keywords" function
# Ver 1.02(10/12,2001): Deleted unused parameter $serverurl.
#                       Changed order of access statistics.
# Ver 1.01(10/11,2001): Added URL-sweep function for security
# Ver 1.00(10/11,2001): Added automatic link to referrer(proposed by AAF
#                       Hamaken)
# Ver 0.93(10/10,2001): Added $paramlines variable
#                       (Bug fix)Eliminated ~username/ from $uri
# Ver 0.92(10/9, 2001): (Bug fix)Ignored spaces before parameter string.
# Ver 0.91(8/22, 2001): Changed order of log message.
#                       Added 'Today' and 'Yesterday' counter function.
#                       (Works with "todayx.cgi" and "yesterdayx.cgi")
# Ver 0.9 (8/21, 2001): First release.
#-----------------------------------------------------------------------
# Usage
#  1.Save this file as "countx.cgi"
#  2.Edit this file and give correct path to perl(at first line)
#  3.Edit $local_ip, $topdir, $password, $digit, etc...
#  4.Change permission of this file "chmod 755 countx.cgi"
#  5.Create directory "mkdir countx_data" and "chmod 777 countx_data"
#  Note: SSI must be work with your web server.
#
#  To setup access couter in your page:
#  1.Give parameters in first 5 lines of your html file.
#   <!-- countx?PARAM1&PARAM2&PARAM3 -->
#   ex) <!-- countx?name=foo&showtop=1 -->
#  2.Insert this line where you want to print access counter.
#   <!--#exec cgi="/cgi-bin/countx.cgi"-->
# 
#  To show access log:
#   access to "/cgi-bin/countx.cgi?password=YOUR_PASSWORD"
#
#  To show search engine keywords:
#   access to "/cgi-bin/countx.cgi?keywords=1"
#
# ----- Parameters -----
# name=PAGE_NAME    : Page name. Default is "_top". 
#                     Also used as conter log file name.
# hidden=1          : Count only (Do not print counter)
# showtop=1         : Show counter of toppage instead of individual page.
# password=PASSWORD : If password is matched, show report page.
#---------------------------------------------------------------------

# ----------------- User defined  parameters -----------------------

# If Jcode.pm is not installed on your system, use jcode.pl instead. 
# $jcode_pl = 1;
$jcode_pl = 0;

# Local IP (do not count if accessed from this address)
$local_ip ="192.168.1.";

# URL of your homepage
$home ="http://www.yourserver.com/~yourname/";

# Top directory of html
$topdir = "/home/httpd/html";

# Password for report page
$password = 'password';

# Number of digit
$digit = 6;

# Search parameters in first $paramlines of html file
$paramlines = 10;

# Maximum log lines
$maxlog = 100;

# History size of duplicate access check
$dup_size = 10;

# Use 'Kiri-ban' function?
#  (emphasize figure when count number is like '10000' or '5555')
$use_kiriban = 1;

# Color of 'Kiri-ban'
$kiriban_color = "#0000FF";

# Color of search engine keyword
$searchcolor = "#FF0000";
$imagecolor = "#00FF00";

# For report customize
$show_count = 1;
$show_host = 1;
$show_agent = 0;
$show_entrance = 1;
$show_referrer = 1;
$show_date = 1;
$show_time = 1;

# --------------- End of user defined parameters ----------------

# Japanese code conversion
if ($jcode_pl){
    require 'jcode.pl';
}else{
    use Jcode;
}

# Directory for log-file (must be followed by '/')
$logdir = "./countx_data/";

# Top page name
$toppage = "_top";

# Lock for inhibit multiple invocation
# 0: Don't lock, 1: Lock(symlink), 2: Lock(mkdir)
$lockkey = 1;

# Test mode (If 1 is given, count local access)
$testmode = 0;

# Lock-file
$lockfile = $logdir . ".lock";

# Counter of 'Today'
$todaylog = $logdir . "today.log";

# Counter of 'Yesterday'
$yesterdaylog = $logdir . "yesterday.log";

# Deliminator for search engine
$searchdelim = "search=|MT=|query=|Text=|qt=|p=|s=|q=|as_q=";

#----------------------------------------------------------

# Get parameter string
if ($ENV{'QUERY_STRING'} eq ""){
    $uri = "$ENV{'DOCUMENT_URI'}";
    $uri =~ s/^\/~[^\/]+\//\//;
    $file = $topdir . $uri;
    if (!open(IN,"< $file")) {
	print "Content-type: text/html\n\n Cannot open file: $file";
	exit;
    }
    # Search parameters in first $paramlines lines
    for ($i=0; $i<$paramlines; $i++){
	$tmp = <IN>;
	chomp($tmp);
	if ($tmp =~ /countx?/) {
	    $tmp =~ s/.*<!--\s*countx\?//;
	    $tmp =~ s/\s*-->.*//;
	    $params = $tmp;
	    last;
	}
    }
    close (IN);
}else{
    $params = $ENV{'QUERY_STRING'};
}

# Split parameters
@pairs = split(/&/,$params);
foreach $pair (@pairs) {
    ($name,$value) = split(/=/,$pair);
    $in{$name} = $value;
}

# Show Search engine keywords
if ($in{'keywords'} ne ""){
    &showkeywords;
    exit;
}

# Show report
if ($in{'password'} eq "$password"){
    &report;
    exit;
}

# Jump to link URL
if ($in{'url'} ne ""){
    $url = $in{'url'};
    $url=~s/%([0-9a-f][0-9a-f])/pack("C",hex($1))/egi;
    &jumptourl;
    exit;
}

# Page name
if ($in{'name'} ne ""){
    $pagename = $in{'name'};
}else{
    $pagename = $toppage;
}

# Log file name
$logfile = $logdir . $pagename;
$toplog = $logdir . $toppage;

# Hidden mode?
$hidden=0;
if($in{'hidden'} == 1){
    $hidden = 1;
}

# Show toppage counter?
$showtop=0;
if($in{'showtop'} == 1){
    $showtop = 1;
}

# Accessed from Local PC?
$fromlocal=0;
if($ENV{'REMOTE_ADDR'} =~ /$local_ip/){
    if($testmode == 0){ $fromlocal=1; }
}

# Get remote host
if($ENV{'REMOTE_HOST'} !~/[a-zA-Z]/){
    $n_host = $ENV{'REMOTE_ADDR'};
    $ENV{'REMOTE_HOST'} = gethostbyaddr(pack('C4',split(/\./,$n_host)),2) || $n_host;
}

# Read from toppage logfile
if (-e $toplog) {
    # Lock
    &lock if ($lockkey);
    open(IN,"$toplog") || &error;
    @in = <IN>;
    close(IN);
    # Unlock
    &unlock if ($lockkey);
}else{
    @in = ();
}

# Search matched host for first $dup_size lines
@new=();
$flag = 0;
$newcount = 0;
$imax = @in;
if ($imax > $dup_size){
    $imax = $dup_size;
}
for ($i=0; $i<$imax; $i++){
    ($count,$rhost,$agent,$entrance,$referer,$atime) = split(/\t/, $in[$i]);
    chomp($atime);
    if ($i == 0){ $newcount =  $count; }
    # Don't count access from same host within 2hours
    if (($ENV{'REMOTE_HOST'} eq "$rhost") && ($atime > time - 7200)) {
	$flag=1;
    }
}

# Write to toppage log
if (($flag == 0) && ($fromlocal == 0)){
    # Lock
    &lock if ($lockkey);
    # Open logfile
    open(OUT,">$toplog") || &error;
    # Write new entry
    $newcount++;
    print OUT "$newcount"."\t";
    print OUT "$ENV{'REMOTE_HOST'}"."\t";
    print OUT "$ENV{'HTTP_USER_AGENT'}"."\t";
    print OUT "$pagename"."\t";
    $ref = $ENV{'HTTP_REFERER'};
    print OUT "$ref"."\t";
    $atime = time;
    print OUT "$atime"."\n";
    $lines = 1;
    foreach $in(@in){
	$lines++;
	print (OUT "$in");
	if($lines >= $maxlog){last;}
    }
    close(OUT);
    # Unlock
    &unlock if ($lockkey);

    # Update 'Today' and 'Yesterday' log
    $ENV{'TZ'} = "JST-9";
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    $date = sprintf("%02d/%02d", $mon + 1, $mday);
    if (-e $todaylog) {
	# Lock
	&lock if ($lockkey);
	open(IN,"$todaylog") || &error;
	$logdate = <IN>;
	chomp($logdate);
	$todaycount = <IN>;
	chomp($todaycount);
	close(IN);
	# Unlock
	&unlock if ($lockkey);
    }else{
	$logdate = $date;
	$todaycount = 0;
    }
    if ($logdate eq $date) {
	# Lock
	&lock if ($lockkey);
	# Today log data
	$todaycount++;
	open(OUT,">$todaylog") || &error;
	print OUT "$date"."\n";
	print OUT "$todaycount"."\n";
	close(OUT);
	# Unlock
	&unlock if ($lockkey);
    }else{
	# Lock
	&lock if ($lockkey);
	# New log data
	open(OUT,">$todaylog") || &error;
	print OUT "$date"."\n";
	print OUT "1"."\n";
	close(OUT);
	# Copy data to yesterday log
	open(OUT,">$yesterdaylog") || &error;
	print OUT "$logdate"."\n";
	print OUT "$todaycount"."\n";
	close(OUT);
	# Unlock
	&unlock if ($lockkey);
    }
}
$toppage_count = $newcount;

if ($pagename ne $toppage){
    # Read from logfile of $pagename
    if (-e $logfile) {
	# Lock
	&lock if ($lockkey);
	open(IN,"$logfile") || &error;
	@in = <IN>;
	close(IN);
	# Unlock
	&unlock if ($lockkey);
    }else{
	@in = ();
    }
    # Search matched host for first $dup_size lines
    @new=();
    $flag = 0;
    $newcount = 0;
    $imax = @in;
    if ($imax > $dup_size){
	$imax = $dup_size;
    }
    for ($i=0; $i<$imax; $i++){
	($count,$rhost,$atime) = split(/\t/, $in[$i]);
	chomp($atime);
	if ($i == 0){ $newcount =  $count; }
	# Don't count access from same host within 2hours
	if (($ENV{'REMOTE_HOST'} eq "$rhost") && ($atime > time - 7200)) {
	    $flag=1;
	}
    }
    # Write to logfile
    if (($flag == 0) && ($fromlocal == 0)){
	# Lock
	&lock if ($lockkey);
	# Open logfile
	open(OUT,">$logfile") || &error;
	# Write new entry
	$newcount++;
	print OUT "$newcount"."\t";
	print OUT "$ENV{'REMOTE_HOST'}"."\t";
	$atime = time;
	print OUT "$atime"."\n";
	$lines = 1;
	foreach $in(@in){
	    $lines++;
	    print (OUT "$in");
	    if($lines >= $dup_size){last;}
	}
	close(OUT);
	# Unlock
	&unlock if ($lockkey);
    }
}

if ($showtop == 1){
    $newcount = $toppage_count;
}

# Decimal to String
$count = sprintf("%0$digit\d",$newcount);

# Output conter
print "Content-type: text/html\n\n";
if ($hidden == 0){
    # Check Kiri-ban
    if ((($count =~ /^0*[1-9]0+$/) || ($count =~ /^0*([1-9])\1+$/)) && ($use_kiriban == 1)) {
	print "<FONT COLOR='$kiriban_color'><B>";
	print "$count";
	print "</B></FONT>";
    }else{
	print "$count";
    }
}

exit;

#--------------------------------------------------------------
sub lock {
    local($retry)=5;
    # delete old lock (older than 3 minutes)
    if (-e $lockfile) {
	($mtime) = (stat($lockfile))[9];
	if ($mtime && $mtime < time - 180) { &unlock; }
    }
    # symlink lock
    if ($lockkey == 1) {
	while (!symlink(".", $lockfile)) {
	    if (--$retry <= 0) { &error; }
	    sleep(1);
	}
    # mkdir lock
    } elsif ($lockkey == 2) {
	while (!mkdir($lockfile, 0755)) {
	    if (--$retry <= 0) { &error; }
	    sleep(1);
	}
    }
}

sub unlock {
    if ($lockkey == 1) { unlink($lockfile); }
    elsif ($lockkey == 2) { rmdir($lockfile); }
}

sub error{
    print "Content-type: text/html\n\n";
    print "ERROR";
    # unlock
    &unlock if ($lockkey);
    exit;
}

#--------------------------------------------------------------
sub report{
    print "Content-type: text/html\n\n";
    # Main report
    print "<HTML><HEAD>\n";
    print "<TITLE>Access Statistics</TITLE>";
    print "<META HTTP-EQUIV='Content-type' CONTENT='text/html; charset=Shift_JIS'>";
    print "</HEAD>\n";
    print "<BODY BGCOLOR=#FFFFFF>";

    $logfile = $logdir . $toppage;
    print "<HR>";
    print "<B>Access Log of Top page</B>";
    print "<HR>";
    print "<TABLE BORDER=0 CELLPADDING=2>\n";
    print "<TR>";
    if ($show_count){ print "<TH>Count</TH>"; }
    if ($show_date){ print "<TH>Date</TH>"; }
    if ($show_time){ print "<TH>Time</TH>"; }
    if ($show_referrer){ print "<TH>Referer</TH>"; }
    if ($show_entrance){ print "<TH>Entrance</TH>"; }
    if ($show_host){ print "<TH>Remote Host</TH>"; }
    if ($show_agent){ print "<TH>User Agent</TH>"; }
    print "</TR>\n";
    # Lock
    &lock if ($lockkey);
    open(IN,"$logfile") || &error;
    @in = <IN>;
    close(IN);
    # Unlock
    &unlock if ($lockkey);
    # Print log 
    foreach $in (@in) {
	($count,$rhost,$agent,$entrance,$referer,$atime) = split(/\t/, $in);
	chomp($atime);
	# Format Date and Time
	$ENV{'TZ'} = "JST-9";
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($atime);
	$year +=1900;
	$date = sprintf("%04d/%02d/%02d", $year , $mon + 1, $mday);
	$hour = sprintf("%02d:%02d", $hour,$min);
	print "<TR>";
	if ($show_count){ print "<TD>$count</TD>"; }
	if ($show_date){ print "<TD>$date</TD>"; }
	if ($show_time){ print "<TD>$hour</TD>"; }
	if ($show_referrer){
	    $url=$referer;
	    $url=~s/(\W)/sprintf("%%%02X",unpack("C",$1))/eg;
	    # Do not show if referer is your home
	    $referer =~ s/^$home.*//;
	    # Eliminate Keywords of search engine
	    if ($referer =~ s/.*[\?\&](?:$searchdelim)([^\&]*).*/<FONT COLOR='$searchcolor'>$1<\/FONT>/){
		$referer =~ s/cache:[^\+]*\+//;
		$referer =~ s/\+/ /g;
	    }
	    # from image search
	    if ($referer =~ /\?imgurl=/){
		$referer = "<FONT COLOR='$imagecolor'>[image]</FONT>";
	    }
	    $referer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	    # Convert to SJIS
	    if ($jcode_pl) {  
	        jcode::convert(*referer,'sjis');
	    }else{
		$referer=jcode($referer)->sjis;
	    }
	    print "<TD><A HREF=\"countx.cgi?url=$url\">$referer</A></TD>";
	}
	if ($show_entrance){ print "<TD>$entrance</TD>"; }
	if ($show_host){ print "<TD>$rhost</TD>"; }
	if ($show_agent){ print "<TD>$agent</TD>"; }
	print "</TR>\n";
	
    }
    print "</TABLE>\n";
    print "<P>";

    print "<HR>";
    print "<B>Access Statistics</B>";
    print "<HR>";
    print "<TABLE BORDER=0 CELLPADDING=2>\n";
    print "<TR><TH>Page name</TH><TH>Count</TH><TH>Last Access</TH></TR>\n";
    @files = sort glob("$logdir*");
    foreach $file(@files){
	$name = `basename "$file"`;
	chomp($name);
	if ($name eq $toppage){
	    next;
	}
	if (($logdir . $name) eq $todaylog){
	    next;
	}
	if (($logdir . $name) eq $yesterdaylog){
	    next;
	}
	# Lock
	&lock if ($lockkey);
	# Read counter value
	open(IN,"$file") || &error;
	($count,$rhost,$atime) = split(/\t/, <IN>);
	close(IN);
	# Unlock
	&unlock if ($lockkey);
	# Format Date and Time
	chomp($atime);
	$ENV{'TZ'} = "JST-9";
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($atime);
	$year +=1900;
	$date = sprintf("%04d/%02d/%02d", $year , $mon + 1, $mday);
	$hour = sprintf("%02d:%02d", $hour,$min);
	print "<TR><TD>$name</TD>";
	print "<TD>$count</TD>";
	print "<TD>$date $hour</TD>";
	print "</TR>\n";
    }
    print "</TABLE>\n";


    print "</BODY></HTML>\n";
}
#--------------------------------------------------------------
sub showkeywords{
    print "Content-type: text/html\n\n";
    # Main report
    print "<HTML><HEAD>\n";
    print "<TITLE>Keywords from Search engine</TITLE>";
    print "<META HTTP-EQUIV='Content-type' CONTENT='text/html; charset=Shift_JIS'>";
    print "</HEAD>\n";
    print "<BODY BGCOLOR=#FFFFFF>";

    $logfile = $logdir . $toppage;
    print "<HR>";
    print "<B>Keywords from Search engine</B>";
    print "<HR>";
    print "<TABLE BORDER=0 CELLPADDING=2>\n";
    print "<TR>";
    print "<TH>Date</TH>";
    print "<TH>Time</TH>";
    print "<TH>Keywords</TH>";
    print "<TH>Entrance</TH>";
    print "</TR>\n";

    # Lock
    &lock if ($lockkey);
    open(IN,"$logfile") || &error;
    @in = <IN>;
    close(IN);
    # Unlock
    &unlock if ($lockkey);
    # Print log 
    foreach $in (@in) {
	($count,$rhost,$agent,$entrance,$referer,$atime) = split(/\t/, $in);
	chomp($atime);
	# Format Date and Time
	$ENV{'TZ'} = "JST-9";
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($atime);
	$year +=1900;
	$date = sprintf("%04d/%02d/%02d", $year , $mon + 1, $mday);
	$hour = sprintf("%02d:%02d", $hour,$min);
	$url=$referer;
	$url=~s/(\W)/sprintf("%%%02X",unpack("C",$1))/eg;
	# from image search
	if ($referer =~ /\?imgurl=/){
	    $referer = "<FONT COLOR='$imagecolor'>[image]</FONT>";
	}
	# Eliminate Keywords of search engine
	if (($referer =~ s/.*[\?\&](?:$searchdelim)([^\&]*).*/<FONT COLOR='$searchcolor'>$1<\/FONT>/) || ($referer =~ /\[image\]/)){
	    $referer =~ s/cache:[^\+]*\+//;
	    $referer =~ s/\+/ /g;
	    $referer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	    # Convert to SJIS
	    if ($jcode_pl) {  
	      jcode::convert(*referer,'sjis');
	    }else{
		$referer=jcode($referer)->sjis;
	    }
	    print "<TR>";
	    print "<TD>$date</TD>";
	    print "<TD>$hour</TD>";
	    print "<TD><A HREF=\"countx.cgi?url=$url\">$referer</A></TD>";
	    print "<TD>$entrance</TD>";
	    print "</TR>\n";
	}
	
    }
    print "</TABLE>\n";
    print "</BODY></HTML>\n";
}
#--------------------------------------------------------------
sub jumptourl{
    $referer = $url;
    $referer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    # Convert to SJIS
    if ($jcode_pl) {  
        jcode::convert(*referer,'sjis');
    }else{
	$referer=jcode($referer)->sjis;
    }
    print <<"EOF";
Content-type: text/html

<HTML>
<HEAD>
<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=Shift-JIS">
<META HTTP-EQUIV="refresh" CONTENT="1; URL=$url">
</HEAD>
<BODY>
<CENTER>
<A HREF="$url">$referer</A>
</CENTER>
</BODY>
</HTML>
EOF

}