package Master404T;
###########################################################
#
# Master 404-Terminator(TM)
# Version 2.0b
# Version 1.0 completed October 3, 2004
# Version 2.0c completed April 1, 2004
#
# File Master404T.pm
# Supporting variables and subroutines.
#
# Programmer: William Bontrager
# Website: http://willmaster.com
# Email: william@willmaster.com
#
# Copyright 2004,2005 Bontrager Connection, LLC
#
# This custom version of Master 404-Terminator downloaded
# from:
# "Master Series CGI programs"
#
# for: hobbyline.com
# by: 66.32.92.12
# at: (1118505280) Saturday, June 11, 2005 at 3:54:40 PM GMT.
#
# For tech support, see http://willmaster.com/support/
#
###########################################################
use strict; # Commented out after development.
use Fcntl qw(:DEFAULT :flock);
use vars qw(
@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
$OfficialName $Version $CopyrightLine
$DataDirectory $ConfigurationFile
%In %G $V $Query $ME $ThisDirectory $d $Time
%LogLine @LogLine $LogFile
%Destinations @DestinationFields %DestinationFields
%Cliff @CliffFields %CliffFields
);
require Exporter;
$VERSION = 1.00;
@ISA = qw( Exporter );
@EXPORT = qw(
$OfficialName $Version $CopyrightLine
$DataDirectory $ConfigurationFile
%In %G $V $Query $ME $ThisDirectory $d $Time
%LogLine @LogLine $LogFile
%Destinations @DestinationFields %DestinationFields
%Cliff @CliffFields %CliffFields
trail
MakeDirectory
LockFile
UnLockFile
TieDestinationsDB
TieCliffDB
Conform404Turl
FormattedDateTime
WriteConfig
MakeDirectory
);
sub LocalError { print "Content-type: text/html\n\n" . join "\n\n",@_; exit; }
$OfficialName = 'Master 404-Terminator™';
$Version = '2.0c';
$CopyrightLine = qq~Copyright 2004 Bontrager Connection, LLC~;
$Query = $ENV{QUERY_STRING};
$DataDirectory = 'm404Tdata';
$ConfigurationFile = "${DataDirectory}/m404Tconfig.cgi";
$LogFile = "${DataDirectory}/m404Tactivity.cgi";
my $DBused = '';
my $CliffDB = 'Cliff';
my $CliffDBTieTracker = '';
my $CliffDBFlockFile = 'CliffFlockFile';
my $DestinationsDB = 'Destinations';
my $DestinationsDBTieTracker = '';
my $DestinationsDBFlockFile = 'DestinationsFlockFile';
%LogLine = ();
@LogLine = qw(
TimeStamp
FormattedTime
The404URL
IPaddress
UserAgent
Assigned
DestinationURL
Status
);
for(0..$#LogLine) { $LogLine{$LogLine[$_]} = $_; }
%DestinationFields = (); # '404URL' ($The404R) is the key for the database.
@DestinationFields = qw(
Location
Status
);
for(0..$#DestinationFields) { $DestinationFields{$DestinationFields[$_]} = $_; }
%CliffFields = (); # '404URL' ($The404R) is the key for the database.
@CliffFields = qw(
IPaddresses
);
for(0..$#CliffFields) { $CliffFields{$CliffFields[$_]} = $_; }
$ME = $0; $ME =~ s!^(.*)[/\\](.*?)$!$2!;
$ThisDirectory = $1;
$Time = time;
my ($DBtype,$DestinationsDBopen) = ();
my $FlatLineBreakSubstitute = chr(3);
my $FThashKeys = "${DataDirectory}/hashKeys";
my $FTwhich = "${DataDirectory}/WhichDBmodule";
#################################################
&ReadConfig;
END { &UnTieDestinationsDB; &UnTieCliffDB; }
#################################################
sub LocalMessage { print "Content-type: text/html\n\n" . join("\n",@_) . ''; exit; }
sub trail { ($d,$V) = @_; $_[0]; }
sub MakeDirectory
{
my($base,$dir) = @_;
($dir,$base) = ($base,$ENV{DOCUMENT_ROOT}) unless $dir;
return '' unless -e $base;
$dir =~ s!/+$!!;
$dir =~ s!^/+!!;
return $dir if -e "${base}/$dir";
my $exists = '';
my @dir = split /\/+/,$dir;
my $path = '';
for(@dir)
{
$path .= "/$_";
next if -e "${base}$path";
if(mkdir "${base}$path",0777) { $exists = 1; }
else { $exists = ''; last; }
}
$path =~ s!^/!!;
return $exists ? $path : '';
} # sub MakeDirectory
sub LockFile
{
my $f = "$_[0].lock";
my $tm = time;
while((time - $tm) < 12)
{
last unless -e $f;
sleep 2;
}
open LOCKFILE,">$f";
close LOCKFILE;
} # sub LockFile
sub UnLockFile { unlink "$_[0].lock"; }
sub TieDestinationsFlockFile
{
my $f = "$_[0].flock";
unless(sysopen(DESTFLOCKHANDLE,$f,O_RDONLY|O_CREAT))
{
LocalMessage "Sorry, can't sysopen $f for flock -- $@";
unless(flock(DESTFLOCKHANDLE,LOCK_EX|LOCK_NB))
{ LocalMessage "Sorry, can't flock lock $f -- $!"; }
}
} # sub TieDestinationsFlockFile
sub UnTieDestinationsFlockFile { close DESTFLOCKHANDLE; }
sub UnTieDestinationsDB
{
untie %Destinations;
UnTieDestinationsFlockFile "${DataDirectory}/$DestinationsDBFlockFile";
UnLockFile "${DataDirectory}/$DestinationsDB";
$DestinationsDBTieTracker = '';
} # sub UnTieDestinationsDB
sub TieDestinationsDB
{
unless($G{WhichDB})
{
my @whichDB = ();
push @whichDB,'GDBM_File' if eval('require GDBM_File');
push @whichDB, 'DB_File' if eval('require DB_File');
push @whichDB,'NDBM_File' if eval('require NDBM_File');
push @whichDB,'ODBM_File' if eval('require ODBM_File');
push @whichDB,'SDBM_File' if eval('require SDBM_File');
$G{WhichDB} = $whichDB[0];
&WriteConfig;
}
return if $DestinationsDBTieTracker;
TieDestinationsFlockFile "${DataDirectory}/$DestinationsDBFlockFile";
LockFile "${DataDirectory}/$DestinationsDB";
$DestinationsDBTieTracker = 1;
eval("use $G{WhichDB}") unless $DBused;
$DBused = 1;
UnTieDestinationsDB unless tie(%Destinations,$G{WhichDB},"${DataDirectory}/$DestinationsDB",O_RDWR|O_CREAT,0666);
} # sub TieDestinationsDB
sub TieCliffFlockFile
{
my $f = "$_[0].flock";
unless(sysopen(CLIFFFLOCKHANDLE,$f,O_RDONLY|O_CREAT))
{
LocalMessage "Sorry, can't sysopen $f for flock -- $@";
unless(flock(CLIFFFLOCKHANDLE,LOCK_EX|LOCK_NB))
{ LocalMessage "Sorry, can't flock lock $f -- $!"; }
}
} # sub TieCliffFlockFile
sub UnTieCliffFlockFile { close CLIFFFLOCKHANDLE; }
sub UnTieCliffDB
{
untie %Cliff;
UnTieCliffFlockFile "${DataDirectory}/$CliffDBFlockFile";
UnLockFile "${DataDirectory}/$CliffDB";
$CliffDBTieTracker = '';
} # sub UnTieCliffDB
sub TieCliffDB
{
unless($G{WhichDB})
{
my @whichDB = ();
push @whichDB,'GDBM_File' if eval('require GDBM_File');
push @whichDB, 'DB_File' if eval('require DB_File');
push @whichDB,'NDBM_File' if eval('require NDBM_File');
push @whichDB,'ODBM_File' if eval('require ODBM_File');
push @whichDB,'SDBM_File' if eval('require SDBM_File');
$G{WhichDB} = $whichDB[0];
&WriteConfig;
}
return if $CliffDBTieTracker;
TieCliffFlockFile "${DataDirectory}/$CliffDBFlockFile";
LockFile "${DataDirectory}/$CliffDB";
$CliffDBTieTracker = 1;
eval("use $G{WhichDB}") unless $DBused;
$DBused = 1;
UnTieCliffDB unless tie(%Cliff,$G{WhichDB},"${DataDirectory}/$CliffDB",O_RDWR|O_CREAT,0666);
} # sub TieCliffDB
sub Conform404Turl
{
my $uri = shift;
my $uriR = $uri;
$uriR =~ s/^\s*(.*?)\s*$/$1/;
$uriR =~ s!^\w+:/*(?:www\.)?\Q$G{SelfDomain}\E!!i if $uriR =~ /\Q$G{SelfDomain}\E/i;
$uriR = "/$uriR" unless $uriR =~ m!^/! or $uriR =~ m!^\w+:!;
my $uriC = $uriR;
$uriC =~ tr/+/ /;
$uriC =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return($uri,$uriR,$uriC);
} # sub Conform404Turl
sub FormattedDateTime
{
my $t = shift;
$t = $Time unless $t > 1;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
$year += 1900;
$year = substr($year,2);
my @Mon = qw(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC);
$mday = "0$mday" if $mday < 10;
my $tt = $hour < 10 ? "0${hour}:" : "${hour}:";
$tt .= $min < 10 ? "0${min}:" : "${min}:";
$tt .= $sec < 10 ? "0${sec}" : ${sec};
return "$year$Mon[$mon]$mday $tt";
} # sub FormattedDateTime
sub WriteConfig
{
my $f = $ConfigurationFile;
LockFile $f;
if(open Wwc,">$f")
{
my %g = %G;
for(keys %g)
{
$g{$_} =~ s/\n/$FlatLineBreakSubstitute/gs;
print Wwc "$_\t$g{$_}\n" if substr($d,2,1) =~ /b/i;
}
close Wwc;
}
UnLockFile $f;
} # sub WriteConfig
sub ReadConfig
{
my $f = $ConfigurationFile;
LockFile $f;
unless(open Rrc,"<$f")
{
UnLockFile $f;
MakeDirectory $ThisDirectory, $DataDirectory;
$G{SelfDomain} = $d = 'hobbyline.com';
my $www = $G{SelfDomain} =~ /[a-zA-Z]/ ? 'www.' : '';
$G{maximumManage} = '25';
$d =~ s/^www\.//;
WriteConfig;
return;
}
open Rrc,"<$f";
while()
{
chomp;
my($k,$v) = split /\t/,$_,2;
$v =~ s/\Q$FlatLineBreakSubstitute\E/\n/gs;
$G{$k} = $v;
}
close Rrc;
UnLockFile $f;
} # sub ReadConfig
1;