#! /usr/bin/perl
#----------------------------------------------------------------------------
# PERL SCRIPT FOR COUNTING AND LOGGING WWW ACCESSES
#----------------------------------------------------------------------------
# 15-11-2000 : Rolf van Gelder
#----------------------------------------------------------------------------

# IS IT MY IP? -> $itsme (0 or 1)
require '../cage-cgi/itsme.ph';

# files
$countlog = "rgcount.log";
$homelog  = "rghome.log";
### $loglog   = ">>/usr/people/rcrolf/public_html/r/log.log";

# logging ON (1)/OFF (0)
$logging       = 1;
$updatehomelog = 0;

# ignoring ON (1)/OFF (0)
$ignoring	= 1;

# counter width
$min_width      = 2;
$counter_width  = 16;
$counter_height = 20;

$refok  = 0;
$caller = $ENV{'HTTP_REFERER'};
if ( $caller =~ /sibylle/i )
{	$refok = 1;
}

# if ( !$refok ) { exit; }

# print "content-type: text/html\n\n";
# print "referrer: ${caller}<br>";

@dig_arr = (
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xFA', '0x17', '0xF6', '0x1B', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x06', '0x18', '0x00', '0x00', '0x06', '0x18', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0xF6', '0x1B', '0xFA', '0x17', '0xFC', '0x0F', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0x00', '0x00', '0x00', '0x10', '0x00', '0x18', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x18', '0x00', '0x00', '0x00', '0x18', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x18', '0x00', '0x10', '0x00', '0x00', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xF8', '0x17', '0xF0', '0x1B', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0xF0', '0x1B', '0xF8', '0x07', '0xF6', '0x03', '0x0E', '0x00', '0x0E', '0x00', '0x0E', '0x00', '0x0E', '0x00', '0xF6', '0x03', '0xFA', '0x07', '0xFC', '0x0F', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xF8', '0x17', '0xF0', '0x1B', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0xF0', '0x1B', '0xF8', '0x07', '0xF0', '0x1B', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0xF0', '0x1B', '0xF8', '0x17', '0xFC', '0x0F', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0x00', '0x00', '0x02', '0x10', '0x06', '0x18', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0xF6', '0x1B', '0xF8', '0x07', '0xF0', '0x1B', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x18', '0x00', '0x10', '0x00', '0x00', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xFA', '0x07', '0xF6', '0x03', '0x0E', '0x00', '0x0E', '0x00', '0x0E', '0x00', '0x0E', '0x00', '0xF6', '0x03', '0xF8', '0x07', '0xF0', '0x1B', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0xF0', '0x1B', '0xF8', '0x17', '0xFC', '0x0F', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xFA', '0x07', '0xF6', '0x03', '0x0E', '0x00', '0x0E', '0x00', '0x0E', '0x00', '0x0E', '0x00', '0xF6', '0x03', '0xF8', '0x07', '0xF6', '0x1B', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0xF6', '0x1B', '0xFA', '0x17', '0xFC', '0x0F', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xF8', '0x17', '0xF0', '0x1B', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x18', '0x00', '0x00', '0x00', '0x18', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x18', '0x00', '0x10', '0x00', '0x00', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xFA', '0x17', '0xF6', '0x1B', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0xF6', '0x1B', '0xF8', '0x07', '0xF6', '0x1B', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0xF6', '0x1B', '0xFA', '0x17', '0xFC', '0x0F', '0x00', '0x00',
'0x00', '0x00', '0x00', '0x00', '0xFC', '0x0F', '0xFA', '0x17', '0xF6', '0x1B', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0x0E', '0x1C', '0xF6', '0x1B', '0xF8', '0x07', '0xF0', '0x1B', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0x00', '0x1C', '0xF0', '0x1B', '0xF8', '0x17', '0xFC', '0x0F', '0x00', '0x00',
);

@digits = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);

$HomeLog   = ">>".$homelog;

@args = split ( /,/, @ARGV[0] );
$doc_uri = @args[0];
$doc_uri =~ s/\\//g;

$refer   = @args[1];

# print "content-type: text/html\n\n";
# print "ARGS: [@{ARGV}]<br>";
# exit;

### open ( LOGLOG, $loglog );

if ( length ( $doc_uri ) < 1 )
{ # doc_uri NOT passed as a parameter
	$doc_uri  = $ENV { "DOCUMENT_URI" };
}

