Hi,

First, you check is a little bit ugly, try to do something like this:

use File::Spec;

my $file = File::Spec->catfile($protected_folder, $protected{'file'});
[download]

Is more portable. And also check all the incomming stuff before using it... die early when error/asserts happen...

The other thing is that you must sent something like this, as far as I know:

print "Content-type: text/plain", "\n";
print "Status: 404 Not Found", "\n\n";
[download]

Regards,

The first part of you message confuses me a bit, are you saying my check is done wrong? As for your second part setting the status code after the content-type gives me the good old bad headers error. Also as requested the entire code is this:

#!/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, $f
+ile, $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 p
+rotected files. Use a comma (,) to separate each one
@allowed_domains = ('http://www.finalfantasyinfo.com', 'http://finalfa
+ntasyinfo.com', 'http://www.ffinfo.com', 'http://ffinfo.com');

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

#Enter the full path the the mimetypes.txt file, if it is the same fol
+der 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 hotlinki
+ng to your files for $badname
$badname = "bad-domain.gif"; 

#Set $badtype to "image/gif" for GIF files, "image/jpeg" for JPG or JP
+EG 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 fami
+lare 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[$#fi
+lename]"\n\n~;
    } else {
        print qq~Content-disposition: filename-parm := filename=$filen
+ame[$#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=$badna
+me\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;}}
[download]

Hi,

Hum, you should use more stuff from CPAN, that take account of all this little stuff as URI parsing, MIME types, request methods, etc...

Also adquiring a book like Perl Best Practices would be a good idea.

Regards,

fmerges at irc.freenode.net

One mistake I see is that you use \n as line terminator. The HTTP specification explicitely defines the line separator to be CRLF (\015\012). This may not be the problem that's biting you though, since most servers are lenient in what they accept, and if you're on windows \n equals CRLF. It's probably something you should fix anyway though.

Another possibility is of course that you've already printed an incompatible header earlier in your program, but without more source that's just conjecture.

This makes my server generate a 404 header:

#!/usr/bin/perl

print "Status: 404 Not Found\n\n";
[download]

Note, the page will be blank unless you specify some content for the "Not Found" page.

$ telnet www.chargrill.com 80
Trying 69.136.244.189...
Connected to chargrill.com.
Escape character is '^]'.
GET /404.cgi HTTP/1.0
Host: www.chargrill.com

HTTP/1.1 404 Not Found
Date: Sat, 29 Apr 2006 20:54:33 GMT
Connection: close
Content-Type: text/plain
[download]

$,=42;for(34,0,-3,9,-11,11,-17,7,-5){$*.=pack'c'=>$,+=$_}for(reverse s
+plit//=>$*
){$%++?$ %%2?push@C,$_,$":push@c,$_,$":(push@C,$_,$")&&push@c,$"}$C[$#
+C]=$/;($#C
>$#c)?($ c=\@C)&&($ C=\@c):($ c=\@c)&&($C=\@C);$%=$|;for(@$c){print$_^
+$$C[$%++]}
[download]

I have tryed the status header also and the same problem, linkchecking programs and the IIS logs still recive a 200 OK status and not the 404 Not Found status.