#!/usr/bin/perl 
##############################################################################
# IP eye - Visitor book that serves a graphic (or ZIP file) 
# 	and notes the visitor's details
#
# Doug Rice, 2004
# 
# Some of the code is based on code found in Matt Wright's Perl guest book.
#
# Filters out my IP address
#
# upload this file to your CGI server,
# ( Some servers do not like PERL scripts with CRLF, so upload as ASCII file)
#
# Rename this file to gbOjpg.pl
#
# If serving a GIF file call it gbOjpg.pl
# on your web page include the HTML:
# <IMG src="http://cgi.YOUR_USER_NAME.plus.com/cgi-bin/gbOjpg.pl">
#
# OR
#
# If serving a GIF file call it IPeye.gif
# on your web page include the HTML:
# <IMG src="http://cgi.YOUR_USER_NAME.plus.com/cgi-bin/IPeye.gif">
#
# This works fine.
#
#
#
# If serving a ZIP file call it code.zip
# on your web page include the HTML:
# <a href="http://cgi.YOUR_USER_NAME.plus.com/cgi-bin/code.zip" target="_blank">code.zip</a> 
#
# NOTE: IMPORTANT
#
# You must correctly set:
# $picFile      = ".//code_to_be_downloaded.zip";
# $header 	= "Content-Type: application/zip\n\n";
#
#
#
#
##############################################################################

# If you are getting Internal server error messages,
# use the code below to pipe  script errors to the browser
use CGI::Carp ( fatalsToBrowser);
use Socket;
# Set Variables
my ($name, $aliases, $addrtype, $length, @addrs);

# comment out the Xitami line for use with webhoster.
$path              = "$ENV{'DOCUMENT_ROOT'}"; 
# path for Plus net
$path              = "$ENV{'C_DOCUMENT_ROOT'}"; 

$guestbookjsf      = $path.'/gb/gbookF';


#
# Serving a ZIP file: code_to_be_downloaded.zip as called code.zip
#

# Upload this perl script to your CGI area and rename this perl script code.zip
# The server ( appachie on Linux ) uses the execute flag and the first line, not the file name.
# hence the !/usr/bin/perl on the first line. 
#
# Include the HTML below on your web page.
# <a href="http://cgi.dougrice.plus.com/cgi-bin/code.zip" target="_blank">code.zip</a> 
#
# and use these:
#

$picFile = "./code_to_be_downloaded.zip";
$header  = "Content-Type: application/zip\n\n";

# Example HTML headers captured with Ethereal

# GET /hp/picprog/PicProgv1_3.zip HTTP/1.1
# Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*
# Referer: http://www.dougrice.plus.com/hp/picprog/
# Accept-Language: en-gb
# Accept-Encoding: gzip, deflate
# User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)
# Host: www.dougrice.plus.com
# Connection: Keep-Alive

# HTTP/1.0 200 OK
# Date: Mon, 31 May 2004 10:08:59 GMT
# Server: Apache/1.3.29 (Unix)
# Last-Modified: Fri, 25 Jul 2003 07:12:39 GMT
# ETag: "179ef5-1d600-3f20d867"
# Accept-Ranges: bytes
# Content-Length: 120320
# Connection: close
# Content-Type: application/zip
# X-Pad: avoid browser bug

#
# Serving a GIF file.
#
#Include the HTML below on your web page.
#<IMG src="http://cgi.dougrice.plus.com/cgi-bin/gbOjpg.pl">
#
# Alternatively upload this perl script to your CGI area and rename this perl script  IPeye.gif and use HTML
#<IMG src="http://cgi.dougrice.plus.com/cgi-bin/IPeye.gif">
#
# The server ( appachie on Linux ) uses the execute flag and the first line, not the file name.
# hence the !/usr/bin/perl on the first line. 
#
# and use these:
#

$picFile  = ".//ipstats.gif";
$header   = "Content-Type: image/gif\n\n";

# Example HTML headers captured with Ethereal
#
# HTML header
# GET /cgi-bin/gbOjpg.pl HTTP/1.1
# Accept: */*
# Referer: http://www.dougrice.plus.com/gbbook/ipeye/index.htm
# Accept-Language: en-gb
# Accept-Encoding: gzip, deflate
# User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)
# Host: cgi.dougrice.plus.com
# Connection: Keep-Alive
#
# HTTP/1.1 200 OK
# Date: Mon, 31 May 2004 10:22:50 GMT
# Server: Apache/1.3.29 (Unix) mod_perl/1.28 PHP/4.3.5
# Keep-Alive: timeout=15, max=96
# Connection: Keep-Alive
# Transfer-Encoding: chunked
# Content-Type: image/gif



# list IP addresses that you wish to ignore
$ignoreIPA{ "21A2.56.108.219 " } = 1;
$ignoreIPA{ "19A3.113.37.9 132.146.89.88" } = 1;


# Done
##############################################################################

# Get the Date for Entry
#($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);		   
#  0     1     2    3     4     5    6     7     8
@t = localtime();
@days= ('sun','Mon','Tue','Wed','Thu','Fri','Sat','Sun');
@months=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
$fullYear=1900+$t[5];
#$date = " $days[$t[6]] $t[3]/$months[$t[4]]/$fullYear at $t[2]: $t[1]: $t[0] ";

#toUTCString():
#Tue, 25 Jun 2002 05:47:32 UTC
$date = "$days[$t[6]], $t[3] $months[$t[4]] $fullYear ".substr("0".$t[2],-2,2).":".substr("0".$t[1],-2,2).":".substr("0".$t[0],-2,2)." UTC+0100";

# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});

