#! /usr/local/bin/perl

# YAAC
# Yet Another Access Counter

# By: Omar Syed
# v1.1 - July 1995
#        Added ability to allow counter to be included only on pages
#          in a specified domain.
#        Changed the access count file to be a dmb file rather than
#          a plain ASCII file for faster lookup.
# v1.0 - April 1995
#  <P ALIGN=CENTER>
#  <IMG ALIGN=bottom
#       SRC="http://www.sims.net/rick-bin/count.pl?http://www.sims.net/ribaum/index.html+zero+inv"
#       ALT="A Beautiful Naked Lady">
<BR>

	#  <I>accesses since Oct. 3, 1995</I></P>
# Based on ideas from other counter programs.


###################################################################
# Setup some variables
#   You may need to edit these.
###################################################################

# You definitely have to change this.
# This is used to keep others from including your counter on their
# page and causing a false count.  Also to keep other sites from using
# your server to keep count for their pages.
# Allows only web pages in this
# domain to get counters.  Setting this to "" allows any page to
# include counters.
# Examples:
# $LimitDomainTo = "lerc.nasa.gov"; # Allows only hosts in lerc.nasa.gov
# $LimitDomainTo = "www.lerc.nasa.gov"; # Allows only the host www.lerc.nasa.gov
# Note this is not fool proof since it relies on the browser telling us
#   what host has the page including the counter.
# $LimitDomainTo = "hydrolab.arsusda.gov";

# The name of the access count file to use.  
# Dont really need to change this.  This will be created in the directory
#   where you install YAAC.
$FileName = "yaac_access_count2";

# Replace with a list of regular expression IP addresses that
# are supposed to be ignored.  If you don't know what this means,
# just put '#'s in front of the following lines.
#@IgnoreIP = ("199\.18\.203\..*", # Change Me!
#            "199\.18\.159\.1",  # Change Me!
#            );

# Maximum number of times to try to lock the file.
# Each try is 1 second.  Try for 10 seconds.
$MaxTries = 10;

###################################################################
# Setup some error codes.  Since we can only return an image and
#   no text message.
###################################################################

$CreateFileErr = "111111101";
$AccessRightsErr = "111111102";
$OpenFileErr = "111111103";
$TimeoutLockErr = "111111104";
$BadVersionErr = "111111105";
$AccessDeniedErr = "111111111";


###################################################################
# bitmap for each digit
###################################################################
@digits = (0x00,0x00,0x00,0x3c,0x66,0x66,0x66,0x66,
           0x66,0x66,0x66,0x66,0x3c,0x00,0x00,0x00,
           0x00,0x00,0x00,0x30,0x38,0x30,0x30,0x30,
           0x30,0x30,0x30,0x30,0x30,0x00,0x00,0x00,
           0x00,0x00,0x00,0x3c,0x66,0x60,0x60,0x30,
           0x18,0x0c,0x06,0x06,0x7e,0x00,0x00,0x00,
           0x00,0x00,0x00,0x3c,0x66,0x60,0x60,0x38,
           0x60,0x60,0x60,0x66,0x3c,0x00,0x00,0x00,
           0x00,0x00,0x00,0x30,0x30,0x38,0x38,0x34,
           0x34,0x32,0x7e,0x30,0x78,0x00,0x00,0x00,
           0x00,0x00,0x00,0x7e,0x06,0x06,0x06,0x3e,
           0x60,0x60,0x60,0x66,0x3c,0x00,0x00,0x00,
           0x00,0x00,0x00,0x38,0x0c,0x06,0x06,0x3e,
           0x66,0x66,0x66,0x66,0x3c,0x00,0x00,0x00,
           0x00,0x00,0x00,0x7e,0x66,0x60,0x60,0x30,
           0x30,0x18,0x18,0x0c,0x0c,0x00,0x00,0x00,
           0x00,0x00,0x00,0x3c,0x66,0x66,0x66,0x3c,
           0x66,0x66,0x66,0x66,0x3c,0x00,0x00,0x00,
           0x00,0x00,0x00,0x3c,0x66,0x66,0x66,0x66,
           0x7c,0x60,0x60,0x30,0x1c,0x00,0x00,0x00
           );

###################################################################
# Start of YAAC.  First print the usual line
# Content-type: text/html
###################################################################

print <<EOM;
Content-type: image/xbm

EOM

