#!/usr/bin/perl
# You may have to change the line above to refer to where perl
# is located on your system. At the Unix prompt, type whereis perl
# and a list of locations of perl on your server will be shown.
# Change the line above to match one of those locations.
##KloakItPAGE.CGI#####################################################
#
# (C) Copyright 2000 Volatile Graphix, Inc. All rights reserved.
# This script may not be copied or modified in any way without
# permission in writing from Volatile Graphix, Inc.
#
# Limitation of Liability: KloakIt is to be used at your own risk
# Volatile Graphix, Inc. d.b.a. KloakIt expressly disclaims any and
# all liability from any and all consequences arising from the use
# of this and all scripts that Volatile Graphix, Inc. d.b.a. KloakIt
# have written. By using this script in whole or in part, the user
# hereby agrees to abide by this statement.
#
######################################################################
######################################################################

# OPTIONAL
# If you change the name of the data directory, make $writedir equal
# to the new name and path of the directory.
$writedir = "data";

######################################################################
############# NO EDITING NECESSARY BELOW HERE ########################
############# NO EDITING NECESSARY BELOW HERE ########################
############# NO EDITING NECESSARY BELOW HERE ########################
######################################################################

#open (STDERR, ">>pageerrorlog.txt");

if ($ENV{'SERVER_SOFTWARE'} =~ /Win/i) {$winserver = 1;}

use LWP::Simple;
use LWP::UserAgent;
use HTTP::Date;

open (R, "$writedir/config.daq");
flock (R, 2) unless($winserver);
$config = <R>;
flock (R, 8) unless($winserver);
close (R);
chomp($config);
($redir, $timeModifier, $suckerURL) = split (/\t/, $config);

$temp="";
$keywordarray="";
$tobedisplayed="";
$ifMail=0;
$notify=0;
$autoIPupdateRequired=0;
$IPupdateURL = "http://www.iplists.com/nw";

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time+ (3600*$timeModifier)); # set time
$sec;$yday;$isdst;$wday; # second use of vars to stop errors
$mon++;

if ($min !~ /^..$/) {$min= '0'.$min;}
if ($hour !~ /^..$/) {$hour= '0'.$hour;}
if ($mday !~ /^..$/) {$mday= '0'.$mday;}
if ($mon !~ /^..$/) {$mon= '0'.$mon;}
if ($year !~ /^..$/) {$year= '0'.$year;}

$year =~ s/.+(..)$/$1/;
if ($year < 90) { $year = "20" . $year; }
$date="$mon/$mday/$year, $hour:$min";
$nowdate = "$year-$mon-$mday";

$loc = "http://" . $ENV{'SERVER_NAME'};
$myname = $ENV{'QUERY_STRING'};
if ($myname eq "") { exit; }
$myname =~ s/^\/.*\///;
$myname =~ s/^\///;
$gethost = $ENV{'REMOTE_HOST'};
$getaddr = $ENV{'REMOTE_ADDR'};
$ref     = $ENV{'HTTP_REFERER'};
$agent   = $ENV{'HTTP_USER_AGENT'};
$localdirectory = $ENV{'SCRIPT_NAME'};
$localdirectory =~ s/^(.+)\/page\.cgi$/$1/;
$localdirectory =~ s/\/page\.cgi//;
$ext = $myname;
$ext =~ s/.*(\..*)$/$1/;

if (-e("$writedir/customloc.daq")){
    open (CUSTLOC, "<$writedir/customloc.daq");
    $customloc = <CUSTLOC>;
    close (CUSTLOC);
} else {
    $customloc = "";
}

if (-e "$writedir/mail.daq"){
    open (MAIL, "<$writedir/mail.daq");
    flock (MAIL, 2) unless $winserver;
    $mailinfo = <MAIL>;
    flock (MAIL, 8) unless $winserver;
    chomp($mailinfo);
    ($mailProgram, $email) = split(/\t/,$mailinfo);
    if (($mailProgram ne "") and ($email =~ /.+@.+\..+/)){
        $ifMail = 1;
    }
}

open (SEP, "$writedir/sep.daq");
flock (SEP, 2) unless $winserver;
$sep = <SEP>;
flock (SEP, 8) unless $winserver;
close (SEP);
chomp($sep);

if (-e "$writedir/mailsettings.daq"){
    open (MAILSETTINGS, "<$writedir/mailsettings.daq");
    flock (MAILSETTINGS, 2) unless $winserver;
    $mailsettings= <MAILSETTINGS>;
    flock (MAILSETTINGS, 8) unless $winserver;
    close (MAILSETTINGS);
    chomp($mailsettings);
    ($unknownUA, $unknownIP, $noRef) = split(/\t/,$mailsettings);
}
@messagebody = ();

if (-e "$writedir/uaredirect.daq"){
    open (UA, "<$writedir/uaredirect.daq");
    flock (UA, 2) unless $winserver;
    @UAredirect=<UA>;
    flock (UA, 8) unless $winserver;
    close (UA);
    if (@UAredirect>0){ $UARedirection=1; }
}

if (-e "$writedir/uaredirectbot.daq"){
    open (UA, "<$writedir/uaredirectbot.daq");
    flock (UA, 2) unless $winserver;
    @UAredirectbot=<UA>;
    flock (UA, 8) unless $winserver;
    close (UA);
    if (@UAredirectbot>0){ $UARedirectionbot=1; }
}

if (-e "$writedir/refererredirect.daq"){
    open (REFERER, "<$writedir/refererredirect.daq");
    flock (REFERER, 2) unless $winserver;
    @refererRedirects=<REFERER>;
    flock (REFERER, 8) unless $winserver;
    close (REFERER);
    if (@refererRedirects>0){ $rrd=1;}
}

if (-e "$writedir/aipufc.daq"){
    open (IPUPDATE, "<$writedir/lastipupdate.txt");
    $lastupdate = <IPUPDATE>;
    close (IPUPDATE);
    
    ($lastYear, $lastMonth, $lastDay) = split ($lastupdate, /-/);
    if ($lastupdate ne $nowdate) {$autoIPupdateRequired = 1;}
}

