#!/usr/local/bin/perl
# This Software Package is copyrighted and the SOLE OWNERSHIP is
# (c) 1997 - 2000 DragonWare Internet Solutions Corp. ALL RIGHTS RESERVED
#
# You may freely copy and distribute this software so long
# as all documentation and this notice is included.
#
# If you wish to modify and distribute this software, feel free.
# You MAY NOT charge for distributing it. If you modify it,
# please make sure you document it (and if it is a good hack
# let me know - I might include it in a future release).chris@zarahemla.com
#
# The most current release can always be found at
#
#
# SOFTWARE WARRANTY AND DISCLAIMER
#
#DragonWare Internet Solutions Corp. makes no warranty of any kind, either express or implied
#with respect to the design or use of this software package. This software package provided
#hereunder is provided "as is", and all warranties, express or implied including but not limited
# to implied warranties of merchantability and fitness for a particular purpose are expressly
# disclaimed. There is no guarantee that the operation of the software package will be error
#free. USER assumes any and all risk as the the results and the performance of this software
#package. In no event shall DragonWare Internet Solutions Corp. be held liable for any loss,
#expenses, or damages of any kind, whether such damages are direct, indirect, incidental or
#consequential arising in any manner from the use of the software package or any portion
#thereof.
#
############################################################
#VERSION 1.95
#gets a missing page request and forwards it to the new location
# location of the HTML skin for cusomization
$SERVERNAME = $ENV{'SERVER_NAME'};
# use the following for a Virtual domain server
$errorPage="/home/httpd/conf/$SERVERNAME.html";
# use for an non virtual server
#$errorPage="/home/httpd/conf/errorpage.html";
# location of redirect database
$redirectFile="/home/httpd/conf/redirect.dbf";
# the main program
initIt();
mainProg();
#notHere();
exit(0);
################### SUBS FOLLOW ###################
sub initIt{
$fromUrl=$ENV{'HTTP_REFERER'};
$missingUrl=$ENV{'REDIRECT_URL'};
$newUrl=$ENV{'SERVER_NAME'};
$newUrl="http://".$newUrl;
$serverBase=$newUrl;
$admin=$ENV{'SERVER_ADMIN'};
#un comment for debug
#print "Content-type: text/html\n\n";
#print "From :$fromUrl
";
#print "URL Called $missingUrl
";
#print "NEW URL $newUrl
";
}
sub mainProg{
#if a missing url matches the list
#call the redirectIt routine with the $newUrl
open(SHOW, "$redirectFile") || print "Content-type: text/html\n\n unable to open $redirectFile\n\n";
while(!eof(SHOW)){
$buffer = ;
($redirectUrl, $newUrl) = split(/\t/,$buffer);
if( $missingUrl eq $redirectUrl) {
close(SHOW);
redirectIt();
return;
}
}
close(SHOW);
notHere();
}
sub notHere{
print qq!Content-type: text/html\n\n!;
open (PAGE, "$errorPage")||defaultpage();
@EPAGE=;
close(PAGE);
foreach $key (@EPAGE){
$test=$key;
while ($test =~ s/\$\$//){
($dum, $string_name) = split /\$\$/,$key;
($string_name, $dum) = split /\:/,$string_name;
if ($string_name){
$string_name2 = \$$string_name;
$key=~ s/\$\$$string_name\:/$$string_name2/;
$string_name="";
}
}
}
print @EPAGE;
return();
}
sub defaultpage{
print qq!
This File can not be found
This URL $serverBase$missingUrl Can not be located
Please contact the WebMaster of the refering URL
$fromUrl and tell of the inaccurate link.
$errorPage
$SERVERNAME Webmaster
!;
#email section
exit(0);
}
sub redirectIt{
print "Status: 302 Moved Permanently\nLocation: $newUrl\n\n";
print "Content-type: text/html\n\n";
print "This resource has moved\r This resource has moved
\n";
print "the url $missingUrl has moved to $newUrl";
}