#!/usr/bin/perl -w
##################################################
# Click-Through Tracker
#
# 1998, schilli@perlmeister.com
##################################################

use Socket;          # For address reversal

my $LOG_FILE = "/services/http/DATA/go.log";

my $path = $ENV{PATH_INFO};
$path =~ s#^/##g;

die "Redirect Path not set" unless defined $path;

print "Location: $path\r\n\r\n";  # Issue redirect

my $newpid = fork();     # New Child process

     # Parent exits on sucessful creation of child
exit(0) if (defined $newpid && $newpid != 0);
# child running from here
close(STDOUT);           # We're done sending
log_request($path);      # Log redirect

##################################################
sub log_request {
##################################################
    my $url = shift;

    open(LOG, ">>$LOG_FILE") || 
        die("Cannot open $LOG_FILE: $!");

    flock(LOG,2);        # Lock exclusive
    seek(LOG, 0, 2);     # Seek to end

    my @months = qw(Jan Feb Mar Apr May Jun Jul 
                    Aug Sep Oct Nov Dec);

    my ($sec,$min,$hour,$mday,$mon,$year) = 
                                  localtime(time);

    $time = sprintf(
              "[%02d/%s/%d:%02d:%02d:%02d +0000]",
              $mday, $months[$mon], $year + 1900,
              $hour, $min, $sec);

    print LOG reverse_lookup($ENV{REMOTE_ADDR}), 
              " -",                # Always a dash
              " -",                # User name
              " $time",            # Time
              " \"GET $url HTTP/1.0\"",   # Request
              " 200",              # Status code
              " 0",                # Bytes: 0
              " $ENV{HTTP_REFERER}",    # Referer
                                   # User Agent
              " \"$ENV{HTTP_USER_AGENT}\"",
              "\n";
    close LOG;
}

##################################################
sub reverse_lookup {
##################################################
  my $ip = shift;

             # Return if it's already a hostname
  return $ip if($ip =~ /[a-z]/);

             # IP -> 4 byte struct
  my $ipstruct = inet_aton($ip);

             # Return resolved host or original IP
  gethostbyaddr($ipstruct, AF_INET) || $ip;
}