如何使用Perl以一些安全性和最少的资源提供映像？

Question

I found some posts related here but, nothing right on.. I need to serve up an image (humm) "correctly" and using as little resources as possible. I was working on a sub (below) but, is not too resource friendly just by the fact I use CGI. That is just my assumption though. I am a Perl newbie but, I like it better than php.

The query would be generated by "somescript.pl?img=image.png"

#!/usr/bin/perl -Tw
use strict;
use warnings;
use CGI;

#I should drop warnings after all is said and done. Also name my vars generically. Right?
#I dont know if this query method will work or is even the best method.
$query = new CGI;
my @img = $query->param;
if ( $_ eq "img" ) { my $file = $query->param($_); }
if ( $_ ne "img" ) {    ## I will send to an error sub that serves up a error image
}

# Prob a one liner to take care of the above. Not within my ability though.
# Still figuring all this out here.. Very verbose sorry...
# I will strip everything but lowercase alpha and the "."
# with s =~ /[something like A-Z] I will look it up //g;
# Still.. prob all above will fit in a one liner by a PERL guru!

# Below is related to -Taint, I was told this is important to use the -T.
$ENV{PATH} = "bin:/usr/bin";
delete( $ENV{qw(IFS CDPATH BASH_ENV ENV)} );

# now I will grab the images extension.
my $ext = ( $file =~ m/[^.]+$/ )[0];

#I was informed to use the "three" but, I am unsure what that means.
# My attempt based on my reading many posts here.

my $length = ( stat($file) )[10];
my $image  = do {
    local $/ = undef;
    print "Content-type: image/$ext\n";
    print "Content-length: $length \n\n";
    binmode STDOUT;
    open( FH, "<", $file ) || die "Could not find $file: $!";
    my $buffer = "";
    while ( read( FH, $buffer, 10240 ) ) {
        print $buffer;
    }
    close(FH);
};

As you can see, my attempt here is obviously a beginners.

I have found great advice here in stack overflow. I thank everyone past and present.

Answer 1

1. If you're going to use extension as a substitute for MIME-type, then you'd better name all your JPEG images .jpeg and not .jpg ! File::MMagic or File::MimeInfo would make better general-purpose solutions.
2. (stat $file)[10] isn't the content-length, it's the ctime , which is worthless to you. (stat $file)[7] works, but -s $file works just as well and it's obvious to any Perl programmer what it does without having to consult the stat manual. ( 2a: use -s on the filehandle once you open it instead of the filename to avoid racing against file replacement. )
3. I can access any file on the filesystem that's readable by the user the CGI runs as, eg image.pl?image=../../../../../../../etc/passwd . I'd suggest specifically mentioning the images directory so that you're not dependent on the getcwd , and using File::Spec ->no_upwards and File::Spec->catfile to build a pathname that can only be inside the images directory.
4. It's not really good form for a CGI to die if it's avoidable. If the file isn't found, return a 404 status. If the request is illegal, return a 400 or 403 status, etc.
5. Your URLs would be nicer if you used path_info to allow image.pl/foo.png instead of image.pl?img=foo.png .
6. Unless you add some more logic, the images you serve up won't be cached by the client.
7. Man, these are stacking up. Have you considered finding some code that's already written for the purpose instead of writing your own?

Answer 2

Have a look at the way it is done in Apachegallery

http://metacpan.org/pod/Apache::Gallery

It's using Imlib2 and it is quite efficient, including advanced features as resizing and rotate on the fly and using a shared disk cache.

Answer 3

I think you're missing something here:

my @img = $query->param;
if ( $_ eq "img" ) { my $file = $query->param($_); }
if ( $_ ne "img" ) {    ## error }

$_ is uninitialized. I think you wanted to say:

my @img = $query->param;
foreach (@img) {
  if ( $_ eq "img" ) { my $file = $query->param($_); }
  if ( $_ ne "img" ) {    ##  error }
}

or for better readability and maintainability

my @img = $query->param;
foreach my $param (@img) {
  if ( $param eq "img" ) { my $file = $query->param($param); }
  if ( $param ne "img" ) {    ## error }
}

---

For another thing, you probably want to use

( stat($file) )[7];

and not

( stat($file) )[10];

to get the length of a file. (stat $file)[10] will give you the file's change time.

Answer 4

The simplest way to serve an image is by using the file handling that is probably already included in your webserver.

You can also add authentication by using an .htaccess file (if you're using Apache).

Answer 5

I would only change a few things.

First, replace the block of code after the first comment block with this:

my $query = new CGI;
my $file = $query->params('img');

Your code to get the file extension doesn't work for me. This does:

my ($ext) = $file =~ m/\.([^\.]+)$/;

I do not understand the use of "my $image = do {...". It just doesn't seem necessary.

Since you're using the CGI module already, use it to do your headers for you:

print $query->header(
    -type => 'image/' . $ext,
    -Content_length => $length,
    );

The way you're reading the file and writing it back out looks functionally perfect.

I have several additional comments & suggestions. First, your code is extremely insecure. It's nice that you're thinking about taint mode, but you're not doing anything about the filename passed in from your client. What if they passed "/etc/passwd", for example? Another is that you might as well open your image file (after doing more security checks) before sending the HTTP headers. This would allow you to send a reasonable error back to the client (404?), rather than just dying. Use CGI's "header" method to make that easy. You can still write something to STDERR if you like.

That's all I can think of just now. I hope this is enough to get you going.

Answer 6

I'm not sure what you are trying to do, but it looks like it would be much easier to handle this without Perl and CGI. Which server are you using? I'd prefer to fix this up with a rewrite rule in Apache.

I've never been a fan of gatekeeper scripts, though. Maybe if you can say why you are trying to do this we can come up with a good solution (and not just a better one :).