#!/usr/bin/perl
#
# BANNERMATIC 3 - Version using IP Addresses
#
# Operates rotating banners and tracks display and click-thru stats.
# IMG<->URL associated by session IP addresses and banner numbers.
#
# Filename: banmat3.cgi
# Copyright: 1997,1998 Joe DePasquale
# Last Revised: August 29, 1998
# 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 SCRIPT -
#
# Change the sample paths to the actual paths on your server:
# Your Unix system sendmail and date commands
$mailCmd = '/usr/lib/sendmail';
$dateCmd = '/bin/date';
# Your E-Mail address - note mandatory backslash before \@
$myMail = "nfo\@erotiksearch.de";
# Unix path to the banmat directory
$banmatDir = '/srv/www/vhosts/erotiksearch.de/httpdocs/banner';
# URL to the banmat directory
$banmatUrl = 'http://www.erotiksearch.de/banner';
# URL to banmat3.cgi
$scriptUrl = 'http://www.erotiksearch.de/cgi-bin/banmat3.cgi';
# Go to this URL when exiting manager
$exitUrl = 'http://www.erotiksearch.de';
# If you use Example #2 above, when a user clicks the small
# banner (promo.gif), where should the script send them?
$promoUrl = 'http://www.erotiksponsor.de';
# If you use 'group' codes and no banner is found with the required
# code, which banner number (in ban.dat) should be defaulted to?
$failBan = 0;
# If you want a signature file attached to mail messages,
# uncomment the next line and enter its Unix path ..
# $MYSIG = "/usr/home/yourpath/to/mysig.txt";
# .. otherwise uncomment the next 2 lines and replace with your info ..
$myName = "Ruth Klippel";
$homeUrl = "http://www.erotiksearch.de";
# OPTIONAL - YOU CAN EDIT THESE VARIABLES IF DESIRED:
$headTitle = "BANNERMATIC3: IP Version";
$bodyTag = qq|
|;
$bodyTitle = qq|BANNERMATIC3 IP Version|;
# 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';
# Daily maintenance of banip.dat is done when the first visitor runs
# the script between $admOn and $admOff. Use 24-hour time from
# 1 to 23 (1 AM to 11PM). If confooosed, use the defaults.
$admOn = 12; $admOff = 17;
# If you use HITMATIC, save yourself from having to place HTML for both
# scripts on the same web page. If $hitFlag is 'Y', after Bannermatic
# runs an 'IMG' command, it passes pagecode and group to HITMATIC.
$hitFlag = 'N';
# If you don't want backups of the ban*.dat file, set $bakFlag to 'N',
# otherwise choose your settings in the following 'if' loop ..
$bakFlag = 'N';
if ($bakFlag eq "Y")
{ $bakTime = 2; # days btwn backups
$bakMax = 7; # days to keep backups
# Unix path to backup directory
$bakDir = '/usr/home/yourpath/to/bak';
# END OF INSTALLATION - SHOULD NOT CHANGE STUFF BELOW THIS LINE
######################################################################
chop ($jDate = `$dateCmd +"%j"`);
$BANBAK = "$bakDir/ban$jDate.bak";
}
chop ($timeStamp = `$dateCmd +"%a %D %H%M%Z"`);
chop ($dateStamp = `$dateCmd +"%Y%m%d"`);
chop ($hourStamp = `$dateCmd +"%H"`);
chop ($dowStamp = `$dateCmd +"%w"`);
$BANDAT = "$banmatDir/ban.dat";
$BANFLK = "$banmatDir/ban.flk";
$BANLOG = "$banmatDir/ban.log";
$IPCNT = "$banmatDir/banip.cnt";
$IPDAT = "$banmatDir/banip.dat";
########################################################################
# Get stuff and read input from query string
require "./banip.pl";
if ($ENV{'QUERY_STRING'} eq 'manager' || $ENV{'REQUEST_METHOD'} eq 'POST')
{ require "./banman.pl";
$BANUNDO = "$banmatDir/ban.bak";
$BANPWD = "$banmatDir/banmat.pwd";
&banman;
exit;
} elsif ($ENV{'QUERY_STRING'} =~ /(\S+?)(\+(\S))?=(\S+?)(&.*|$)/)
{ $pagecode =$1; $group =$3; $command =$4;
} else
{ &endIt;
}
open (LOCK,">$BANFLK") || &endIt;
if (!flock (LOCK,2)) { &endIt; }
######################################################################
# Case: Send banner Image to browser
if ($command =~ /IMG(X?)/)
{
# Get the banner info
open (DAT,"+<$BANDAT") || &endIt;
flock (DAT,2); seek (DAT,0,0);
@banFile = ;
srand (time^$$);
@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 image to browser
if ($cacheFlag eq "N")
{ print "Expires: Wed, 01 Jan 1997 12:00:00 GMT\n";
}
print "Content-type: image/$imageExt\n\n";
$IMGDAT = "$banmatDir/$banLine[1]";
open (IMG,"<$IMGDAT") || &endIt;
read (IMG,$imgDat,-s $IMGDAT);
print $imgDat; close (IMG);
if ($bakFlag eq "Y" && ($jDate % $bakTime ==0) && !-e $BANBAK)
{ &backUp (@banFile);
}
# record the IP nbr and banner nbr
open (IPDAT,"+<$IPDAT") || &endIt;
flock (IPDAT,2); seek (IPDAT,0,0);
@ipFile = ;
# IP file maintenance if due
if ($admOff > $hourStamp && $admOn <=$hourStamp) { &ipAdm (@ipFile); }
$remote = $ENV{'REMOTE_ADDR'};
$remote =~ s/\s//g;
$foundFlag = "N"; $recNbr = 0;
do
{ @ipLine = split (/\|/,$ipFile[$recNbr]);
if ("$remote\|$pagecode" eq "$ipLine[0]\|$ipLine[1]")
{ $ipFile[$recNbr] = join ("\|",$remote,$pagecode,$banNbr,$dowStamp,"\n");
$foundFlag = "Y";
} else
{ $recNbr ++;
}
} while ($foundFlag eq "N" && $remote ge $ipLine[0] && $recNbr <= $#ipFile);
if ($foundFlag eq "N")
{ $newLine = join ("\|",$remote,$pagecode,$banNbr,$dowStamp,"\n");
push @ipFile, $newLine;
}
@newIpFile = sort {$a cmp $b} @ipFile;
seek (IPDAT,0,0);
print (IPDAT @newIpFile);
truncate (IPDAT,tell(IPDAT)); close (IPDAT);
if ($hitFlag eq 'Y' && $command eq "IMG")
{ close (LOCK);
do "hitmat.cgi";
}
} # end IMG
######################################################################
# Case: Get bannerNbr from address file or fail. Send browser to URL
elsif ($command eq "URL")
{
open (IPDAT,"+<$IPDAT") || &endIt;
flock (IPDAT,2); seek (IPDAT,0,0);
@ipFile = ;
$remote = $ENV{'REMOTE_ADDR'};
$remote =~ s/\s//g;
$foundFlag = "N"; $recNbr = 0;
do
{ @ipLine = split (/\|/,$ipFile[$recNbr]);
if ($remote eq $ipLine[0] && $pagecode eq $ipLine[1])
{ $banNbr = $ipLine[2];
$ipFile[$recNbr] = join ("\|",$remote,$pagecode,$banNbr,$dowStamp,"\n");
$foundFlag = "Y";
@newIpFile = sort {$a cmp $b} @ipFile;
seek (IPDAT,0,0);
print (IPDAT @newIpFile);
truncate (IPDAT,tell(IPDAT));
} else
{ $recNbr ++;
}
} while ($foundFlag eq "N" && $remote ge $ipLine[0] && $recNbr <= $#ipFile);
close (IPDAT);
if ($foundFlag eq "Y")
{ open (DAT,"+<$BANDAT") || &endIt;
flock (DAT,2); seek (DAT,0,0);
@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)); close (DAT);
# send browser to URL for IMG
print "Content-type: text/html\n";
print "Window-target: _top\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 # ip address not in file
{ open (DAT,"+<$BANDAT") || &endIt;
flock (DAT,2); seek (DAT,0,0);
@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)); close (DAT);
# send browser to URL for IMG
print "Content-type: text/html\n";
print "Window-target: _top\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);
}
} # end URL
######################################################################
# Case: Send browser to promo page
elsif ($command eq "PROMO")
{
print "Content-type: text/html\n";
print "Window-target: _top\n";
print "Location: $promoUrl\n\n";
# log the click-thru
# $banLog = join ("\|",$timeStamp,$promoUrl,$pagecode,$group,$ENV{'REMOTE_ADDR'});
# open (LOG,">>$BANLOG");
# flock (LOG,2); seek (LOG,0,2);
# print (LOG "$banLog\n");
# close (LOG);
} # end promo
close (LOCK);
exit; # end program
##################################################################
sub backUp # Backup data and delete old backups
{
@bakData = @_;
open (BAK,">$BANBAK") || &endIt;
print (BAK @bakData);
close (BAK);
chmod (0666,$BANBAK);
opendir (BAKDIR,$bakDir);
@bakFiles = grep (/ban\d{3}\.bak/, readdir(BAKDIR));
closedir (BAKDIR);
foreach $bakFile (@bakFiles)
{ if (-M "$bakDir/$bakFile" > $bakMax) { unlink "$bakDir/$bakFile"; }
}
} # end backup
sub endIt # error handling for user script
{ exit;
}