diff options
Diffstat (limited to 'contrib/award_plugin_roms/award_plugin_roms.pl')
| -rwxr-xr-x | contrib/award_plugin_roms/award_plugin_roms.pl | 341 |
1 files changed, 341 insertions, 0 deletions
diff --git a/contrib/award_plugin_roms/award_plugin_roms.pl b/contrib/award_plugin_roms/award_plugin_roms.pl new file mode 100755 index 00000000..2b95eed1 --- /dev/null +++ b/contrib/award_plugin_roms/award_plugin_roms.pl @@ -0,0 +1,341 @@ +#!/usr/bin/perl -w +use strict; +use FileHandle; +use integer; + +sub unsigned_little_endian_to_value +{ + # Assumes the data is initially little endian + my ($buffer) = @_; + my $bytes = length($buffer); + my $value = 0; + my $i; + for($i = $bytes -1; $i >= 0; $i--) { + my $byte = unpack('C', substr($buffer, $i, 1)); + $value = ($value * 256) + $byte; + } + return $value; +} + +sub decode_fixed_string +{ + my ($data, $bytes) = @_; + return $data; +} + +sub decode_pstring +{ + my ($buf_ref, $offset_ref) = @_; + # Decode a pascal string + my $offset = ${$offset_ref}; + my $len = unpack('C',substr(${$buf_ref}, $offset, 1)); + my $data = substr(${$buf_ref}, $offset +1, $len); + ${$offset_ref} = $offset + $len +1; + return $data; +} + +sub decode_cstring +{ + # Decode a c string + my ($buf_ref, $offset_ref) = @_; + my ($data, $byte); + my $index = ${$offset_ref}; + while(1) { + $byte = substr(${$buf_ref}, $index, 1); + if (!defined($byte) || ($byte eq "\0")) { + last; + } + $data .= $byte; + $index++; + } + ${$offset_ref} = $index; + return $data; +} + +sub type_size +{ + my ($entry) = @_; + my %type_length = ( + byte => 1, + half => 2, + word => 4, + xword => 8, + 'fixed-string' => $entry->[2], + pstring => 0, + cstring => 0, + ); + my $type = $entry->[0]; + if (!exists($type_length{$type})) { + die "unknown type $type"; + } + my $length = $type_length{$type}; + return $length; +} + +sub decode_fixed_type +{ + my ($type, $data, $bytes) = @_; + my %decoders = ( + 'byte' => \&unsigned_little_endian_to_value, + 'half' => \&unsigned_little_endian_to_value, + 'word' => \&unsigned_little_endian_to_value, + 'xword' => \&unsigned_little_endian_to_value, + 'fixed-string' => \&decode_fixed_string, + ); + my $decoder = $decoders{$type} or die "unknow fixed type $type"; + return $decoder->($data, $bytes); +} + +sub decode_variable_type +{ + my ($type, $buf_ref, $offset_ref) = @_; + my %decoders = ( + 'pstring' => \&decode_pstring, + 'cstring' => \&decode_cstring, + ); + my $decoder = $decoders{$type} or die "unknow variable type $type"; + return $decoder->($buf_ref, $offset_ref); +} + +sub decode_struct +{ + my ($buf_ref, $offset, $layout) = @_; + my $initial_offset = $offset; + my ($entry, %results); + foreach $entry (@$layout) { + my ($type, $name) = @$entry; + my $bytes = type_size($entry); + if ($bytes > 0) { + my $data = substr(${$buf_ref}, $offset, $bytes); + $results{$name} = decode_fixed_type($type, $data, $bytes); + $offset += $bytes; + } else { + $results{$name} = decode_variable_type($type, $buf_ref, \$offset); + } + } + return (\%results, $offset - $initial_offset); +} + +sub print_big_hex +{ + my ($min_digits, $value) = @_; + my @digits; + while($min_digits > 0 || ($value > 0)) { + my $digit = $value%16; + $value /= 16; + unshift(@digits, $digit); + $min_digits--; + } + my $digit; + foreach $digit (@digits) { + printf("%01x", $digit); + } +} + + + +my %lha_signatures = ( + '-com-' => 1, + '-lhd-' => 1, + '-lh0-' => 1, + '-lh1-' => 1, + '-lh2-' => 1, + '-lh3-' => 1, + '-lh4-' => 1, + '-lh5-' => 1, + '-lzs-' => 1, + '-lz4-' => 1, + '-lz5-' => 1, + '-afx-' => 1, + '-lzf-' => 1, +); + +my %lha_os = ( + 'M' => 'MS-DOS', + '2' => 'OS/2', + '9' => 'OS9', + 'K' => 'OS/68K', + '3' => 'OS/386', + 'H' => 'HUMAN', + 'U' => 'UNIX', + 'C' => 'CP/M', + 'F' => 'FLEX', + 'm' => 'Mac', + 'R' => 'Runser', + 'T' => 'TownOS', + 'X' => 'XOSK', + 'A' => 'Amiga', + 'a' => 'atari', + ' ' => 'Award ROM', +); + + +my @lha_level_1_header = ( + [ 'byte', 'header_size' ], # 1 + [ 'byte', 'header_sum', ], # 2 + [ 'fixed-string', 'method_id', 5 ], # 7 + [ 'word', 'skip_size', ], # 11 + [ 'word', 'original_size' ], # 15 + [ 'half', 'dos_time' ], # 17 + [ 'half', 'dos_date' ], # 19 + [ 'byte', 'fixed' ], # 20 + [ 'byte', 'level' ], # 21 + [ 'pstring', 'filename' ], # 22 + [ 'half', 'crc' ], + [ 'fixed-string', 'os_id', 1 ], + [ 'half', 'ext_size' ], +); + +# General lha_header +my @lha_header = ( + [ 'byte', 'header_size' ], + [ 'byte', 'header_sum', ], + [ 'fixed-string', 'method_id', 5 ], + [ 'word', 'skip_size', ], + [ 'word', 'original_size' ], + [ 'half', 'dos_time' ], + [ 'half', 'dos_date' ], + [ 'half', 'rom_addr' ], + [ 'half', 'rom_flags' ], + [ 'byte', 'fixed' ], + [ 'byte', 'level' ], + [ 'pstring', 'filename' ], + [ 'half', 'crc' ], + [ 'lha_os', 'os_id', 1 ], + [ 'half', 'ext_size' ], + [ 'byte', 'zero' ], + [ 'byte', 'total_checksum' ], + [ 'half', 'total_size' ], +); + +sub print_struct +{ + my ($layout, $self) = @_; + my $entry; + my $width = 0; + foreach $entry(@$layout) { + my ($type, $name) = @$entry; + if (length($name) > $width) { + $width = length($name); + } + } + foreach $entry (@$layout) { + my ($type, $name) = @$entry; + printf("%*s = ", $width, $name); + my $value = $self->{$name}; + if (!defined($value)) { + print "undefined"; + } + elsif ($type eq "lha_os") { + print "$lha_os{$value}"; + } + elsif ($type =~ m/string/) { + print "$value"; + } + else { + my $len = type_size($entry); + print "0x"; + print_big_hex($len *2, $value); + } + print "\n"; + } +} + +sub checksum +{ + my ($buf_ref, $offset, $length) = @_; + my ($i, $sum); + $sum = 0; + for($i = 0; $i < $length; $i++) { + my $byte = unpack('C', substr($$buf_ref, $offset + $i, 1)); + $sum = ($sum + $byte) %256; + } + return $sum; +} + +sub decode_lha_header +{ + my ($buf_ref, $offset) = @_; + my $level = unpack('C',substr(${$buf_ref}, $offset + 20, 1)); + + my %self; + my ($struct, $bytes); + if ($level == 1) { + ($struct, $bytes) + = decode_struct($buf_ref, $offset, \@lha_level_1_header); + %self = %$struct; + if ($self{fixed} != 0x20) { + die "bad fixed value"; + } + $self{total_size} = $self{header_size} + 2 + $self{skip_size}; + if ($bytes != $self{header_size} +2) { + die "$bytes != $self{header_size} +2"; + } + my $checksum = checksum($buf_ref, $offset +2, $self{header_size}); + if ($checksum != $self{header_sum}) { + printf("WARN: Header bytes checksum to %02lx\n", + $checksum); + } + # If we are an award rom... + if ($self{os_id} eq ' ') { + @self{qw(zero total_checksum)} = + unpack('CC', substr($$buf_ref, + $offset + $self{total_size}, 2)); + if ($self{zero} != 0) { + warn "Award ROM without trailing zero"; + } + else { + $self{total_size}++; + } + my $checksum = + checksum($buf_ref, $offset, $self{total_size}); + if ($self{total_checksum} != $checksum) { + printf("WARN: Image bytes checksum to %02lx\n", + $checksum); + } + else { + $self{total_size}++; + } + $self{rom_addr} = $self{dos_time}; + $self{rom_flags} = $self{dos_date}; + delete @self{qw(dos_time dos_date)}; + } + } + else { + die "Unknown header type"; + } + return \%self; +} + +sub main +{ + my ($filename, $rom_length) = @_; + my $fd = new FileHandle; + if (!defined($rom_length)) { + my ($dev, $ino, $mode, $nlink, $uid, $gid,$rdev,$size, + $atime, $mtime, $ctime, $blksize, $blocks) + = stat($filename); + $rom_length = $size; + } + $fd->open("<$filename") or die "Cannot ope $filename"; + my $data; + $fd->read($data, $rom_length); + $fd->close(); + + my $i; + for($i = 0; $i < $rom_length; $i++) { + my $sig = substr($data, $i, 5); + if (exists($lha_signatures{$sig})) { + my $start = $i -2; + my $header = decode_lha_header(\$data, $start); + + my $length = $header->{total_size}; + print "AT: $start - @{[$start + $length -1]}, $length bytes\n"; + print_struct(\@lha_header, $header); + print "\n"; + + } + } +} + +main(@ARGV); |