qemu/roms/ipxe/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., 51 Franklin Street, Fifth Floor, Boston, MA
  18 # 02110-1301, USA.
  19
  20 =head1 NAME
  21
  22 Option::ROM - Option ROM manipulation
  23
  24 =head1 SYNOPSIS
  25
  26     use Option::ROM;
  27
  28     # Load a ROM image
  29     my $rom = new Option::ROM;
  30     $rom->load ( "rtl8139.rom" );
  31
  32     # Modify the PCI device ID
  33     $rom->pci_header->{device_id} = 0x1234;
  34     $rom->fix_checksum();
  35
  36     # Write ROM image out to a new file
  37     $rom->save ( "rtl8139-modified.rom" );
  38
  39 =head1 DESCRIPTION
  40
  41 C<Option::ROM> provides a mechanism for manipulating Option ROM
  42 images.
  43
  44 =head1 METHODS
  45
  46 =cut
  47
  48 ##############################################################################
  49 #
  50 # Option::ROM::Fields
  51 #
  52 ##############################################################################
  53
  54 package Option::ROM::Fields;
  55
  56 use strict;
  57 use warnings;
  58 use Carp;
  59 use bytes;
  60
  61 sub TIEHASH {
  62   my $class = shift;
  63   my $self = shift;
  64
  65   bless $self, $class;
  66   return $self;
  67 }
  68
  69 sub FETCH {
  70   my $self = shift;
  71   my $key = shift;
  72
  73   return undef unless $self->EXISTS ( $key );
  74   my $raw = substr ( ${$self->{data}},
  75                      ( $self->{offset} + $self->{fields}->{$key}->{offset} ),
  76                      $self->{fields}->{$key}->{length} );
  77   my $unpack = ( ref $self->{fields}->{$key}->{unpack} ?
  78                  $self->{fields}->{$key}->{unpack} :
  79                  sub { unpack ( $self->{fields}->{$key}->{pack}, shift ); } );
  80   return &$unpack ( $raw );
  81 }
  82
  83 sub STORE {
  84   my $self = shift;
  85   my $key = shift;
  86   my $value = shift;
  87
  88   croak "Nonexistent field \"$key\"" unless $self->EXISTS ( $key );
  89   my $pack = ( ref $self->{fields}->{$key}->{pack} ?
  90                $self->{fields}->{$key}->{pack} :
  91                sub { pack ( $self->{fields}->{$key}->{pack}, shift ); } );
  92   my $raw = &$pack ( $value );
  93   substr ( ${$self->{data}},
  94            ( $self->{offset} + $self->{fields}->{$key}->{offset} ),
  95            $self->{fields}->{$key}->{length} ) = $raw;
  96 }
  97
  98 sub DELETE {
  99   my $self = shift;
 100   my $key = shift;
 101
 102   $self->STORE ( $key, 0 );
 103 }
 104
 105 sub CLEAR {
 106   my $self = shift;
 107
 108   foreach my $key ( keys %{$self->{fields}} ) {
 109     $self->DELETE ( $key );
 110   }
 111 }
 112
 113 sub EXISTS {
 114   my $self = shift;
 115   my $key = shift;
 116
 117   return ( exists $self->{fields}->{$key} &&
 118            ( ( $self->{fields}->{$key}->{offset} +
 119                $self->{fields}->{$key}->{length} ) <= $self->{length} ) );
 120 }
 121
 122 sub FIRSTKEY {
 123   my $self = shift;
 124
 125   keys %{$self->{fields}};
 126   return each %{$self->{fields}};
 127 }
 128
 129 sub NEXTKEY {
 130   my $self = shift;
 131   my $lastkey = shift;
 132
 133   return each %{$self->{fields}};
 134 }
 135
 136 sub SCALAR {
 137   my $self = shift;
 138
 139   return 1;
 140 }
 141
 142 sub UNTIE {
 143   my $self = shift;
 144 }
 145
 146 sub DESTROY {
 147   my $self = shift;
 148 }
 149
 150 sub checksum {
 151   my $self = shift;
 152
 153   my $raw = substr ( ${$self->{data}}, $self->{offset}, $self->{length} );
 154   return unpack ( "%8C*", $raw );
 155 }
 156
 157 ##############################################################################
 158 #
 159 # Option::ROM
 160 #
 161 ##############################################################################
 162
 163 package Option::ROM;
 164
 165 use strict;
 166 use warnings;
 167 use Carp;
 168 use bytes;
 169 use Exporter 'import';
 170
 171 use constant ROM_SIGNATURE => 0xaa55;
 172 use constant PCI_SIGNATURE => 'PCIR';
 173 use constant PCI_LAST_IMAGE => 0x80;
 174 use constant PNP_SIGNATURE => '$PnP';
 175 use constant IPXE_SIGNATURE => 'iPXE';
 176
 177 our @EXPORT_OK = qw ( ROM_SIGNATURE PCI_SIGNATURE PCI_LAST_IMAGE
 178                       PNP_SIGNATURE IPXE_SIGNATURE );
 179 our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
 180
 181 use constant JMP_SHORT => 0xeb;
 182 use constant JMP_NEAR => 0xe9;
 183 use constant CALL_NEAR => 0xe8;
 184
 185 sub pack_init {
 186   my $dest = shift;
 187
 188   # Always create a near jump; it's simpler
 189   if ( $dest ) {
 190     return pack ( "CS", JMP_NEAR, ( $dest - 6 ) );
 191   } else {
 192     return pack ( "CS", 0, 0 );
 193   }
 194 }
 195
 196 sub unpack_init {
 197   my $instr = shift;
 198
 199   # Accept both short and near jumps
 200   my $jump = unpack ( "C", $instr );
 201   if ( $jump == JMP_SHORT ) {
 202     my $offset = unpack ( "xC", $instr );
 203     return ( $offset + 5 );
 204   } elsif ( $jump == JMP_NEAR ) {
 205     my $offset = unpack ( "xS", $instr );
 206     return ( $offset + 6 );
 207   } elsif ( $jump == CALL_NEAR ) {
 208     my $offset = unpack ( "xS", $instr );
 209     return ( $offset + 6 );
 210   } elsif ( $jump == 0 ) {
 211     return 0;
 212   } else {
 213     croak "Unrecognised jump instruction in init vector\n";
 214   }
 215 }
 216
 217 =pod
 218
 219 =item C<< new () >>
 220
 221 Construct a new C<Option::ROM> object.
 222
 223 =cut
 224
 225 sub new {
 226   my $class = shift;
 227
 228   my $hash = {};
 229   tie %$hash, "Option::ROM::Fields", {
 230     data => undef,
 231     offset => 0x00,
 232     length => 0x20,
 233     fields => {
 234       signature =>      { offset => 0x00, length => 0x02, pack => "S" },
 235       length =>         { offset => 0x02, length => 0x01, pack => "C" },
 236       # "init" is part of a jump instruction
 237       init =>           { offset => 0x03, length => 0x03,
 238                           pack => \&pack_init, unpack => \&unpack_init },
 239       checksum =>       { offset => 0x06, length => 0x01, pack => "C" },
 240       ipxe_header =>    { offset => 0x10, length => 0x02, pack => "S" },
 241       bofm_header =>    { offset => 0x14, length => 0x02, pack => "S" },
 242       undi_header =>    { offset => 0x16, length => 0x02, pack => "S" },
 243       pci_header =>     { offset => 0x18, length => 0x02, pack => "S" },
 244       pnp_header =>     { offset => 0x1a, length => 0x02, pack => "S" },
 245     },
 246   };
 247   bless $hash, $class;
 248   return $hash;
 249 }
 250
 251 =pod
 252
 253 =item C<< set ( $data ) >>
 254
 255 Set option ROM contents.
 256
 257 =cut
 258
 259 sub set {
 260   my $hash = shift;
 261   my $self = tied(%$hash);
 262   my $data = shift;
 263
 264   # Store data
 265   $self->{data} = \$data;
 266
 267   # Split out any data belonging to the next image
 268   delete $self->{next_image};
 269   my $pci_header = $hash->pci_header();
 270   if ( ( defined $pci_header ) &&
 271        ( ! ( $pci_header->{last_image} & PCI_LAST_IMAGE ) ) ) {
 272     my $length = ( $pci_header->{image_length} * 512 );
 273     my $remainder = substr ( $data, $length );
 274     $data = substr ( $data, 0, $length );
 275     $self->{next_image} = new Option::ROM;
 276     $self->{next_image}->set ( $remainder );
 277   }
 278 }
 279
 280 =pod
 281
 282 =item C<< get () >>
 283
 284 Get option ROM contents.
 285
 286 =cut
 287
 288 sub get {
 289   my $hash = shift;
 290   my $self = tied(%$hash);
 291
 292   my $data = ${$self->{data}};
 293   $data .= $self->{next_image}->get() if $self->{next_image};
 294   return $data;
 295 }
 296
 297 =pod
 298
 299 =item C<< load ( $filename ) >>
 300
 301 Load option ROM contents from the file C<$filename>.
 302
 303 =cut
 304
 305 sub load {
 306   my $hash = shift;
 307   my $self = tied(%$hash);
 308   my $filename = shift;
 309
 310   $self->{filename} = $filename;
 311
 312   open my $fh, "<$filename"
 313       or croak "Cannot open $filename for reading: $!";
 314   read $fh, my $data, -s $fh;
 315   $hash->set ( $data );
 316   close $fh;
 317 }
 318
 319 =pod
 320
 321 =item C<< save ( [ $filename ] ) >>
 322
 323 Write the ROM data back out to the file C<$filename>.  If C<$filename>
 324 is omitted, the file used in the call to C<load()> will be used.
 325
 326 =cut
 327
 328 sub save {
 329   my $hash = shift;
 330   my $self = tied(%$hash);
 331   my $filename = shift;
 332
 333   $filename ||= $self->{filename};
 334
 335   open my $fh, ">$filename"
 336       or croak "Cannot open $filename for writing: $!";
 337   my $data = $hash->get();
 338   print $fh $data;
 339   close $fh;
 340 }
 341
 342 =pod
 343
 344 =item C<< length () >>
 345
 346 Length of option ROM data.  This is the length of the file, not the
 347 length from the ROM header length field.
 348
 349 =cut
 350
 351 sub length {
 352   my $hash = shift;
 353   my $self = tied(%$hash);
 354
 355   return length ${$self->{data}};
 356 }
 357
 358 =pod
 359
 360 =item C<< pci_header () >>
 361
 362 Return a C<Option::ROM::PCI> object representing the ROM's PCI header,
 363 if present.
 364
 365 =cut
 366
 367 sub pci_header {
 368   my $hash = shift;
 369   my $self = tied(%$hash);
 370
 371   my $offset = $hash->{pci_header};
 372   return undef unless $offset != 0;
 373
 374   return Option::ROM::PCI->new ( $self->{data}, $offset );
 375 }
 376
 377 =pod
 378
 379 =item C<< pnp_header () >>
 380
 381 Return a C<Option::ROM::PnP> object representing the ROM's PnP header,
 382 if present.
 383
 384 =cut
 385
 386 sub pnp_header {
 387   my $hash = shift;
 388   my $self = tied(%$hash);
 389
 390   my $offset = $hash->{pnp_header};
 391   return undef unless $offset != 0;
 392
 393   return Option::ROM::PnP->new ( $self->{data}, $offset );
 394 }
 395
 396 =pod
 397
 398 =item C<< undi_header () >>
 399
 400 Return a C<Option::ROM::UNDI> object representing the ROM's UNDI header,
 401 if present.
 402
 403 =cut
 404
 405 sub undi_header {
 406   my $hash = shift;
 407   my $self = tied(%$hash);
 408
 409   my $offset = $hash->{undi_header};
 410   return undef unless $offset != 0;
 411
 412   return Option::ROM::UNDI->new ( $self->{data}, $offset );
 413 }
 414
 415 =pod
 416
 417 =item C<< ipxe_header () >>
 418
 419 Return a C<Option::ROM::iPXE> object representing the ROM's iPXE
 420 header, if present.
 421
 422 =cut
 423
 424 sub ipxe_header {
 425   my $hash = shift;
 426   my $self = tied(%$hash);
 427
 428   my $offset = $hash->{ipxe_header};
 429   return undef unless $offset != 0;
 430
 431   return Option::ROM::iPXE->new ( $self->{data}, $offset );
 432 }
 433
 434 =pod
 435
 436 =item C<< next_image () >>
 437
 438 Return a C<Option::ROM> object representing the next image within the
 439 ROM, if present.
 440
 441 =cut
 442
 443 sub next_image {
 444   my $hash = shift;
 445   my $self = tied(%$hash);
 446
 447   return $self->{next_image};
 448 }
 449
 450 =pod
 451
 452 =item C<< checksum () >>
 453
 454 Calculate the byte checksum of the ROM.
 455
 456 =cut
 457
 458 sub checksum {
 459   my $hash = shift;
 460   my $self = tied(%$hash);
 461
 462   my $raw = substr ( ${$self->{data}}, 0, ( $hash->{length} * 512 ) );
 463   return unpack ( "%8C*", $raw );
 464 }
 465
 466 =pod
 467
 468 =item C<< fix_checksum () >>
 469
 470 Fix the byte checksum of the ROM.
 471
 472 =cut
 473
 474 sub fix_checksum {
 475   my $hash = shift;
 476   my $self = tied(%$hash);
 477
 478   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
 479 }
 480
 481 ##############################################################################
 482 #
 483 # Option::ROM::PCI
 484 #
 485 ##############################################################################
 486
 487 package Option::ROM::PCI;
 488
 489 use strict;
 490 use warnings;
 491 use Carp;
 492 use bytes;
 493
 494 sub new {
 495   my $class = shift;
 496   my $data = shift;
 497   my $offset = shift;
 498
 499   my $hash = {};
 500   tie %$hash, "Option::ROM::Fields", {
 501     data => $data,
 502     offset => $offset,
 503     length => 0x0c,
 504     fields => {
 505       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
 506       vendor_id =>      { offset => 0x04, length => 0x02, pack => "S" },
 507       device_id =>      { offset => 0x06, length => 0x02, pack => "S" },
 508       device_list =>    { offset => 0x08, length => 0x02, pack => "S" },
 509       struct_length =>  { offset => 0x0a, length => 0x02, pack => "S" },
 510       struct_revision =>{ offset => 0x0c, length => 0x01, pack => "C" },
 511       base_class =>     { offset => 0x0d, length => 0x01, pack => "C" },
 512       sub_class =>      { offset => 0x0e, length => 0x01, pack => "C" },
 513       prog_intf =>      { offset => 0x0f, length => 0x01, pack => "C" },
 514       image_length =>   { offset => 0x10, length => 0x02, pack => "S" },
 515       revision =>       { offset => 0x12, length => 0x02, pack => "S" },
 516       code_type =>      { offset => 0x14, length => 0x01, pack => "C" },
 517       last_image =>     { offset => 0x15, length => 0x01, pack => "C" },
 518       runtime_length => { offset => 0x16, length => 0x02, pack => "S" },
 519       conf_header =>    { offset => 0x18, length => 0x02, pack => "S" },
 520       clp_entry =>      { offset => 0x1a, length => 0x02, pack => "S" },
 521     },
 522   };
 523   bless $hash, $class;
 524
 525   # Retrieve true length of structure
 526   my $self = tied ( %$hash );
 527   $self->{length} = $hash->{struct_length};
 528
 529   return $hash;
 530 }
 531
 532 sub device_list {
 533   my $hash = shift;
 534   my $self = tied(%$hash);
 535
 536   my $device_list = $hash->{device_list};
 537   return undef unless $device_list;
 538
 539   my @ids;
 540   my $offset = ( $self->{offset} + $device_list );
 541   while ( 1 ) {
 542     my $raw = substr ( ${$self->{data}}, $offset, 2 );
 543     my $id = unpack ( "S", $raw );
 544     last unless $id;
 545     push @ids, $id;
 546     $offset += 2;
 547   }
 548
 549   return @ids;
 550 }
 551
 552 ##############################################################################
 553 #
 554 # Option::ROM::PnP
 555 #
 556 ##############################################################################
 557
 558 package Option::ROM::PnP;
 559
 560 use strict;
 561 use warnings;
 562 use Carp;
 563 use bytes;
 564
 565 sub new {
 566   my $class = shift;
 567   my $data = shift;
 568   my $offset = shift;
 569
 570   my $hash = {};
 571   tie %$hash, "Option::ROM::Fields", {
 572     data => $data,
 573     offset => $offset,
 574     length => 0x06,
 575     fields => {
 576       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
 577       struct_revision =>{ offset => 0x04, length => 0x01, pack => "C" },
 578       struct_length =>  { offset => 0x05, length => 0x01, pack => "C" },
 579       checksum =>       { offset => 0x09, length => 0x01, pack => "C" },
 580       manufacturer =>   { offset => 0x0e, length => 0x02, pack => "S" },
 581       product =>        { offset => 0x10, length => 0x02, pack => "S" },
 582       bcv =>            { offset => 0x16, length => 0x02, pack => "S" },
 583       bdv =>            { offset => 0x18, length => 0x02, pack => "S" },
 584       bev =>            { offset => 0x1a, length => 0x02, pack => "S" },
 585     },
 586   };
 587   bless $hash, $class;
 588
 589   # Retrieve true length of structure
 590   my $self = tied ( %$hash );
 591   $self->{length} = ( $hash->{struct_length} * 16 );
 592
 593   return $hash;
 594 }
 595
 596 sub checksum {
 597   my $hash = shift;
 598   my $self = tied(%$hash);
 599
 600   return $self->checksum();
 601 }
 602
 603 sub fix_checksum {
 604   my $hash = shift;
 605   my $self = tied(%$hash);
 606
 607   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
 608 }
 609
 610 sub manufacturer {
 611   my $hash = shift;
 612   my $self = tied(%$hash);
 613
 614   my $manufacturer = $hash->{manufacturer};
 615   return undef unless $manufacturer;
 616
 617   my $raw = substr ( ${$self->{data}}, $manufacturer );
 618   return unpack ( "Z*", $raw );
 619 }
 620
 621 sub product {
 622   my $hash = shift;
 623   my $self = tied(%$hash);
 624
 625   my $product = $hash->{product};
 626   return undef unless $product;
 627
 628   my $raw = substr ( ${$self->{data}}, $product );
 629   return unpack ( "Z*", $raw );
 630 }
 631
 632 ##############################################################################
 633 #
 634 # Option::ROM::UNDI
 635 #
 636 ##############################################################################
 637
 638 package Option::ROM::UNDI;
 639
 640 use strict;
 641 use warnings;
 642 use Carp;
 643 use bytes;
 644
 645 sub new {
 646   my $class = shift;
 647   my $data = shift;
 648   my $offset = shift;
 649
 650   my $hash = {};
 651   tie %$hash, "Option::ROM::Fields", {
 652     data => $data,
 653     offset => $offset,
 654     length => 0x16,
 655     fields => {
 656       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
 657       struct_length =>  { offset => 0x04, length => 0x01, pack => "C" },
 658       checksum =>       { offset => 0x05, length => 0x01, pack => "C" },
 659       struct_revision =>{ offset => 0x06, length => 0x01, pack => "C" },
 660       version_revision =>{ offset => 0x07, length => 0x01, pack => "C" },
 661       version_minor =>  { offset => 0x08, length => 0x01, pack => "C" },
 662       version_major =>  { offset => 0x09, length => 0x01, pack => "C" },
 663       loader_entry =>   { offset => 0x0a, length => 0x02, pack => "S" },
 664       stack_size =>     { offset => 0x0c, length => 0x02, pack => "S" },
 665       data_size =>      { offset => 0x0e, length => 0x02, pack => "S" },
 666       code_size =>      { offset => 0x10, length => 0x02, pack => "S" },
 667       bus_type =>       { offset => 0x12, length => 0x04, pack => "a4" },
 668     },
 669   };
 670   bless $hash, $class;
 671
 672   # Retrieve true length of structure
 673   my $self = tied ( %$hash );
 674   $self->{length} = $hash->{struct_length};
 675
 676   return $hash;
 677 }
 678
 679 sub checksum {
 680   my $hash = shift;
 681   my $self = tied(%$hash);
 682
 683   return $self->checksum();
 684 }
 685
 686 sub fix_checksum {
 687   my $hash = shift;
 688   my $self = tied(%$hash);
 689
 690   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
 691 }
 692
 693 ##############################################################################
 694 #
 695 # Option::ROM::iPXE
 696 #
 697 ##############################################################################
 698
 699 package Option::ROM::iPXE;
 700
 701 use strict;
 702 use warnings;
 703 use Carp;
 704 use bytes;
 705
 706 sub new {
 707   my $class = shift;
 708   my $data = shift;
 709   my $offset = shift;
 710
 711   my $hash = {};
 712   tie %$hash, "Option::ROM::Fields", {
 713     data => $data,
 714     offset => $offset,
 715     length => 0x06,
 716     fields => {
 717       signature =>      { offset => 0x00, length => 0x04, pack => "a4" },
 718       struct_length =>  { offset => 0x04, length => 0x01, pack => "C" },
 719       checksum =>       { offset => 0x05, length => 0x01, pack => "C" },
 720       shrunk_length =>  { offset => 0x06, length => 0x01, pack => "C" },
 721       build_id =>       { offset => 0x08, length => 0x04, pack => "L" },
 722     },
 723   };
 724   bless $hash, $class;
 725
 726   # Retrieve true length of structure
 727   my $self = tied ( %$hash );
 728   $self->{length} = $hash->{struct_length};
 729
 730   return $hash;
 731 }
 732
 733 sub checksum {
 734   my $hash = shift;
 735   my $self = tied(%$hash);
 736
 737   return $self->checksum();
 738 }
 739
 740 sub fix_checksum {
 741   my $hash = shift;
 742   my $self = tied(%$hash);
 743
 744   $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff );
 745 }
 746
 747 1;