perl rulez

а вот например я сегодня убедился в очередной раз что perl внутри IDA Pro давно перестал быть гиковской игрушкой
Например мне нужно узнать какие инструкции в модуле передают управление через указатель
Собственно их две всего: call [mem] (ff 15 xx xx xx xx) & jmp [mem] (ff 25 xx xx xx xx)
Дело осложняется тем что таких очень дофига - например ссылки на import table. Пришлось скрипт написать, который проходит по списку сегментов, ищет те, что содержат импорты и код и ищет всякое по двум сигнатурам. Работает пару секунд даже на ntoskrnl.exe

#!/usr/bin/perl

use IDA;
use strict;
use warnings;

my(@iats, @codes);
my $sort_by_addr = 1; # sort on addr or frequency

sub is_iat
{
  my $addr = shift;
  my $iter;
  foreach $iter ( @iats )
  {
    return 1 if ( ($addr >= $iter->[0]) and ($addr < $iter->[1]) );
  }
  return 0;
}

# iterate on all segments

my $seg = FirstSeg();
for ( ; $seg != BADADDR; $seg = NextSeg($seg) )
{
  my $addr = SegStart($seg);
  my $end  = SegEnd($seg);
  my $name = SegName($seg);
  next if ( $name eq 'HEADER' );
  if ( $name eq '.idata' )
  {
    push @iats, [ $addr, $end ];
  } elsif ( $name eq '.text' )
  {
    push @codes, [ $addr, $end ];
  } else {
    my $flag = GetSegmentAttr($seg, SEGATTR_PERM);
    # undocumented trick - to know if section contains code we need low bit of section SEGATTR_PERM attribute
    push @codes, [ $addr, $end ] if ( $flag & 1 );
  }
}

sub find_sig
{
  my($hdb, $pattern) = @_;
  my($iter, $start, $end, $addr);
  foreach $iter ( @codes )
  {
    $start = $iter->[0];
    $end   = $iter->[1];
    $addr = FindBinary($start, 3, $pattern);
    for ( ; $addr != BADADDR; $addr = FindBinary($addr + 6, 3, $pattern) )
    {
      last if ( $addr >= $end );
      my $val = Dword($addr + 2);
      next if ( !isLoaded($val) );
      next if ( is_iat($val) );
      $hdb->{$val}++;
    }
  }
}

# find patterns in all codes section 

my %hdb;
find_sig(\%hdb, "ff 15");
find_sig(\%hdb, "ff 25");

# write to log file ff.log

my($fh, $iter);
open($fh, ">ff.log") or die("Cannot open log file, error $!\n");
foreach $iter ( sort { $sort_by_addr ? $a <=> $b : $hdb{$b} <=> $hdb{$a} } keys %hdb )
{
  my $name = NameEx(BADADDR, $iter);
  if ( defined($name) and $name !~ /^off_[0-9A-F]+$/i )
  {
    printf($fh "%X (%s): %d\n", $iter, $name, $hdb{$iter});
  } else {
    printf($fh "%X: %d\n", $iter, $hdb{$iter});
  }
}
close $fh;