[util] Add Option::ROM library and rewrite disrom.pl to use it.
[people/mcb30/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   return unpack ( $self->{fields}->{$key}->{pack}, $raw );
77 }
78
79 sub STORE {
80   my $self = shift;
81   my $key = shift;
82   my $value = shift;
83
84   croak "Nonexistent field \"$key\"" unless $self->EXISTS ( $key );
85   my $raw = pack ( $self->{fields}->{$key}->{pack}, $value );
86   substr ( ${$self->{data}},
87            ( $self->{offset} + $self->{fields}->{$key}->{offset} ),
88            $self->{fields}->{$key}->{length} ) = $raw;
89 }
90
91 sub DELETE {
92   my $self = shift;
93   my $key = shift;
94
95   $self->STORE ( $key, 0 );
96 }
97
98 sub CLEAR {
99   my $self = shift;
100
101   foreach my $key ( keys %{$self->{fields}} ) {
102     $self->DELETE ( $key );
103   }
104 }
105
106 sub EXISTS {
107   my $self = shift;
108   my $key = shift;
109
110   return ( exists $self->{fields}->{$key} &&
111            ( ( $self->{fields}->{$key}->{offset} +
112                $self->{fields}->{$key}->{length} ) <= $self->{length} ) );
113 }
114
115 sub FIRSTKEY {
116   my $self = shift;
117
118   keys %{$self->{fields}};
119   return each %{$self->{fields}};
120 }
121
122 sub NEXTKEY {
123   my $self = shift;
124   my $lastkey = shift;
125
126   return each %{$self->{fields}};
127 }
128
129 sub SCALAR {
130   my $self = shift;
131
132   return 1;
133 }
134
135 sub UNTIE {
136   my $self = shift;
137 }
138
139 sub DESTROY {
140   my $self = shift;
141 }
142
143 sub checksum {
144   my $self = shift;
145
146   my $raw = substr ( ${$self->{data}}, $self->{offset}, $self->{length} );
147   return unpack ( "%8C*", $raw );
148 }
149
150 ##############################################################################
151 #
152 # Option::ROM
153 #
154 ##############################################################################
155
156 package Option::ROM;
157
158 use strict;
159 use warnings;
160 use Carp;
161 use bytes;
162 use Exporter 'import';
163
164 use constant ROM_SIGNATURE => 0xaa55;
165 use constant PCI_SIGNATURE => 'PCIR';
166 use constant PNP_SIGNATURE => '$PnP';
167
168 our @EXPORT_OK = qw ( ROM_SIGNATURE PCI_SIGNATURE PNP_SIGNATURE );
169 our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
170
171 =pod
172
173 =item C<< new () >>
174
175 Construct a new C<Option::ROM> object.
176
177 =cut
178
179 sub new {
180   my $class = shift;
181
182   my $hash = {};
183   tie %$hash, "Option::ROM::Fields", {
184     data => undef,
185     offset => 0x00,
186     length => 0x20,
187     fields => {
188       signature =>      { offset => 0x00, length => 0x02, pack => "S" },
189       length =>         { offset => 0x02, length => 0x01, pack => "C" },
190       checksum =>       { offset => 0x06, length => 0x01, pack => "C" },
191       undi_header =>    { offset => 0x16, length => 0x02, pack => "S" },
192       pci_header =>     { offset => 0x18, length => 0x02, pack => "S" },
193       pnp_header =>     { offset => 0x1a, length => 0x02, pack => "S" },
194     },
195   };
196   bless $hash, $class;
197   return $hash;
198 }
199
200 =pod
201
202 =item C<< load ( $filename ) >>
203
204 Load option ROM contents from the file C<$filename>.
205
206 =cut
207
208 sub load {
209   my $hash = shift;
210   my $self = tied(%$hash);
211   my $filename = shift;
212
213   $self->{filename} = $filename;
214
215   open my $fh, "<$filename"
216       or croak "Cannot open $filename for reading: $!";
217   read $fh, my $data, ( 128 * 1024 ); # 128kB is theoretical max size
218   $self->{data} = \$data;
219   close $fh;
220 }
221
222 =pod
223
224 =item C<< save ( [ $filename ] ) >>
225
226 Write the ROM data back out to the file C<$filename>.  If C<$filename>
227 is omitted, the file used in the call to C<load()> will be used.
228
229 =cut
230
231 sub save {
232   my $hash = shift;
233   my $self = tied(%$hash);
234   my $filename = shift;
235
236   $filename ||= $self->{filename};
237
238   open my $fh, ">$filename"
239       or croak "Cannot open $filename for writing: $!";
240   print $fh ${$self->{data}};
241   close $fh;
242 }
243
244 =pod
245
246 =item C<< length () >>
247
248 Length of option ROM data.  This is the length of the file, not the
249 length from the ROM header length field.
250
251 =cut
252
253 sub length {
254   my $hash = shift;
255   my $self = tied(%$hash);
256
257   return length ${$self->{data}};
258 }
259
260 =pod
261
262 =item C<< pci_header () >>
263
264 Return a C<Option::ROM::PCI> object representing the ROM's PCI header,
265 if present.
266
267 =cut
268
269 sub pci_header {
270   my $hash = shift;
271   my $self = tied(%$hash);
272
273   my $offset = $hash->{pci_header};
274   return undef unless $offset != 0;
275
276   return Option::ROM::PCI->new ( $self->{data}, $offset );
277 }
278
279 =pod
280
281 =item C<< pnp_header () >>
282
283 Return a C<Option::ROM::PnP> object representing the ROM's PnP header,
284 if present.
285
286 =cut
287
288 sub pnp_header {
289   my $hash = shift;
290   my $self = tied(%$hash);
291
292   my $offset = $hash->{pnp_header};
293   return undef unless $offset != 0;
294
295   return Option::ROM::PnP->new ( $self->{data}, $offset );
296 }
297
298 =pod
299
300 =item C<< checksum () >>
301
302 Calculate the byte checksum of the ROM.
303
304 =cut
305
306 sub checksum {
307   my $hash = shift;
308   my $self = tied(%$hash);
309
310   return unpack ( "%8C*", ${$self->{data}} );
311 }
312
313 =pod
314
315 =item C<< fix_checksum () >>
316
317 Fix the byte checksum of the ROM.
318
319 =cut
320
321 sub fix_checksum {
322   my $hash = shift;
323   my $self = tied(%$hash);
324
325   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
326 }
327
328 ##############################################################################
329 #
330 # Option::ROM::PCI
331 #
332 ##############################################################################
333
334 package Option::ROM::PCI;
335
336 use strict;
337 use warnings;
338 use Carp;
339 use bytes;
340
341 sub new {
342   my $class = shift;
343   my $data = shift;
344   my $offset = shift;
345
346   my $hash = {};
347   tie %$hash, "Option::ROM::Fields", {
348     data => $data,
349     offset => $offset,
350     length => 0x0c,
351     fields => {
352       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
353       vendor_id =>      { offset => 0x04, length => 0x02, pack => "S" },
354       device_id =>      { offset => 0x06, length => 0x02, pack => "S" },
355       device_list =>    { offset => 0x08, length => 0x02, pack => "S" },
356       struct_length =>  { offset => 0x0a, length => 0x02, pack => "S" },
357       struct_revision =>{ offset => 0x0c, length => 0x01, pack => "C" },
358       base_class =>     { offset => 0x0d, length => 0x01, pack => "C" },
359       sub_class =>      { offset => 0x0e, length => 0x01, pack => "C" },
360       prog_intf =>      { offset => 0x0f, length => 0x01, pack => "C" },
361       image_length =>   { offset => 0x10, length => 0x02, pack => "S" },
362       revision =>       { offset => 0x12, length => 0x02, pack => "S" },
363       code_type =>      { offset => 0x14, length => 0x01, pack => "C" },
364       last_image =>     { offset => 0x15, length => 0x01, pack => "C" },
365       runtime_length => { offset => 0x16, length => 0x02, pack => "S" },
366       conf_header =>    { offset => 0x18, length => 0x02, pack => "S" },
367       clp_entry =>      { offset => 0x1a, length => 0x02, pack => "S" },
368     },
369   };
370   bless $hash, $class;
371
372   # Retrieve true length of structure
373   my $self = tied ( %$hash );
374   $self->{length} = $hash->{struct_length};
375
376   return $hash;  
377 }
378
379 ##############################################################################
380 #
381 # Option::ROM::PnP
382 #
383 ##############################################################################
384
385 package Option::ROM::PnP;
386
387 use strict;
388 use warnings;
389 use Carp;
390 use bytes;
391
392 sub new {
393   my $class = shift;
394   my $data = shift;
395   my $offset = shift;
396
397   my $hash = {};
398   tie %$hash, "Option::ROM::Fields", {
399     data => $data,
400     offset => $offset,
401     length => 0x06,
402     fields => {
403       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
404       struct_revision =>{ offset => 0x04, length => 0x01, pack => "C" },
405       struct_length =>  { offset => 0x05, length => 0x01, pack => "C" },
406       checksum =>       { offset => 0x09, length => 0x01, pack => "C" },
407       manufacturer =>   { offset => 0x0e, length => 0x02, pack => "S" },
408       product =>        { offset => 0x10, length => 0x02, pack => "S" },
409       bcv =>            { offset => 0x16, length => 0x02, pack => "S" },
410       bdv =>            { offset => 0x18, length => 0x02, pack => "S" },
411       bev =>            { offset => 0x1a, length => 0x02, pack => "S" },
412     },
413   };
414   bless $hash, $class;
415
416   # Retrieve true length of structure
417   my $self = tied ( %$hash );
418   $self->{length} = ( $hash->{struct_length} * 16 );
419
420   return $hash;  
421 }
422
423 sub checksum {
424   my $hash = shift;
425   my $self = tied(%$hash);
426
427   return $self->checksum();
428 }
429
430 sub fix_checksum {
431   my $hash = shift;
432   my $self = tied(%$hash);
433
434   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
435 }
436
437 sub manufacturer {
438   my $hash = shift;
439   my $self = tied(%$hash);
440
441   my $manufacturer = $hash->{manufacturer};
442   return undef unless $manufacturer;
443
444   my $raw = substr ( ${$self->{data}}, $manufacturer );
445   return unpack ( "Z*", $raw );
446 }
447
448 sub product {
449   my $hash = shift;
450   my $self = tied(%$hash);
451
452   my $product = $hash->{product};
453   return undef unless $product;
454
455   my $raw = substr ( ${$self->{data}}, $product );
456   return unpack ( "Z*", $raw );
457 }
458
459 1;