#!/usr/bin/perl
#######################################################
# 404 Manager version 1.0
#
# Created by: Solution Scripts
# Email: solutions@solutionscripts.com
# Web: http://solutionscripts.com
#
#######################################################
#
#
# COPYRIGHT NOTICE:
#
# Copyright 2000 Solution Scripts All Rights Reserved.
#
# This program is being distributed as freeware. It may be used and
# modified free of charge, so long as this copyright notice, the header
# above and all the footers in the program that give me credit remain
# intact. Please also send me an email, and let me know
# where you are using this script.
#
# By using this program you agree to indemnify Solution Scripts from any liability.
#
# Selling the code for this program without prior written consent is
# expressly forbidden. Obtain permission before redistributing this
# program over the Internet or in any other medium. In all cases
# copyright and header must remain intact.
#
######################################################
### DATA DIRECTORY ##
my $data_path = "d:/cgi-bin/free/404manager/data";
# Location you want 404 Manager data files stored in
# Must be writable by the server, (chmod 666 most cases)
# There will be a lot of data files.
### STRIP QUERY STRING ###
my $strip = 0;
# Removes query string (everything after ? in a url)
# From a request and the referal
# Setting to 1 will give you less results in a less accurate way
# Although may reduce number of data files as well
### HTML DISPLAYED ON 404 PAGE ###
# Extra html that will be shown on the 404 not found page
# the end user seens
my $html = qq~
~;
#######################################################################
################### Nothing else needs to be edited ###################
use Fcntl;
use AnyDBM_File;
use Config;
use strict;
use vars qw(%fields);
print "Content-type: text/html \n\n";
my %fields;
my $current_time = time();
my $time = time;
(my $sec,my $min,my $hour,my $mday,my $mon,my $year,my $wday,my $yday,my $isdst) = localtime($time);
$year += 1900;
$mon++;
my $now = "$mon.$mday.$year";
######### PRINT NOT FOUND MESSAGE #########
print qq~
404 File Not Found
404 File Not Found
The file you requested: $ENV{'REQUEST_URI'}
was not found on this server.
~;
if ($ENV{'HTTP_REFERER'}) {
print qq~
The url you just came from:
$ENV{'HTTP_REFERER'}
has been logged for investigation so we can fix the current 404 situation
~;
}
print qq~
$html
Powered by 404 Manager from Solution Scripts
~;
exit unless ($ENV{'REDIRECT_STATUS'} == 404);
my $filenotfound = $ENV{'REQUEST_URI'};
unless ($strip) {
$filenotfound .= "?" . $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'};
}
$filenotfound =~ s/\/$//;
my $therefferer = $ENV{'HTTP_REFERER'}; # What was tacked on to the url
my $therefferers = "\L$therefferer\E";
$therefferer = "unknown" unless $therefferer;
if ($strip) {
$therefferer=~ s/\?.*$//;
}
my $flags = O_CREAT | O_RDWR;
my $db = "$data_path/notfound";
tie(my %acc, 'AnyDBM_File', $db , $flags, 0666) || &error("Cannot open database-- referrer");
if ($acc{$filenotfound}) {
my @refferer_array= split(/\|/,$acc{$filenotfound});
$refferer_array[0]++;
$refferer_array[2]++;
$refferer_array[3]= "$current_time";
if ($refferer_array[5] eq $now) {
$refferer_array[6]++;
}
else {
$refferer_array[5] = $now;
$refferer_array[6] = 1;
}
if ($refferer_array[7] eq $mon) {
$refferer_array[8]++;
}
else {
$refferer_array[7] = $mon;
$refferer_array[8] = 1;
}
$acc{$filenotfound} = join("\|",@refferer_array);
}
else {
$acc{$filenotfound} = "1|0|1|$current_time|$now|$now|1|$mon|1|0|";
}
untie(%acc);
my $fnfdb = $filenotfound;
$fnfdb =~ s/\//_/g;
$fnfdb =~ s/\./_/g;
my $flags = O_CREAT | O_RDWR;
my $db = "$data_path/$fnfdb";
tie(my %acc, 'AnyDBM_File', $db , $flags, 0666) || &error("Cannot open database-- $db");
if ($acc{$therefferer}) {
my @refferer_array= split(/\|/,$acc{$therefferer});
$refferer_array[0]++;
$refferer_array[2]++;
$refferer_array[3]= "$current_time";
if ($refferer_array[5] eq $now) {
$refferer_array[6]++;
}
else {
$refferer_array[5] = $now;
$refferer_array[6] = 1;
}
if ($refferer_array[7] eq $mon) {
$refferer_array[8]++;
}
else {
$refferer_array[7] = $mon;
$refferer_array[8] = 1;
}
$acc{$therefferer} = join("\|",@refferer_array);
}
else {
$acc{$therefferer} = "1|0|1|$current_time|$now|$now|1|$mon|1|0|";
}
untie(%acc);
sub error {
print qq~
Error - $_[0] - $!
Any and all problems regarding the running and using of 404 Manager
should be posted on our help forum at: http://forum.solutionscripts.com