#!/usr/bin/perl



############################################################

# Simple CGI counter v1.8 (Aug-15-2002)                    #

############################################################

# Copyright (C) 1999-2002 Kan-chan <hana@goyomi.club.ne.jp>#

#  Web site: http://kan-chan.stbbs.net/download/           #

############################################################

# 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 the GNU General Public License   #

# for more details.                                        #

#                                                          #

# You should have received a copy of the GNU General       #

# Public License along with this program; if not, write to #

# the Free Software Foundation, Inc., 675 Mass Ave,        #

# Cambridge, MA 02139, USA.                                #

############################################################



# Release note:

# v1.8 (Aug-15-2002)

#   added codes to eliminate invalid meta characters

# v1.7 (Mar-05-2000)

#   added parameter input, now font, file, digits and inverse

#   selectable from link, if called without parameters, 

#   defaults are used. gk.

#   added parameter nocount by Kan-chan.

# v1.6 (Feb-24-2000)

#   code which generates inverse bitmap by gk.

#   divided between program (main) module and font module.

# v1.5 (Feb-20-2000)

#   added inverse switch by gk.

#   added selection of enable/disable a log function

#   added a log function written by gk.

# v1.3 (Feb-07-2000)

#   Added $pad_to to print out fix width by gk.

# v1.2 (Jan-06-2000)

#   Small bug fixes.

# v1.0 (Jul-05-1999)

#   First release.



# Usage:

# 1. Modify the perl directory written on the top of this script 

#    if it is required.

# 2. Modify settings if needed.

# 3. Upload files to the following directories and change the 

#    permission.  If you cannot use 707/705/606, try 777/755/666.

# 4. Add <img src="count.cgi"> to index.html or use parameters:

#    <img src="count.pl?font=dgscoreb&inverse=1&file=index">

#

# public_html/

#      |

#      |-- index.html

#      |-- cgi-bin/

#             |-- count.cgi (permission:705 or 755)

#             |-- tinyss.cfm (permission:604 or 644)

#             |  (or you can use one of the other cfm files

#             |

#             |-- count.txt (permission:606 or 666)

#             |-- count.log (optional, permission:606 or 666)

#



############################################################



&read_parse;



# Files must be in $basedir

# Accessing outside of the directory can be a security hole to 

# destroy files used by other CGI scripts (such as guestbooks)!

if ($in{file} =~ /\.\//){

	&error_cannot_open;	# "CANNOT LOAD COUNT FILE!"

}



############################################################

# Settings you may need to modify if necessary             #

############################################################



# Base directory of the count file / lock file / log file

$basedir = "./";

#$basedir = "/Inetpub/logs/";

#$basedir = "/web/counters/";

#$basedir = "/usr/local/httpd/logs/";

#$basedir = "$ENV{NETSITE_ROOT}/counters/";



# File name of font module

$font = $in{font} || 'tinyss';



# Number of digits

$pad_to = $in{digits} || 5;



# 0(Normal) or 1(Inverse)

# If 1, digits are white on black

$inverse = $in{inverse} || 0;



# 0(Count) or 1(Don't count)

$nocount = $in{nocount} || 0;



# 0(Don't record a log) or 1(Record a log)

$recordlog = $in{nocount} || 0;

#$recordlog = $in{nocount} || 1;



# The name of count/log/lock file

$file = $in{file} || 'count';



# The name of count file

$countfile = $file.'.txt';



# The name of log file

#$logfile = $file.'.log';



# The name of temporary file to lock the file

$lockfile = $file.'.loc';



############################################################



$font = $font.'.cfm';



require $font;



$countfilepath = $basedir.$countfile;

$logfilepath = $basedir.$logfile;

$lockfilepath = $basedir.$lockfile;



# Wait until the lock is released

for ($i=1;$i<=6;$i++){

	if (!(-e $lockfilepath)) {

		last;

	} elsif ($i == 1){

		$filetime = (stat($lockfilepath))[9];

		if ($filetime < time() - 10 * 60){

			&unlock();

		}

	} elsif ($i >= 6){

		&error_server_busy;	# "SERVER BUSY"

	}

	sleep(1);

}



