#!/usr/bin/perl -w

# Name     : Perl Web Access Log
# Author   : Terrence Ma
# Email    : terrence@terrence.com
# Web      : http://www.terrence.com
# Date     : V2.1 07/25/2002, V1.0 08/14/1998
# Modified : http://www.perlguy.com

#############################################################################################
# This script logs visitors to web pages. It can be used as either a SSI, or                #
# can be called from a link. To use as a SSI, the $SSI variable must be set to 1.           #
# Conversly, to have it be called from links, have $SSI set to 0.                           #
# To call this script from a link it should have this syntax:                               #
# <a href="/pathToScript/logger.pl?dest=http://yourDomain.com/wherever">Click Here</a>      #
#                                                                                           #
# After the logging is done, it will redirect to the page you have after the ?dest=         #
# Log format can be changed, but by default it is like:                                     #
#                                                                                           #
# Date - IP - Host - Browser - Where they are going - Where they came from                  #
#############################################################################################
# This script may be modified at will. If you do anything cool with it, please let me know. #
# Do not sell this script without my permission and always leave the comments.              #
# Kevin Meltzer 3/12/97 kmeltz@cris.com | www.ctcom.com/~kmeltz                             #
#############################################################################################

use 5;
use Fcntl qw(:DEFAULT :flock);           # imports LOCK_EX, LOCK_SH, LOCK_NB

# Set variables

$SSI = 1;       # 0 - Used from link
                # 1 - Used as Server Side Include
                # 2 - Used from <img> tag

# Path to your log/tmp file, must be chmod 666
$logfile     = "/virtual/customer/terrence.com/htdocs/log/logger.txt";
$tmpfile     = "/virtual/customer/terrence.com/htdocs/log/logger.tmp";
$ymindexfile = "/virtual/customer/terrence.com/htdocs/log/logyrmon.txt";
$browserdeny = "webcollage";

$ip = $ENV{'REMOTE_ADDR'};
$browser = $ENV{'HTTP_USER_AGENT'};
$referer = $ENV{'HTTP_REFERER'};
$here = $ENV{'DOCUMENT_URI'};
@digits = split (/\./, $ip);
$address = pack ("C4", @digits);
$host = gethostbyaddr ($address, 2);

# From Link
if ($SSI eq 0) {
&parse_query;
&clean;
$dest = $query{'dest'};
&write_file;
&redirect;
}

# From SSI
if (($SSI eq 1) && !($browser =~ /$browserdeny/)) {
&write_file;
}

# From <img> tag
if ($SSI eq 2) {
&parse_query;
&clean;
$this = $query{'dest'};
&write_file;
&show_img;
}

################################################
# Parse the query then clean it up for our uses
################################################

sub parse_query {
    @query_strings = split("&", $ENV{"QUERY_STRING"});
    foreach $q (@query_strings) {
        ($attr, $val) = split("=", $q);
        $query{$attr} = $query{$attr}." ".$val;
    }
}

sub clean {
    if ($query{'dest'} =~ /\/$/) {
        chop($query{'dest'});
    }
    #$query{'dest'} =~ s/http\:\/\///g;
    #$query{'dest'} =~ s/\//_\|_/g;
}

################################################
# Go!
################################################

sub redirect {
print "Location: $dest\n\n";
}

################################################
# Write information to the log
################################################

