elf.pm

内存管理工具Exmap。该工具比 ps 或 top 更精确

sub set_fh
{
    my $s = shift;
    $s->{_fh} = shift;
}


=pod

A single section header.
    
typedef struct
{
    Elf32_Word	sh_name;		/* Section name (string tbl index) */
    Elf32_Word	sh_type;		/* Section type */
    Elf32_Word	sh_flags;		/* Section flags */
    Elf32_Addr	sh_addr;		/* Section virtual addr at execution */
    Elf32_Off	sh_offset;		/* Section file offset */
    Elf32_Word	sh_size;		/* Section size in bytes */
    Elf32_Word	sh_link;		/* Link to another section */
    Elf32_Word	sh_info;		/* Additional section information */
    Elf32_Word	sh_addralign;		/* Section alignment */
    Elf32_Word	sh_entsize;		/* Entry size if section holds table */
} Elf32_Shdr;

=cut

sub _unpack_buffer
{
    my $s = shift;
    
    my @fieldnames = map {"_$_"}
    qw(name type flags addr offset size link info addralign entsize);
    my %fields;
    @{$s}{@fieldnames} = unpack('i10', $s->{_buffer});
    $s->{_file_range} = Range->new($s->offset, $s->offset + $s->size);
    $s->{_mem_range} = Range->new($s->addr, $s->addr + $s->size);
    return 1;
}

sub offset { return $_[0]->{_offset}; }
sub addr { return $_[0]->{_addr}; }
sub size { return $_[0]->{_size}; }
sub link { return $_[0]->{_link}; }
sub file_range { return $_[0]->{_file_range}; }
sub mem_range { return $_[0]->{_mem_range}; }

sub name
{
    my $s = shift;
    return $s->{_string_section}->find_string($s->{_name});
}

=pod

/* Legal values for sh_type (section type).  */

#define SHT_NULL	  0		/* Section header table entry unused */
#define SHT_PROGBITS	  1		/* Program data */
#define SHT_SYMTAB	  2		/* Symbol table */
#define SHT_STRTAB	  3		/* String table */
#define SHT_RELA	  4		/* Relocation entries with addends */
#define SHT_HASH	  5		/* Symbol hash table */
#define SHT_DYNAMIC	  6		/* Dynamic linking information */
#define SHT_NOTE	  7		/* Notes */
#define SHT_NOBITS	  8		/* Program space with no data (bss) */
#define SHT_REL		  9		/* Relocation entries, no addends */
#define SHT_SHLIB	  10		/* Reserved */
#define SHT_DYNSYM	  11		/* Dynamic linker symbol table */
#define SHT_INIT_ARRAY	  14		/* Array of constructors */
#define SHT_FINI_ARRAY	  15		/* Array of destructors */
#define SHT_PREINIT_ARRAY 16		/* Array of pre-constructors */
#define SHT_GROUP	  17		/* Section group */
#define SHT_SYMTAB_SHNDX  18		/* Extended section indeces */
#define	SHT_NUM		  19		/* Number of defined types.  */

=cut

sub sh_type
{
    my $s = shift;
    my $type = $s->{_type};
    my $SHT_NUM = 19;
    return undef unless defined $type && $type < $SHT_NUM;
    my @types = qw/NULL PROGBITS SYMTAB STRTAB RELA HASH DYNAMIC NOTE NOBITS
	REL SHLIB DYNSYM INIT_ARRAY FINI_ARRAY PREINIT_ARRAY GROUP SYMTAX_SHNDX/;
    return $types[$type];
}

sub is_null
{
    my $s = shift;
    return (!defined $s->sh_type) || ($s->sh_type eq 'NULL');
}

sub is_string_table
{
    my $s = shift;
    return !$s->is_null && $s->sh_type eq 'STRTAB';
}

sub is_symbol_table
{
    my $s = shift;
    return !$s->is_null && $s->sh_type eq 'SYMTAB';
}

sub is_nobits
{
    my $s = shift;
    return !$s->is_null && $s->sh_type eq 'NOBITS';
}

sub find_string
{
    my $s = shift;
    return undef unless $s->is_string_table;
    my $index = shift;
    return "" unless defined $index;

#    print "looking up index $index\n";
    
    # Read zero terminated string
    my $offset = $s->{_offset} + $index;
    my $MAX_STRING_SIZE = 1024;
    my $name;
    seek($s->{_fh}, $offset, 0);
#    print "reading at offset: ", sprintf("%08X", $offset), "\n";
    sysread($s->{_fh}, $name, $MAX_STRING_SIZE);
    $name =~ s/\x00.*$//s;
    return $name;
}

