Return to ROM.pm CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / ipxe / src / util / Option

Annotation of qemu/roms/ipxe/src/util/Option/ROM.pm, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.