Немного подумав список критериев можно сократить до:
- Размер структуры - равен в точности X, меньше X или больше X
- Тип поля по некоторому смещению. Является указателем, имеет длину X, предположительно имеет тип Y etc
- pdbparse.pm - собственно парзить файл, полученный из pdb с помощью pdbdump
- pdbiter.pm - строить ленивые итераторы с учетом критериев поиска
- lazylist.pm - просто реализация ленивых списков, потыренная из книжки Higher-Order Perl
Получается примерно такой адовый кусок кода:
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; } } }
Комментариев нет:
Отправить комментарий