sub symbols
{
    my $s = shift;
    $s->load_symbols unless $s->{_sorted_symbol_table};
    return @{$s->{_sorted_symbol_table}};
}

sub find_symbols_in_mem_range
{
    my $s = shift;
    my $r = shift;

    my @symbols;
    foreach my $symbol ($s->symbols) {
	push @symbols, $symbol
	    if $symbol->is_defined && $r->overlaps($symbol->range);
    }

    return @symbols;
}

sub load_symbols
{
    my $s = shift;
    my $string_table = shift;

    return undef unless $s->is_symbol_table;

    my $symentry_size = $s->{_entsize};
    unless ($symentry_size > 0) {
	warn("Invalid symbol table entry size");
	return undef;
    }
    my $total_size = $s->size;
    my $read_size;
    my $buffer;

    my @symbols;
    seek($s->{_fh}, $s->{_offset}, 0);
    for ($read_size = 0;
	 $read_size < $total_size;
	 $read_size += $symentry_size) {
	my $nbytes = sysread($s->{_fh}, $buffer, $symentry_size);
	if ($nbytes != $symentry_size) {
	    warn("Failed to read symbol table entry");
	    return undef;
	}

	my $symbol = Elf::Symbol->new($buffer);
	unless ($symbol) {
	    warn("Error unpacking symbol");
	    return undef;
	}
	$symbol->set_string_table($string_table);

	push @symbols, $symbol;
    }

    @symbols = sort { $a->value <=> $b->value } @symbols;
    
    $s->{_sorted_symbol_table} = \@symbols;
    
    return 1;
}


package Elf::Symbol;

sub new
{
    my $c = shift;
    $c = ref $c if ref $c;
    my $s = {};
    $s->{_buffer} = shift;
    bless $s, $c;
    return undef unless $s->_unpack_buffer;
    return $s;
}


=pod
    
typedef struct
{
  Elf32_Word	st_name;		/* Symbol name (string tbl index) */
  Elf32_Addr	st_value;		/* Symbol value */
  Elf32_Word	st_size;		/* Symbol size */
  unsigned char	st_info;		/* Symbol type and binding */
  unsigned char	st_other;		/* Symbol visibility */
  Elf32_Section	st_shndx;		/* Section index */
} Elf32_Sym;

=cut


sub _unpack_buffer
{
    my $s = shift;

    my @fieldnames = map {"_$_"} qw(name value size info other shndx);
    my %fields;
    @{$s}{@fieldnames} = unpack('i3C2s1', $s->{_buffer});

    # bind and type are packed into info as low and high nibbles
    $s->{_bind} = ($s->{_info} & 0xf0) >> 4;
    $s->{_type} = ($s->{_info} & 0xf);
    $s->{_range} = Range->new($s->value, $s->value + $s->size);
    return 1;
}

sub range { return $_[0]->{_range}; }
sub value { return $_[0]->{_value}; }
sub size { return $_[0]->{_size}; }

=pod
    
/* Legal values for ST_TYPE subfield of st_info (symbol type).  */

#define STT_NOTYPE	0		/* Symbol type is unspecified */
#define STT_OBJECT	1		/* Symbol is a data object */
#define STT_FUNC	2		/* Symbol is a code object */
#define STT_SECTION	3		/* Symbol associated with a section */
#define STT_FILE	4		/* Symbol's name is file name */
#define STT_COMMON	5		/* Symbol is a common data object */
#define STT_TLS		6		/* Symbol is thread-local data object*/
#define	STT_NUM		7		/* Number of defined types.  */
#define STT_LOOS	10		/* Start of OS-specific */
#define STT_HIOS	12		/* End of OS-specific */
#define STT_LOPROC	13		/* Start of processor-specific */
#define STT_HIPROC	15		/* End of processor-specific */

=cut
    
sub st_type
{
    my $s = shift;
    my $type = $s->{_type};
    return undef unless defined $type && $type <= 15;
    return "OS-SPECIFIC" if $type >= 10 && $type <= 12;
    return "PROC-SPECIFIC" if $type >= 13 && $type <= 15;
    return undef unless $type < 7;
    my @types = qw/NOTYPE OBJECT FUNC SECTION FILE COMMON TLS/;
	
    return $types[$type];
}

sub is_func { return $_[0]->st_type eq 'FUNC' }
sub is_data { return $_[0]->st_type eq 'OBJECT' }
sub is_file { return $_[0]->st_type eq 'FILE' }
sub is_section { return $_[0]->st_type eq 'SECTION' }

sub set_string_table
{
    my $s = shift;
    $s->{_string_table} = shift;
    return 1;
}
    