if (-e "$writedir/randompages.txt"){
    open (RA, "$writedir/randompages.txt");
    @randompages = <RA>;
    @randompagesInUse = @randompages;
    close (RA);
}
if (-e "$writedir/nolistlinks.daq") { $listLinks = "0";}
else { $listLinks = "1";}
open (REDIR, "$writedir/altredir.txt");
@redirlist=<REDIR>;
close (REDIR);
$stop=0;
foreach (@redirlist){
    chomp;
    ($pageName,$altRedir,$customTemplate,$randomSeed) = split (/#/, $_);
    if ($myname eq $pageName) {
        if ($altRedir ne "") { $redir = $altRedir; $altRedirection = 1;}
        if ($customTemplate ne "") { $altTempl = 1; }
        $randseed = $randomSeed;
        last;
    }

}

foreach (@redirlist){
    chomp;
    ($linkName,$tempfoo,$tempfoo2,$tempfoo3) = split (/#/, $_);
    push (@cloakedURLs, $linkName);
}
@cloakedURLsInUse = @cloakedURLs;

open (K, "$writedir/gr.daq");
flock (K, 2) unless($winserver);
$c = <K>;
flock (K, 8) unless($winserver);
close (K);
if (-e "$writedir/nocache.daq") { $nocache = 1; }
unless (($c =~ /$ENV{'SERVER_NAME'}/) or ($c =~ /kk.+ .+/)) {
    open (A, "$writedir/gra.daq");
    flock (A, 2) unless($winserver);
    @gra = <A>;
    flock (A, 8) unless($winserver);
    close (A);
}
if ($localdirectory =~ /\.s?html?$/) {
    $localdirectory =~ s/.+.s?html?$//;
}

if (-e "$writedir/nocloak.daq"){
    $nocloakcheck=1;
    open (NOCLOAK, "$writedir/nocloak.daq");
    @nocl = <NOCLOAK>;
    close (NOCLOAK);
    foreach (@nocl){
        chomp;
        ($enginename, $switch) = split(/\t/, $_);
        $nocloak{$enginename} = $switch;
    }
}


@exclude =  ("204.123.9.65",   # @exclude is for certain applications
             "204.123.9.66",    # sponsored by search engines such
             "204.123.9.67",    # as Babelfish that translate pages into
             "204.123.9.68",    # other languages and display them. You
             "204.123.9.106",   # don't want humans seeing this, so I
             "204.123.9.107",   # made an exclude list.
             "204.152.191.27",
             "204.152.191.28",
             "204.152.191.29",
             "204.152.190.27",
             "204.152.190.28",
             "204.152.190.29",
             "204.152.190.37",
             "204.152.190.154",
             "204.162.96.104",
             "204.162.96.154",
             "204.162.96.176",
             "209.247.194.35",
             "209.247.194.100",
             "64.208.35.5");

if (-e "$writedir/customexclude.daq"){
    open (CUSTOMEXCLUDE, "$writedir/customexclude.daq");
    @customexclude = <CUSTOMEXCLUDE>;
    close (CUSTOMEXCLUDE);
} else {
    open (CUSTOMEXCLUDE, "+>$writedir/customexclude.daq");
    close (CUSTOMEXCLUDE);
    chmod (0777, "$writedir/customexclude.daq");
}

open (SUCKERLIST, "$writedir/suckerlist.txt");
flock(SUCKERLIST, 2) unless($winserver);
@suckerlist = <SUCKERLIST>;
flock(SUCKERLIST, 8) unless($winserver);
close(SUCKERLIST);

if ((-e "$writedir/langredirect.daq") and ($ENV{'HTTP_ACCEPT_LANGUAGE'} ne "")){
    @languagecodes = split (/,/,$ENV{'HTTP_ACCEPT_LANGUAGE'});

    open (LANGREDIRECT, "<$writedir/langredirect.daq");
    flock (LANGREDIRECT, 2) unless $winserver;
    @langredirection = <LANGREDIRECT>;
    flock (LANGREDIRECT, 8) unless $winserver;
    close(LANGREDIRECT);
    foreach (@langredirection){
        chomp;
        ($langcode, $langurl) = split(/###/, $_);
        if ($languagecodes[0] eq $langcode){
            $languageRedirectURL = $langurl;
            last;
        }
    }
}

if ($gethost eq "") { $gethost = $getaddr; }

for ($count=1; $count<=10; $count++){
    open (ENGINELIST, "$writedir\/$count" . ".list");
    flock(ENGINELIST, 2) unless($winserver);
    @enginelist1=<ENGINELIST> if $count eq 1;
    @enginelist2=<ENGINELIST> if $count eq 2;
    @enginelist3=<ENGINELIST> if $count eq 3;
    @enginelist4=<ENGINELIST> if $count eq 4;
    @enginelist5=<ENGINELIST> if $count eq 5;
    @enginelist6=<ENGINELIST> if $count eq 6;
    @enginelist7=<ENGINELIST> if $count eq 7;
    @enginelist8=<ENGINELIST> if $count eq 8;
    @enginelist9=<ENGINELIST> if $count eq 9;
    @enginelist10=<ENGINELIST> if $count eq 10;
    flock(ENGINELIST, 8) unless($winserver);
    close (ENGINELIST);
}

open (UAS, "<$writedir/uas.daq");
flock (UAS, 2) unless $winserver;
@UA = <UAS>;
flock (UAS, 8) unless $winserver;
close (UAS);


# MAIN PROGRAM
######################################################################
######################################################################

# Do not cloak if cloaking is turned off.
open (IFCL, "<$writedir/ifcl.daq");
flock (IFCL, 2) unless($winserver);
$ifcl = <IFCL>;
flock (IFCL, 8) unless($winserver);
close (IFCL);
if (!$ifcl) {
    &detect;
    &robot;
    exit;
}

# Detect if requestor is a robot or a normal person
&detect;

# Detect if on Sucker List
&sucker;

# Display normal page to normal person or entrance page to robot
if (($isRobot ne "0") and ($isSucker eq "0")) { &robot; } else { &normal; }

# Do an automatic IP update if required
&autoipupdate if ($autoIPupdateRequired);

exit;

######################################################################



# DETECT IF REQUESTOR IS ROBOT OR NORMAL
######################################################################
######################################################################
sub detect{
    $isRobot = 0;
    $classCclient = $getaddr;
    $classCclient =~ s/\.\d+$//;
    for ($count=1;$count<=11;$count++){

        @list = @enginelist1 if $count eq 1;   # MSN
        $SE = "MSN" if $count eq 1;
        @list = @enginelist2 if $count eq 2;   # Alta Vista
        $SE = "Alta Vista" if $count eq 2;
        @list = @enginelist3 if $count eq 3;   # Lycos
        $SE = "Lycos" if $count eq 3;
        @list = @enginelist4 if $count eq 4;   # Inktomi
        $SE = "Inktomi" if $count eq 4;
        @list = @enginelist5 if $count eq 5;   # WiseNut
        $SE = "WiseNut" if $count eq 5;
        @list = @enginelist6 if $count eq 6;   # Google
        $SE = "Google" if $count eq 6;
        @list = @enginelist7 if $count eq 7;   # Ask Jeeves/Teoma
        $SE = "Ask Jeeves/Teoma" if $count eq 7;
        @list = @enginelist8 if $count eq 8;   # Misc
        $SE = "Misc" if $count eq 8;
        @list = @enginelist9 if $count eq 9;   # Custom List 1
        $SE = "Custom List 1" if $count eq 9;
        @list = @enginelist10 if $count eq 10; # Custom List 2
        $SE = "Custom List 2" if $count eq 10;
        $SE = "" if $count eq 11;

        foreach $line (@list) {
            chomp $line;
            next if $line eq "";
            next if $line =~ /^\#/;
            $line =~ s/ //g;
            if (($gethost =~ /$line/i) and ($gethost =~ /[abcdefghijklmnopqrstuvwxyz\-]+/i)) {
                $isRobot = $count;
            }
            if ($getaddr eq $line){
                $isRobot = $count;
            }
            if ($line =~ /^\d+\.\d+\.\d+$/){
                if ($classCclient eq $line){
                    $isRobot = $count;
                }
            }        
            last if $isRobot eq $count;
        }
        last if $isRobot eq $count;
    }
    
    # check for User Agent Bot cloaking
    if (($UARedirectionbot) and (!$isRobot)){
        foreach (@UAredirectbot) {
            $t = $_;
            chomp $t;
            if ($t !~ /##/) {$t = $t . "##8";}
            ($ua, $templateUA) = split(/##/, $t);
            if ($ENV{'HTTP_USER_AGENT'} =~ /$ua/i){
                $isRobot = $templateUA;
                chomp($isRobot);
                $UACloak = " -- User Agent Cloaking Engaged";
        $SE = "MSN" if $isRobot eq 1;
        $SE = "Alta Vista" if $isRobot eq 2;
        $SE = "Lycos" if $isRobot eq 3;
        $SE = "Inktomi" if $isRobot eq 4;
        $SE = "WiseNut" if $isRobot eq 5;
        $SE = "Google" if $isRobot eq 6;
        $SE = "Ask Jeeves/Teoma" if $isRobot eq 7;
        $SE = "Misc" if $isRobot eq 8;
        $SE = "Custom List 1" if $isRobot eq 9;
        $SE = "Custom List 2" if $isRobot eq 10;
        if ($SE eq "") { $isRobot = 8; $SE = "Misc";}
        $count = $isRobot;
            }
        }
    }
    
    # protect against translators
    if ($gethost =~ /babelfish/i) {
        $translator = " -- Translator";
        $SE = "";
        $isRobot = 0;
    }
    # protect against BabelFish using Scooter IPs
    if ($getaddr eq "209.73.164.50"){
        unless ($agent =~ /scooter/i){
            $translator = " -- Translator";
            $SE = "";
            $isRobot = 0;
        }
    }
    foreach $ip (@exclude) {
        if ($getaddr eq $ip) {
            $isRobot = 0;
            $translator = " -- Translator";
            $SE = "";
        }
    }
    
    # check for custom excludes
    foreach $ip (@customexclude) {
        chomp($ip);
        if ($getaddr eq $ip) {
            $isRobot = 0;
            $NoCloak = " -- Exclude on for $getaddr ";
            $SE = "";
        }
    }    
    
    # check for nocloak
    if ($nocloak{$SE}) {
        $NoCloak = " -- Cloaking off for $SE ";
        $isRobot = 0;
    }
    
}
######################################################################

# DETECT IF ON SUCKER LIST
######################################################################
######################################################################
sub sucker{

    $isSucker=0;
    foreach $line (@suckerlist) {
        chomp $line;
        next if $line eq "";
        next if $line =~ /^\#/;
        $line =~ s/ //g;
        
        if (($gethost =~ /$line/i) and ($gethost =~ /[abcdefghijklmnopqrstuvwxyz\-]+/i)) {
            $isSucker = 1;
        }
        if ($getaddr eq $line){
            $isSucker = 1;
        }
        if ($line =~ /^\d+\.\d+\.\d+$/){
            if ($classCclient eq $line){
                $isSucker = 1;
            }
        }        
        
        last if($isSucker);
    }
    @suckerlist = ();
}
######################################################################


# SERVE NORMAL PAGE TO NORMAL REQUESTOR
######################################################################
######################################################################
sub normal{

    if ($isSucker) {$redir = $suckerURL;}

    # User Agent Redirection
    if ($UARedirection){
        foreach (@UAredirect){
            chomp;
            ($thisagent, $thisUAredir) = split(/###/, $_);
            if ($agent =~ /$thisagent/i){
                if (!$thisUAredir) { $thisUAredir = $redir; }
                $redir = $thisUAredir;
                $UARredirectionNotice =" -- UA Redirect";
                last;
            }
        }
        @UAredirect=();
    }
    
    # Referer Redirection -- overrides user agent redirection
    if ($rrd){
        foreach $line (@refererRedirects){
            chomp($line);
            ($regex, $rrdurl) = split(/###/, $line);
            $rrd_ref = $ref;
            $rrd_ref =~ s/\+/ /g;
            $rrd_ref =~ s/\%20/ /g;
            if ($rrd_ref =~ /$regex/i){
                $redir = $rrdurl;
                $rrdnotice = " -- Referrer Redirect";
                last;
            }
        }
    }
    
    # sucker list redirection -- overrides user agent redirection, referer redirection and $altRedirection
    if ($isSucker) {
        $redir = $suckerURL;
        $sucker = " -- Sucker!";
        $UARredirectionNotice = "";
    }
    
    # language redirection -- overridden by altRedirection, referrer redirection and sucker list redirection, overrides user agent redirection
    if ($languageRedirectURL){
        unless (($altRedirection) or ($sucker) or ($rrdnotice)){
            $redir = $languageRedirectURL;
            $LanguageRedirectMessage =  "-- Language Redirect ($langcode)";
            $UARredirectionNotice = "";
        }
    }
    
    # Log the access
    open (ACCESSLOG, ">>$writedir/access.log");
    flock(ACCESSLOG, 2) unless($winserver);
    $logline = "  $date -- $gethost -- \"$agent\" -- $myname -- $NoCloak$ref$translator$sucker$UARredirectionNotice$rrdnotice$LanguageRedirectMessage\n";
    print ACCESSLOG $logline;
    flock(ACCESSLOG, 8) unless($winserver);
    close (ACCESSLOG);
    
    # log suspect IPs
    if (!$NoCloak){
        foreach $userAgent (@UA) {
            chomp($userAgent);
            if ($agent =~ /$userAgent/){
                open (SUS, ">>$writedir/suspected.log");
                flock(SUS, 2) unless($winserver);
                $logline = "  $date -- $gethost -- \"$agent\" -- $myname -- $NoCloak$ref$translator$sucker$UARredirectionNotice$rrdnotice$LanguageRedirectMessage\n";
                print SUS $logline;
                flock(SUS, 8) unless($winserver);
                close (SUS);
                if ($unknownIP) {
                    push(@messagebody, "Unknown IP Address\n$logline\n\n");
                    $notify=1;
                }
                last;
            }
        }
        if (($agent !~ /mozilla/i) and (!$notify)){
            $unknownUA = 1;
            if (-e "$writedir/uasx.daq"){
                open (UASx, "<$writedir/uasx.daq");
                flock (UASx, 2) unless $winserver;
                @uasx = <UASx>;
                flock (UASx, 8) unless $winserver;
                close (UASx);
                
                foreach $uasxi (@uasx){
                    chomp ($uasxi);
                    if ($agent =~ /$uasxi/i){
                        $notify = 0;
                        $unknownUA = 0;
                        last;
                    }
                }
            }
            if ($unknownUA){
                open (SUS, ">>$writedir/suspected.log");
                flock(SUS, 2) unless($winserver);
                $logline = "  $date -- $gethost -- \"$agent\" -- $myname -- $NoCloak$ref$translator$sucker$UARredirectionNotice$rrdnotice$LanguageRedirectMessage\n";
                print SUS $logline;
                flock(SUS, 8) unless($winserver);
                close (SUS);
                if ($unknownUA){
                    push(@messagebody, "Unknown User Agent\n$logline\n\n");
                    $notify=1;
                }
            }
        }
        if (($ref eq "") and ($noRef)){
            push(@messagebody, "No Referrer\n$logline\n\n");
            $notify=1;
        }
    }
    
    
    if ($redir ne "") {
        #$redirectedpage = get "$redir";
        # replaced older code (above) to pass on original user agent and referer strings
        
        if ($redir !~ /^redirect: */i){
            # handles useragent requests
            $uatopasson = $ENV{"HTTP_USER_AGENT"};
            $referertopasson = $ENV{"HTTP_REFERER"};
            $ua = LWP::UserAgent->new;
            $ua->agent($uatopasson);
            $req = HTTP::Request->new (GET => "$redir");  
            $req->header('referer' => $referertopasson);
            $res = $ua->request($req);
            $redirectedpage = $res->content;
        
            print STDOUT "Content-type: text/html\n\n";
            print STDOUT @gra unless $gra[0] eq "";
            if ($redir =~ /\.htm.*$/i){
                $redir =~ s/^(.+\/).+\.htm.*$/$1/i;
            }
            if ($redir !~ /\/$/) { $redir = $redir . "/";}

            # check for custom base href tag
            if (-e "$writedir/bhref.txt"){
                open (BHREF, "<$writedir/bhref.txt");
                flock(BHREF, 2) unless $winserver;
                $bhref = <BHREF>;
                flock(BHREF, 8) unless $winserver;
                close (BHREF);
                chomp($bhref);
            } else {
                $BASE_HREF = $redir;
                @href_array = split(/\//, $BASE_HREF);
                if (($href_array[@href_array-1] =~ /\./) and (@href_array > 3)){
                    $foo = pop(@href_array);
                    $foo = "";
                }
                $BASE_HREF = join ("/",@href_array);
                if ($BASE_HREF !~ /\/$/){
                    $BASE_HREF .= "/"; 
                }
                $bhref = $BASE_HREF;
            }

            @htmlout = split (/\n/, $redirectedpage);

            if (-e "$writedir/marker.daq"){
                $insertText = 1;
                open (MARKER, "<$writedir/marker.daq");
                flock (MARKER, 2) unless $winserver;
                $tempmarker = <MARKER>;
                flock (MARKER, 8) unless $winserver;
                close (MARKER);
                chomp($tempmarker);
                ($insertMarker,$insertType) = split(/###/,$tempmarker);

                if (-e "$writedir/insert.daq"){
                    open (INSERT, "<$writedir/insert.daq");
                    flock (INSERT, 2) unless $winserver;
                    @insert = <INSERT>;
                    flock (INSERT, 8) unless $winserver;
                    close (INSERT);
                } else {
                    $insertText = 0;
                    $insert[0]= "";
                }
            } else {
                $insertText = 0;
            }        
            if ($insertText){
                $TextToInsert = "";
                # handle normal page text insertion
                foreach $ins (@insert){
                    $ins =~ s/#filename#/$myname/g;
                    $TextToInsert = $TextToInsert . $ins;
                }
            }

            $count=0;
            foreach $li (@htmlout){
                if ($li =~ /\<head\>/i){
                    $li =~ s/^(.*)\<([hH][eE][aA][dD])\>(.*)$/$1\<$2\>\n<BASE HREF=\"$bhref\"\>$3/;
                    $htmlout[$count] = $li;
                    if (!$insertText) { last; }
                }
                if ($insertText){
                    if ($insertType eq "replace"){
                        $li =~ s/$insertMarker/$TextToInsert/g;
                    } else {
                        $li =~ s/($insertMarker)/$1$TextToInsert/g;
                    }
                }
                $count++;        
            }

            #print STDOUT "<BASE HREF=\"$redir\">\n";
            #print STDOUT $redirectedpage;

            foreach (@htmlout){
                print STDOUT "$_\n";
            }
        
        } else {
            # handles redirection requests
            $redir =~ s/^redirect: *//i;
            print STDOUT "Content-type: text/html\n\n";
            print STDOUT @gra unless $gra[0] eq "";
            print STDOUT <<"_end_";
<html>
<head>
<META HTTP-EQUIV=Refresh CONTENT="0; URL=$redir">
</head>
<body>
</body>
</html>
_end_
        }

        
        if (($ifMail) and ($notify)){
            &mailNotify("Automatic eMail Notification", @messagebody);
        }
    }
}
######################################################################


# SERVE ROBOT PAGE TO ROBOT REQUESTOR
######################################################################
######################################################################
sub robot{


    # determine primary keyword

    $keyword = $myname;
    $keyword =~ s/\.s?html?$//;
    $keyword =~ s/[\-\_\.]/ /g;
    $keyword =~ s/^\///;

    open (KEY, "<$writedir/indexkeywords.daq");
    flock (KEY, 2) unless($winserver);
    $indexOrSitemapkeyword = <KEY>;
    flock (KEY, 8) unless($winserver);
    close (KEY);        
        
    if (($keyword eq "index") or ($keyword eq "sitemap")){
        if ($keyword eq "sitemap") {$IsSitemap=1;}
        $keyword = $indexOrSitemapkeyword;
        $IsindexORsitemap = 1;
    }

        
    @keywordarray = split (/ /, $keyword);
    @keyword = split (/ /, $keyword);

    $lckey = lc($keyword);
    $uckey = uc($keyword);
    $ucfirstkey = "";
    foreach $circ (@keyword){
        $circ = ucfirst($circ);
        $ucfirstkey = $ucfirstkey . " " . $circ;
    }
    $ucfirstkey =~ s/^ //;

    $hyphenkeyword = &hyphenate($keyword);
    $hyphenLC = &hyphenate($lckey);
    $hyphenUC = &hyphenate($uckey);
    $hyphenTC = &hyphenate($ucfirstkey);
    $underkeyword = &underscore($keyword);
    $underLC = &underscore($lckey);
    $underUC = &underscore($uckey);
    $underTC = &underscore($ucfirstkey);
    
    open (RANDOM, "$writedir/random.txt");
    flock (RANDOM, 2) unless($winserver);
    @random = <RANDOM>;
    flock (RANDOM, 8) unless($winserver);
    close (RANDOM);
    
    # initialize random stuff
    $randomset = 0;
    $randomdyn = 0;
    srand($randseed);
    $nothing = rand(10);
    @randomInUse = @random;
    @randomdynamic = @random;
    @randomdynamicInUse = @random;

    $SEsymbol = "# ";

    if (!$ifcl) {
        if ($SE eq "") {
            $SE = "web surfer";
            $SEsymbol = "  ";
        }
        $SE = $SE . " (cloaking disabled)";
        $count = 9;
    }

    # access secondary keyword list
    open (SECONDARYKEYWORDS, "$writedir/keywords.txt");
    flock(SECONDARYKEYWORDS, 2) unless($winserver);
    @secondarykeywords = <SECONDARYKEYWORDS>;
    flock(SECONDARYKEYWORDS, 8) unless($winserver);
    @secondarykeywordsInUse = @secondarykeywords;
    
    # access tertiary keyword list
    open (TERTIARYKEYWORDS, "$writedir/tertiarykeywords.txt");
    flock(TERTIARYKEYWORDS, 2) unless($winserver);
    @tertiarykeywords = <TERTIARYKEYWORDS>;
    flock(TERTIARYKEYWORDS, 8) unless($winserver);
    @tertiarykeywordsInUse = @tertiarykeywords;
    
    # open template
    unless ($altTempl){
        open (TEMPLATE, "$writedir/template" . $count . ".txt");
        flock(TEMPLATE, 2) unless($winserver);
        @template = <TEMPLATE>;
        flock(TEMPLATE, 8) unless($winserver);
    } else {
        if ($customTemplate =~ /\,/){
            @templatelist = split (/\,/, $customTemplate);
            $whichtemplate = $count - 1;
            $whichtemplate = $templatelist[$whichtemplate];
            $whichtemplate =~ s/ //g;
            if (!$whichtemplate){
                $customTemplate = "template" . $count . ".txt";
            } else {
                $customTemplate = $whichtemplate;
            }
        }
        if ($customTemplate =~ /^http/){
            chomp($customTemplate);
            $uatopasson = $ENV{"HTTP_USER_AGENT"};
            $referertopasson = $ENV{"HTTP_REFERER"};
            $ua = LWP::UserAgent->new;
            $ua->agent($uatopasson);
            $req = HTTP::Request->new (GET => "$customTemplate");  
            $req->header('referer' => $referertopasson);
            $res = $ua->request($req);
            @template = $res->content;
        } else {
            open (TEMPLATE, "$writedir/$customTemplate");
            flock(TEMPLATE, 2) unless($winserver);
            @template = <TEMPLATE>;
            flock(TEMPLATE, 8) unless($winserver);
        }
    }
        

    # populate template
    @tobedisplayed = ();
    $rr = 0;

    $splitcount=0;

    foreach $line (@template) {
        if (($line =~ /\<\/head\>/i) and ($nocache)){
            $line = "<META NAME=\"ROBOTS\" CONTENT=\"NOARCHIVE\">\n" . $line;
        }
        if ($line =~ /#filename#/)              { &filename; }
        if ($line =~ /#remote: *".+" *#/)       { &remoteGrab; }
        if ($line =~ /#randomtext#/)            { &randomizer; }
        if ($line =~ /#randomtextdynamic#/)     { &dynamicrandomizer; }
        if ($line =~ /#keyword\(\d\)[ULT]?C?#/) { &splitkey; }
        if ($line =~ /#keyword[ULT]?C?\-?\_?#/) { &prikey; }
        if ($line =~ /#secondarykeyword#/)      { &secondkey; }
        if ($line =~ /#tertiarykeyword#/)       { &thirdkey; }
        if ($line =~ /#randomlink#/)            { &randomLinker; }
        if ($line =~ /#randompage#/)            { &randompage; }
        if ($line =~ /#filename#/)              { &filename; }
        if ($line =~ /#indexkeyword#/)          { &indexkeyword; }
        $line =~ s/\<\/body\>//i;
        $line =~ s/\<\/html\>//i;
        $tobedisplayed[$rr] = $line;
        $rr++;
    }

    # Log the access
    open (ACCESSLOG, ">>$writedir/access.log");
    flock(ACCESSLOG, 2) unless($winserver);
    print ACCESSLOG "$SEsymbol$date -- $gethost -- \"$agent\"$UACloak -- $SE -- $myname -- $ref\n";
    flock(ACCESSLOG, 8) unless($winserver);
    close (ACCESSLOG);

    # Display the HTML

    print STDOUT "Content-type: text/html\n\n";
    print STDOUT @gra unless $gra[0] eq "";
    if (($IsSitemap) and ($altTempl eq "")) { 
        print STDOUT "<html>\n<head>\n<title>$indexOrSitemapkeyword</title>\n";
        if ($nocache){
            print STDOUT "<META NAME=\"ROBOTS\" CONTENT=\"NOARCHIVE\">\n";
        }
        print STDOUT "</head>\n<body bgcolor=\"white\">\n<h1>Sitemap</h1>\n";
    }
    
    unless (($IsSitemap) and ($altTempl eq "")) { 
        print STDOUT @tobedisplayed;
    }
  

    if (-e "$writedir/useurlinlink.daq") { $checkflop = 1; }

    $localdirectory =~ s/\/page\.cgi//;

    if ((($listLinks) and (!$IsSitemap)) or (($IsSitemap) and ($altTempl eq ""))){
        print STDOUT "\n<br><br>\n\n";
        foreach $listing (@cloakedURLs){
            if ($listing =~ /.s?html?$/){
                unless ($checkflop){
                    $linkKeyword = $listing;
                    $linkKeyword =~ s/\.s?html?$//;
                    $linkKeyword =~ s/\-|\_|\./ /g;
                    if (($linkKeyword =~ /^index$/i) or ($linkKeyword =~ /^sitemap$/i)){
                        $linkKeyword = $indexOrSitemapkeyword;
                    }
                } else {
                    if ($customloc){
                        $linkKeyword = "$customloc/$listing";
                    } else {
                        $linkKeyword = "$loc$localdirectory/$listing";
                    }
                }
                if ($customloc){
                    print STDOUT "<a href=\"$customloc/$listing\">$linkKeyword</a><br>\n";
                } else {
                    print STDOUT "<a href=\"$loc$localdirectory/$listing\">$linkKeyword</a><br>\n";
                }
            }
        }
    }
    print STDOUT "</body>\n</html>\n\n";
}
######################################################################

# RANDOM HTML GENERATOR
######################################################################
######################################################################
sub randomizer {
    # open ramdomizer
    unless ($setseed){
        srand($randseed + $randomset);
        $nothing = rand(10);
    }
    $dynamicseed = 0;
    $setseed = 1;
    my $randomnumber = int(rand(@randomInUse));
    $randomtext = $randomInUse[$randomnumber];
    splice (@randomInUse, $randomnumber, 1);
    if (@randomInUse eq 0) {
        @randomInUse = @random;
    }
    chomp ($randomtext);
    $line =~ s/#randomtext#/$randomtext/;
    $randomset++;
    if ($line =~ /#randomtext#/) { &randomizer; }
}

sub dynamicrandomizer {
    # open ramdomizer
    unless ($dynamicseed){
        srand($sec + $randomdyn);
        $nothing = rand(10);
    }
    $dynamicseed = 1;
    $setseed = 0;
    my $randomnumber = int(rand(@randomdynamicInUse));
    my $randomtext = $randomdynamicInUse[$randomnumber];
    splice (@randomdynamicInUse, $randomnumber, 1);
    if (@randomdynamicInUse eq 0) {
        @randomdynamicInUse = @randomdynamic;
    }
    chomp ($randomtext);
    $line =~ s/#randomtextdynamic#/$randomtext/;
    $randomdyn++;
    if ($line =~ /#randomtextdynamic#/) { &dynamicrandomizer; }
}
######################################################################

# PRIMARY KEYWORD GENERATOR
######################################################################
######################################################################
sub prikey {
    if ($line =~ /#keywordLC#/){ $line =~ s/#keywordLC#/$lckey/; }
    if ($line =~ /#keywordUC#/){ $line =~ s/#keywordUC#/$uckey/; }
    if ($line =~ /#keywordTC#/){ $line =~ s/#keywordTC#/$ucfirstkey/; }
    if ($line =~ /#keyword#/)  { $line =~ s/#keyword#/$keyword/; }
    
    if ($line =~ /#keywordLC\-#/){ $line =~ s/#keywordLC\-#/$hyphenLC/; }
    if ($line =~ /#keywordUC\-#/){ $line =~ s/#keywordUC\-#/$hyphenUC/; }
    if ($line =~ /#keywordTC\-#/){ $line =~ s/#keywordTC\-#/$hyphenTC/; }
    if ($line =~ /#keyword\-#/)  { $line =~ s/#keyword\-#/$hyphenkeyword/; }

    if ($line =~ /#keywordLC\_#/){ $line =~ s/#keywordLC\_#/$underLC/; }
    if ($line =~ /#keywordUC\_#/){ $line =~ s/#keywordUC\_#/$underUC/; }
    if ($line =~ /#keywordTC\_#/){ $line =~ s/#keywordTC\_#/$underTC/; }
    if ($line =~ /#keyword\_#/)  { $line =~ s/#keyword\_#/$underkeyword/; }

    if ($line =~ /#keyword[ULT]?C?\-?\_?#/) { &prikey; }
}
######################################################################

# SPLIT KEYWORD GENERATOR
######################################################################
######################################################################
sub splitkey {

    $arraykey = $line;
    chomp ($arraykey);
    $arraykey =~ s/^.*#keyword\((.)\)[UTL]?C?#.*$/$1/;
    chomp ($arraykey);

    $splitword = $keywordarray[$arraykey-1];
    $splitworduc = uc($splitword);
    $splitwordlc = lc($splitword);
    $splitwordtc = ucfirst($splitword);
    
    $line =~ s/#keyword\($arraykey\)#/$splitword/;
    $line =~ s/#keyword\($arraykey\)UC#/$splitworduc/;
    $line =~ s/#keyword\($arraykey\)LC#/$splitwordlc/;
    $line =~ s/#keyword\($arraykey\)TC#/$splitwordtc/;

    #$splitcount++;
    #if ($splitcount > 100) { print "\n$splitcount\n";exit; }

    if ($line =~ /#keyword\(\d\)[ULT]?C?#/) { &splitkey;}
}
######################################################################

# SECONDARY KEYWORD GENERATOR
######################################################################
######################################################################
sub secondkey {
    my $temprand = int(rand(@secondarykeywordsInUse));
    $randomkeyword = $secondarykeywordsInUse[$temprand];
    splice (@secondarykeywordsInUse, $temprand, 1);
    if (@secondarykeywordsInUse eq 0) {
        @secondarykeywordsInUse = @secondarykeywords;
    }
    chomp ($randomkeyword);
    $line =~ s/#secondarykeyword#/$randomkeyword/;
    if ($line =~ /#secondarykeyword#/) { &secondkey; }
}
######################################################################

# TERTIARY KEYWORD GENERATOR
######################################################################
######################################################################
sub thirdkey {
    my $temprand = int(rand(@tertiarykeywordsInUse));
    $randomkeyword = $tertiarykeywordsInUse[$temprand];
    splice (@tertiarykeywordsInUse, $temprand, 1);
    if (@tertiarykeywordsInUse eq 0) {
        @tertiarykeywordsInUse = @tertiarykeywords;
    }
    chomp ($randomkeyword);
    $line =~ s/#tertiarykeyword#/$randomkeyword/;
    if ($line =~ /#tertiarykeyword#/) { &thirdkey; }
}
######################################################################

# RANDOM LINK GENERATOR (INTERIOR LINKS)
######################################################################
######################################################################
sub randomLinker {
    my $randomnumber = int(rand(@cloakedURLsInUse));
    $randomlink = $cloakedURLsInUse[$randomnumber];
    splice (@cloakedURLsInUse, $randomnumber, 1);
    if (@cloakedURLsInUse eq 0) {
        @cloakedURLsInUse = @cloakedURLs;
    }
    $randomlinkKeyword = $randomlink;
    $randomlinkKeyword =~ s/\.s?html?//;
    $randomlinkKeyword =~ s/\-|\_|\./ /g;
    if (($randomlinkKeyword eq "index") or ($randomlinkKeyword eq "sitemap")) {$randomlinkKeyword = $indexOrSitemapkeyword;}
    chomp ($randomlink);
    if ($customloc){
        $line =~ s/#randomlink#/$customloc\/$randomlink/;
        $line =~ s/#randomlinktext#/$customloc\/$randomlink/;
        $line =~ s/#randomlinkkeyword#/$randomlinkKeyword/;
    } else {
        $line =~ s/#randomlink#/$loc$localdirectory\/$randomlink/;
        $line =~ s/#randomlinktext#/$loc$localdirectory\/$randomlink/;
        $line =~ s/#randomlinkkeyword#/$randomlinkKeyword/;
    }

    if ($line =~ /#randomlink#/) { &randomLinker; }

}
######################################################################

# RANDOM LINK GENERATOR (EXTERIOR LINKS)
######################################################################
######################################################################
sub randompage {
    my $randomnumber = int(rand(@randompagesInUse));
    $randomp = $randompagesInUse[$randomnumber];
    splice (@randompagesInUse, $randomnumber, 1);
    if (@randompagesInUse eq 0) {
        @randompagesInUse = @randompages;
    }
    chomp ($randomp);
    if ($randomp =~ /##/) {
        ($randompageURL, $randompageLinktext) = split (/##/, $randomp);
    } else {
        $randompageURL = $randomp;
    }
    $line =~ s/#randompage#/$randompageURL/;
    $line =~ s/#randompagelinktext#/$randompageLinktext/;
    if ($line =~ /#randompage#/) { &randompage; }
}
######################################################################

# FILENAME GENERATOR
######################################################################
######################################################################
sub filename {
    $filename = $keyword;
    if ($IsindexORsitemap){
        $filename = $myname;
        $filename =~ s/\.s*html*//i;
    }
    $filename =~ s/ /$sep/g;
    $filename = "$filename$ext";
    if ($line =~ /#filename#/){ $line =~ s/#filename#/$filename/g; }
    if ($line =~ /#filename#/) { &filename; }
}
######################################################################

# REMOTE FILE GRABBER
######################################################################
######################################################################
sub remoteGrab {
    $file = $line;
    $file =~ s/.*#remote: *"(.+)" *#.*/$1/;
    chomp($file);
    $uatopasson = $ENV{"HTTP_USER_AGENT"};
    $referertopasson = $ENV{"HTTP_REFERER"};
    $ua = LWP::UserAgent->new;
    $ua->agent($uatopasson);
    $req = HTTP::Request->new (GET => "$file");  
    $req->header('referer' => $referertopasson);
    $res = $ua->request($req);
    $line = $res->content;
}
######################################################################

# CONVERT SPACES TO HYPHENS
######################################################################
######################################################################
sub hyphenate {
    $word = $_[0];
    $word =~ s/ /\-/g;
    return($word);
}
######################################################################

# CONVERT SPACES TO UNDERSCORES
######################################################################
######################################################################
sub underscore {
    $word = $_[0];
    $word =~ s/ /\_/g;
    return($word);
}
######################################################################

# INDEX KEYWORD GENERATOR
######################################################################
######################################################################
sub indexkeyword {
    if ($line =~ /#indexkeyword#/){ $line =~ s/#indexkeyword#/$indexOrSitemapkeyword/g; }
    if ($line =~ /#indexkeyword#/) { &indexkeyword; }
}
######################################################################

############ mailNotify is run to notify admin of various things
sub mailNotify {

    ($subject, @message) = @_;
    open (MAIL, "|$mailProgram");
    print MAIL "To: $email\n";
    print MAIL "X-Sender: Kloakit Control Panel\n";
    print MAIL "From: \"Kloakit Control Panel\" <$email>\n";
    print MAIL "Reply-To: $email\n";
    print MAIL "Subject: $subject\n\n";
    
    if ($customloc){
        print MAIL "Your KloakIt Control Panel at $customloc reports:\n\n";
    } else {
        print MAIL "Your KloakIt Control Panel at $loc$localdirectory reports:\n\n";
    }
    
    print MAIL @message;

    print MAIL "\n\n";
    close (MAIL);
    
} ######### end mailNotify sub

############ autoipupdate is run to automate the updating of IP addresses
sub autoipupdate {

    open (IPUPDATE, "<$writedir/lastipupdate.txt");
    $lastupdate = <IPUPDATE>;
    close (IPUPDATE);
    
    # grab last modified dates from the remote server
    $ua = new LWP::UserAgent;
    $ua->timeout(30);
    $re = new HTTP::Request(GET => "$IPupdateURL/dates.php");
    $response = $ua->request($re);
    if ($response->is_success){
        $datex = $response->content;
        @dates = split(/\n/,$datex);
        foreach $foob(@dates){
            chomp($foob);
            if ($foob =~ /\.txt/){
                ($sename,$sedateRemote) = split(/ /,$foob);
                $listname = $sename;

                $listnumber = 1 if $listname eq "msn.txt";
                $listnumber = 2 if $listname eq "altavista.txt";
                $listnumber = 3 if $listname eq "lycos.txt";
                $listnumber = 4 if $listname eq "inktomi.txt";
                $listnumber = 5 if $listname eq "wisenut.txt";
                $listnumber = 6 if $listname eq "google.txt";
                $listnumber = 7 if $listname eq "askjeeves.txt";
                $listnumber = 8 if $listname eq "misc.txt";

                $sedateLocal = (stat("$writedir/$listnumber".".list"))[9];

                ($xsec,$xmin,$xhour,$xmday,$xmon,$xyear,$xwday,$xyday,$xisdst)=localtime($sedateLocal); # set time
                if (length ($xmin) eq 1) {$xmin= '0'.$xmin;}
                if (length ($xmon) eq 1) {$xmon= "0".$xmon;}
                $xmon++;
                $xyear =~ s/.+(..)$/$1/;
                if ($xyear < 90) { $xyear = "20" . $xyear; }
                $xdate="$xmon/$xmday/$xyear, $xhour:$xmin";
                $sedateLocal = "$xyear-$xmon-$xmday";

                ($YRemote,$MRemote,$DRemote) = split(/\-/,$sedateRemote);
                ($YLocal,$MLocal,$DLocal) = split(/\-/,$sedateLocal);

                $listname = $sename;

                # print $listname . "(local ".$sedateLocal.") (remote ".$sedateRemote.")<br>\n";
                $downloading = 0;
                if ($YRemote == $YLocal){
                    if ($MRemote == $MLocal){
                        if ($DRemote > $DLocal){
                            &getiplist();
                            $downloading = 1;
                            # print "downloading $listname<br>\n";
                        }
                    }
                    if ($MRemote > $MLocal){
                        &getiplist();
                        $downloading = 1;
                        # print "downloading $listname<br>\n";
                    }
                }
                if ($YRemote > $YLocal){
                    &getiplist();
                    $downloading = 1;
                    # print "downloading $listname<br>\n";
                }
                # if (!$downloading) { print "not downloading $listname<br>\n"; }
            }
        }

        open (THISUPDATE, ">$writedir/lastipupdate.txt");
        print THISUPDATE $nowdate;
        close (THISUPDATE);
    }
            
} ########### end autoipupdate sub


############ getiplist is run to get a list along with date header
sub getiplist{

    $responseGood = 1;
    $ua = new LWP::UserAgent;
    $ua->timeout(30);
    $re = new HTTP::Request(GET => "$IPupdateURL/$listname");
    $response = $ua->request($re);
    if (!$response->is_success){
        # ip list site is down. fail
        $responseGood = 0;
    }
    
    $headers = $response->headers;
    $filedate_secs = $headers->last_modified;
        
    if ($responseGood) {&updateip($listnumber);}

} ######### end getiplist sub

############ updateip is run to update an individual IP list
sub updateip{


    my (@addthese,
        @newips,
        @oldips,
        @reallyadd,
        @reallyaddtemp,
        @reprint,
        $nextIP,
        $lastIP,
        $count);
    
    open (LIST, "<$writedir/$listnumber.list");
    @oldips = <LIST>;
    close (LIST);
    
    @reprint = @oldips;
    
    $iplist = $response->content; # get new list
    @newips = split (/\n/, $iplist);
    $co=0;
    foreach (@newips){         # set order of new list
        $newips[$co] = "$_\t$co";
        $co++;
    }
    
    push (@oldips, @newips); # merge new and old lists
    @oldips = sort(@oldips); # sort lists to optimize dupe removal of new list
    
    
    $lastIP = "";
    $count = 1;
    foreach $foo (@oldips){
        chomp($foo);
        $nextIP = $oldips[$count];
        chomp ($nextIP);
        if ($foo =~ /\t/) {
            $order = $foo;
            $order =~ s/^.+\t(.+)$/$1/;
            $foo =~ s/\t.+$//;
        }
        if ($nextIP =~ /\t/){ $nextIP =~ s/\t.+$//; }
        unless (($foo eq $lastIP) or ($foo eq $nextIP)){ 
            push (@addthese, "$foo\t$order");
        }                      # dup check... checking each IP against previous 
                               # and next IP. If no match is found, then add 
                               # to list that is to be added.
        $lastIP = $foo;
        $count++;
    }
    
    
    foreach $add (@addthese){  # this loop makes sure the IPs to be added
                               # weren't part of the old list and NOT the new.
                               # it also re-orders the IPs to be added.
        $match=0;
        chomp($add);
        ($thisIP, $thisOrder) = split (/\t/, $add);
        foreach $re (@reprint){
            chomp($re);
            if ($thisIP eq $re) { $match =1; }
        }
        $reallyaddtemp[$thisOrder] = $thisIP if $match eq 0;
    }
    
    @addthese = ();
    
    if (@reallyaddtemp > 0){       # if new lines are found, add them to bottom of list.
        open (LIST, ">$writedir/$listnumber.list");
        flock (LIST, 2) unless($winserver);
        foreach (@reprint){ print LIST "$_\n";}             # print the old IPs, preserving original order
        print LIST "\n# Auto-updated $mon-$mday-$year\n";   # print date of update
        while (@reallyaddtemp) { $fi = shift(@reallyaddtemp); print LIST "$fi\n" unless $fi eq ""; }  # print the new IPs, preserving original order
        flock (LIST, 8) unless($winserver);
        close (LIST);
        @reallyaddtemp = ();
        @oldips = ();
        @newips = ();
        @tempold = ();
        @reprint = ();
        $IPupdatemessage = 1;
    } else {       # if the array of new IPs is empty, reinitialize variables and move
                   # on to next list.
        @reallyaddtemp = ();
        @oldips = ();
        @newips = ();
        @tempold = ();
        @reprint = ();
    }
    
} ######### end updateip sub