0byt3m1n1

Path: /data/.snapshot/daily.2025-04-17_0010/templates/counter/ [ Home ]
File: count.cgi
#!/usr/bin/perl -w
use strict;
#use Fcntl ':flock';
#####################
# BS Counter (v2.0.2)
# Copyright 1999-2003 Brian Stanback <brian at stanback dot net>
# This software is protected under the GNU General Public License (see LICENSE)

#
# Set config options (see the docs/README for config instructions)
#

# WWW path where png digit images are located (include trailing slash)
my $digits_dir = "http://images.netsolhost.com/counter/";

# Directory that houses the xml data files (include trailing slash)
my $data_dir = ".";

# Put your ip here if you don't want the counter to count hits from you (otherwise leave it as 127.0.0.1)
my $my_ip = "127.0.0.1";

#
# Constants related to locking
#

# If the lock is not created at first time, we will sleep a random number of seconds. The initial random
# number is chosen  betwen 0 and $INITIAL_SLEEP_RANDOM_INTERVAL and subsequent random intervals are
# multiplied by $MULTIPLIER_SLEEP_RANDOM_INTERVAL. When creating a link, if the creation is not succesful
# at first the same algorithm and constants apply
my $INITIAL_SLEEP_RANDOM_INTERVAL = 0.0625; # 62.5 miliseconds
my $MULTIPLIER_SLEEP_RANDOM_INTERVAL = 2;  # Double the interval every time

# If we can't the lock after $MAX_TRIES_LOCK tries or
# if we can't create a link in $MAX_TRIES_LINK tries, we give up
my $MAX_TRIES_LOCK = 10;
my $MAX_TRIES_LINK = 5;

# If we can't get the lock after $MAX_TIME_WAIT_LOCK seconds or
# if we can't create a link after $MAX_TIME_WAIT_LINK seconds, we give up
my $MAX_TIME_WAIT_LINK = 10;
my $MAX_TIME_WAIT_LOCK = 60;

# In the event that we didn;t get the lock, remove possible stale locks older than $MAX_LOCK_AGE seconds.
my $MAX_LOCK_AGE = 120;
#
# Begin script
#

my @time = localtime(time);
my $total;
my @today;
my %geographic;
my %browsers;
my %platforms;
my %terms;
my %referrers;
my @hosts;

my %in;
&getvars;
my $file = $in{'page'} || "default";
my $style = $in{'style'} || "default";
my $type = $in{'type'} || "text";
my $imgtype = $in{'imgtype'} || "png";
my $nbdigits = $in{'nbdigits'} || 1;
my $allow_reloads = $in{'reloads'} || 0;

# List of Browsers (Name => Regex)
my @agents = (
		"MSN => MSN",
		"Opera => Opera",
		"AOL => AOL",
		"Internet Explorer 5+ => MSIE [5-9]",
		"Internet Explorer 4- => MSIE",
		"Netscape 6+ => Netscape",
		"Netscape 4- => Nav",
		"Apple/Safari => Safari",
		"Nokia => Nokia",
		"Robot/Spider => Googlebot|Surf|Crawler|Mercator|Seek|Arachnoidea|Link|Slurp|Copier|Shrelock",
		"Konqueror => Konqueror",
		"WebTV => WebTV",
		"Mosaic => NCSA",
		"Lynx => Lynx",
		"Download Agents => Kontiki|Wget|GetRight|gozilla",
		"Mozilla => Mozilla",
		"Unknown => .*"
	);

# List of Platforms
my @os = (
		"Windows NT/2K/XP => Windows NT|Windows 2000|Windows XP|WinNT",
		"Windows 9x/ME => Windows|Win98|Win95",
		"Windows 3.1 => Win3.1",
		"Mac OSX => Mac OS X",
		"Mac PowerPC => Mac",
		"Linux => Linux",
		"HP-UX => HP-UX",
		"SunOS => SunOS",
		"BSD => BSD",
		"UNIX => UNIX",
		"IRIX => IRIX",
		"QNX => QNX",
		"OS/2 => OS/2",
		"Nokia => Nokia",
		"Amiga => Amiga",
		"WebTV => WebTV",
		"Unknown => .*"
	);

#
# Parse the XML stats file
#

if (-f "$data_dir$file.xml") {
	exclusive_access_begin($data_dir,"$file.xml");
	&parse_xml("$data_dir$file.xml");
	if (! defined($total)) {
		exclusive_access_end($data_dir,"$file.xml");
		fail_safe($data_dir,"$file.xml");
	}
} else {
	open(XML,">$data_dir$file.xml"); close(XML);
	exclusive_access_begin($data_dir,"$file.xml");
}

#
# Update stats
#

