#!/usr/bin/perl

# count.gif - Perl script to keep count of users of this
# home page.
#
# Credits:
#   Original C code:  Frans van Hoesel (hoesel@chem.rug.nl)
#   Original port to Perl: Dan Rich (drich@corp.sgi.com)
#   Modifications for cgi: Michael Nelson (m.l.nelson@larc.nasa.gov)
#   Modifications for NSF: Mike Morse (mmorse@nsf.gov)
#   Modified from NSF version: Spencer Thomas (spencer.thomas@med.umich.edu)
#   Modified to handle multiple pages: Adam J. Griff, Ph.D. (griff@computer.org)
#   Modified to block out pages from specific domains Dr. Griff
#   Modified to produce xbm or gif :Dr. G. www.griffmonster.com

# This version is NSF specific, but you can easily modify it
# for your own needs.  The main NSF-ism is that we run three
# servers on the same machine, and this script needs to figure
# out which server it is being called in behalf of.
# To install:
#  1. Look at initialize() and fix everything you need to.
#  2. Create the files referenced in initialize(), with the
#     same owner as your server runs under, or world writable.
#  3. Stick the script in cgi-bin.  My experience is that the
#     script file must have the extension ".xbm".
#  4. Stick something like this in your home page:
#         Number of home page visitors: 
#         <A HREF=http://my-server.domain/cgi-bin/stats?unique_page_name>
#         <IMG SRC="http://my-server.domain/cgi-bin/count.xbm?unique_page_name"></A>
#     The second line is only if you use our "stats" program, you
#     can put anything there, or just use the IMG SRC bare.
#  5. When the home page is displayed, Mosaic clients will retrieve
#     the in-line bitmap.  This will invoke this script, which
#     responds with a bitmap it builds on the fly, that looks like
#     an automobile odometer.  If you include the A HREF, the odometer
#     will be surrounded by a border (and look better), and users
#     can click the odometer to get some other information.
#  6. Don't worry if older WinMosaic versions display "Error" for
#     the bitmap.  The script is doing the Right Thing.
#
#  7. Extensions may be .text .xbm .dot or .gif - depending on the server
#     conviguration the program needs to be copied 4 times or links can be
#     used when acceptable by the server.
#  
#  REQUIRED CHANGES
#  Modified by Griff to handle multiple pages.
#  Just call the counter followed by a ?unique_page_name.
#  Change the directory path for $serverRoot in the init procedure to the
#  path on your server
#  for example $serverRoot = "/home/www/htdocs"
#  The files dot.gif and access.gif must be in the $serverRoot/images directory


use POSIX;
use NDBM_File;

&initialize;
if (&banned) {
  print ("Content-type: image/gif\n\n");
  open (FILE,"<$serverRoot/images/access.gif");
  print <FILE>;
  close(FILE);
} else {
  &incrementCount;
  if ($ENV{SCRIPT_NAME} && $ENV{SCRIPT_NAME} =~ /.*text(.*)/) {
    &writeTextCounter;
  } elsif ($ENV{SCRIPT_NAME} && $ENV{SCRIPT_NAME} =~ /.*dot(.*)/) {
    print ("Content-type: image/gif\n\n");
    open (FILE,"<$serverRoot/images/dot.gif");
    print <FILE>;
    close(FILE);
  } elsif ($ENV{SCRIPT_NAME} && $ENV{SCRIPT_NAME} =~ /.*xbm(.*)/) {
    &generateBitmap;
    &writeBitmap;
  } else {
    print ("Content-type: image/gif\n\n");
    open (IMAGE, "/usr/bin/text2gif -t \"$totalReads\" 2>&1|");
    print <IMAGE>;
    close(IMAGE);
  } 
  exit(0);
}

