a86d3262026518cc728b4e0e905a6efe2d2d9010
[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   return unpack ( "%8C*", ${$self->{data}} );
353 }
354
355 =pod
356
357 =item C<< fix_checksum () >>
358
359 Fix the byte checksum of the ROM.
360
361 =cut
362
363 sub fix_checksum {
364   my $hash = shift;
365   my $self = tied(%$hash);
366
367   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
368 }
369
370 ##############################################################################
371 #
372 # Option::ROM::PCI
373 #
374 ##############################################################################
375
376 package Option::ROM::PCI;
377
378 use strict;
379 use warnings;
380 use Carp;
381 use bytes;
382
383 sub new {
384   my $class = shift;
385   my $data = shift;
386   my $offset = shift;
387
388   my $hash = {};
389   tie %$hash, "Option::ROM::Fields", {
390     data => $data,
391     offset => $offset,
392     length => 0x0c,
393     fields => {
394       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
395       vendor_id =>      { offset => 0x04, length => 0x02, pack => "S" },
396       device_id =>      { offset => 0x06, length => 0x02, pack => "S" },
397       device_list =>    { offset => 0x08, length => 0x02, pack => "S" },
398       struct_length =>  { offset => 0x0a, length => 0x02, pack => "S" },
399       struct_revision =>{ offset => 0x0c, length => 0x01, pack => "C" },
400       base_class =>     { offset => 0x0d, length => 0x01, pack => "C" },
401       sub_class =>      { offset => 0x0e, length => 0x01, pack => "C" },
402       prog_intf =>      { offset => 0x0f, length => 0x01, pack => "C" },
403       image_length =>   { offset => 0x10, length => 0x02, pack => "S" },
404       revision =>       { offset => 0x12, length => 0x02, pack => "S" },
405       code_type =>      { offset => 0x14, length => 0x01, pack => "C" },
406       last_image =>     { offset => 0x15, length => 0x01, pack => "C" },
407       runtime_length => { offset => 0x16, length => 0x02, pack => "S" },
408       conf_header =>    { offset => 0x18, length => 0x02, pack => "S" },
409       clp_entry =>      { offset => 0x1a, length => 0x02, pack => "S" },
410     },
411   };
412   bless $hash, $class;
413
414   # Retrieve true length of structure
415   my $self = tied ( %$hash );
416   $self->{length} = $hash->{struct_length};
417
418   return $hash;  
419 }
420
421 ##############################################################################
422 #
423 # Option::ROM::PnP
424 #
425 ##############################################################################
426
427 package Option::ROM::PnP;
428
429 use strict;
430 use warnings;
431 use Carp;
432 use bytes;
433
434 sub new {
435   my $class = shift;
436   my $data = shift;
437   my $offset = shift;
438
439   my $hash = {};
440   tie %$hash, "Option::ROM::Fields", {
441     data => $data,
442     offset => $offset,
443     length => 0x06,
444     fields => {
445       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
446       struct_revision =>{ offset => 0x04, length => 0x01, pack => "C" },
447       struct_length =>  { offset => 0x05, length => 0x01, pack => "C" },
448       checksum =>       { offset => 0x09, length => 0x01, pack => "C" },
449       manufacturer =>   { offset => 0x0e, length => 0x02, pack => "S" },
450       product =>        { offset => 0x10, length => 0x02, pack => "S" },
451       bcv =>            { offset => 0x16, length => 0x02, pack => "S" },
452       bdv =>            { offset => 0x18, length => 0x02, pack => "S" },
453       bev =>            { offset => 0x1a, length => 0x02, pack => "S" },
454     },
455   };
456   bless $hash, $class;
457
458   # Retrieve true length of structure
459   my $self = tied ( %$hash );
460   $self->{length} = ( $hash->{struct_length} * 16 );
461
462   return $hash;  
463 }
464
465 sub checksum {
466   my $hash = shift;
467   my $self = tied(%$hash);
468
469   return $self->checksum();
470 }
471
472 sub fix_checksum {
473   my $hash = shift;
474   my $self = tied(%$hash);
475
476   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
477 }
478
479 sub manufacturer {
480   my $hash = shift;
481   my $self = tied(%$hash);
482
483   my $manufacturer = $hash->{manufacturer};
484   return undef unless $manufacturer;
485
486   my $raw = substr ( ${$self->{data}}, $manufacturer );
487   return unpack ( "Z*", $raw );
488 }
489
490 sub product {
491   my $hash = shift;
492   my $self = tied(%$hash);
493
494   my $product = $hash->{product};
495   return undef unless $product;
496
497   my $raw = substr ( ${$self->{data}}, $product );
498   return unpack ( "Z*", $raw );
499 }
500
501 1;