Initial revision
[etherboot.git] / contrib / award_plugin_roms / award_plugin_roms.pl
1 #!/usr/bin/perl -w
2 use strict;
3 use FileHandle;
4 use integer;
5
6 sub unsigned_little_endian_to_value
7 {
8         # Assumes the data is initially little endian
9         my ($buffer) = @_;
10         my $bytes = length($buffer);
11         my $value = 0;
12         my $i;
13         for($i = $bytes -1; $i >= 0; $i--) {
14                 my $byte = unpack('C', substr($buffer, $i, 1));
15                 $value = ($value * 256) + $byte;
16         }
17         return $value;
18 }
19
20 sub decode_fixed_string
21 {
22         my ($data, $bytes) = @_;
23         return $data;
24 }
25
26 sub decode_pstring
27 {
28         my ($buf_ref, $offset_ref) = @_;
29         # Decode a pascal string
30         my $offset = ${$offset_ref};
31         my $len = unpack('C',substr(${$buf_ref}, $offset, 1));
32         my $data = substr(${$buf_ref}, $offset +1,  $len);
33         ${$offset_ref} = $offset + $len +1;
34         return $data;
35 }
36
37 sub decode_cstring
38 {
39         # Decode a c string
40         my ($buf_ref, $offset_ref) = @_;
41         my ($data, $byte);
42         my $index = ${$offset_ref};
43         while(1) {
44                 $byte = substr(${$buf_ref}, $index, 1);
45                 if (!defined($byte) || ($byte eq "\0")) {
46                         last;
47                 }
48                 $data .= $byte;
49                 $index++;
50         }
51         ${$offset_ref} = $index;
52         return $data;
53 }
54
55 sub type_size
56 {
57         my ($entry) = @_;
58         my %type_length = (
59                 byte => 1,
60                 half => 2,
61                 word => 4,
62                 xword => 8,
63                 'fixed-string' => $entry->[2],
64                 pstring => 0,
65                 cstring => 0,
66         );
67         my $type = $entry->[0];
68         if (!exists($type_length{$type})) {
69                  die "unknown type $type";
70          }
71         my $length = $type_length{$type};
72         return $length;
73 }
74
75 sub decode_fixed_type
76 {
77         my ($type, $data, $bytes) = @_;
78         my %decoders = (
79                 'byte' => \&unsigned_little_endian_to_value,
80                 'half' => \&unsigned_little_endian_to_value,
81                 'word' => \&unsigned_little_endian_to_value,
82                 'xword' => \&unsigned_little_endian_to_value,
83                 'fixed-string' => \&decode_fixed_string,
84         );
85         my $decoder = $decoders{$type} or die "unknow fixed type $type";
86         return $decoder->($data, $bytes);
87 }
88
89 sub decode_variable_type
90 {
91         my ($type, $buf_ref, $offset_ref) = @_;
92         my %decoders = (
93                 'pstring' => \&decode_pstring,
94                 'cstring' => \&decode_cstring,
95         );
96         my $decoder = $decoders{$type} or die "unknow variable type $type";
97         return $decoder->($buf_ref, $offset_ref);
98 }
99
100 sub decode_struct
101 {
102         my ($buf_ref, $offset, $layout) = @_;
103         my $initial_offset = $offset;
104         my ($entry, %results);
105         foreach $entry (@$layout) {
106                 my ($type, $name) = @$entry;
107                 my $bytes = type_size($entry);
108                 if ($bytes > 0) {
109                         my $data = substr(${$buf_ref}, $offset, $bytes);
110                         $results{$name} = decode_fixed_type($type, $data, $bytes);
111                         $offset += $bytes;
112                 } else {
113                         $results{$name} = decode_variable_type($type, $buf_ref, \$offset);
114                 }
115         }
116         return (\%results, $offset - $initial_offset);
117 }
118
119 sub print_big_hex
120 {
121         my ($min_digits, $value) = @_;
122         my @digits;
123         while($min_digits > 0 || ($value > 0)) {
124                 my $digit = $value%16;
125                 $value /= 16;
126                 unshift(@digits, $digit);
127                 $min_digits--;
128         }
129         my $digit;
130         foreach $digit (@digits) {
131                 printf("%01x", $digit);
132         }
133 }
134
135
136
137 my %lha_signatures = (
138         '-com-' => 1,   
139         '-lhd-' => 1,
140         '-lh0-' => 1,
141         '-lh1-' => 1,
142         '-lh2-' => 1,
143         '-lh3-' => 1,
144         '-lh4-' => 1,
145         '-lh5-' => 1,
146         '-lzs-' => 1,
147         '-lz4-' => 1,
148         '-lz5-' => 1,
149         '-afx-' => 1,
150         '-lzf-' => 1,
151 );
152
153 my %lha_os = (
154         'M' => 'MS-DOS',
155         '2' => 'OS/2',
156         '9' => 'OS9',
157         'K' => 'OS/68K',
158         '3' => 'OS/386',
159         'H' => 'HUMAN',
160         'U' => 'UNIX',
161         'C' => 'CP/M',
162         'F' => 'FLEX',
163         'm' => 'Mac',
164         'R' => 'Runser',
165         'T' => 'TownOS',
166         'X' => 'XOSK',
167         'A' => 'Amiga',
168         'a' => 'atari',
169         ' ' => 'Award ROM',
170 );
171
172
173 my @lha_level_1_header = (
174         [ 'byte',         'header_size' ],    # 1
175         [ 'byte',         'header_sum', ],    # 2
176         [ 'fixed-string', 'method_id', 5 ],   # 7
177         [ 'word',         'skip_size', ],     # 11
178         [ 'word',         'original_size' ],  # 15
179         [ 'half',         'dos_time' ],       # 17
180         [ 'half',         'dos_date' ],       # 19
181         [ 'byte',         'fixed'   ],        # 20
182         [ 'byte',         'level'   ],        # 21
183         [ 'pstring',      'filename' ],       # 22
184         [ 'half',         'crc' ],
185         [ 'fixed-string', 'os_id', 1 ],
186         [ 'half',         'ext_size' ],           
187 );
188
189 # General lha_header
190 my @lha_header = (
191         [ 'byte',         'header_size' ],
192         [ 'byte',         'header_sum', ],
193         [ 'fixed-string', 'method_id', 5 ],
194         [ 'word',         'skip_size', ],
195         [ 'word',         'original_size' ],
196         [ 'half',         'dos_time' ],
197         [ 'half',         'dos_date' ],
198         [ 'half',         'rom_addr' ],
199         [ 'half',         'rom_flags' ],
200         [ 'byte',         'fixed'   ],
201         [ 'byte',         'level'   ],
202         [ 'pstring',      'filename' ],
203         [ 'half',         'crc' ],
204         [ 'lha_os',       'os_id', 1 ],
205         [ 'half',         'ext_size' ],
206         [ 'byte',         'zero' ],
207         [ 'byte',         'total_checksum' ],
208         [ 'half',         'total_size' ],
209 );
210
211 sub print_struct
212 {
213         my ($layout, $self) = @_;
214         my $entry;
215         my $width = 0;
216         foreach $entry(@$layout) {
217                 my ($type, $name) = @$entry;
218                 if (length($name) > $width) {
219                         $width = length($name);
220                 }
221         }
222         foreach $entry (@$layout) {
223                 my ($type, $name) = @$entry;
224                 printf("%*s = ", $width, $name);
225                 my $value = $self->{$name};
226                 if (!defined($value)) {
227                         print "undefined";
228                 }
229                 elsif ($type eq "lha_os") {
230                         print "$lha_os{$value}";
231                 }
232                 elsif ($type =~ m/string/) {
233                         print "$value";
234                 } 
235                 else {
236                         my $len = type_size($entry);
237                         print "0x";
238                         print_big_hex($len *2, $value);
239                 }
240                 print "\n";
241         }
242 }
243
244 sub checksum
245 {
246         my ($buf_ref, $offset, $length) = @_;
247         my ($i, $sum);
248         $sum = 0;
249         for($i = 0; $i < $length; $i++) {
250                 my $byte = unpack('C', substr($$buf_ref, $offset + $i, 1));
251                 $sum = ($sum + $byte) %256;
252         }
253         return $sum;
254 }
255
256 sub decode_lha_header
257 {
258         my ($buf_ref, $offset) = @_;
259         my $level = unpack('C',substr(${$buf_ref}, $offset + 20, 1));
260
261         my %self;
262         my ($struct, $bytes);
263         if ($level == 1) {
264                 ($struct, $bytes) 
265                         = decode_struct($buf_ref, $offset, \@lha_level_1_header);
266                 %self = %$struct;
267                 if ($self{fixed} != 0x20) {
268                          die "bad fixed value";
269                 }
270                 $self{total_size} = $self{header_size} + 2 + $self{skip_size};
271                 if ($bytes != $self{header_size} +2) {
272                         die "$bytes != $self{header_size} +2";
273                 }
274                 my $checksum = checksum($buf_ref, $offset +2, $self{header_size});
275                 if ($checksum != $self{header_sum}) {
276                         printf("WARN: Header bytes checksum to %02lx\n", 
277                                      $checksum);
278                 }
279                 # If we are an award rom...
280                 if ($self{os_id} eq ' ') {
281                         @self{qw(zero total_checksum)} = 
282                             unpack('CC', substr($$buf_ref, 
283                                 $offset + $self{total_size}, 2));
284                         if ($self{zero} != 0) {
285                                 warn "Award ROM without trailing zero";
286                         }
287                         else {
288                                 $self{total_size}++;
289                         }
290                         my $checksum = 
291                                 checksum($buf_ref, $offset, $self{total_size});
292                         if ($self{total_checksum} != $checksum) {
293                                 printf("WARN: Image bytes checksum to %02lx\n", 
294                                         $checksum);
295                         }
296                         else {
297                                 $self{total_size}++;
298                         }
299                         $self{rom_addr} = $self{dos_time};
300                         $self{rom_flags} = $self{dos_date};
301                         delete @self{qw(dos_time dos_date)};
302                 }
303         }
304         else {
305                 die "Unknown header type";
306         }
307         return \%self;
308 }
309
310 sub main
311 {
312         my ($filename, $rom_length) = @_;
313         my $fd = new FileHandle;
314         if (!defined($rom_length)) {
315                 my ($dev, $ino, $mode, $nlink, $uid, $gid,$rdev,$size,
316                         $atime, $mtime, $ctime, $blksize, $blocks)
317                         = stat($filename);
318                 $rom_length = $size;
319         }
320         $fd->open("<$filename") or die "Cannot ope $filename";
321         my $data;
322         $fd->read($data, $rom_length);
323         $fd->close();
324         
325         my $i;
326         for($i = 0; $i < $rom_length; $i++) {
327                 my $sig = substr($data, $i, 5);
328                 if (exists($lha_signatures{$sig})) {
329                         my $start = $i -2;
330                         my $header = decode_lha_header(\$data, $start);
331                         
332                         my $length = $header->{total_size};
333                         print "AT:  $start - @{[$start + $length -1]},  $length bytes\n";
334                         print_struct(\@lha_header, $header);
335                         print "\n";
336
337                 }
338         }
339 }
340
341 main(@ARGV);