sub initialize {
  $serverRoot = "/home/www/www.griffmonster.com/htdocs";
  $host_addr = $ENV{REMOTE_ADDR};
  ($user = $ENV{REMOTE_USER}) if (defined $ENV{REMOTE_USER});
  if (defined $ENV{REMOTE_HOST}) {
    $host = $ENV{REMOTE_HOST};
  } else {
    open(TEMP, "/usr/bin/host $host_addr 2>&1|"); 
    while ((!defined $host) && ($temp = <TEMP>)) {
      if ($temp =~ /domain name pointer\s*(\S*)\./) {
	$host = $1;
      }
    }
    close (TEMP);
  }
   
  ($host = $host_addr) if (!defined $host);
  $pagename = $ENV{QUERY_STRING};

   # track where the pointer is located.
   $referer = $ENV{HTTP_REFERER};
   open(LOG,">>$serverRoot/logs/tracker.$pagename") || die "$0: can\'t open tracker $!\n";
   print (LOG "$referer\t$user\@$host\n");
   close(LOG);

   $minLen = 7;           # minimum number of digits in bigmap
   $isHigh = 1;           # if 1, digits are 16 pixels high, to
                          # allow room for border
   $isInverse = 1;        # If 1, digits are white on black

   $logFiles = "$serverRoot/logs/counter";
   $dbmFile =   "$serverRoot/logs/hosts";
   $lockWait = 5;         # number of seconds to wait for lock
   # bitmap for each digit
   #  Each digit is 8 pixels wide, 10 high
   #  @invdigits are white on black, @digits black on white
   @invdigits = ("c3 99 99 99 99 99 99 99 99 c3",  # 0
                 "cf c7 cf cf cf cf cf cf cf c7",  # 1
                 "c3 99 9f 9f cf e7 f3 f9 f9 81",  # 2
                 "c3 99 9f 9f c7 9f 9f 9f 99 c3",  # 3
                 "cf cf c7 c7 cb cb cd 81 cf 87",  # 4
                 "81 f9 f9 f9 c1 9f 9f 9f 99 c3",  # 5
                 "c7 f3 f9 f9 c1 99 99 99 99 c3",  # 6
                 "81 99 9f 9f cf cf e7 e7 f3 f3",  # 7
                 "c3 99 99 99 c3 99 99 99 99 c3",  # 8
                 "c3 99 99 99 99 83 9f 9f cf e3"); # 9
   
   
      @digits = ("3c 66 66 66 66 66 66 66 66 3c",  # 0
                 "30 38 30 30 30 30 30 30 30 30",  # 1
                 "3c 66 60 60 30 18 0c 06 06 7e",  # 2
                 "3c 66 60 60 38 60 60 60 66 3c",  # 3
                 "30 30 38 38 34 34 32 7e 30 78",  # 4
                 "7e 06 06 06 3e 60 60 60 66 3c",  # 5
                 "38 0c 06 06 3e 66 66 66 66 3c",  # 6
                 "7e 66 60 60 30 30 18 18 0c 0c",  # 7
                 "3c 66 66 66 3c 66 66 66 66 3c",  # 8
                 "3c 66 66 66 66 7c 60 60 30 1c"); # 9
}

sub banned {
  if ($referer =~ /http:\/\/.*(web.mit.edu|ouray.cudenver.edu|www.netaxs.com|www.iaf.nl|rpi.edu|www.webcrawler.com|www.uroulette.com|www.geopages.com|www.phone.net|spidome.net|localhost.com)/) {
    return 1;
  } else {
    return 0;
  }
}

sub writeTextCounter {
    print ("Content-type: text/html\n\n");
    print ("<HTML><HEAD><TITLE>Visitor counter for $pagename</TITLE></HEAD>\n");
    print ("<BODY>You are visitor number <B>$totalReads</B> to the $pagename</BODY></HTML>\n");
}

