Bug #84122 for Image-Info: image_info on Jpeg with bad EXIF data produces "substr outside of string" exception in Image::TIFF

Hi guys, When running image_info with the attached 'bad-exif-1.jpg' (which has been anonymised, hence the 'broken' look), Image::TIFF produces an error: substr outside of string at ../Image-Info-1.34.orig/lib/Image/TIFF.pm line 825. This is strange, as the expression is not attempting to modify the substr: my $next_ifd = $self->unpack("N", substr($_, $ifd + 2 + $num_fields*12, 4)); So the error should just be a warning, according to 'perldoc -f substr'. I suppose it might be because it's returned as an l-value that *might* be updated... This occurs on perl 5.8.9, Image::Info v1.31 & up. I've not had a chance to try on more modern perls (on the off-chance that this is a bug in perl 5.8.9?). The attached patch fixes it. -Steve

Binary files Image-Info-1.34.orig/img/bad-exif-1.jpg and Image-Info-1.34/img/bad-exif-1.jpg differ diff -ruN Image-Info-1.34.orig/lib/Image/TIFF.pm Image-Info-1.34/lib/Image/TIFF.pm --- Image-Info-1.34.orig/lib/Image/TIFF.pm 2012-02-22 04:52:30.000000000 -0500 +++ Image-Info-1.34/lib/Image/TIFF.pm 2013-03-21 12:08:54.000000000 -0400 @@ -822,7 +822,12 @@ while ($ifd) { push(@{$self->{ifd}}, $ifd); my($num_fields) = $self->unpack("x$ifd n", $_); - my $next_ifd = $self->unpack("N", substr($_, $ifd + 2 + $num_fields*12, 4)); + + my $substr_ifd = substr($_, $ifd + 2 + $num_fields*12, 4); + last unless defined $substr_ifd; # bad TIFF header, eg: substr idx > length($substr_ifd) + + my $next_ifd = $self->unpack("N", $substr_ifd); + # guard against (bug #26127) $next_ifd = 0 if $next_ifd > length($_); # guard against looping ifd (bug #26130) diff -ruN Image-Info-1.34.orig/t/bad_exif.t Image-Info-1.34/t/bad_exif.t --- Image-Info-1.34.orig/t/bad_exif.t 1969-12-31 19:00:00.000000000 -0500 +++ Image-Info-1.34/t/bad_exif.t 2013-03-21 12:13:13.000000000 -0400 @@ -0,0 +1,13 @@ +use strict; +use warnings; + +use FindBin qw( $Bin ); +use Test::More tests => 2; + +use Image::Info; + +{ + my $info = Image::Info::image_info("$Bin/../img/bad-exif-1.jpg"); + ok( ! $info->{error}, "no error on bad EXIF data" ) or diag( "Got Error: $info->{error}" ); + is( join("\n", @{ $info->{resolution} }), "75 dpi\n3314/3306 dpi", "resolution as expected" ); +}