# Create a lock file

open(OUT, ">$lockfilepath");

close(OUT);



# Log access to log file

if (($recordlog == 1) && ($nocount != 1)) { &make_log_entry; }



# Read/write count file

if (!open(IN, "<$countfilepath")) {

	&unlock();

	&error_cannot_open;	# "CANNOT LOAD COUNT FILE!"

}

$count = <IN>;

close(IN);



if ($nocount != 1){

	$count++;

	if (!open(OUT, ">$countfilepath")) {

		&unlock();

		&error_cannot_open;	# "CANNOT LOAD COUNT FILE!"

	}

	print(OUT $count);

	close(OUT);

}



$count_length = length($count); # pad $count if smaller than $pad_to  

for ($i = $pad_to;$i>$count_length;$i--) {

    $count = "0$count";

};



# Output a number as XBM format

&xbmout($count);



# Remove the lock file

&unlock();



# Exit this program

exit;



# If a lock file exists, delete the file

sub unlock {

	if (-e $lockfilepath) { unlink($lockfilepath); }

}



sub xbmout {

	$count = $_[0];



	$digitwidth = $digitwidthbyte * 8;

	$xbmwidth = length($count) * $digitwidth;



	print "Content-type: image/x-xbitmap\n\n";



	print "#define count_width $xbmwidth\n";

	print "#define count_height $digitheight\n";

	print "static unsigned char count_bits[] = {";



	$bytes = 0;

	$totalbytes = $digitwidthbyte * length($count) * $digitheight;

	for $i (0..$digitheight-1) {

		print "\n";

		foreach (0..length($count)-1) {

			$n = substr($count, $_, 1);

			$pos = ($n * $digitheight * $digitwidthbyte) + ($i * $digitwidthbyte);

			for $j (0..$digitwidthbyte-1) {

				if ($inverse) {

					$data = sprintf ("%02x",(255 - hex $bitmap[$pos + $j]));

				} else {

					$data = $bitmap[$pos + $j];

				}

				print "0x$data";

				$bytes++;

				if ($bytes < $totalbytes) {

					print ",";

				}

			}

		}

	}

	print "};\n";

}





sub error_server_busy {

	print <<"EOF"

Content-type: image/x-xbitmap



#define err_width 96

#define err_height 24

static unsigned char err_bits[] = {

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0xc0, 0xe3, 0xe7, 0x27, 0xe8, 0xe7, 0x07, 0x3e, 0x82, 0x78, 0x82, 0x00,

  0x20, 0x24, 0x20, 0x28, 0x28, 0x20, 0x08, 0x42, 0x82, 0x84, 0x44, 0x00,

  0x20, 0x24, 0x20, 0x48, 0x24, 0x20, 0x08, 0x42, 0x82, 0x84, 0x44, 0x00,

  0x20, 0x20, 0x20, 0x48, 0x24, 0x20, 0x08, 0x42, 0x82, 0x04, 0x28, 0x00,

  0xc0, 0xe3, 0xe7, 0x47, 0xe4, 0xe7, 0x07, 0x7e, 0x82, 0x78, 0x10, 0x00,

  0x00, 0x24, 0x20, 0x82, 0x22, 0x20, 0x02, 0x42, 0x82, 0x80, 0x10, 0x00,

  0x20, 0x24, 0x20, 0x84, 0x22, 0x20, 0x04, 0x42, 0x82, 0x84, 0x10, 0x00,

  0x20, 0x24, 0x20, 0x04, 0x21, 0x20, 0x04, 0x42, 0x44, 0x84, 0x10, 0x00,

  0xc0, 0xe3, 0x27, 0x08, 0xe1, 0x27, 0x08, 0x3e, 0x38, 0x78, 0x10, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};

EOF

}