sub writeBitmap {
   print ("Content-type: image/x-xbitmap\n\n");
   if ($isHigh) {
      printf ("#define count_width %d\n#define count_height 16\n", 
              $len*8);
   }
   else {
      printf ("#define count_width %d\n#define count_height 10\n", 
              $len*8);
   }
   printf STDOUT "static char count_bits[] = {\n";
   for($i = 0; $i < ($#bytes + 1); $i++) {
      print("0x$bytes[$i]");
      if ($i != $#bytes) {
         print(",");
         if (($i+1) % 7 == 0) {
            print("\n");
         }
      }
   }
   print("};\n");
}

# generateBitmap() - $count contains number to display
#                    $minLen contains minimum number of digits to display
#                    $isHigh is one for 16 bit high numbers (else 10)
#                    $isInverse is one for reverse video (white on black);
sub generateBitmap {
   $count = $totalReads;
   @bytes = ();
   $len = length($count) > $minLen ? length($count) : $minLen;
   $formattedCount = sprintf("%0${len}d",$count);
   if ($isHigh) {
      for ($i = 0; $i < $len*3; $i++ ) {
         if ($isInverse) {
            push(@bytes,"ff");       # add three blank rows to each digit
         }
         else {
            push(@bytes,"00");
         }
      }
   }
   for ($y=0; $y < 10; $y++) {
       for ($x=0; $x < $len; $x++) {
           $digit = substr($formattedCount,$x,1);
           if ($isInverse) {             # $inv = 1 for inverted text
               $byte = substr(@invdigits[$digit],$y*3,2);
           } 
           else {
               $byte = substr(@digits[$digit],$y*3,2);
           }
           push(@bytes,$byte);
       }
   }
   if ($isHigh) {
      for ($i = 0; $i < $len*3; $i++ ) {
         if ($isInverse) {
            push(@bytes,"ff");       # add three blank rows to each digit
         }
         else {
            push(@bytes,"00");
         }
      }
   }
}


sub incrementCount {
   &makeLogEntry;
   if (&lockFile == 1) {
      $count = "0";
      return;
   }
   &incrementTotalReads;
   &incrementHosts;
   &unlockFile;
}


sub unlockFile {
   unlink("$logFiles.$pagename.lock");
}

sub lockFile {
   $lockCount = 0;
   while (-f "$logFiles.$pagename.lock") { 
      if ($lockCount > $lockWait) {
         $count = 0;
         return 1;             # forget it (would be nice to log though)
      }
      sleep 1; 
      $lockCount++;
   }
   open(LOCK,">$logFiles.$pagename.lock") || die("Can't open $logFiles.$pagename.lock: $!\n");
   return 0;
}



sub incrementTotalReads {
   $totalReads = 0;
   if (-e "$logFiles.$pagename.txt") {
     open(COUNT,"$logFiles.$pagename.txt") || die("Can't open $logFiles.$pagename.txt: $!\n");
   $totalReads = <COUNT>;
   chop $totalReads;
   close(COUNT);
   }

   $totalReads++;

   # protection from loosing count in case the file write fails
   open(COUNT,">$logFiles.$pagename.txt.tmp") || die "$0: can\'t open $logFiles.$pagename.txt.tmp: $!\n";
   (print (COUNT "$totalReads\n")) || die "$0: can\'t write to $logFiles.$pagename.txt.tmp: $!\n";
   close(COUNT) || die "$0: can\'t close $logFiles.$pagename.txt.tmp: $!\n";
   rename("$logFiles.$pagename.txt.tmp","$logFiles.$pagename.txt");
   
}


sub makeLogEntry {
   local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
           localtime(time);
   $date = sprintf("%04d/%02d/%02d %02d:%02d:%02d",($year+1900),$mon+1,$mday,
             $hour,$min,$sec);
   open(LOG,">>$logFiles.$pagename.log") || die "$0: can\'t open $logFiles.$pagename.log: $!\n";
   print (LOG "$date\t$user\@$host\n");
   close(LOG);
}


sub incrementHosts {
   $totalHosts = 0;
   if (-e "$logFiles.$pagename.hosts.txt") {
     open(COUNT,"$logFiles.$pagename.hosts.txt") || die("Can't open $logFiles.$pagename.hosts.txt: $!\n");
   $totalHosts = <COUNT>;
   chop $totalHosts;
   close(COUNT);
   }
   
   tie(%HOSTS, 'NDBM_File', "$dbmFile.$pagename", O_RDWR | O_CREAT, 0664);

   if (! $host) {
      $host = "unknown";
   }
   $HOSTS{$host}++;
   if ($HOSTS{$host} == 1) {
      $totalHosts++;
   }
   untie(%HOSTS);
   
   
   open(COUNT,">$logFiles.$pagename.hosts.txt.tmp") || die "$0: can\'t open $logFiles.$pagename.hosts.txt.tmp: $!\n";
   (print (COUNT "$totalHosts\n")) || die "$0: can\'t write to $logFiles.$pagename.hosts.txt.tmp: $!\n";
   close(COUNT) || die "$0: can\'t close $logFiles.$pagename.hosts.txt.tmp: $!\n";
   rename("$logFiles.$pagename.hosts.txt.tmp","$logFiles.$pagename.hosts.txt");
}