sub name
{
    my $s = shift;
    my $string_table = $s->{_string_table};
    return undef unless $string_table;
    return $string_table->find_string($s->{_name});
}


sub is_defined
{
    my $s = shift;
    return $s->value && $s->name;
}


# ------------------------------------------------------------
# Wrap one ELF program header segment
package Elf::Segment;

sub new
{
    my $c = shift;
    $c = ref $c if ref $c;
    my $s = {};
    $s->{_buffer} = shift;
    bless $s, $c;
    return undef unless $s->_unpack_buffer;
    return $s;
}

=pod

/* Program segment header.  */

typedef struct
{
  Elf32_Word	p_type;			/* Segment type */
  Elf32_Off	p_offset;		/* Segment file offset */
  Elf32_Addr	p_vaddr;		/* Segment virtual address */
  Elf32_Addr	p_paddr;		/* Segment physical address */
  Elf32_Word	p_filesz;		/* Segment size in file */
  Elf32_Word	p_memsz;		/* Segment size in memory */
  Elf32_Word	p_flags;		/* Segment flags */
  Elf32_Word	p_align;		/* Segment alignment */
} Elf32_Phdr;

=cut
    
sub _unpack_buffer
{
    my $s = shift;
    
    my @fieldnames = map {"_$_"}
    qw(type offset vaddr paddr filesz memsz flags align);
    my %fields;
    @{$s}{@fieldnames} = unpack('i8', $s->{_buffer});
    $s->{_file_range} = Range->new($s->offset, $s->offset + $s->file_size);
    $s->{_mem_range} = Range->new($s->vaddr, $s->vaddr + $s->mem_size);
    return 1;
}

=pod

/* Legal values for p_type (segment type).  */

#define	PT_NULL		0		/* Program header table entry unused */
#define PT_LOAD		1		/* Loadable program segment */
#define PT_DYNAMIC	2		/* Dynamic linking information */
#define PT_INTERP	3		/* Program interpreter */
#define PT_NOTE		4		/* Auxiliary information */
#define PT_SHLIB	5		/* Reserved */
#define PT_PHDR		6		/* Entry for header table itself */
#define PT_TLS		7		/* Thread-local storage segment */
#define	PT_NUM		8		/* Number of defined types */
#define PT_LOOS		0x60000000	/* Start of OS-specific */
#define PT_GNU_EH_FRAME	0x6474e550	/* GCC .eh_frame_hdr segment */
#define PT_GNU_STACK	0x6474e551	/* Indicates stack executability */
#define PT_GNU_RELRO	0x6474e552	/* Read-only after relocation */
#define PT_LOSUNW	0x6ffffffa
#define PT_SUNWBSS	0x6ffffffa	/* Sun Specific segment */
#define PT_SUNWSTACK	0x6ffffffb	/* Stack segment */
#define PT_HISUNW	0x6fffffff
#define PT_HIOS		0x6fffffff	/* End of OS-specific */
#define PT_LOPROC	0x70000000	/* Start of processor-specific */
#define PT_HIPROC	0x7fffffff	/* End of processor-specific */

=cut

use constant PT_LOAD => 1;    
sub is_load
{
    my $s = shift;
    return $s->type == PT_LOAD;
}

=pod
    
/* Legal values for p_flags (segment flags).  */

#define PF_X		(1 << 0)	/* Segment is executable */
#define PF_W		(1 << 1)	/* Segment is writable */
#define PF_R		(1 << 2)	/* Segment is readable */
#define PF_MASKOS	0x0ff00000	/* OS-specific */
#define PF_MASKPROC	0xf0000000	/* Processor-specific */

=cut

use constant PF_X => 1;
use constant PF_W => 2;
use constant PF_R => 4;    
    
sub is_readable
{
    my $s = shift;
    return $s->_flag_is_set(PF_R);
}
sub is_writable
{
    my $s = shift;
    return $s->_flag_is_set(PF_W);
}
sub is_executable
{
    my $s = shift;
    return $s->_flag_is_set(PF_X);
}

sub _flag_is_set
{
    my $s = shift;
    my $bitflag = shift;
    my $flags = $s->{_flags};
    return $bitflag & $flags;
}

sub offset { return $_[0]->{_offset}; }
sub vaddr { return $_[0]->{_vaddr}; }
sub file_size { return $_[0]->{_filesz}; }
sub mem_size { return $_[0]->{_memsz}; }
sub file_range { return $_[0]->{_file_range}; }
sub mem_range { return $_[0]->{_mem_range}; }
sub type { return $_[0]->{_type}; }


1;