1package 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
21Option::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
40C<Option::ROM> provides a mechanism for manipulating Option ROM
41images.
42
43=head1 METHODS
44
45=cut
46
47##############################################################################
48#
49# Option::ROM::Fields
50#
51##############################################################################
52
53package Option::ROM::Fields;
54
55use strict;
56use warnings;
57use Carp;
58use bytes;
59
60sub TIEHASH {
61  my $class = shift;
62  my $self = shift;
63
64  bless $self, $class;
65  return $self;
66}
67
68sub 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
82sub 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
97sub DELETE {
98  my $self = shift;
99  my $key = shift;
100
101  $self->STORE ( $key, 0 );
102}
103
104sub CLEAR {
105  my $self = shift;
106
107  foreach my $key ( keys %{$self->{fields}} ) {
108    $self->DELETE ( $key );
109  }
110}
111
112sub 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
121sub FIRSTKEY {
122  my $self = shift;
123
124  keys %{$self->{fields}};
125  return each %{$self->{fields}};
126}
127
128sub NEXTKEY {
129  my $self = shift;
130  my $lastkey = shift;
131
132  return each %{$self->{fields}};
133}
134
135sub SCALAR {
136  my $self = shift;
137
138  return 1;
139}
140
141sub UNTIE {
142  my $self = shift;
143}
144
145sub DESTROY {
146  my $self = shift;
147}
148
149sub 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
162package Option::ROM;
163
164use strict;
165use warnings;
166use Carp;
167use bytes;
168use Exporter 'import';
169
170use constant ROM_SIGNATURE => 0xaa55;
171use constant PCI_SIGNATURE => 'PCIR';
172use constant PNP_SIGNATURE => '$PnP';
173
174our @EXPORT_OK = qw ( ROM_SIGNATURE PCI_SIGNATURE PNP_SIGNATURE );
175our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
176
177use constant JMP_SHORT => 0xeb;
178use constant JMP_NEAR => 0xe9;
179
180sub 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
191sub 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
213Construct a new C<Option::ROM> object.
214
215=cut
216
217sub 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
246Load option ROM contents from the file C<$filename>.
247
248=cut
249
250sub 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
268Write the ROM data back out to the file C<$filename>.  If C<$filename>
269is omitted, the file used in the call to C<load()> will be used.
270
271=cut
272
273sub 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
290Length of option ROM data.  This is the length of the file, not the
291length from the ROM header length field.
292
293=cut
294
295sub 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
306Return a C<Option::ROM::PCI> object representing the ROM's PCI header,
307if present.
308
309=cut
310
311sub 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
325Return a C<Option::ROM::PnP> object representing the ROM's PnP header,
326if present.
327
328=cut
329
330sub 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
344Calculate the byte checksum of the ROM.
345
346=cut
347
348sub 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
359Fix the byte checksum of the ROM.
360
361=cut
362
363sub 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
376package Option::ROM::PCI;
377
378use strict;
379use warnings;
380use Carp;
381use bytes;
382
383sub 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
427package Option::ROM::PnP;
428
429use strict;
430use warnings;
431use Carp;
432use bytes;
433
434sub 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
465sub checksum {
466  my $hash = shift;
467  my $self = tied(%$hash);
468
469  return $self->checksum();
470}
471
472sub fix_checksum {
473  my $hash = shift;
474  my $self = tied(%$hash);
475
476  $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
477}
478
479sub 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
490sub 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
5011;
502