-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
#!/usr/bin/perl
################################################################################
## ##
## Name: lockout.pl ##
## Auth: Chris Knight <merlin@ghostwheel.com> ##
## ##
## Desc: This script prevents 'deep linking' from external sites, while ##
## allowing search engines to crawl through your site for indexing. ##
## People visiting from 'deep links' on another site or Portal are ##
## automagically translocated to an introduction page from which ##
## they can proceed to your goodies. ##
## ##
## Docs: http://www.ghostwheel.com/~merlin/perl/ ##
## ##
################################################################################
## ##
## Copyright 1999, Chris Knight ##
## ##
## Private Use - This software is free for use in personal and noncommercial ##
## websites. ##
## ##
## Commercial Use - Use of this software in a commercial website, whether or ##
## not the site has any eCommerce functionality, requires ##
## a prior written agreement. Contact Chris Knight ##
## at merlin@ghostwheel.com for details. ##
## (Thank Universal Studios for this clause.) ##
## ##
## Distribution - This software is free to distribute as long as you only ##
## distribute it unmodified, with my PGP signature intact. ##
## ##
## Modification - You may modify and redistribute this code as long as: ##
## a) You email a copy of the modified module to merlin@ghostwheel.com ##
## b) This entire comment block remains intact, with the addition of ##
## your change notes in the section provided below. ##
## (It would be nice, but not required, if the modified module was ##
## PGP signed by the contributor and then myself.) ##
## c) You include the PGP signed original script in your distribution. ##
## d) The terms of use above are not compromised by your modification ##
## and/or distribution. ##
## ##
## Why not GPL? Because I object to 'GNU/Linux' and the mentality behind ##
## the attempt to forcefully take credit for another free project. I'm not ##
## going to insist that you rename your website if you use my script to ##
## verify email address in a comment form, but I'm not GNU! :) ##
## ##
################################################################################
## ##
## History: ##
## 1.0 - Initial release by Chris Knight, 10/12/1999 ##
## ##
## ##
################################################################################
$LocationOfProtectedFiles = 'downloads';
$IntroductionURL = 'http://www.ghostwheel.com/~merlin/perl/';
$ErrorURL = 'http://www.ghostwheel.com/transmorgrification.html';
$RefererMustStartWith = 'http://www.ghostwheel.com/~merlin/perl';
$ApacheConfigDirectory = '/usr/local/etc/apache';
# This is an array of keywords for browsers that are known to support the referrer tag.
# I built this list my analyzing my logs, so this is guaranteed to be incomplete. Feel free to add to this, and
# to send me any that I don't have. -ck
@MustHaveReferer = ( "Mozilla", "MSIE", "Opera", "Mosaic", "Lynx", "Lotus-Notes", "Digimarc WebReader", "InterGO",
"NETCOMplete", "IWENG", "Microsoft", "Charlotte", "PRODIGY", "NaviPress", "Amiga-AWeb");
# Slap down anyone trying to get an index of the 'protected' directory. :)
if ($ENV{'REQUEST_URI'} =~ m/\/$/) {
print "Location: $IntroductionURL\n\r\n\r";
exit;
}
if (-f "$LocationOfProtectedFiles/$ENV{'PATH_INFO'}" )
{
if ( &AccessCheck == 1)
{
&AccessGranted;
}
else
{
print "Location: $IntroductionURL\n\r\n\r";
}
}
else
{
print "Location: $ErrorURL\n\r\n\r";
}
exit;
sub AccessGranted {
my %mime_type = &LoadMimeTypes;
my $FileSize = (-s "$LocationOfProtectedFiles/$ENV{'PATH_INFO'}");
my @PathElements = split(/\//, $ENV{'PATH_INFO'});
my @smeg = split(/\./, @PathElements[$#PathElements]);
if ( $mime_type{$smeg[$#smeg]} eq "" )
{
# This is not pretty, but if I don't get this into the server logs it will be harder for the admin
# to debug.
die "Sorry, I need a MIME type for $ENV{'PATH_INFO'}.";
}
print "Content-Type: $mime_type{$smeg[$#smeg]}\n";
print "Content-Length: $FileSize\n\n";
open(FILE,"$LocationOfProtectedFiles/$ENV{'PATH_INFO'}");
while (read FILE, $Buffer, 1024) {
print "$Buffer";
}
close(FILE);
}
sub AccessCheck {
if ($ENV{'HTTP_REFERER'} =~ m/^$RefererMustStartWith/i)
{
#print "If the referrer contains the required string, why bother with the rest?\n";
return(1);
}
elsif ($ENV{'HTTP_REFERER'} ne '')
{
#print "Non-empty referrer that doesn't start with the match string. Bounce this puppy!\n";
return(-1);
}
else
{
#print "If the referrer is empty, lets see if it should have one.\n";
my $Browser;
foreach $Browser (@MustHaveReferer)
{
if ($ENV{'HTTP_USER_AGENT'} =~ m/$Browser/i)
{
#print "Empty referrer, but it should have one, lets reject it.\n";
return(-1);
}
}
#print "Empty referrer, but it didn't need one, lets pass it through.\n";
return(1);
}
}
sub LoadMimeTypes {
my %mime_type;
open(MIMES,"$ApacheConfigDirectory/mime.types") || die "Unabel to open $ApacheConfigDirectory/mime.types.\n";
while ()
{
my $Temp;
($Temp = $_) =~ s/[\n\r]//g;
if ($Temp =~ m/\t/)
{
my @Junk = split(/\t/, $Temp);
my @extensions = split(/ /,$Junk[$#Junk]);
my $ext_tmp;
foreach $ext_tmp (@extensions)
{
$mime_type{$ext_tmp} = $Junk[0];
}
}
}
return(%mime_type);
}
-----BEGIN PGP SIGNATURE-----
Version: PGP 8.0.3
iQA/AwUBQE3+n6arIxUYN+gyEQKS7wCfREha5U3w1PYhCZDuKmRZWkmIljEAn1yR
DJk4Xd6Qx6KtkIJDuEOws7g3
=EAz7
-----END PGP SIGNATURE-----