### print LOGLOG "doc_uri: ".$doc_uri."\n";
### print LOGLOG "referer: ".$refer."\n";
   
# Page from RvGCC
$FileName = $countlog;

# Timestamp
#                 Thu 17 August 1995 12:21
$datum  = `date +"%a %d %b %Y %R"`;
$datum  = substr ( $datum, 0, length ( $datum ) - 1 );
#                 170895-12:21
$timest = `date +"%d%m%Y-%R"`;
$timest = substr ( $timest, 0, length ( $timest ) - 1 );

# Maximum number of times to try to lock the file.
# Each try is .1 second.  Try for 1 second.
$MaxTries = 20;

# Whether or not to use locking.  If perl complains that flock is not
# defined, change this to 0.  Not *really* necessary because we check
# to make sure it works properly.
$UseLocking = 1;

### Stage 3
###
### Open the access_count file for read-write taking all the precautions

# Make sure the file exists:
if (!(-f $FileName)) {
    if (!open (COUNT,">$FileName")) {
	# Can't create the file
	print $CreateFile;
	exit 1;
    }
} else {
    if (!((-r $FileName) && (-w $FileName))) {
	# Make sure that we can in fact read and write to the file in
	# question.  If not, direct them to the FAQ.
	print $AccessRights;
	exit 1;
    }

    if (!open (COUNT,"+<$FileName")) {	# Now make sure it *really* opens
	print $AccessRights;	        # ...just in case...
	exit 1;
    }
}

### Stage 4
###
### Attempt to lock the file

$lockerror = &LockFile(COUNT);

# You would figure that $MaxTries would equal 0 if it didn't work.  The
# post-decrement takes it to -1 when the loop finally exits.
if ($lockerror) {
    print $TimeoutLock;
    exit(0);
}

### Stage 7
###
### Find the relevant place in the file

$location = tell COUNT;
$newurl   = 1;
while ($line = <COUNT>) {
    # Read the file line-by-line.
    if (($startdate, $lastacc, $accesses, $uri) = ($line =~ /'(.*)' '(.*)' (\d\d\d\d\d\d\d\d\d\d) '(\S*)' $/)) {
	# A new line
	if ($uri eq $doc_uri) {
            $newurl = 0;
	    last;
	}
    }

    last if ($uri eq $doc_uri);
    $location = tell COUNT;
    
    #reset the fields
    $accesses = 0;
}


### Stage 8
###
### Update the access count of the file

$accesses += 1;	# *NOT* '++' because we don't want '++'s magic


### Stage 9
###
### Print counter score
($count, $nLink) = &output_counter($accesses);

### Stage 10
###
### Now we actually tell the browser what the count is.

### Added by RvG
if ( $newurl == 1 )
{  # Date format : 12 December  1995
    $day   = `date +"%e"`;
    # Trim CR
    $day   = substr ( $day, 0, length ( $day ) - 1 );

    $month = `date +"%B"`;
    # Trim CR
    $month = substr ( $month, 0, length ( $month ) - 1 );
    # Pad month to 9 characters
    $month = sprintf ( "%9s", $month );

    $year  = `date +"%Y"`;
    # Trim CR
    $year  = substr ( $year, 0, length ( $year ) - 1 );

    $startdate = $day." ".$month." ".$year;
}

### Stage 11
###
### Check if we are supposed to update the count in the file.  (ie. we're
### not ignoring the host that just accessed us)

# Make sure we are not ignoring the host:

### print LOGLOG qq|Remote address: ${ENV{"REMOTE_ADDR"}}\n|;

if ( $ignoring == 1 )
{	# ignore enabled

	# IGNORE MY IP(S)
	$ignore = $itsme;
}

# now show the actual count
$size = &fill_digits ( $count );
&print_digits ( $size );

#OLD print "Number of visitors of this page since ".$startdate.":</font><p>\n";
#OLD print "<table border=3 cellpadding=2><tr><td bgcolor=#FFFFFF><font><b>".$count."</b></font></tr></table>\n";

### Stage 12
###
### Actually write the updated information back to the file

if (!$ignore)			# If we aren't ignoring this access
{
    # Now update the counter file
    seek(COUNT, $location, 0);
    $longaccesses = sprintf("%010.10d", $accesses);
    if ( $logging )
    {	print COUNT "'$startdate' '$timest' $longaccesses '$doc_uri' \n";
    }
}

