%PDF- %PDF-
Direktori : /usr/share/perl5/Dpkg/Shlibs/ |
Current File : //usr/share/perl5/Dpkg/Shlibs/Objdump.pm |
# Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org> # Copyright © 2007-2009,2012-2015,2017-2018 Guillem Jover <guillem@debian.org> # # 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 # (at your option) 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, see <https://www.gnu.org/licenses/>. =encoding utf8 =head1 NAME Dpkg::Shlibs::Objdump - symbol support via objdump =head1 DESCRIPTION This module provides a class that wraps objdump to handle symbols and their attributes from a shared object. B<Note>: This is a private module, its API can change at any time. =cut package Dpkg::Shlibs::Objdump 0.01; use strict; use warnings; use feature qw(state); use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Shlibs::Objdump::Object; sub new { my $this = shift; my $class = ref($this) || $this; my $self = { objects => {} }; bless $self, $class; return $self; } sub add_object { my ($self, $obj) = @_; my $id = $obj->get_id; if ($id) { $self->{objects}{$id} = $obj; } return $id; } sub analyze { my ($self, $file) = @_; my $obj = Dpkg::Shlibs::Objdump::Object->new($file); return $self->add_object($obj); } sub locate_symbol { my ($self, $name) = @_; foreach my $obj (values %{$self->{objects}}) { my $sym = $obj->get_symbol($name); if (defined($sym) && $sym->{defined}) { return $sym; } } return; } sub get_object { my ($self, $objid) = @_; if ($self->has_object($objid)) { return $self->{objects}{$objid}; } return; } sub has_object { my ($self, $objid) = @_; return exists $self->{objects}{$objid}; } use constant { # ELF Class. ELF_BITS_NONE => 0, ELF_BITS_32 => 1, ELF_BITS_64 => 2, # ELF Data encoding. ELF_ORDER_NONE => 0, ELF_ORDER_2LSB => 1, ELF_ORDER_2MSB => 2, # ELF Machine. EM_NONE => 0, EM_SPARC => 2, EM_386 => 3, EM_68K => 4, EM_MIPS => 8, EM_SPARC64_OLD => 11, EM_PARISC => 15, EM_SPARC32PLUS => 18, EM_PPC => 20, EM_PPC64 => 21, EM_S390 => 22, EM_ARM => 40, EM_ALPHA_OLD => 41, EM_SH => 42, EM_SPARC64 => 43, EM_IA64 => 50, EM_X86_64 => 62, EM_OR1K => 92, EM_AARCH64 => 183, EM_ARCV2 => 195, EM_RISCV => 243, EM_LOONGARCH => 258, EM_OR1K_OLD => 0x8472, EM_ALPHA => 0x9026, EM_S390_OLD => 0xa390, EM_NIOS32 => 0xfebb, # ELF Version. EV_NONE => 0, EV_CURRENT => 1, # ELF Flags (might influence the ABI). EF_ARM_ALIGN8 => 0x00000040, EF_ARM_NEW_ABI => 0x00000080, EF_ARM_OLD_ABI => 0x00000100, EF_ARM_SOFT_FLOAT => 0x00000200, EF_ARM_HARD_FLOAT => 0x00000400, EF_ARM_EABI_MASK => 0xff000000, EF_IA64_ABI64 => 0x00000010, EF_LOONGARCH_SOFT_FLOAT => 0x00000001, EF_LOONGARCH_SINGLE_FLOAT => 0x00000002, EF_LOONGARCH_DOUBLE_FLOAT => 0x00000003, EF_LOONGARCH_ABI_MASK => 0x00000007, EF_MIPS_ABI2 => 0x00000020, EF_MIPS_32BIT => 0x00000100, EF_MIPS_FP64 => 0x00000200, EF_MIPS_NAN2008 => 0x00000400, EF_MIPS_ABI_MASK => 0x0000f000, EF_MIPS_ARCH_MASK => 0xf0000000, EF_OR1K_NODELAY => 0x00000001, EF_PPC64_ABI64 => 0x00000003, EF_RISCV_FLOAT_ABI_SOFT => 0x0000, EF_RISCV_FLOAT_ABI_SINGLE => 0x0002, EF_RISCV_FLOAT_ABI_DOUBLE => 0x0004, EF_RISCV_FLOAT_ABI_QUAD => 0x0006, EF_RISCV_FLOAT_ABI_MASK => 0x0006, EF_RISCV_RVE => 0x0008, EF_SH_MACH_MASK => 0x0000001f, }; # These map machine IDs to their name. my %elf_mach_name = ( EM_NONE() => 'none', EM_386() => 'i386', EM_68K() => 'm68k', EM_AARCH64() => 'arm64', EM_ALPHA() => 'alpha', EM_ARCV2() => 'arcv2', EM_ARM() => 'arm', EM_IA64() => 'ia64', EM_LOONGARCH() => 'loong', EM_MIPS() => 'mips', EM_NIOS32() => 'nios2', EM_OR1K() => 'or1k', EM_PARISC() => 'hppa', EM_PPC() => 'ppc', EM_PPC64() => 'ppc64', EM_RISCV() => 'riscv', EM_S390() => 's390', EM_SH() => 'sh', EM_SPARC() => 'sparc', EM_SPARC64() => 'sparc64', EM_X86_64() => 'amd64', ); # These map alternative or old machine IDs to their canonical form. my %elf_mach_map = ( EM_ALPHA_OLD() => EM_ALPHA, EM_OR1K_OLD() => EM_OR1K, EM_S390_OLD() => EM_S390, EM_SPARC32PLUS() => EM_SPARC, EM_SPARC64_OLD() => EM_SPARC64, ); # These masks will try to expose processor flags that are ABI incompatible, # and as such are part of defining the architecture ABI. If uncertain it is # always better to not mask a flag, because that preserves the historical # behavior, and we do not drop dependencies. my %elf_flags_mask = ( # XXX: The mask for ARM had to be disabled due to objects in the wild # with EABIv4, while EABIv5 is the current one, and the soft and hard # flags not always being set on armel and armhf respectively, although # the Tag_ABI_VFP_args in the ARM attribute section should always be # present on armhf, and there are even cases where both soft and hard # float flags are set at the same time(!). Once these are confirmed to # be fixed, we could reconsider enabling the below for a more strict # ABI mismatch check. See #853793. # EM_ARM() => EF_ARM_EABI_MASK | # EF_ARM_NEW_ABI | EF_ARM_OLD_ABI | # EF_ARM_SOFT_FLOAT | EF_ARM_HARD_FLOAT, EM_IA64() => EF_IA64_ABI64, EM_LOONGARCH() => EF_LOONGARCH_ABI_MASK, EM_MIPS() => EF_MIPS_ABI_MASK | EF_MIPS_ABI2, EM_OR1K() => EF_OR1K_NODELAY, EM_PPC64() => EF_PPC64_ABI64, EM_RISCV() => EF_RISCV_FLOAT_ABI_MASK | EF_RISCV_RVE, ); sub get_format { my ($file) = @_; state %format; return $format{$file} if exists $format{$file}; my $header; open my $fh, '<', $file or syserr(g_('cannot read %s'), $file); my $rc = read $fh, $header, 64; if (not defined $rc) { syserr(g_('cannot read %s'), $file); } elsif ($rc != 64) { return; } close $fh; my %elf; # Unpack the identifier field. @elf{qw(magic bits endian vertype osabi verabi)} = unpack 'a4C5', $header; return unless $elf{magic} eq "\x7fELF"; return unless $elf{vertype} == EV_CURRENT; my %abi; my ($elf_word, $elf_endian); if ($elf{bits} == ELF_BITS_32) { $abi{bits} = 32; $elf_word = 'L'; } elsif ($elf{bits} == ELF_BITS_64) { $abi{bits} = 64; $elf_word = 'Q'; } else { return; } if ($elf{endian} == ELF_ORDER_2LSB) { $abi{endian} = 'l'; $elf_endian = '<'; } elsif ($elf{endian} == ELF_ORDER_2MSB) { $abi{endian} = 'b'; $elf_endian = '>'; } else { return; } # Unpack the endianness and size dependent fields. my $tmpl = "x16(S2Lx[${elf_word}3]L)${elf_endian}"; @elf{qw(type mach version flags)} = unpack $tmpl, $header; # Canonicalize the machine ID. $elf{mach} = $elf_mach_map{$elf{mach}} // $elf{mach}; $abi{mach} = $elf_mach_name{$elf{mach}} // $elf{mach}; # Mask any processor flags that might not change the architecture ABI. $abi{flags} = $elf{flags} & ($elf_flags_mask{$elf{mach}} // 0); # Normalize into a colon-separated string for easy comparison, and easy # debugging aid. $format{$file} = join ':', 'ELF', @abi{qw(bits endian mach flags)}; return $format{$file}; } sub is_elf { my $file = shift; open(my $file_fh, '<', $file) or syserr(g_('cannot read %s'), $file); my ($header, $result) = ('', 0); if (read($file_fh, $header, 4) == 4) { $result = 1 if ($header =~ /^\177ELF$/); } close($file_fh); return $result; } =head1 CHANGES =head2 Version 0.xx This is a private module. =cut 1;