#!/user/bin/perl
#######################################################
#File Protection					Version 1.2       #
#Copyright 2005 Matt Verstraete		matt@ffinfo.com   #
#Created: 							August 23, 2005	  #
#Last Modified:						September 5, 2005 #
#This script may be modified as needed.				  #
#This script can not be redistributed in hole or      #
#part with out the express written permission of      #
#Matt Verstraete.									  #
#######################################################
use CGI qw/:standard/;
&get_protected;
my($allowed_domains, @allowed_domains, $protected_folder, $accepted, $holder, @paths, $name, $value, @extentions, $extention, $mimetype, $file, $mimeext, $type, $bytes, $badname, $badtype, %protected, %env, $path, $mimepath, @filename);

#Please Edit the following sections as needed for your site

#Make a list of all the domain names that are allowed to access your protected files. Use a comma (,) to separate each one
@allowed_domains = ('http://www.finalfantasyinfo.com', 'http://finalfantasyinfo.com', 'http://www.ffinfo.com', 'http://ffinfo.com');

#Put the full path to the folder that you want to protect in $protected_folder
$protected_folder = 'D:/finalfantasyinfo.com/www/protected';

#Enter the full path the the mimetypes.txt file, if it is the same folder as your protected files leave it as $protected_folder/
$mimepath = "$protected_folder";

#Enter the path to and name of the image to display to people hotlinking to your files for $badname
$badname = "bad-domain.gif"; 

#Set $badtype to "image/gif" for GIF files, "image/jpeg" for JPG or JPEG files, "image/png" for PNG files, or "image/tiff" for TIF or TIFF files
$badtype = "image/gif"; 

#Please do not alter anything below this line unless you are very familare with PERL
#Do a few seciruity regexs to protect the webserver
$protected{'file'} =~ s/["';]//g;
$protected{'file'} =~ s/\.\.[\/]*?//g;
#Set mime type of protected file
@extentions = split (/\./, $protected{'file'});
$extention = $extentions[$#extentions];
open (MIMETYPE, "$mimepath/mimetypes.txt") or die;
do {
	$file = <MIMETYPE>;
	chomp($file);
	($mimeext, $type) = split (/;/, $file);
	if (lc($extention) =~ m/lc($mimeext)/i){
		$mimetype = $type;}
		} until eof(MIMETYPE);
		close(MIMETYPE);
#Get the name of the file to be shown so we can later tell the browser that name
@filename = split(/\//, $protected{'file'});
#Check the referer against the allowed domains
foreach $allowed_domains (@allowed_domains){
	if ($ENV{'HTTP_REFERER'} =~ m/$allowed_domains/i){
		$accepted = 'Yes';}}
#Do all the work of showing the files
if ($accepted eq 'Yes'){
	if (-e "$protected_folder/$protected{'file'}"){
		print "Status: 200 OK\n";
		print "Content-type: $mimetype\n";
			if ($ENV{'HTTP_USER_AGENT'} =~ /MSIE/){
		print qq~Content-disposition: inline; filename="$filename[$#filename]"\n\n~;
	} else {
		print qq~Content-disposition: filename-parm := filename=$filename[$#filename]\n\n~;}
		if (-B "$protected_folder/$protected{'file'}"){
			open (FILE, "$protected_folder/$protected{'file'}");
			binmode (FILE);
			binmode (STDOUT);
			while ($bytes = read(FILE, $holder, 1024)){
				print "$holder";}
				close (FILE);
		} else {
		open (FILE, "$protected_folder/$protected{'file'}");
		do {
			$holder = <FILE>;
			print "$holder";}
			until eof(FILE);}
	} else {
		print "Content-type: text/plain", "\n";
		print "Status: 404 Not Found", "\n\n";
} else {
	print "Status: 200 OK\n";
	print "Content-type: $badtype\n";
	if ($ENV{'HTTP_USER_AGENT'} =~ /MSIE/){
		print qq~Content-disposition: inline; filename="$badname"\n\n~;
	} else {
		print qq~Content-disposition: filename-parm := filename=$badname\n\n~;}
	open (FILE, "$protected_folder/$badname");
	binmode (FILE);
	binmode (STDOUT);
	while ($bytes = read(FILE, $holder, 1024)){
		print "$holder";}
		close (FILE);}		
sub get_protected {
	if ($ENV{'REQUEST_METHOD'} eq 'POST'){
		read(STDIN, $holder, $ENV{'CONTENT_LENGTH'});
		@paths = split(/&/, $holder);
	} else {
		@paths = split(/&/, $ENV{'QUERY_STRING'});}
	foreach	$path (@paths){
		($name, $value) = split (/=/, $path);
		$value =~ tr/+/ /;
		$value =~ s/;/:/g;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ s/\cM\n/ <br \/>/g;
		$protected{$name} = $value;}}