gpxe/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;