&UnlockFile(COUNT);

close COUNT;

### print LOGLOG "ignore: ".$ignore."\n";

if ( !$updatehomelog )
{
	### DON'T UPDATE HOME.LOG
	exit;
}

if ( $logging == 1 )

{
#######################################################################
# ADDED BY RVG: LOG VISITOR TO LOG FILE
#######################################################################


if ( !$ignore )        # if we aren't ignored
{
   # LOG CONNECTION TO HOME.LOG
   if ( $doc_uri =~ /index.html/ )
   {
      # ONE OF THE HOME PAGES
      $ipadr = sprintf ( "%15s", $ENV{'REMOTE_ADDR'} );

      if ( open ( HOME, $HomeLog ) )
      {
         # LOG FILE OPENED

         if ( ! ( &LockFile ( HOME ) ) )
         {
            # LOG FILE LOCKED: APPEND ENTRY
            $tmp = "[".$accesses."]";
            $vis = " ";
            print HOME sprintf ( "%8s", $tmp ).
                       sprintf ( "%8s", $vis ).
               " ".$datum." [".$ipadr."] ".$ENV{'REMOTE_HOST'}."\n";

            # UNLOCK LOG FILE
            &UnlockFile ( HOME );

         }

         # CLOSE LOG FILE
         close ( HOME );
      }

   }
 }

}	# $logging
#######################################################################

### close ( LOGLOG );

#######################################################################
#
# Support functions
#

sub LockFile {
    local(*FILE) = @_;
    local($TrysLeft) = $MaxTries;

    if ($UseLocking) {
	# Try to get a lock on the file
	while ($TrysLeft--) {
	    
	    # Try to use locking, if it doesn't use locking, the eval would
	    # die.  Catch that, and don't use locking.

	    # Try to grab the lock with a non-blocking (4) exclusive (2) lock.
	    # (4 | 2 = 6)
            # MODIFIED BY RVG (was flock(COUNT,6))
	    $lockresult = eval("flock(FILE,6)");

	    if ($@) {
		$UseLocking = 0;
		last;
	    }

	    if (!$lockresult) {
		select(undef,undef,undef,0.1); # Wait for 1/10 sec.
	    } else {
		last;		# We have gotten the lock.
	    }
	}
    }

    if ($TrysLeft >= 0) {
	# Success!
	return 0;
    } else {
	return -1;
    }
}

sub UnlockFile {
    local(*FILE) = @_;

    if ($UseLocking) {
	flock(FILE,8);			# Unlock the file.
    }
}

########################################################################
#
# Output functions
#
# The following are the routines that actually convert the number
# of accesses into something that we print out.
#
# The name of each function is "output_" followed by the program's name.
# For instance, is the program is called "counter" then "output_counter"
# will be called; a program called "counterbanner" will call
# "output_counterbanner" to get the output.
#
# If the function is not defined, then "output_counter" will be called.
#

# output_counter
#
# The simplest function: just returns the number of accesses and the link.

sub output_counter {
    local($count) = @_;

    return ( $count, $Link ); # we return the count and the link
}

# ------------------------------------------------------------
# FILL DIGITS
# ------------------------------------------------------------
sub fill_digits {
  $q = @_[0];
  $i = 0;
  do {
    $digits[$i++] = $q % 10;
    $q = int($q/10);
  }
  # force width to be at least $min_width
  while(($q != 0) || ($i < $min_width));
  $i = $i; # make it the return value
}

# ------------------------------------------------------------
# PRINT DIGITS
# ------------------------------------------------------------
sub print_digits {
  $width = @_[0];
  $cw = $width * $counter_width;
  $chh = $counter_height * 2;
  print "Content-type:image/x-xbitmap\n\n";
  print "#define counter_width $cw\n";
  print "#define counter_height $counter_height\n";
  print "static unsigned char counter_bits[] = {\n";
  $start = 1;
  for($i=0;$i<$chh;$i=$i + 2) {
    for($j=$width-1;$j>=0;$j--) {
      for($k=0;$k<2;$k++) {
        if ($start == 0) {
          print",";
        }
        print "$dig_arr[($digits[$j]*$chh)+$i+$k]";
        $start = 0;
      }
    }
    print "\n";
  }
  print "};\n";
}
# EOF cccount.pl