#!/usr/bin/perl
#
# BANNERMATIC 2 - Version using HTTP cookies
#
# Operates rotating banners and tracks display and click-thru stats.
#
# Filename: banmat2.cgi
# Copyright: 1997-2006 by Joe DePasquale
# Last Revised: September 15, 2006
# E-Mail: crypt@getcruising.com
# Website: http://www.getcruising.com
#
# See the document 'how2ban.txt' for set-up instructions.
#
########################################################################
# #
# This script and accompanying files may be distributed freely #
# and modified, provided this header with my name, E-Mail address and #
# this notice remain intact. Ownership rights remain with me. You may #
# not sell this script without my approval. #
# #
# This script comes with no guarantee or warranty except for my good #
# intentions. By using this code you agree to indemnify me from any #
# liability that might arise from it's use. #
# #
# There is no technical support for this script, neither am I a #
# professional programmer. Refer to 'HELPME.TXT' for general guidance. #
# #
########################################################################
#
# CONFIGURE THE SCRIPT -
#
# Change these sample paths to the actual paths on your server:
# Your Unix system sendmail command and email address
$mailCmd = '/usr/sbin/sendmail';
$myMail = 'yourmail@yourdomain.com';
# Unix path to banmat data directory
$banmatDir = '/usr/home/yourpath/banmat';
# OPTIONAL - YOU CAN EDIT THESE VARIABLES IF DESIRED:
# If you want a signature file attached to mail messages,
# uncomment the next line and enter the correct Unix path ..
# $MYSIG = '/usr/home/yourpath/to/mysig.txt';
# .. otherwise uncomment the next 2 lines and replace with your info ..
# $myName = 'Bonzo Clone';
# $homeUrl = 'http://yourdomain.com/anypage.html';
# If you use 'group' codes and no banner is found with the required
# code, which banner number (in bandat.txt) should be defaulted to?
# Also, cookie-challenged browsers will ALWAYS get this banner.
$failBan = 0;
# Go to this URL when exiting manager
$exitUrl = '/';
# Browser will keep retrieving same banner associated with a pagecode
# until banner is deleted from cache. If using animated GIF's you should
# set to 'Y' to avoid 'slideshow'. Otherwise use 'N' (but try both!)
$cacheFlag = 'Y';
# [Optional] URL to the styleheet
$styleUrl = '/www.css';
# END OF INSTALLATION - SHOULD NOT CHANGE STUFF BELOW THIS LINE
########################################################################
($ss,$mm,$hh,$dd,$mo,$yyyy,$d,$jjj,$b) = localtime (time);
$mo++; $yyyy+=1900;
$timeStamp = localtime (time);
$dateStamp = $yyyy.sprintf("%02d",$mo).sprintf("%02d",$dd);
$BANDAT = "$banmatDir/bandat.txt";
$BANFLK = "$banmatDir/banflk.txt";
$BANLOG = "$banmatDir/ban.log";
$BANUNDO = "$banmatDir/banmat.bak";
$BANPWD = "$banmatDir/banpwd.txt";
$scriptUrl = $ENV{'SCRIPT_NAME'};
########################################################################
# Get stuff and read input from query string
if ($ENV{'QUERY_STRING'} eq 'manager' || $ENV{'REQUEST_METHOD'} eq 'POST')
{ require "./banman.pl";
&banman;
exit;
} elsif ($ENV{'QUERY_STRING'} =~ /(\S+?)(\+(\S))?=(\S+?)(\+(\S+?))?(&.*|$)/)
{ $pagecode =$1; $group =$3; $command =$4; $result =$6;
# Test Cookieness
if ($ENV{'HTTP_COOKIE'})
{ $result = 'Y';
} elsif ($result eq 'TEST')
{ $result = 'N';
} else
{ print "Set-Cookie: banmat=Y; expires=Sat, 31 Dec 2999 12:00:00 GMT; path=/\n";
print "Location: $scriptUrl?$pagecode+$group=$command+TEST\n\n";
exit;
}
} else # bounce bad input
{ &endIt;
}
########################################################################
# Case: Send banner Image to browser
if ($command eq 'IMG')
{
open (LOCK,">$BANFLK") || &endIt;
if (!flock (LOCK,2)) { &endIt; }
# Get the banner info
open (DAT,"+<$BANDAT") || &endIt;
flock (DAT,2);
seek (DAT,0,0);
@banFile = <DAT>;
if ($result eq 'Y')
{ @ndx = (0..$#banFile);
while ((!defined $banNbr) && $#ndx >=0)
{ $x = int (rand ($#ndx +1));
@banLine = split(/\|/,$banFile[$ndx[$x]]);
if ($banLine[4] =~ /$group/)
{ $banNbr = $ndx[$x];
} else
{ splice (@ndx,$x,1);
}
}
}
if (!defined $banNbr)
{ $banNbr = $failBan;
@banLine = split(/\|/,$banFile[$banNbr]);
}
# count the impression
$banLine[3] ++;
$banFile[$banNbr] = join ("\|",@banLine);
seek (DAT,0,0);
print (DAT @banFile);
truncate (DAT,tell(DAT)); close (DAT);
$imageExt = substr ($banLine[1],rindex ($banLine[1],".")+1);
# send cookie and image to browser
if ($cacheFlag eq 'N')
{ print "Expires: Wed, 01 Jan 1997 12:00:00 GMT\n";
}
print "Set-Cookie: $pagecode=$banNbr\n";
print "Content-type: image/$imageExt\n";
print "Location: $banLine[1]\n\n";
close (LOCK);
} # end IMG
########################################################################
# Case: Send browser to the banner's URL
elsif ($command eq "URL")
{
open (LOCK,">$BANFLK") || &endIt;
if (!flock (LOCK,2)) { &endIt; }
if ($result eq 'Y')
{ @cookiePairs = split (/; /,$ENV{'HTTP_COOKIE'});
$x=0;
do
{ ($name,$value) = split(/=/,$cookiePairs[$x]);
if ($name eq $pagecode) { $banNbr = $value; }
$x++;
} until (defined $banNbr || $x >$#cookiePairs);
}
if (!defined $banNbr) { $banNbr = $failBan; }
# Get the banner info
open (DAT,"+<$BANDAT") || &endIt;
flock (DAT,2);
seek (DAT,0,0);
@banFile = <DAT>;
if ($banNbr <= $#banFile)
{ @banLine = split(/\|/,$banFile[$banNbr]);
# count the click-thru
$banLine[2] ++;
$banFile[$banNbr] = join ("\|",@banLine);
seek (DAT,0,0);
print (DAT @banFile);
truncate (DAT,tell(DAT));
# send browser to URL for IMG
print "Content-type: text/html\n";
print "Location: $banLine[0]\n\n";
# log the click-thru
$banLog = join ("\|",$timeStamp,$banLine[0],$pagecode,$group,$ENV{'REMOTE_ADDR'});
open (LOG,">>$BANLOG");
flock (LOG,2);
seek (LOG,0,2);
print (LOG "$banLog\n");
close (LOG);
} else
{ print "Content-type: text/html\n\n";
print "Banner Requested Does Not Exist ($banLine[0])<br>\n";
}
close (DAT);
close (LOCK);
} # end URL
exit; # end program
########################################################################
sub endIt # error handling for user script
{ exit;
}