[romprefix] Add .mrom format, allowing loading of large ROMs
[people/peper/gpxe.git] / src / util / Option / ROM.pm
1 package Option::ROM;
2
3 # Copyright (C) 2008 Michael Brown <mbrown@fensystems.co.uk>.
4 #
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License as
7 # published by the Free Software Foundation; either version 2 of the
8 # License, or any later version.
9 #
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13 # General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18
19 =head1 NAME
20
21 Option::ROM - Option ROM manipulation
22
23 =head1 SYNOPSIS
24
25     use Option::ROM;
26
27     # Load a ROM image
28     my $rom = new Option::ROM;
29     $rom->load ( "rtl8139.rom" );
30
31     # Modify the PCI device ID
32     $rom->pci_header->{device_id} = 0x1234;
33     $rom->fix_checksum();
34
35     # Write ROM image out to a new file
36     $rom->save ( "rtl8139-modified.rom" );
37
38 =head1 DESCRIPTION
39
40 C<Option::ROM> provides a mechanism for manipulating Option ROM
41 images.
42
43 =head1 METHODS
44
45 =cut
46
47 ##############################################################################
48 #
49 # Option::ROM::Fields
50 #
51 ##############################################################################
52
53 package Option::ROM::Fields;
54
55 use strict;
56 use warnings;
57 use Carp;
58 use bytes;
59
60 sub TIEHASH {
61   my $class = shift;
62   my $self = shift;
63
64   bless $self, $class;
65   return $self;
66 }
67
68 sub FETCH {
69   my $self = shift;
70   my $key = shift;
71
72   return undef unless $self->EXISTS ( $key );
73   my $raw = substr ( ${$self->{data}},
74                      ( $self->{offset} + $self->{fields}->{$key}->{offset} ),
75                      $self->{fields}->{$key}->{length} );
76   my $unpack = ( ref $self->{fields}->{$key}->{unpack} ?
77                  $self->{fields}->{$key}->{unpack} :
78                  sub { unpack ( $self->{fields}->{$key}->{pack}, shift ); } );
79   return &$unpack ( $raw );
80 }
81
82 sub STORE {
83   my $self = shift;
84   my $key = shift;
85   my $value = shift;
86
87   croak "Nonexistent field \"$key\"" unless $self->EXISTS ( $key );
88   my $pack = ( ref $self->{fields}->{$key}->{pack} ?
89                $self->{fields}->{$key}->{pack} :
90                sub { pack ( $self->{fields}->{$key}->{pack}, shift ); } );
91   my $raw = &$pack ( $value );
92   substr ( ${$self->{data}},
93            ( $self->{offset} + $self->{fields}->{$key}->{offset} ),
94            $self->{fields}->{$key}->{length} ) = $raw;
95 }
96
97 sub DELETE {
98   my $self = shift;
99   my $key = shift;
100
101   $self->STORE ( $key, 0 );
102 }
103
104 sub CLEAR {
105   my $self = shift;
106
107   foreach my $key ( keys %{$self->{fields}} ) {
108     $self->DELETE ( $key );
109   }
110 }
111
112 sub EXISTS {
113   my $self = shift;
114   my $key = shift;
115
116   return ( exists $self->{fields}->{$key} &&
117            ( ( $self->{fields}->{$key}->{offset} +
118                $self->{fields}->{$key}->{length} ) <= $self->{length} ) );
119 }
120
121 sub FIRSTKEY {
122   my $self = shift;
123
124   keys %{$self->{fields}};
125   return each %{$self->{fields}};
126 }
127
128 sub NEXTKEY {
129   my $self = shift;
130   my $lastkey = shift;
131
132   return each %{$self->{fields}};
133 }
134
135 sub SCALAR {
136   my $self = shift;
137
138   return 1;
139 }
140
141 sub UNTIE {
142   my $self = shift;
143 }
144
145 sub DESTROY {
146   my $self = shift;
147 }
148
149 sub checksum {
150   my $self = shift;
151
152   my $raw = substr ( ${$self->{data}}, $self->{offset}, $self->{length} );
153   return unpack ( "%8C*", $raw );
154 }
155
156 ##############################################################################
157 #
158 # Option::ROM
159 #
160 ##############################################################################
161
162 package Option::ROM;
163
164 use strict;
165 use warnings;
166 use Carp;
167 use bytes;
168 use Exporter 'import';
169
170 use constant ROM_SIGNATURE => 0xaa55;
171 use constant PCI_SIGNATURE => 'PCIR';
172 use constant PNP_SIGNATURE => '$PnP';
173
174 our @EXPORT_OK = qw ( ROM_SIGNATURE PCI_SIGNATURE PNP_SIGNATURE );
175 our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
176
177 use constant JMP_SHORT => 0xeb;
178 use constant JMP_NEAR => 0xe9;
179
180 sub pack_init {
181   my $dest = shift;
182
183   # Always create a near jump; it's simpler
184   if ( $dest ) {
185     return pack ( "CS", JMP_NEAR, ( $dest - 6 ) );
186   } else {
187     return pack ( "CS", 0, 0 );
188   }
189 }
190
191 sub unpack_init {
192   my $instr = shift;
193
194   # Accept both short and near jumps
195   my $jump = unpack ( "C", $instr );
196   if ( $jump == JMP_SHORT ) {
197     my $offset = unpack ( "xC", $instr );
198     return ( $offset + 5 );
199   } elsif ( $jump == JMP_NEAR ) {
200     my $offset = unpack ( "xS", $instr );
201     return ( $offset + 6 );
202   } elsif ( $jump == 0 ) {
203     return 0;
204   } else {
205     croak "Unrecognised jump instruction in init vector\n";
206   }
207 }
208
209 =pod
210
211 =item C<< new () >>
212
213 Construct a new C<Option::ROM> object.
214
215 =cut
216
217 sub new {
218   my $class = shift;
219
220   my $hash = {};
221   tie %$hash, "Option::ROM::Fields", {
222     data => undef,
223     offset => 0x00,
224     length => 0x20,
225     fields => {
226       signature =>      { offset => 0x00, length => 0x02, pack => "S" },
227       length =>         { offset => 0x02, length => 0x01, pack => "C" },
228       # "init" is part of a jump instruction
229       init =>           { offset => 0x03, length => 0x03,
230                           pack => \&pack_init, unpack => \&unpack_init },
231       checksum =>       { offset => 0x06, length => 0x01, pack => "C" },
232       bofm_header =>    { offset => 0x14, length => 0x02, pack => "S" },
233       undi_header =>    { offset => 0x16, length => 0x02, pack => "S" },
234       pci_header =>     { offset => 0x18, length => 0x02, pack => "S" },
235       pnp_header =>     { offset => 0x1a, length => 0x02, pack => "S" },
236     },
237   };
238   bless $hash, $class;
239   return $hash;
240 }
241
242 =pod
243
244 =item C<< load ( $filename ) >>
245
246 Load option ROM contents from the file C<$filename>.
247
248 =cut
249
250 sub load {
251   my $hash = shift;
252   my $self = tied(%$hash);
253   my $filename = shift;
254
255   $self->{filename} = $filename;
256
257   open my $fh, "<$filename"
258       or croak "Cannot open $filename for reading: $!";
259   read $fh, my $data, ( 128 * 1024 ); # 128kB is theoretical max size
260   $self->{data} = \$data;
261   close $fh;
262 }
263
264 =pod
265
266 =item C<< save ( [ $filename ] ) >>
267
268 Write the ROM data back out to the file C<$filename>.  If C<$filename>
269 is omitted, the file used in the call to C<load()> will be used.
270
271 =cut
272
273 sub save {
274   my $hash = shift;
275   my $self = tied(%$hash);
276   my $filename = shift;
277
278   $filename ||= $self->{filename};
279
280   open my $fh, ">$filename"
281       or croak "Cannot open $filename for writing: $!";
282   print $fh ${$self->{data}};
283   close $fh;
284 }
285
286 =pod
287
288 =item C<< length () >>
289
290 Length of option ROM data.  This is the length of the file, not the
291 length from the ROM header length field.
292
293 =cut
294
295 sub length {
296   my $hash = shift;
297   my $self = tied(%$hash);
298
299   return length ${$self->{data}};
300 }
301
302 =pod
303
304 =item C<< pci_header () >>
305
306 Return a C<Option::ROM::PCI> object representing the ROM's PCI header,
307 if present.
308
309 =cut
310
311 sub pci_header {
312   my $hash = shift;
313   my $self = tied(%$hash);
314
315   my $offset = $hash->{pci_header};
316   return undef unless $offset != 0;
317
318   return Option::ROM::PCI->new ( $self->{data}, $offset );
319 }
320
321 =pod
322
323 =item C<< pnp_header () >>
324
325 Return a C<Option::ROM::PnP> object representing the ROM's PnP header,
326 if present.
327
328 =cut
329
330 sub pnp_header {
331   my $hash = shift;
332   my $self = tied(%$hash);
333
334   my $offset = $hash->{pnp_header};
335   return undef unless $offset != 0;
336
337   return Option::ROM::PnP->new ( $self->{data}, $offset );
338 }
339
340 =pod
341
342 =item C<< checksum () >>
343
344 Calculate the byte checksum of the ROM.
345
346 =cut
347
348 sub checksum {
349   my $hash = shift;
350   my $self = tied(%$hash);
351
352   my $raw = substr ( ${$self->{data}}, 0, ( $hash->{length} * 512 ) );
353   return unpack ( "%8C*", $raw );
354 }
355
356 =pod
357
358 =item C<< fix_checksum () >>
359
360 Fix the byte checksum of the ROM.
361
362 =cut
363
364 sub fix_checksum {
365   my $hash = shift;
366   my $self = tied(%$hash);
367
368   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
369 }
370
371 ##############################################################################
372 #
373 # Option::ROM::PCI
374 #
375 ##############################################################################
376
377 package Option::ROM::PCI;
378
379 use strict;
380 use warnings;
381 use Carp;
382 use bytes;
383
384 sub new {
385   my $class = shift;
386   my $data = shift;
387   my $offset = shift;
388
389   my $hash = {};
390   tie %$hash, "Option::ROM::Fields", {
391     data => $data,
392     offset => $offset,
393     length => 0x0c,
394     fields => {
395       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
396       vendor_id =>      { offset => 0x04, length => 0x02, pack => "S" },
397       device_id =>      { offset => 0x06, length => 0x02, pack => "S" },
398       device_list =>    { offset => 0x08, length => 0x02, pack => "S" },
399       struct_length =>  { offset => 0x0a, length => 0x02, pack => "S" },
400       struct_revision =>{ offset => 0x0c, length => 0x01, pack => "C" },
401       base_class =>     { offset => 0x0d, length => 0x01, pack => "C" },
402       sub_class =>      { offset => 0x0e, length => 0x01, pack => "C" },
403       prog_intf =>      { offset => 0x0f, length => 0x01, pack => "C" },
404       image_length =>   { offset => 0x10, length => 0x02, pack => "S" },
405       revision =>       { offset => 0x12, length => 0x02, pack => "S" },
406       code_type =>      { offset => 0x14, length => 0x01, pack => "C" },
407       last_image =>     { offset => 0x15, length => 0x01, pack => "C" },
408       runtime_length => { offset => 0x16, length => 0x02, pack => "S" },
409       conf_header =>    { offset => 0x18, length => 0x02, pack => "S" },
410       clp_entry =>      { offset => 0x1a, length => 0x02, pack => "S" },
411     },
412   };
413   bless $hash, $class;
414
415   # Retrieve true length of structure
416   my $self = tied ( %$hash );
417   $self->{length} = $hash->{struct_length};
418
419   return $hash;  
420 }
421
422 ##############################################################################
423 #
424 # Option::ROM::PnP
425 #
426 ##############################################################################
427
428 package Option::ROM::PnP;
429
430 use strict;
431 use warnings;
432 use Carp;
433 use bytes;
434
435 sub new {
436   my $class = shift;
437   my $data = shift;
438   my $offset = shift;
439
440   my $hash = {};
441   tie %$hash, "Option::ROM::Fields", {
442     data => $data,
443     offset => $offset,
444     length => 0x06,
445     fields => {
446       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
447       struct_revision =>{ offset => 0x04, length => 0x01, pack => "C" },
448       struct_length =>  { offset => 0x05, length => 0x01, pack => "C" },
449       checksum =>       { offset => 0x09, length => 0x01, pack => "C" },
450       manufacturer =>   { offset => 0x0e, length => 0x02, pack => "S" },
451       product =>        { offset => 0x10, length => 0x02, pack => "S" },
452       bcv =>            { offset => 0x16, length => 0x02, pack => "S" },
453       bdv =>            { offset => 0x18, length => 0x02, pack => "S" },
454       bev =>            { offset => 0x1a, length => 0x02, pack => "S" },
455     },
456   };
457   bless $hash, $class;
458
459   # Retrieve true length of structure
460   my $self = tied ( %$hash );
461   $self->{length} = ( $hash->{struct_length} * 16 );
462
463   return $hash;  
464 }
465
466 sub checksum {
467   my $hash = shift;
468   my $self = tied(%$hash);
469
470   return $self->checksum();
471 }
472
473 sub fix_checksum {
474   my $hash = shift;
475   my $self = tied(%$hash);
476
477   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
478 }
479
480 sub manufacturer {
481   my $hash = shift;
482   my $self = tied(%$hash);
483
484   my $manufacturer = $hash->{manufacturer};
485   return undef unless $manufacturer;
486
487   my $raw = substr ( ${$self->{data}}, $manufacturer );
488   return unpack ( "Z*", $raw );
489 }
490
491 sub product {
492   my $hash = shift;
493   my $self = tied(%$hash);
494
495   my $product = $hash->{product};
496   return undef unless $product;
497
498   my $raw = substr ( ${$self->{data}}, $product );
499   return unpack ( "Z*", $raw );
500 }
501
502 1;