foreach $pair (@pairs) {
   ($name, $value) = split(/=/, $pair);

   # Un-Webify plus signs and %-encoding
   $value =~ tr/+/ /;
   $value =~ s/<!--(.|\n)*-->//g;

   if ($allow_html != 1) {
      $value =~ s/<([^>]|\n)*>//g;
   }
   $value =~ s/%0D/<BR>\n/g;
   $value =~ s/%0A//g;
   $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

   $FORM{$name} = $value;
}



if ( exists $ignoreIPA{ "$ENV{'REMOTE_ADDR'} $ENV{'HTTP_X_FORWARDED_FOR'}" } ) {
} else { 
  &appendTogbookFImg();

  &incrementVisitorCount();
}


# #########################################
# Now open the file to be downloaded as binary, and make sure correct MIME type is set up
# so that correct HTTP header is used.
#
#


$buff = "";
$got=0;

# ensure the following are set up
#$picFile  = ".//ipstats.gif";
#$header   = "Content-Type: image/gif\n\n";


open (PICFILE,"$picFile") || die "Can't Open $picFile: $!\n";

binmode PICFILE;
syswrite( STDOUT,$header,length($header));
$finished = ( 1==0 );
while ( ! $finished ) {
   $got = sysread( PICFILE,$buff,100);
   if ( $got > 0 ) {
        syswrite( STDOUT,$buff,$got);
   }	
   #printf "read file $got \n";

   if ( $got < 100) {
      $finished = ( 1==1 );
   } 

}

close PICFILE;

exit;






#######################
# Subroutines
sub appendTogbookFImg{
  # append visitor data as javascript functiona calls gbF() in gbbokFImg

  # New format 
  $N = "Img";
  $X = "";

  ($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr( inet_aton( $ENV{'REMOTE_ADDR'} ), PF_INET );

  open (GUESTFJS,">>$guestbookjsf$N.js") || die "Can't Open $guestbookjsf$N.js: $!\n";
  $X = "$FORMJS{'guestBookArrayName'}";

  print GUESTFJS "\n";
  print GUESTFJS "// new amendement $N:$X: \n";
  # print GUESTFJS "// $ENV{'C_DOCUMENT_ROOT'}\n // $picFile \n";
  # print GUESTFJS "//HTTP_REFERER   = $ENV{'HTTP_REFERER'}\n";
  # print GUESTFJS "//HTTP_USER_AGENT= $ENV{'HTTP_USER_AGENT'}\n";

  #print GUESTFJS "  guestBookFile$N$X\[ count$X \] = new GB( \n";
  print GUESTFJS "gbF$X( \n";

  print GUESTFJS "\"$name $aliases\",";
  print GUESTFJS "\"$ENV{'HTTP_HOST'}\",";
  print GUESTFJS "\"$date\",\n";
  print GUESTFJS "\"$ENV{'REMOTE_ADDR'} $ENV{'HTTP_X_FORWARDED_FOR'}\",\n";
  #// output in format so that it can be loaded into BasicForm3.htm
  print GUESTFJS "\"$ENV{'REMOTE_HOST'}\",\n";       #uf1
  print GUESTFJS "\"$ENV{'HTTP_USER_AGENT'}\",\n";   #uf2
  print GUESTFJS "\"$ENV{'HTTP_ACCEPT'}\",\n";       #uf3
  print GUESTFJS "\"$ENV{'HTTP_REFERER'}\",\n";      #uf4
  print GUESTFJS "\"$ENV{'REMOTE_ADDR'} $ENV{'HTTP_X_FORWARDED_FOR'} $ENV{'REMOTE_USER'}\"\n";
  print GUESTFJS ");\n";
  #print GUESTFJS "  count$X=count$X+1;\n";
  close (GUESTFJS);
}



# file_error - call if problems opening files
sub file_error {

    local($FH, $fileName) = @_; 
    # Print Beginning of HTML
    print "Content-Type: text/html\n\n";
    print "<html><head><title>Thank You</title></head><body>\n";
    print "<H1>Error Opening File: $path : $fileName :, press back</h1> \n";
    print "Your data has not been added, press back <P>\n";

    print "If you can log into the server, check file permissions\n";
    print '</body></html>';
    exit;
}

#-----------------------------------------------------------------
# Check the credits
sub incrementVisitorCount {
  $VisitorCountFile    = $path.'/gb/visits.js';

  open (VISITORCOUNTFILE,$VisitorCountFile ) || &file_error( VISITORCOUNTFILE,$VisitorCountFile ); 
  @CREDIT_LINES=<VISITORCOUNTFILE>;
  close(VISITORCOUNTFILE);

  $CREDIT_SIZE=@CREDIT_LINES;
  foreach $memRow (@CREDIT_LINES){
   ($sp1,$name,$sp2,$value)  = split(/\'|=/gi, $memRow);

   if ( $name ne '' ) {
     $CREDITSA{$name} =($value+0);
   }
  }

  $page = "page:".$ENV{'HTTP_REFERER'};
  
  if ( exists $CREDITSA{ $page } ) {
     $CREDITSA{$page}++;
  } else { 
     $CREDITSA{$page}=1;
  }

  # want a file with lines =
  # cntA[ 'HTTP' ] = value 
  open (VISITORCOUNTFILE,">$VisitorCountFile" ) || &file_error( VISITORCOUNTFILE,$VisitorCountFile ); 
  while ( ($name, $value)  = each %CREDITSA ){
   print VISITORCOUNTFILE "visitsA[ \'$name\' ] = $value \n";
   $CREDITSA{$name} = $value;
  }
  close(VISITORCOUNTFILE);
}