Search code examples
perlactiveperl

Serving Image with Perl prints wrong Content-Length (Gives net::ERR_CONTENT_LENGTH_MISMATCH in Chrome)


Activeperl 5.16 + Windows environment.

Windows machine:

Summary of my perl5 (revision 5 version 16 subversion 3) configuration:

Linux machine:

Summary of my perl5 (revision 5 version 14 subversion 2) configuration:

Doesn't occur on Linux based at all with the same code.

Here's my code that fetches a weather gif image, and does some magic (serving from cached directory for failover support in case internet dies or remote server does a radar update in the middle of a fetch, going offline)

sub get_map
{
    my $whichImage = $_[0];

    my $ua = LWP::UserAgent->new;
    my $cache_file      = $GLOB{'cache_mapA'};          # tempdata file path
    my $cache_file_age  = 100000;                       # this is used to determine if we have to get fresh data from the ems site will hold the tempdata file age in seconds 
    my $data            = '';                           # initializing empty data variable to enable later check for empty variable
    my $cache_time      = $GLOB{'cache_timeMap'};       # Max age of the temdata file in seconds
    my $useCached       = 0;
    my $url             = $GLOB{'mapAurl'};

    if( $whichImage eq "B" )
    {
        $cache_file     = $GLOB{'cache_mapB'};
        $url            = $GLOB{'mapBurl'};
    }

    if ( -s $cache_file )   # test existence of the tempdata file - if it has a size it exists
    {
        my $mtime           = ( stat $cache_file )[9];  # get the Unix time of the last change (in seconds)
        my $current_time    = time;                     # get the current Unix time (in  seconds)
        $cache_file_age     = $current_time - $mtime;       # get the age of the tempdata fileim seconds!       
    }

    if( $cache_file_age > $cache_time ) # check if we have to query the ems server 
    {
        my $response = $ua->get($url);

        if ($response->is_success) # checking if we were able to get the website
        {
            $data = $response->decoded_content( charset => 'none' );
            open my $filehandle , '>' , $cache_file or die 'Horribly';  
            binmode $filehandle;
            print $filehandle $data;
            close $filehandle;
        }
    }

    my $file = $cache_file;
    my $length = -s $file;

    print "Content-type: image/gif\n";
    print "Content-length: $length \n\n";

    binmode STDOUT;

    open (FH,'<', $file) || die "Could not open $file: $!";
    my $buffer = "";

    while (read(FH, $buffer, 10240)) 
    {
        print $buffer;
    }
    close(FH);
}

cache_mapA points to tmp/map.A.gif and cache

Going to http://mywebserver.com/whatever.cgi?type=mapA gives a corrupted gif file that shows net::ERR_CONTENT_LENGTH_MISMATCH in Google Chrome's debugger.

Going to http://mywebserver.com/tmp/map.A.gif works fine in a browser.

Tried switching server software on my test box, Apache and LightTPD both show this behavior.

I'm out of ideas since this works perfectly fine on non Windows based machine.

It's possible there is an issue with this section but it looks fine to me:

print "Content-type: image/gif\n";
print "Content-length: $length \n\n";

binmode STDOUT;

open (FH,'<', $file) || die "Could not open $file: $!";
my $buffer = "";

while (read(FH, $buffer, 10240)) 
{
    print $buffer;
}
close(FH);

Help!


Solution

  • You did binmode STDOUT but not binmode FH. Windows Perl opens files with :crlf enabled by default; Unix Perl does not.

    The more modern technique would be open (FH,'<:raw', $file) instead of using a separate call to binmode.

    If the image displays in other browsers, then the corruption for that particular image is probably minor enough that it doesn't prevent decoding.