| package Option::ROM; |
| |
| # Copyright (C) 2008 Michael Brown <mbrown@fensystems.co.uk>. |
| # |
| # This program is free software; you can redistribute it and/or |
| # modify it under the terms of the GNU General Public License as |
| # published by the Free Software Foundation; either version 2 of the |
| # License, or any later version. |
| # |
| # This program is distributed in the hope that it will be useful, but |
| # WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| # General Public License for more details. |
| # |
| # You should have received a copy of the GNU General Public License |
| # along with this program; if not, write to the Free Software |
| # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
| |
| =head1 NAME |
| |
| Option::ROM - Option ROM manipulation |
| |
| =head1 SYNOPSIS |
| |
| use Option::ROM; |
| |
| # Load a ROM image |
| my $rom = new Option::ROM; |
| $rom->load ( "rtl8139.rom" ); |
| |
| # Modify the PCI device ID |
| $rom->pci_header->{device_id} = 0x1234; |
| $rom->fix_checksum(); |
| |
| # Write ROM image out to a new file |
| $rom->save ( "rtl8139-modified.rom" ); |
| |
| =head1 DESCRIPTION |
| |
| C<Option::ROM> provides a mechanism for manipulating Option ROM |
| images. |
| |
| =head1 METHODS |
| |
| =cut |
| |
| ############################################################################## |
| # |
| # Option::ROM::Fields |
| # |
| ############################################################################## |
| |
| package Option::ROM::Fields; |
| |
| use strict; |
| use warnings; |
| use Carp; |
| use bytes; |
| |
| sub TIEHASH { |
| my $class = shift; |
| my $self = shift; |
| |
| bless $self, $class; |
| return $self; |
| } |
| |
| sub FETCH { |
| my $self = shift; |
| my $key = shift; |
| |
| return undef unless $self->EXISTS ( $key ); |
| my $raw = substr ( ${$self->{data}}, |
| ( $self->{offset} + $self->{fields}->{$key}->{offset} ), |
| $self->{fields}->{$key}->{length} ); |
| my $unpack = ( ref $self->{fields}->{$key}->{unpack} ? |
| $self->{fields}->{$key}->{unpack} : |
| sub { unpack ( $self->{fields}->{$key}->{pack}, shift ); } ); |
| return &$unpack ( $raw ); |
| } |
| |
| sub STORE { |
| my $self = shift; |
| my $key = shift; |
| my $value = shift; |
| |
| croak "Nonexistent field \"$key\"" unless $self->EXISTS ( $key ); |
| my $pack = ( ref $self->{fields}->{$key}->{pack} ? |
| $self->{fields}->{$key}->{pack} : |
| sub { pack ( $self->{fields}->{$key}->{pack}, shift ); } ); |
| my $raw = &$pack ( $value ); |
| substr ( ${$self->{data}}, |
| ( $self->{offset} + $self->{fields}->{$key}->{offset} ), |
| $self->{fields}->{$key}->{length} ) = $raw; |
| } |
| |
| sub DELETE { |
| my $self = shift; |
| my $key = shift; |
| |
| $self->STORE ( $key, 0 ); |
| } |
| |
| sub CLEAR { |
| my $self = shift; |
| |
| foreach my $key ( keys %{$self->{fields}} ) { |
| $self->DELETE ( $key ); |
| } |
| } |
| |
| sub EXISTS { |
| my $self = shift; |
| my $key = shift; |
| |
| return ( exists $self->{fields}->{$key} && |
| ( ( $self->{fields}->{$key}->{offset} + |
| $self->{fields}->{$key}->{length} ) <= $self->{length} ) ); |
| } |
| |
| sub FIRSTKEY { |
| my $self = shift; |
| |
| keys %{$self->{fields}}; |
| return each %{$self->{fields}}; |
| } |
| |
| sub NEXTKEY { |
| my $self = shift; |
| my $lastkey = shift; |
| |
| return each %{$self->{fields}}; |
| } |
| |
| sub SCALAR { |
| my $self = shift; |
| |
| return 1; |
| } |
| |
| sub UNTIE { |
| my $self = shift; |
| } |
| |
| sub DESTROY { |
| my $self = shift; |
| } |
| |
| sub checksum { |
| my $self = shift; |
| |
| my $raw = substr ( ${$self->{data}}, $self->{offset}, $self->{length} ); |
| return unpack ( "%8C*", $raw ); |
| } |
| |
| ############################################################################## |
| # |
| # Option::ROM |
| # |
| ############################################################################## |
| |
| package Option::ROM; |
| |
| use strict; |
| use warnings; |
| use Carp; |
| use bytes; |
| use Exporter 'import'; |
| |
| use constant ROM_SIGNATURE => 0xaa55; |
| use constant PCI_SIGNATURE => 'PCIR'; |
| use constant PNP_SIGNATURE => '$PnP'; |
| |
| our @EXPORT_OK = qw ( ROM_SIGNATURE PCI_SIGNATURE PNP_SIGNATURE ); |
| our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] ); |
| |
| use constant JMP_SHORT => 0xeb; |
| use constant JMP_NEAR => 0xe9; |
| |
| sub pack_init { |
| my $dest = shift; |
| |
| # Always create a near jump; it's simpler |
| if ( $dest ) { |
| return pack ( "CS", JMP_NEAR, ( $dest - 6 ) ); |
| } else { |
| return pack ( "CS", 0, 0 ); |
| } |
| } |
| |
| sub unpack_init { |
| my $instr = shift; |
| |
| # Accept both short and near jumps |
| my $jump = unpack ( "C", $instr ); |
| if ( $jump == JMP_SHORT ) { |
| my $offset = unpack ( "xC", $instr ); |
| return ( $offset + 5 ); |
| } elsif ( $jump == JMP_NEAR ) { |
| my $offset = unpack ( "xS", $instr ); |
| return ( $offset + 6 ); |
| } elsif ( $jump == 0 ) { |
| return 0; |
| } else { |
| croak "Unrecognised jump instruction in init vector\n"; |
| } |
| } |
| |
| =pod |
| |
| =item C<< new () >> |
| |
| Construct a new C<Option::ROM> object. |
| |
| =cut |
| |
| sub new { |
| my $class = shift; |
| |
| my $hash = {}; |
| tie %$hash, "Option::ROM::Fields", { |
| data => undef, |
| offset => 0x00, |
| length => 0x20, |
| fields => { |
| signature => { offset => 0x00, length => 0x02, pack => "S" }, |
| length => { offset => 0x02, length => 0x01, pack => "C" }, |
| # "init" is part of a jump instruction |
| init => { offset => 0x03, length => 0x03, |
| pack => \&pack_init, unpack => \&unpack_init }, |
| checksum => { offset => 0x06, length => 0x01, pack => "C" }, |
| bofm_header => { offset => 0x14, length => 0x02, pack => "S" }, |
| undi_header => { offset => 0x16, length => 0x02, pack => "S" }, |
| pci_header => { offset => 0x18, length => 0x02, pack => "S" }, |
| pnp_header => { offset => 0x1a, length => 0x02, pack => "S" }, |
| }, |
| }; |
| bless $hash, $class; |
| return $hash; |
| } |
| |
| =pod |
| |
| =item C<< load ( $filename ) >> |
| |
| Load option ROM contents from the file C<$filename>. |
| |
| =cut |
| |
| sub load { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| my $filename = shift; |
| |
| $self->{filename} = $filename; |
| |
| open my $fh, "<$filename" |
| or croak "Cannot open $filename for reading: $!"; |
| read $fh, my $data, ( 128 * 1024 ); # 128kB is theoretical max size |
| $self->{data} = \$data; |
| close $fh; |
| } |
| |
| =pod |
| |
| =item C<< save ( [ $filename ] ) >> |
| |
| Write the ROM data back out to the file C<$filename>. If C<$filename> |
| is omitted, the file used in the call to C<load()> will be used. |
| |
| =cut |
| |
| sub save { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| my $filename = shift; |
| |
| $filename ||= $self->{filename}; |
| |
| open my $fh, ">$filename" |
| or croak "Cannot open $filename for writing: $!"; |
| print $fh ${$self->{data}}; |
| close $fh; |
| } |
| |
| =pod |
| |
| =item C<< length () >> |
| |
| Length of option ROM data. This is the length of the file, not the |
| length from the ROM header length field. |
| |
| =cut |
| |
| sub length { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| return length ${$self->{data}}; |
| } |
| |
| =pod |
| |
| =item C<< pci_header () >> |
| |
| Return a C<Option::ROM::PCI> object representing the ROM's PCI header, |
| if present. |
| |
| =cut |
| |
| sub pci_header { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| my $offset = $hash->{pci_header}; |
| return undef unless $offset != 0; |
| |
| return Option::ROM::PCI->new ( $self->{data}, $offset ); |
| } |
| |
| =pod |
| |
| =item C<< pnp_header () >> |
| |
| Return a C<Option::ROM::PnP> object representing the ROM's PnP header, |
| if present. |
| |
| =cut |
| |
| sub pnp_header { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| my $offset = $hash->{pnp_header}; |
| return undef unless $offset != 0; |
| |
| return Option::ROM::PnP->new ( $self->{data}, $offset ); |
| } |
| |
| =pod |
| |
| =item C<< checksum () >> |
| |
| Calculate the byte checksum of the ROM. |
| |
| =cut |
| |
| sub checksum { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| return unpack ( "%8C*", ${$self->{data}} ); |
| } |
| |
| =pod |
| |
| =item C<< fix_checksum () >> |
| |
| Fix the byte checksum of the ROM. |
| |
| =cut |
| |
| sub fix_checksum { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff ); |
| } |
| |
| ############################################################################## |
| # |
| # Option::ROM::PCI |
| # |
| ############################################################################## |
| |
| package Option::ROM::PCI; |
| |
| use strict; |
| use warnings; |
| use Carp; |
| use bytes; |
| |
| sub new { |
| my $class = shift; |
| my $data = shift; |
| my $offset = shift; |
| |
| my $hash = {}; |
| tie %$hash, "Option::ROM::Fields", { |
| data => $data, |
| offset => $offset, |
| length => 0x0c, |
| fields => { |
| signature => { offset => 0x00, length => 0x04, pack => "a4" }, |
| vendor_id => { offset => 0x04, length => 0x02, pack => "S" }, |
| device_id => { offset => 0x06, length => 0x02, pack => "S" }, |
| device_list => { offset => 0x08, length => 0x02, pack => "S" }, |
| struct_length => { offset => 0x0a, length => 0x02, pack => "S" }, |
| struct_revision =>{ offset => 0x0c, length => 0x01, pack => "C" }, |
| base_class => { offset => 0x0d, length => 0x01, pack => "C" }, |
| sub_class => { offset => 0x0e, length => 0x01, pack => "C" }, |
| prog_intf => { offset => 0x0f, length => 0x01, pack => "C" }, |
| image_length => { offset => 0x10, length => 0x02, pack => "S" }, |
| revision => { offset => 0x12, length => 0x02, pack => "S" }, |
| code_type => { offset => 0x14, length => 0x01, pack => "C" }, |
| last_image => { offset => 0x15, length => 0x01, pack => "C" }, |
| runtime_length => { offset => 0x16, length => 0x02, pack => "S" }, |
| conf_header => { offset => 0x18, length => 0x02, pack => "S" }, |
| clp_entry => { offset => 0x1a, length => 0x02, pack => "S" }, |
| }, |
| }; |
| bless $hash, $class; |
| |
| # Retrieve true length of structure |
| my $self = tied ( %$hash ); |
| $self->{length} = $hash->{struct_length}; |
| |
| return $hash; |
| } |
| |
| ############################################################################## |
| # |
| # Option::ROM::PnP |
| # |
| ############################################################################## |
| |
| package Option::ROM::PnP; |
| |
| use strict; |
| use warnings; |
| use Carp; |
| use bytes; |
| |
| sub new { |
| my $class = shift; |
| my $data = shift; |
| my $offset = shift; |
| |
| my $hash = {}; |
| tie %$hash, "Option::ROM::Fields", { |
| data => $data, |
| offset => $offset, |
| length => 0x06, |
| fields => { |
| signature => { offset => 0x00, length => 0x04, pack => "a4" }, |
| struct_revision =>{ offset => 0x04, length => 0x01, pack => "C" }, |
| struct_length => { offset => 0x05, length => 0x01, pack => "C" }, |
| checksum => { offset => 0x09, length => 0x01, pack => "C" }, |
| manufacturer => { offset => 0x0e, length => 0x02, pack => "S" }, |
| product => { offset => 0x10, length => 0x02, pack => "S" }, |
| bcv => { offset => 0x16, length => 0x02, pack => "S" }, |
| bdv => { offset => 0x18, length => 0x02, pack => "S" }, |
| bev => { offset => 0x1a, length => 0x02, pack => "S" }, |
| }, |
| }; |
| bless $hash, $class; |
| |
| # Retrieve true length of structure |
| my $self = tied ( %$hash ); |
| $self->{length} = ( $hash->{struct_length} * 16 ); |
| |
| return $hash; |
| } |
| |
| sub checksum { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| return $self->checksum(); |
| } |
| |
| sub fix_checksum { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| $hash->{checksum} = ( ( $hash->{checksum} - $hash->checksum() ) & 0xff ); |
| } |
| |
| sub manufacturer { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| my $manufacturer = $hash->{manufacturer}; |
| return undef unless $manufacturer; |
| |
| my $raw = substr ( ${$self->{data}}, $manufacturer ); |
| return unpack ( "Z*", $raw ); |
| } |
| |
| sub product { |
| my $hash = shift; |
| my $self = tied(%$hash); |
| |
| my $product = $hash->{product}; |
| return undef unless $product; |
| |
| my $raw = substr ( ${$self->{data}}, $product ); |
| return unpack ( "Z*", $raw ); |
| } |
| |
| 1; |