sub error_cannot_open {

	print <<"EOF"

Content-type: image/x-xbitmap



#define err_width 96

#define err_height 24

static unsigned char err_bits[] = {

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0xe0, 0x20, 0x84, 0x42, 0x1c, 0x1f, 0x02, 0x0e, 0x84, 0x07, 0x00,

  0x00, 0x10, 0x51, 0x8c, 0x46, 0x22, 0x04, 0x02, 0x11, 0x8a, 0x08, 0x00,

  0x00, 0x08, 0x50, 0x94, 0x4a, 0x41, 0x04, 0x82, 0x20, 0x8a, 0x10, 0x00,

  0x00, 0x08, 0x50, 0x94, 0x4a, 0x41, 0x04, 0x82, 0x20, 0x8a, 0x10, 0x00,

  0x00, 0x08, 0x88, 0xa4, 0x52, 0x41, 0x04, 0x82, 0x20, 0x91, 0x10, 0x00,

  0x00, 0x08, 0xf8, 0xa4, 0x52, 0x41, 0x04, 0x82, 0x20, 0x9f, 0x10, 0x00,

  0x00, 0x10, 0x05, 0xc5, 0x62, 0x22, 0x04, 0x02, 0x91, 0xa0, 0x08, 0x00,

  0x00, 0xe0, 0x04, 0x85, 0x42, 0x1c, 0x04, 0x3e, 0x8e, 0xa0, 0x07, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

  0x00, 0xe0, 0x70, 0x84, 0x42, 0x1f, 0xbe, 0x82, 0x2f, 0x00, 0x00, 0x00,

  0x00, 0x10, 0x89, 0x84, 0x46, 0x04, 0x82, 0x82, 0x20, 0x00, 0x00, 0x00,

  0x00, 0x08, 0x04, 0x85, 0x4a, 0x04, 0x82, 0x82, 0x20, 0x00, 0x00, 0x00,

  0x00, 0x08, 0x04, 0x85, 0x4a, 0x04, 0x9e, 0x82, 0x2f, 0x00, 0x00, 0x00,

  0x00, 0x08, 0x04, 0x85, 0x52, 0x04, 0x82, 0x82, 0x20, 0x00, 0x00, 0x00,

  0x00, 0x08, 0x04, 0x85, 0x52, 0x04, 0x82, 0x82, 0x20, 0x00, 0x00, 0x00,

  0x00, 0x10, 0x89, 0x84, 0x62, 0x04, 0x82, 0x82, 0x00, 0x00, 0x00, 0x00,

  0x00, 0xe0, 0x70, 0x78, 0x42, 0x04, 0x82, 0xbe, 0x2f, 0x00, 0x00, 0x00,

  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};

EOF

}



sub make_log_entry {

   # Initialize data for logfile

   $host = $ENV{'REMOTE_ADDR'};

   $port = $ENV{'SERVER_PORT'};

   $client = $ENV{'HTTP_USER_AGENT'};

   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 

           localtime(time);

   $year += 1900; 

   $date = sprintf("%04d/%02d/%02d %02d:%02d:%02d",$year,$mon+1,$mday,

             $hour,$min,$sec);

   open(LOG,">>$logfilepath") || die "$0: can\'t open $logfilepath: $!\n";

   print (LOG "$date\t$host:$port\t$client\n");

   close(LOG);

}



sub read_parse {

  local(*in)=@_ if @_;

  local ($q,$key,$val);

  $in=$ENV{'QUERY_STRING'};

  @in=split(/&/,$in);

  

  foreach $q (0 .. $#in) {

    $in[$q] =~ s/\+/ /g;

    $in[$q] =~ s/\;//g;

    $in[$q] =~ s/\|//g;

    $in[$q] =~ s/\\//g;

    ($key,$val)=split(/=/,$in[$q],2);

    $key =~ s/%(..)/pack("c",hex($1))/ge;

    $val =~ s/%(..)/pack("c",hex($1))/ge;

    $in{$key} .= "\0" if (defined($in{$key}));

    $in{$key} .=$val;

  }

  return length($in);

}