#!perl -w
use strict;
use Test::More tests => 215;
use Imager qw(:all);
use Imager::Test qw(test_image_raw is_image is_color3 test_image);
-d "testout" or mkdir "testout";
Imager->open_log(log => "testout/t107bmp.log");
my @files;
my $debug_writes = 0;
my $base_diff = 0;
# if you change this make sure you generate new compressed versions
my $green=i_color_new(0,255,0,255);
my $blue=i_color_new(0,0,255,255);
my $red=i_color_new(255,0,0,255);
my $img = test_image_raw();
Imager::i_tags_add($img, 'i_xres', 0, '300', 0);
Imager::i_tags_add($img, 'i_yres', 0, undef, 300);
write_test($img, "testout/t107_24bit.bmp");
push @files, "t107_24bit.bmp";
# 'webmap' is noticably faster than the default
my $im8 = Imager::i_img_to_pal($img, { make_colors=>'webmap',
translate=>'errdiff'});
write_test($im8, "testout/t107_8bit.bmp");
push @files, "t107_8bit.bmp";
# use a fixed palette so we get reproducible results for the compressed
# version
my @pal16 = map { NC($_) }
qw(605844 966600 0148b2 00f800 bf0a33 5e009e
2ead1b 0000f8 004b01 fd0000 0e1695 000002);
my $im4 = Imager::i_img_to_pal($img, { colors=>\@pal16, make_colors=>'none' });
write_test($im4, "testout/t107_4bit.bmp");
push @files, "t107_4bit.bmp";
my $im1 = Imager::i_img_to_pal($img, { colors=>[ NC(0, 0, 0), NC(176, 160, 144) ],
make_colors=>'none', translate=>'errdiff' });
write_test($im1, "testout/t107_1bit.bmp");
push @files, "t107_1bit.bmp";
my $bi_rgb = 0;
my $bi_rle8 = 1;
my $bi_rle4 = 2;
my $bi_bitfields = 3;
read_test("testout/t107_24bit.bmp", $img,
bmp_compression=>0, bmp_bit_count => 24);
read_test("testout/t107_8bit.bmp", $im8,
bmp_compression=>0, bmp_bit_count => 8);
read_test("testout/t107_4bit.bmp", $im4,
bmp_compression=>0, bmp_bit_count => 4);
read_test("testout/t107_1bit.bmp", $im1, bmp_compression=>0,
bmp_bit_count=>1);
# the following might have slight differences
$base_diff = i_img_diff($img, $im8) * 2;
print "# base difference $base_diff\n";
read_test("testimg/comp4.bmp", $im4,
bmp_compression=>$bi_rle4, bmp_bit_count => 4);
read_test("testimg/comp8.bmp", $im8,
bmp_compression=>$bi_rle8, bmp_bit_count => 8);
my $imoo = Imager->new;
# read via OO
ok($imoo->read(file=>'testout/t107_24bit.bmp'), "read via OO")
or print "# ",$imoo->errstr,"\n";
ok($imoo->write(file=>'testout/t107_oo.bmp'), "write via OO")
or print "# ",$imoo->errstr,"\n";
push @files, "t107_oo.bmp";
# various invalid format tests
# we have so many different test images to try to detect all the possible
# failure paths in the code, adding these did detect real problems
print "# catch various types of invalid bmp files\n";
my @tests =
(
# entries in each array ref are:
# - basename of an invalid BMP file
# - error message that should be produced
# - description of what is being tested
# - possible flag to indicate testing only on 32-bit machines
[ 'badplanes.bmp', 'not a BMP file', "invalid planes value" ],
[ 'badbits.bmp', 'unknown bit count for BMP file (5)',
'should fail to read invalid bits' ],
# 1-bit/pixel BMPs
[ 'badused1.bmp', 'out of range colors used (3)',
'out of range palette size (1-bit)' ],
[ 'badcomp1.bmp', 'unknown 1-bit BMP compression (1)',
'invalid compression value (1-bit)' ],
[ 'bad1wid0.bmp', 'file size limit - image width of 0 is not positive',
'width 0 (1-bit)' ],
[ 'bad4oflow.bmp',
'file size limit - integer overflow calculating storage',
'overflow integers on 32-bit machines (1-bit)', '32bitonly' ],
[ 'short1.bmp', 'failed reading 1-bit bmp data',
'short 1-bit' ],
# 4-bit/pixel BMPs
[ 'badused4a.bmp', 'out of range colors used (272)',
'should fail to read invalid pal size (272) (4-bit)' ],
[ 'badused4b.bmp', 'out of range colors used (17)',
'should fail to read invalid pal size (17) (4-bit)' ],
[ 'badcomp4.bmp', 'unknown 4-bit BMP compression (1)',
'invalid compression value (4-bit)' ],
[ 'short4.bmp', 'failed reading 4-bit bmp data',
'short uncompressed 4-bit' ],
[ 'short4rle.bmp', 'missing data during decompression',
'short compressed 4-bit' ],
[ 'bad4wid0.bmp', 'file size limit - image width of 0 is not positive',
'width 0 (4-bit)' ],
[ 'bad4widbig.bmp', 'file size limit - image width of -2147483628 is not positive',
'width big (4-bit)' ],
[ 'bad4oflow.bmp', 'file size limit - integer overflow calculating storage',
'overflow integers on 32-bit machines (4-bit)', '32bitonly' ],
# 8-bit/pixel BMPs
[ 'bad8useda.bmp', 'out of range colors used (257)',
'should fail to read invalid pal size (8-bit)' ],
[ 'bad8comp.bmp', 'unknown 8-bit BMP compression (2)',
'invalid compression value (8-bit)' ],
[ 'short8.bmp', 'failed reading 8-bit bmp data',
'short uncompressed 8-bit' ],
[ 'short8rle.bmp', 'missing data during decompression',
'short compressed 8-bit' ],
[ 'bad8wid0.bmp', 'file size limit - image width of 0 is not positive',
'width 0 (8-bit)' ],
[ 'bad8oflow.bmp', 'file size limit - integer overflow calculating storage',
'overflow integers on 32-bit machines (8-bit)', '32bitonly' ],
# 24-bit/pixel BMPs
[ 'short24.bmp', 'failed reading image data',
'short 24-bit' ],
[ 'bad24wid0.bmp', 'file size limit - image width of 0 is not positive',
'width 0 (24-bit)' ],
[ 'bad24oflow.bmp', 'file size limit - integer overflow calculating storage',
'overflow integers on 32-bit machines (24-bit)', '32bitonly' ],
[ 'bad24comp.bmp', 'unknown 24-bit BMP compression (4)',
'bad compression (24-bit)' ],
);
use Config;
my $ptrsize = $Config{ptrsize};
for my $test (@tests) {
my ($file, $error, $comment, $bit32only) = @$test;
SKIP:
{
skip("only tested on 32-bit machines", 2)
if $bit32only && $ptrsize != 4;
ok(!$imoo->read(file=>"testimg/$file"), $comment);
print "# ", $imoo->errstr, "\n";
is($imoo->errstr, $error, "check error message");
}
}
# previously we didn't seek to the offbits position before reading
# the image data, check we handle it correctly
# in each case the first is an original image with a given number of
# bits and the second is the same file with data inserted before the
# image bits and the offset modified to suit
my @comp =
(
[ 'winrgb2.bmp', 'winrgb2off.bmp', 1 ],
[ 'winrgb4.bmp', 'winrgb4off.bmp', 4 ],
[ 'winrgb8.bmp', 'winrgb8off.bmp', 8 ],
[ 'winrgb24.bmp', 'winrgb24off.bmp', 24 ],
);
for my $comp (@comp) {
my ($base_file, $off_file, $bits) = @$comp;
my $base_im = Imager->new;
my $got_base =
ok($base_im->read(file=>"testimg/$base_file"),
"read original")
or print "# ",$base_im->errstr,"\n";
my $off_im = Imager->new;
my $got_off =
ok($off_im->read(file=>"testimg/$off_file"),
"read offset file")
or print "# ",$off_im->errstr,"\n";
SKIP:
{
skip("missed one file", 1)
unless $got_base && $got_off;
is(i_img_diff($base_im->{IMG}, $off_im->{IMG}), 0,
"compare base and offset image ($bits bits)");
}
}
{ # check file limits are checked
my $limit_file = "testout/t107_24bit.bmp";
ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
my $im = Imager->new;
ok(!$im->read(file=>$limit_file),
"should fail read due to size limits");
print "# ",$im->errstr,"\n";
like($im->errstr, qr/image width/, "check message");
ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
ok(!$im->read(file=>$limit_file),
"should fail read due to size limits");
print "# ",$im->errstr,"\n";
like($im->errstr, qr/image height/, "check message");
ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
ok($im->read(file=>$limit_file),
"should succeed - just inside width limit");
ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
ok($im->read(file=>$limit_file),
"should succeed - just inside height limit");
# 150 x 150 x 3 channel image uses 67500 bytes
ok(Imager->set_file_limits(reset=>1, bytes=>67499),
"set bytes limit 67499");
ok(!$im->read(file=>$limit_file),
"should fail - too many bytes");
print "# ",$im->errstr,"\n";
like($im->errstr, qr/storage size/, "check error message");
ok(Imager->set_file_limits(reset=>1, bytes=>67500),
"set bytes limit 67500");
ok($im->read(file=>$limit_file),
"should succeed - just inside bytes limit");
Imager->set_file_limits(reset=>1);
}
{ # various short read failure tests, each entry has:
# source filename, size, expected error
# these have been selected based on code coverage, to check each
# failure path is checked, where practical
my @tests =
(
[
"file truncated inside header",
"winrgb2.bmp",
20, "file too short to be a BMP file"
],
[
"1-bit, truncated inside palette",
"winrgb2.bmp",
56, "reading BMP palette"
],
[
"1-bit, truncated in offset region",
"winrgb2off.bmp", 64, "failed skipping to image data offset"
],
[
"1-bit, truncated in image data",
"winrgb2.bmp", 96, "failed reading 1-bit bmp data"
],
[
"4-bit, truncated inside palette",
"winrgb4.bmp",
56, "reading BMP palette"
],
[
"4-bit, truncated in offset region",
"winrgb4off.bmp", 120, "failed skipping to image data offset",
],
[
"4-bit, truncate in image data",
"winrgb4.bmp", 120, "failed reading 4-bit bmp data"
],
[
"4-bit RLE, truncate in uncompressed data",
"comp4.bmp", 0x229, "missing data during decompression"
],
[
"8-bit, truncated in palette",
"winrgb8.bmp", 1060, "reading BMP palette"
],
[
"8-bit, truncated in offset region",
"winrgb8off.bmp", 1080, "failed skipping to image data offset"
],
[
"8-bit, truncated in image data",
"winrgb8.bmp", 1080, "failed reading 8-bit bmp data"
],
[
"8-bit RLE, truncate in uncompressed data",
"comp8.bmp", 0x68C, "missing data during decompression"
],
[
"24-bit, truncate in offset region",
"winrgb24off.bmp", 56, "failed skipping to image data offset",
],
[
"24-bit, truncate in image data",
"winrgb24.bmp", 100, "failed reading image data",
],
);
my $test_index = 0;
for my $test (@tests) {
my ($desc, $srcfile, $size, $error) = @$test;
my $im = Imager->new;
open IMDATA, "< testimg/$srcfile"
or die "$test_index - $desc: Cannot open testimg/$srcfile: $!";
binmode IMDATA;
my $data;
read(IMDATA, $data, $size) == $size
or die "$test_index - $desc: Could not read $size data from $srcfile";
close IMDATA;
ok(!$im->read(data => $data, type =>'bmp'),
"$test_index - $desc: Should fail to read");
is($im->errstr, $error, "$test_index - $desc: check message");
++$test_index;
}
}
{ # various short read success tests, each entry has:
# source filename, size, expected tags
print "# allow_incomplete tests\n";
my @tests =
(
[
"1-bit",
"winrgb2.bmp", 96,
{
bmp_compression_name => 'BI_RGB',
bmp_compression => 0,
bmp_used_colors => 2,
i_lines_read => 8,
},
],
[
"4-bit",
"winrgb4.bmp", 250,
{
bmp_compression_name => 'BI_RGB',
bmp_compression => 0,
bmp_used_colors => 16,
i_lines_read => 11,
},
],
[
"4-bit RLE - uncompressed seq",
"comp4.bmp", 0x229,
{
bmp_compression_name => 'BI_RLE4',
bmp_compression => 2,
bmp_used_colors => 16,
i_lines_read => 44,
},
],
[
"4-bit RLE - start seq",
"comp4.bmp", 0x97,
{
bmp_compression_name => 'BI_RLE4',
bmp_compression => 2,
bmp_used_colors => 16,
i_lines_read => 8,
},
],
[
"8-bit",
"winrgb8.bmp", 1250,
{
bmp_compression_name => 'BI_RGB',
bmp_compression => 0,
bmp_used_colors => 256,
i_lines_read => 8,
},
],
[
"8-bit RLE - uncompressed seq",
"comp8.bmp", 0x68C,
{
bmp_compression_name => 'BI_RLE8',
bmp_compression => 1,
bmp_used_colors => 256,
i_lines_read => 27,
},
],
[
"8-bit RLE - initial seq",
"comp8.bmp", 0x487,
{
bmp_compression_name => 'BI_RLE8',
bmp_compression => 1,
bmp_used_colors => 256,
i_lines_read => 20,
},
],
[
"24-bit",
"winrgb24.bmp", 800,
{
bmp_compression_name => 'BI_RGB',
bmp_compression => 0,
bmp_used_colors => 0,
i_lines_read => 12,
},
],
);
my $test_index = 0;
for my $test (@tests) {
my ($desc, $srcfile, $size, $tags) = @$test;
my $im = Imager->new;
open IMDATA, "< testimg/$srcfile"
or die "$test_index - $desc: Cannot open testimg/$srcfile: $!";
binmode IMDATA;
my $data;
read(IMDATA, $data, $size) == $size
or die "$test_index - $desc: Could not read $size data from $srcfile";
close IMDATA;
ok($im->read(data => $data, type =>'bmp', allow_incomplete => 1),
"$test_index - $desc: Should read successfully");
# check standard tags are set
is($im->tags(name => 'i_format'), 'bmp',
"$test_index - $desc: i_format set");
is($im->tags(name => 'i_incomplete'), 1,
"$test_index - $desc: i_incomplete set");
my %check_tags;
for my $key (keys %$tags) {
$check_tags{$key} = $im->tags(name => $key);
}
is_deeply(\%check_tags, $tags, "$test_index - $desc: check tags");
++$test_index;
}
}
{ # check handling of reading images with negative height
# each entry is:
# source file, description
print "# check handling of negative height values\n";
my @tests =
(
[ "winrgb2.bmp", "1-bit, uncompressed" ],
[ "winrgb4.bmp", "4-bit, uncompressed" ],
[ "winrgb8.bmp", "8-bit, uncompressed" ],
[ "winrgb24.bmp", "24-bit, uncompressed" ],
[ "comp4.bmp", "4-bit, RLE" ],
[ "comp8.bmp", "8-bit, RLE" ],
);
my $test_index = 0;
for my $test (@tests) {
my ($file, $desc) = @$test;
open IMDATA, "< testimg/$file"
or die "$test_index - Cannot open $file: $!";
binmode IMDATA;
my $data = do { local $/; <IMDATA> };
close IMDATA;
my $im_orig = Imager->new;
$im_orig->read(data => $data)
or die "Cannot load original $file: ", $im_orig->errstr;
# now negate the height
my $orig_height = unpack("V", substr($data, 0x16, 4));
my $neg_height = 0xFFFFFFFF & ~($orig_height - 1);
substr($data, 0x16, 4) = pack("V", $neg_height);
# and read the modified image
my $im = Imager->new;
ok($im->read(data => $data),
"$test_index - $desc: read negated height image")
or print "# ", $im->errstr, "\n";
# flip orig to match what we should get
$im_orig->flip(dir => 'v');
# check it out
is_image($im, $im_orig, "$test_index - $desc: check image");
++$test_index;
}
}
{ print "# patched data read failure tests\n";
# like the "various invalid format" tests, these generate fail
# images from other images included with Imager without providing a
# full bmp source, saving on dist size and focusing on the changes needed
# to cause the failure
# each entry is: source file, patches, expected error, description
my @tests =
(
# low image data offsets
[
"winrgb2.bmp",
{ 10 => "3d 00 00 00" },
"image data offset too small (61)",
"1-bit, small image offset"
],
[
"winrgb4.bmp",
{ 10 => "75 00 00 00" },
"image data offset too small (117)",
"4-bit, small image offset"
],
[
"winrgb8.bmp",
{ 10 => "35 04 00 00" },
"image data offset too small (1077)",
"8-bit, small image offset"
],
[
"winrgb24.bmp",
{ 10 => "35 00 00 00" },
"image data offset too small (53)",
"24-bit, small image offset"
],
# compression issues
[
"comp8.bmp",
{ 0x436 => "97" },
"invalid data during decompression",
"8bit, RLE run beyond edge of image"
],
[
# caused glibc malloc or valgrind to complain
"comp8.bmp",
{ 0x436 => "94 00 00 03" },
"invalid data during decompression",
"8bit, literal run beyond edge of image"
],
[
"comp4.bmp",
{ 0x76 => "FF bb FF BB" },
"invalid data during decompression",
"4bit - RLE run beyond edge of image"
],
[
"comp4.bmp",
{ 0x76 => "94 bb 00 FF" },
"invalid data during decompression",
"4bit - literal run beyond edge of image"
],
);
my $test_index = 0;
for my $test (@tests) {
my ($filename, $patches, $error, $desc) = @$test;
my $data = load_patched_file("testimg/$filename", $patches);
my $im = Imager->new;
ok(!$im->read(data => $data, type=>'bmp'),
"$test_index - $desc:should fail to read");
is($im->errstr, $error, "$test_index - $desc:check message");
++$test_index;
}
}
{ # various write failure tests
# each entry is:
# source, limit, expected error, description
my @tests =
(
[
"winrgb2.bmp", 1,
"cannot write bmp header: limit reached",
"1-bit, writing header"
],
[
"winrgb4.bmp", 1,
"cannot write bmp header: limit reached",
"4-bit, writing header"
],
[
"winrgb8.bmp", 1,
"cannot write bmp header: limit reached",
"8-bit, writing header"
],
[
"winrgb24.bmp", 1,
"cannot write bmp header: limit reached",
"24-bit, writing header"
],
[
"winrgb2.bmp", 0x38,
"cannot write palette entry: limit reached",
"1-bit, writing palette"
],
[
"winrgb4.bmp", 0x38,
"cannot write palette entry: limit reached",
"4-bit, writing palette"
],
[
"winrgb8.bmp", 0x38,
"cannot write palette entry: limit reached",
"8-bit, writing palette"
],
[
"winrgb2.bmp", 0x40,
"writing 1 bit/pixel packed data: limit reached",
"1-bit, writing image data"
],
[
"winrgb4.bmp", 0x80,
"writing 4 bit/pixel packed data: limit reached",
"4-bit, writing image data"
],
[
"winrgb8.bmp", 0x440,
"writing 8 bit/pixel packed data: limit reached",
"8-bit, writing image data"
],
[
"winrgb24.bmp", 0x39,
"writing image data: limit reached",
"24-bit, writing image data"
],
);
print "# write failure tests\n";
my $test_index = 0;
for my $test (@tests) {
my ($file, $limit, $error, $desc) = @$test;
my $im = Imager->new;
$im->read(file => "testimg/$file")
or die "Cannot read $file: ", $im->errstr;
my $io = Imager::io_new_cb(limited_write($limit), undef, undef, undef, 1);
$io->set_buffered(0);
print "# writing with limit of $limit\n";
ok(!$im->write(type => 'bmp', io => $io),
"$test_index - $desc: write should fail");
is($im->errstr, $error, "$test_index - $desc: check error message");
++$test_index;
}
}
{
ok(grep($_ eq 'bmp', Imager->read_types), "check bmp in read types");
ok(grep($_ eq 'bmp', Imager->write_types), "check bmp in write types");
}
{
# RT #30075
# give 4/2 channel images a background color when saving to BMP
my $im = Imager->new(xsize=>16, ysize=>16, channels=>4);
$im->box(filled => 1, xmin => 8, color => '#FFE0C0');
$im->box(filled => 1, color => NC(0, 192, 192, 128),
ymin => 8, xmax => 7);
ok($im->write(file=>"testout/t107_alpha.bmp", type=>'bmp'),
"should succeed writing 4 channel image");
push @files, "t107_alpha.bmp";
my $imread = Imager->new;
ok($imread->read(file => 'testout/t107_alpha.bmp'), "read it back");
is_color3($imread->getpixel('x' => 0, 'y' => 0), 0, 0, 0,
"check transparent became black");
is_color3($imread->getpixel('x' => 8, 'y' => 0), 255, 224, 192,
"check color came through");
is_color3($imread->getpixel('x' => 0, 'y' => 15), 0, 96, 96,
"check translucent came through");
my $data;
ok($im->write(data => \$data, type => 'bmp', i_background => '#FF0000'),
"write with red background");
ok($imread->read(data => $data, type => 'bmp'),
"read it back");
is_color3($imread->getpixel('x' => 0, 'y' => 0), 255, 0, 0,
"check transparent became red");
is_color3($imread->getpixel('x' => 8, 'y' => 0), 255, 224, 192,
"check color came through");
is_color3($imread->getpixel('x' => 0, 'y' => 15), 127, 96, 96,
"check translucent came through");
}
{ # RT 41406
my $data;
my $im = test_image();
ok($im->write(data => \$data, type => 'bmp'), "write using OO");
my $size = unpack("V", substr($data, 34, 4));
is($size, 67800, "check data size");
}
{ # check close failures are handled correctly
my $im = test_image();
my $fail_close = sub {
Imager::i_push_error(0, "synthetic close failure");
return 0;
};
ok(!$im->write(type => "bmp", callback => sub { 1 },
closecb => $fail_close),
"check failing close fails");
like($im->errstr, qr/synthetic close failure/,
"check error message");
}
Imager->close_log;
unless ($ENV{IMAGER_KEEP_FILES}) {
unlink map "testout/$_", @files;
unlink "testout/t107bmp.log";
}
sub write_test {
my ($im, $filename) = @_;
local *FH;
if (open FH, "> $filename") {
binmode FH;
my $IO = Imager::io_new_fd(fileno(FH));
unless (ok(Imager::i_writebmp_wiol($im, $IO), $filename)) {
print "# ",Imager->_error_as_msg(),"\n";
}
undef $IO;
close FH;
}
else {
fail("could not open $filename: $!");
}
}
sub read_test {
my ($filename, $im, %tags) = @_;
local *FH;
print "# read_test: $filename\n";
$tags{i_format} = "bmp";
if (open FH, "< $filename") {
binmode FH;
my $IO = Imager::io_new_fd(fileno(FH));
my $im_read = Imager::i_readbmp_wiol($IO);
if ($im_read) {
my $diff = i_img_diff($im, $im_read);
if ($diff > $base_diff) {
fail("image mismatch reading $filename");
}
else {
my $tags_ok = 1;
for my $tag (keys %tags) {
if (my $index = Imager::i_tags_find($im_read, $tag, 0)) {
my ($name, $value) = Imager::i_tags_get($im_read, $index);
my $exp_value = $tags{$tag};
print "# tag $name = '$value' - expect '$exp_value'\n";
if ($exp_value =~ /\d/) {
if ($value != $tags{$tag}) {
print "# tag $tag value mismatch $tags{$tag} != $value\n";
$tags_ok = 0;
}
}
else {
if ($value ne $tags{$tag}) {
print "# tag $tag value mismatch $tags{$tag} != $value\n";
$tags_ok = 0;
}
}
}
}
ok($tags_ok, "reading $filename");
# for my $i (0 .. Imager::i_tags_count($im_read)-1) {
# my ($name, $value) = Imager::i_tags_get($im_read, $i);
# print "# tag '$name' => '$value'\n";
#}
}
}
else {
fail("could not read $filename: ".Imager->_error_as_msg());
}
undef $IO;
close FH;
}
else {
fail("could not open $filename: $!");
}
}
sub limited_write {
my ($limit) = @_;
return
sub {
my ($data) = @_;
$limit -= length $data;
if ($limit >= 0) {
print "# write of ", length $data, " bytes successful ($limit left)\n" if $debug_writes;
return 1;
}
else {
print "# write of ", length $data, " bytes failed\n";
Imager::i_push_error(0, "limit reached");
return;
}
};
}
sub load_patched_file {
my ($filename, $patches) = @_;
open IMDATA, "< $filename"
or die "Cannot open $filename: $!";
binmode IMDATA;
my $data = do { local $/; <IMDATA> };
for my $offset (keys %$patches) {
(my $hdata = $patches->{$offset}) =~ tr/ //d;
my $pdata = pack("H*", $hdata);
substr($data, $offset, length $pdata) = $pdata;
}
return $data;
}