###################################################################
# Check if this page is allowed to get the counter
###################################################################
($referer_host) = ($ENV{'HTTP_REFERER'} =~ /^http:\/\/(.*)\/.*$/);
if (! ($referer_host =~ /.*$LimitDomainTo.*$/)){
    $text = $AccessDeniedErr;
    $inverse = 1;
    $zero = 0;
    goto show_text;
}

#$res = `echo "$ENV{'HTTP_REFERER'} $referer_host" >> referers`;

###################################################################
# Try to open the access count file.
###################################################################

$key = &LockFile("$FileName.lock", $MaxTries); # timeout after $MaxTries seconds
if ($key < 0){
        $text = $TimeoutLockErr;
        $inverse = 1;
        $zero = 0;
        goto show_text;
}

if (! dbmopen(%dbh, "$FileName", 0664)){
        $text = $AccessRightsErr;
        $inverse = 1;
        $zero = 0;
        goto show_text;
}


###################################################################
# Parse the input arguments
###################################################################

$min = $ENV{'QUERY_STRING'};
@a = split(/\+/, $min);
$doc_uri = $a[0];
shift(@a);
$min = join(" ",@a);

$leading_zero = 0;
$inverse = 0;
if ($min =~ /zero/){
  $leading_zero = 1;  
}
if ($min =~ /inv/){
  $inverse = 1;
}

###################################################################
# Find the current access count in the access file
###################################################################

$accesses = $dbh{$doc_uri};


###################################################################
# Increment the access count
###################################################################

$accesses += 1; # *NOT* '++' because we don't want '++'s magic


###################################################################
# Make sure we are not ignoring the host:
###################################################################
 
$ignore = grep($ENV{"REMOTE_ADDR"} =~ /$_/, @IgnoreIP);
 
###################################################################
# Update the access file, close and unlock it
###################################################################

if (!$ignore) # if we aren't ignored 
{
  $dbh{$doc_uri} = $accesses;
}

&UnLockFile($key);


###################################################################
# Show the count, depending on options
###################################################################

$text = $accesses;

show_text:

    $len = length($text) > 7 ? length($text) : 7;
    if ($leading_zero) {
        $text = sprintf("%0${len}u",$text);
    } else {
        $len = length($text);
        $text = sprintf("%${len}u",$text);
    }

    # Generate an X11 bitmap on STDOUT
    printf STDOUT "#define count_width %d\n#define count_height 16\n", $len*8;
    printf STDOUT "static char count_bits[] = {\n";
    for ($y=0; $y < 16; $y++) {
        for ($x=0; $x < $len; $x++) {
            $d = substr($text,$x,1) - '0';
            print STDOUT '0x';
            if ($inverse) {
                printf STDOUT "%1x",(($digits[($d * 16) + $y] >> 4) ^ 0xf) & 0xf;
                printf STDOUT "%1x",($digits[($d * 16) + $y] ^ 0xf) & 0xf;
            } else {
                printf STDOUT "%1x",($digits[($d * 16) + $y] >> 4) & 0xf;
                printf STDOUT "%1x",$digits[($d * 16) + $y] & 0xf;
            }
            if ($x < $len-1) {
                print STDOUT ',';
            }
        }
        if ($y==15) {
            print STDOUT '};';
        } else {
            print STDOUT ',';
        }
        print STDOUT "\n";
    }

exit;

sub LockFile{
  local ($filename, $waitSeconds) = @_;
# Doesnt work if this is uncommented; for some reason the file handle
#   must be global for flock to work.
#  local(*LOCKFH);
  open(LOCKFH, ">$filename");
# Try to grad the lock with a non-blocking (4) exclusive (2) lock.
# (4 | 2 = 6)
  $tries = 0;
  while ($tries < $waitSeconds){
    $lockresult = flock(LOCKFH,6);
# lockresult is 0 if fail; 1 if sucessfull
    if ($lockresult != 1) {
      sleep(1);
      $tries = $tries + 1;
    }
    else{
      $tries = $waitSeconds + 10;
    }
  }
  if ($tries == $waitSeconds){
#    &LogError("Attempt to lock file $filename timed out after $waitSeconds\n");
    return -1;
  }
# LOCKFH is usually set to 0
  return LOCKFH;
}
 
sub UnLockFile{
  local (*LOCKFH) = @_;
  flock(LOCKFH, 8);
}