четверг, 17 февраля 2011 г.

partial structs matcher

У меня довольно часто возникает необходимость отреверсить всякие разные структуры данных. Учитывая что я крайне ленив и например часть структур может быть уже есть в раздаваемых империей добра microsoft pdb файлах - возникла идея написать некую прогу, которой можно было бы дать pdb (ну или выход pdbdump) и всякие разные критерии, по которым она бы сама нашла всех подходящих кандидатов
Немного подумав список критериев можно сократить до:
  1. Размер структуры - равен в точности X, меньше X или больше X
  2. Тип поля по некоторому смещению. Является указателем, имеет длину X, предположительно имеет тип Y etc
Соотв-но был написан простой perl package, точнее даже 3, которые умеют делать следующие вещи:
  • pdbparse.pm - собственно парзить файл, полученный из pdb с помощью pdbdump
  • pdbiter.pm - строить ленивые итераторы с учетом критериев поиска
  • lazylist.pm - просто реализация ленивых списков, потыренная из книжки Higher-Order Perl
Например я хочу найти список структур, у которых первое поле (по смещению 0) предположительно является LIST_ENTRY, поле по смещению 0x38 - указатель (неважно на что), а общий размер структуры не меньше 0x100 байт.
Получается примерно такой адовый кусок кода:
my $iter = off_cond(
     off_cond(
       size_cond(plain_iter($res), sub { return ($_[0] >= 0x100); }),
        0x0, sub { my $aref = shift; return $aref->[2] =~ /LIST_ENTRY/ } ),
        0x38, sub { my $aref = shift; return $aref->[3]; }
)
Пройдясь этим итератором по pdb от vista 64 бита мы получим ровно три структуры, отвечающие всем заданным критериям поиска:
  • _KALPC_MESSAGE
  • _ALPC_PORT
  • _ETW_GUID_ENTRY
Исходный код всех трех запчастей под катом. Слабонервным питонщикам и беременным лучше этого не видеть, бгг
lazylist.pm
# Lame lazy list implementation
# Ripped from book "Higher-Order Perl"
use strict;
use warnings;

package lazylist;
require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/node head is_promise promise tail drop union/;

sub node
{
  my($h, $t) = @_;
  return [$h, $t];
}
sub head
{
  my $s = shift;
  return $s->[0];
}
sub promise(&)
{
  return $_[0];
}
sub is_promise
{
  return UNIVERSAL::isa($_[0], 'CODE');
}
sub tail
{
  my $s = shift;
  if ( is_promise($s->[1]) )
  {
    $s->[1] = $s->[1]->();
  }
  return $s->[1];
}
sub drop
{
  my $h = head($_[0]);
  $_[0] = tail($_[0]);
  return $h;
}
sub union
{
  my($h, @s) = grep $_, @_;
  return unless $h;
  return $h unless @s;
  return node(head($h), promise { union(@s, tail($h)); });
}
# be trve
1; 

pdbparse.pm - содержит лоховской парзер выхода от pdbdump (например не понимает массивы, битовые поля, не подставляет содержимое родительских классов и т.д. и т.п. - список улучшений может быть практически бесконечным).
# Terrible script for pdbdump output parsing
use strict;
use warnings;
use Data::Dumper;

package pdbparse;
require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/parse_pdb dump_list dump_item/;

my %Titles = (
  'Typedefs'     => 0,
  'Enumerations' => 0,
  'Constants'    => 0,
  'Structs'      => 0,
  'Unions'       => 0,
  'Classes'      => 0,
  'Functions'    => 1,
  'Globals/Statics' => 1,
  'Public symbols'  => 1,
);

# return closure for lines counting
sub make_readline
{
  my($fh, $ln) = @_;
  $$ln = 0;
  return sub
  {
    my $str = <$fh>;
    $$ln++ if defined $str;
    return $str;
  }
}

# skip enum definition
sub skip_enums
{
  my $reader = shift;
  my $str;
  while( $str = $reader->() )
  {
    last if ( $str =~ /^};/ );
  }
}

# skip const definition
sub skip_const
{
  my $reader = shift;
  my $str;
  while( $str = $reader->() )
  {
    last if ( $str =~ /^;/ );
  }
}

# read and parse struct or union definition
# fields stored in 'FLDS' as hash
# where offset is key
# and value is [] of 4 element array
#  1st  - size
#  2nd  - name
#  3rd  - type
#  last - 1 if ptr
sub parse_struct
{
  my($str, $reader) = @_;
  my($kwd, $name) = (split /\s+/, $str);
  my(%hash, %fields, $state, $current);
  $hash{'NAME'} = $name;
  $hash{'TYPE'} = $kwd;
  $hash{'FLDS'} = \%fields;
  $state = 0;
  while($str = $reader->() )
  {
    chomp $str;
    if ( $str =~ /^\s*\/\/ non-static data/ )
    {
      $state = 1;
      next;
    }
    if ( $state == 1 )
    {
      if ( $str eq '' )
      {
        $state = 0;
        next;
      }
      if ( $str =~ m#/\*<thisrel this\+0x(\w+)>\*/\s+/\*\|0x(\w+)\|\*/\s+(.*)\s+(\w+);$# )
      {
        my $off = hex($1);
        my $size = hex($2);
        $name = $4;
        # parse type & name of field
        $str = $3;
        if ( $str =~ /\*$/ )
        {
          $current = [ $size, $name, $str, 1 ];
        } else {
          $current = [ $size, $name, $str, 0 ];
        }
        # lets check if we already have such offset (e.q. this is union)
        if ( exists $fields{$off} )
        {
          push @{ $fields{$off} }, $current;
        } else {
          $fields{$off} = [ $current ];
        }
      }
    }
    last if ( $str =~ /^};/ );
  }

  # read size
  $str = $reader->();
  if ( defined($str) and $str =~ /^\/\/ <size 0x(\w+)>/ )
  {
    $hash{'LEN'} = hex($1);
  }
  return \%hash;
}