sub write_file {

# get $date, $time, $yrmon_now
&date;

# step 1
# read $ymindexfile
# if ($yrmon_now ne $yrmon_old)
#   update $ymindexfile
#   copy $logfile to $yrmonoldfile
#   gzip $yrmonoldfile
#   empty $logfile, $tmpfile

# read $ymindexfile
open(YMINDEXFILE, "< $ymindexfile") || die "Can't read $ymindexfile: $!";
flock(YMINDEXFILE, LOCK_SH) || die "Can't lock filename: $!";

$yrmon_old = <YMINDEXFILE>;
chomp($yrmon_old);

close(YMINDEXFILE);

if ($yrmon_now ne $yrmon_old) {

# update $ymindexfile
  open(YMINDEXFILE, "> $ymindexfile") || die "Can't write to $ymindexfile: $!";
  flock(YMINDEXFILE, LOCK_EX) || die "Can't lock filename: $!";

  print(YMINDEXFILE "$yrmon_now\n");

  close(YMINDEXFILE);

# copy $logfile to $yrmonoldfile
  $yrmonoldfile = "/virtual/customer/terrence.com/htdocs/log/" . $yrmon_old . ".txt";

  open(LOG, "< $logfile") || die "Can't open $logfile: $!";
  flock(LOG, LOCK_SH) || die "Can't lock filename: $!";

  open(YRMONOLDFILE, "> $yrmonoldfile") || die "Can't write to $yrmonoldfile: $!";
  flock(YRMONOLDFILE, LOCK_EX) || die "Can't lock filename: $!";

  while (<LOG>) {
    (print YRMONOLDFILE $_) || die "Can't write to $yrmonoldfile: $!";}

  close(YRMONOLDFILE);
  close(LOG);

# gzip $yrmonoldfile
  `/bin/gzip $yrmonoldfile`;

# empty $logfile, $tmpfile
  open(LOG, "> $logfile") || die "Can't write to $logfile: $!";
  flock(LOG, LOCK_EX) || die "Can't lock filename: $!";
  close(LOG);

  open(TMP, "> $tmpfile") || die "Can't write to $tmpfile: $!";
  flock(TMP, LOCK_EX) || die "Can't lock filename: $!";
  close(TMP);

}

# step 2
# write $tmpfile at top

open(LOG, "< $logfile") || die "Can't open $logfile: $!";
flock(LOG, LOCK_SH) || die "Can't lock filename: $!";

open(TMP, "> $tmpfile") || die "Can't write to $tmpfile: $!";
flock(TMP, LOCK_EX) || die "Can't lock filename: $!";

if ($SSI eq 0) {
  print TMP "$date - $ip - $host - $browser - $dest - $referer\n";}
elsif ($SSI eq 1) {
  print TMP "$date.$time - $host - $browser - $referer\n";}
else {
  print TMP "$date - $ip - $host - $browser - $this - $referer\n";}

while (<LOG>) {
  (print TMP $_) || die "Can't write to $tmpfile: $!";
}

close(TMP);
close(LOG);

# step 3
# copy $tmpfile to $logfile

open(TMP, "< $tmpfile") || die "Can't open $tmpfile: $!";
flock(TMP, LOCK_SH) || die "Can't lock filename: $!";

open(LOG, "> $logfile") || die "Can't write to $logfile: $!";
flock(LOG, LOCK_EX) || die "Can't lock filename: $!";

while (<TMP>) {
  (print LOG $_) || die "Can't write to $logfile: $!";
}

close(LOG);
close(TMP);

}

#################################################
# Get date and time
#################################################

sub date {

# if ($year >= 100) {
#   $year = $year % 100;
#   if ($year >= 10) {$year = "20".$year;}
#     else {$year = "200".$year;};
# };
#
# $year = $year + 1900;
# @months = ("01","02","03","04","05","06","07","08","09","10","11","12");
# if ($mday == 0) {$mday = "00";}
#   elsif ($mday < 10) {$mday = "0".$mday;};
# $date = "$months[$mon]/$mday/$year";
#
# if ($hour == 0) {$hour = "00";}
#   elsif ($hour < 10) {$hour = "0".$hour;};
# if ($min == 0) {$min = "00";}
#   elsif ($min < 10) {$min = "0".$min;};
# if ($sec == 0) {$sec = "00";}
#   elsif ($sec < 10) {$sec = "0".$sec;};
# $time = $hour . ":" . $min . ":" . $sec;

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

  $year = $year + 1900;
  @months = ("01","02","03","04","05","06","07","08","09","10","11","12");
  if ($mday < 10) {$mday = "0".$mday;};
  $date = "$months[$mon]/$mday/$year";

# See http://www.terrence.com/perl/clock/clock.txt for CST/CDT
  if ($hour < 10) {$hour = "0".$hour;};
  if ($min < 10) {$min = "0".$min;};
  if ($sec < 10) {$sec = "0".$sec;};
  $time = $hour . ":" . $min . ":" . $sec . "." . (($isdst == 0) ? "CST" : "CDT");

  $yrmon_now = $year . $months[$mon];
}

#################################################
# Subroutine to return a 1-pixel transparent gif
#################################################

sub show_img {
$! = 1;
$| = 1;
print "Content-type: image/gif\n\nGIF89a\1\0\1\0\200\0\0\0\0\0\0\0\0!\371\4\1\0\0\0\0,\0\0\0\0\1\0\1\0\0\2\2D\1\0\n";
}