if ($ENV{'REMOTE_ADDR'} and $ENV{'REMOTE_ADDR'} ne $my_ip) {
	if (!$ENV{'REMOTE_HOST'}) {
		my @subnet_numbers = split (/\./, $ENV{'REMOTE_ADDR'});
		$ENV{'REMOTE_HOST'} = gethostbyaddr(pack("C4", @subnet_numbers), 2) || $ENV{'REMOTE_ADDR'};
	}
	if ($allow_reloads != 1) {
		$allow_reloads = 1;
		foreach my $host (@hosts) {
			if ($host eq $ENV{'REMOTE_HOST'}) { $allow_reloads = 0; }
		}
	}
	if ($allow_reloads) {
		$total++;

		if ($today[0] eq "$time[3]$time[5]") { $today[1]++; }
		else { $today[1] = 1; }

		if ($ENV{'REMOTE_HOST'} eq $ENV{'REMOTE_ADDR'}) {
			$geographic{'ip'}++;
		} else {
			my @hostname = split(/\./, $ENV{'REMOTE_HOST'});
			$geographic{lc($hostname[$#hostname])}++;
		}

		if ($ENV{'HTTP_USER_AGENT'}) {
			foreach my $agent (@agents) {
				my ($name, $regex) = split(' => ', $agent);
				if ($ENV{'HTTP_USER_AGENT'} =~ /$regex/i) { $browsers{$name}++; last; }
			}
			foreach my $platform (@os) {
				my ($name, $regex) = split(' => ', $platform);
				if ($ENV{'HTTP_USER_AGENT'} =~ /$regex/i) { $platforms{$name}++; last; }
			}
		}

		if ($ENV{'HTTP_REFERER'} and $ENV{'HTTP_REFERER'} =~ m!^(https?://)([-a-z0-9\.]{4,})((?::\d+)?)(/[^#?]+(?:#\S+)?)\?([^#?]+(?:#\S+)?)$!i) {
			$referrers{lc("$1$2$3$4")}++;
			foreach my $term (get_terms(lc($5))) {
				$term =~ s/^[\-\+\?]|[\-\+\?]$//;
				if ($term =~ /^[A-Za-z0-9\+\-\?]{2,20}$/) {
					$terms{$term}++;
				}
			}
		}

		unshift(@hosts, $ENV{'REMOTE_HOST'});

		open(XML, ">$data_dir$file.xml");
		#flock(XML, LOCK_EX);
		seek(XML, 0, 0);
		truncate(XML, 0);
		print XML "<?xml version=\"1.0\"?>\n";
		print XML "<counter>\n";
		print XML "\t<total>$total</total>\n";
		print XML "\t<today time=\"$time[3]$time[5]\">$today[1]</today>\n";
		print XML "\t<geographic>\n";
		foreach my $tld (keys %geographic) {
			print XML "\t\t<country tld=\"$tld\" hits=\"$geographic{$tld}\" />\n";
		}
		print XML "\t</geographic>\n";
		print XML "\t<browsers>\n";
		foreach my $agent (keys %browsers) {
			print XML "\t\t<agent name=\"$agent\" hits=\"$browsers{$agent}\" />\n";
		}
		print XML "\t</browsers>\n";
		print XML "\t<platforms>\n";
		foreach my $os (keys %platforms) {
			print XML "\t\t<os name=\"$os\" hits=\"$platforms{$os}\" />\n";
		}
		print XML "\t</platforms>\n";
		print XML "\t<terms>\n";
		foreach my $term (keys %terms) {
			print XML "\t\t<term value=\"$term\" hits=\"$terms{$term}\" />\n";
		}
		print XML "\t</terms>\n";
		print XML "\t<referrers>\n";
		foreach my $ref (keys %referrers) {
			print XML "\t\t<ref url=\"$ref\" hits=\"$referrers{$ref}\" />\n";
		}
		print XML "\t</referrers>\n";
		print XML "\t<hosts>\n";
		foreach my $host (@hosts[0..19]) {
			if ($host) {
				print XML "\t\t<host value=\"$host\" />\n";
			}
		}
		print XML "\t</hosts>\n";
		print XML "</counter>";
		close(XML);
	}
}
exclusive_access_end($data_dir,"$file.xml");

#
# Print out the count
#
print "Content-type: text/html\n\n";
if ($type eq "image") {
	$total = '0' x ($nbdigits - length($total)) . $total;
	my @mydigits = split('', $total);
	foreach my $num (@mydigits) {
		print "<img src=\"$digits_dir$style/$num.$imgtype\" alt=\"$num\" />";
	}
} else {
	while ($total =~ s/(.*\d)(\d\d\d)/$1,$2/) {}
	print $total;
}

#
# XML Parsing Routines
#

sub parse_xml {
	open(XML, $_[0]);
	#flock(XML, LOCK_EX);
	while (my $line = <XML>) {
		if ($line =~ /<ref url=\"(.*)\" hits=\"(\d+)\" \/>/) { $referrers{$1} = $2; }
		elsif ($line =~ /<host value=\"(.*)\" \/>/) { push(@hosts, $1); }
		elsif ($line =~ /<term value=\"(.*)\" hits=\"(\d+)\" \/>/) { $terms{$1} = $2; }
		elsif ($line =~ /<country tld=\"(.*)\" hits=\"(\d+)\" \/>/) { $geographic{$1} = $2; }
		elsif ($line =~ /<agent name=\"(.*)\" hits=\"(\d+)\" \/>/) { $browsers{$1} = $2; }
		elsif ($line =~ /<os name=\"(.*)\" hits=\"(\d+)\" \/>/) { $platforms{$1} = $2; }
		elsif ($line =~ /<today time=\"(\d+)\">(\d+)<\/today>/) { $today[0] = $1; $today[1] = $2; }
		elsif ($line =~ /<total>(\d+)<\/total>/) { $total = $1; }
	}
	close(XML);
}

#
# Get query string configuration variables (strip everything that isn't a number or letter)
#

sub getvars {
	if ($ENV{QUERY_STRING}) {
		for (split(/\&/, $ENV{'QUERY_STRING'})) {
			my($key, $val) = split /=/;
			$val =~ s/%([0-9a-fA-F]{2})/chr(hex($1))/ge;
			$val =~ s/[^[A-Za-z0-9_-]//g;
			$in{$key} = $val;
		}
	}
}

sub get_terms {
	for (split /\&/, $_[0]) {
		my($key, $val) = split /=/;
		if ($key and $key =~ /^(q|p|query)$/) {
			$val =~ tr/+/ /;
			$val =~ s/%([0-9a-fA-F]{2})/chr(hex($1))/ge;
			return split(' ', $val);
		}
	}
}

sub exclusive_access_begin {
	my ($datadir,$fileName) = @_;
	use Time::HiRes qw(sleep time);

	my $filePath = "$datadir$fileName";

	my $lockTryNumber = 1;
	my $startWatchLock = time;
	my $sleepRandomIntervalLock = $INITIAL_SLEEP_RANDOM_INTERVAL;
	while (1) {
		my $linkTryNumber = 1;
		my $startWatchLink = time;
		my $sleepRandomIntervalLink = $INITIAL_SLEEP_RANDOM_INTERVAL;
		while (1) {
			if (link($filePath,"$filePath.lock.$ENV{SERVER_ADDR}.$$")) {
				last;
			}
			my $now = time;
			if (($linkTryNumber <= $MAX_TRIES_LINK) && ( $now - $startWatchLink < $MAX_TIME_WAIT_LINK) && ($now - $startWatchLock < $MAX_TIME_WAIT_LOCK)) {
				sleep(rand($sleepRandomIntervalLink));
				$sleepRandomIntervalLink *= $MULTIPLIER_SLEEP_RANDOM_INTERVAL;
				$linkTryNumber++;
			} else {
				#print "Could not link after $MAX_TRIES_LINK tries or in $MAX_TIME_WAIT_LINK seconds or could not establish lock in $MAX_TIME_WAIT_LOCK seconds!<br/>\n";
				fail_safe($data_dir,$fileName);
			}
		}
		my $nlink = (stat($filePath))[3];
		if ($nlink == 2) {
			# We got the lock
			last;
		}
		unlink("$filePath.lock.$ENV{SERVER_ADDR}.$$");
		if (($lockTryNumber < $MAX_TRIES_LOCK) && (time - $startWatchLock < $MAX_TIME_WAIT_LOCK)) {
			sleep(rand($sleepRandomIntervalLock));
			$sleepRandomIntervalLock *= $MULTIPLIER_SLEEP_RANDOM_INTERVAL;
			$lockTryNumber++;
		} else {
			#print "Could not lock counter file after $MAX_TRIES_LOCK tries or in $MAX_TIME_WAIT_LOCK seconds !<br/>\n";
			fail_safe($data_dir,$fileName);
		}
	}
}

sub exclusive_access_end {
	my ($datadir,$fileName) = @_;
	unlink("$datadir$fileName.lock.$ENV{SERVER_ADDR}.$$");
}

sub fail_safe {
	my ($datadir,$fileName) = @_;
	if ( opendir(DIR,$datadir) ) {
		my $file;
		while ($file = readdir(DIR)) {
			if ($file =~ /$fileName.lock/) {
				my $mTime = (stat($file))[9];
				unlink($file) if (time - $mTime > $MAX_LOCK_AGE);
			}
		}
		closedir(DIR);
	}
	print "Content-type: text/html\n\n";
	if ($type eq "image") {
		$total = '0' x $nbdigits;
		my @mydigits = split('', $total);
		foreach my $num (@mydigits) {
			print "<img src=\"$digits_dir$style/$num.$imgtype\" alt=\"$num\" />";
		}
	} else {
		print 0;
	}
	exit 0;
}