# main horror function
sub parse_pdb
{
  my $fname = shift;
  my($fh, $ln);
  open($fh, '<', $fname) or return undef;
  my $reader = make_readline($fh, \$ln);
  my($str, $res, $kwd);
  while( $str = $reader->() )
  {
    chomp $str;
    next if ( $str eq '' );
    next if ( $str =~ /^\s*\/\// );
    if ( exists $Titles{$str} )
    {
      last if ( $Titles{$str} );
      next;
    }
    $kwd = (split /\s+/, $str)[0];
    if ( $kwd eq 'enum' )
    {
      skip_enums($reader);
      next;
    } elsif ( $kwd eq 'typedef' )
    {
      next;
    } elsif ( $kwd eq 'const' )
    {
      skip_const($reader);
      next;
    } elsif ( $kwd =~ /struct|union|class/ )
    {
      my $current_line = $ln;
      my $sref = parse_struct($str, $reader);
      if ( defined($sref) )
      {
        $sref->{'NEXT'} = $res if defined $res;
        $sref->{'LN'} = $current_line;
        $res = $sref;
      }
    } else {
      printf("unknown keyword %s, ln %d\n", $kwd, $ln);
    }
  }
  return $res;
}

# lame dumper (via Data::Dumper)
# dumping whole list is crap - I got Out of memory!
# So we dump by one element temporary cut off NEXT
sub dump_list
{
  my $href = shift;
  return if ( ! defined $href );
  my $old;
  my $n = 0;
  while( defined($href) )
  {
    # store old NEXT
    $old = $href->{'NEXT'};
    # erase it
    delete $href->{'NEXT'};
    # dump
    printf("[%d] %s\n", $n, Data::Dumper::Dumper($href));
    # inc count
    $n++;
    # restore NEXT
    $href->{'NEXT'} = $old;
    # move to next item
    $href = $old;
  }
}

sub dump_item
{
  my $item = shift;
  return if ( ! defined $item );
  # store old NEXT
  my $old = $item->{'NEXT'};
  delete $item->{'NEXT'};
  # dump
  printf("%s\n", Data::Dumper::Dumper($item));
  # restore NEXT
  $item->{'NEXT'} = $old;
}

# be trve
1; 
pdbiter.pm - для конструирования всяких итераторов с условиями. Умеет делать ровно три типа итераторов:
  • plain_iter - возвращает простой итератор из данных, зачитанных в pdbparse::parse_pdb
  • size_cond - требует итератор и ф-цию, которая будет вызвана с аргументом - размером текущей структуры. Если структура интересна - ф-ция должна вернуть не ноль
  • off_cond - требует итератор, смещение и ф-цию, которая будет вызвана для всех полей по этому смещению (полей может быть несколько - например в union). Ф-ции передается указатель на массив из 4 элементов - размер поля, имя поля, тип поля и является ли поле указателем. Аналогично ф-ция должна вернуть не 0 если поле соотв-вует критериям поиска
# Iterators on pdb data
use strict;
use warnings;
use lazylist;

package pdbiter;
require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/plain_iter size_cond off_cond/;

# get list, returned from pdbparse::parse_pdb
# return plain lazy iterator on this list
sub plain_iter
{
  my $list = shift;
  return if ( ! defined $list );
  my $next = $list->{'NEXT'};
  return lazylist::node($list, lazylist::promise { plain_iter($next) } );
}

# get old iterator + condition on size
# return new iterator (like grep on size)
sub size_cond
{
  my($old_iter, $cond) = @_;
  my $res;
  return if ( !defined $old_iter );
  while($res = lazylist::drop($old_iter))
  {
    next if ( ! exists $res->{'LEN'} );
    next if ( ! $cond->($res->{'LEN'}) );
    return lazylist::node($res, lazylist::promise { size_cond($old_iter, $cond) } );
  }
  return undef;
}

# get old iterator + condition on some offset
# return new iterator (like grep on all fields at some offset)
sub off_cond
{
  my($old_iter, $off, $cond) = @_;
  my $res;
  return if ( !defined $old_iter );
  while( $res = lazylist::drop($old_iter) )
  {
    next if ( !exists $res->{'FLDS'} );
    my $flds = $res->{'FLDS'};
    next if ( !exists $flds->{$off} );
    foreach ( @{ $flds->{$off} } )
    {
      return lazylist::node($res, lazylist::promise { off_cond($old_iter, $off, $cond) }) if $cond->($_);
    }
  }
  return undef;
}
# be trve
1;
Ну и полный примерчик использования всего этого богатства:
test.pl
use strict;
use warnings;
use FindBin qw($Bin);
use lib $Bin;
use pdbparse;
use pdbiter;

foreach (@ARGV)
{
  my $res = pdbparse::parse_pdb($_);
  if ( defined $res )
  {
    my $iter = off_cond(
       off_cond(
         size_cond(plain_iter($res), sub { return ($_[0] >= 0x100); }),
          0x0, sub { my $aref = shift; return $aref->[2] =~ /LIST_ENTRY/ } ),
          0x38, sub { my $aref = shift; return $aref->[3]; }

    );
    my $res;
    while( $res = drop($iter) )
    {
      dump_item $res;
    }
  }
}

Комментариев нет:

Отправить комментарий