script for .idt/.ids files making

Suddenly™ I discovered that even recent version of IDA Pro hasn`t ids files for fresh MFC modules (for example mfc100.dll/mfc110.dll from Visual Studio 2010/2011). Running dll2idt.exe produces nothing:

Convert DLL to IDT file. Copyright 1997 by Yury Haron. Version 1.5
File: mfc100.dll     ... illegal structure or has no export names

So I decided to make needed .ids files by myself. But I am too lazy to make .idt/.ids files manually so I wrote simple perl script for this boring task

Main idea is very simple - we can run dumpbin /exports on some .dll module and then read all ordinal/VA pairs. Next we can download from MS corresponding .pdb file for this .dll module and dump it with pdbdump (I already posted script for downloading pdb files). Next you can parse this dump and find VA/names pairs. Finally with all of this info you can produce .idt file (or even .ids file with -z option if you have idsutils installed)
get_pdb.bat:
"C:\Program Files\Debugging Tools for Windows (x86)\symchk.exe" %1  /s SRV*%tmp%\ida\*http://msdl.microsoft.com/download/symbols /v 2>log

make_idt.pl:

#!perl -w
# Terrible script to produce IDT (for idsutils)/IDS files for IDA Pro

# 18 Mar 2012 (C) RedPlait 

use strict;
use warnings;

require File::Spec;
use Getopt::Std;
use vars qw/$opt_i $opt_n $opt_v $opt_z/;

# constants - you must fix it for your actual paths 

my $pdbdump_path = 'C:/work/wintestz/bin/pdbdump.exe';
my $get_pdb      = 'get_pdb.bat';
my $dumpbin_path = 'dumpbin';
my $zipids_path  = 'C:/ida62/sdk/ids/zipids.exe';

sub usage
{
    print STDERR <<EOF;
Usage is $0 [options] file(s)
Options:
  -i -- skip imports
  -n -- don`t delete tmp files
  -v -- verbose mode
  -z -- run zipids.exe
EOF
    exit (8);
}

sub make_idt_name
{
  my $fname = shift;
  $fname =~ s/\.([^\.\\\/]+)$/.idt/;
  return $fname;
}

sub make_exp_name
{
  my $fname = shift;
  $fname =~ s/\.([^\.\\\/]+)$/.exp/;
  return $fname;
}

sub make_pdb_name
{
  my $fname = shift;
  $fname =~ s/\.([^\.\\\/]+)$/.pdb/;
  return $fname;
}

sub make_pdmp_name
{
  my $fname = shift;
  $fname =~ s/\.([^\.\\\/]+)$/.pdmp/;
  return $fname;
}

sub parse_log
{
  my $fh;
  open($fh, '<', 'log') or return;
  my($str, $res);
  while( $str = <$fh> )
  {
    chomp $str;
    next if ( $str =~ /^\[SYMCHK\]|^DBGHELP:/ );
    if ( $str =~ /^PdbFilename\s+(.*)$/ )
    {
      $res = $1;
      last;
    }
  }
  close $fh;
  unlink 'log' if -f 'log';
  return $res;
}

# parse dumpbin /exports output file 

sub parse_exp
{
  my($fname, $href) = @_;
  my($str, $ord, $addr, $fh, $res, $status);
  open($fh, '<', $fname) or die("Cannot open $fname, error $!\n");
  $res = $status = 0;
  while($str = <$fh> )
  {
    chomp $str;
    $str =~ s/^\s+//;
    next if ( $str eq '' );
    if ( !$status )
    {
      next if ( $str !~ /^ordinal hint RVA      name/ );
      $status = 1;
      next;
    }
    if ( $status )
    {
      last if ( $str eq 'Summary' );
      next if ( $str !~ /^(\d+)\s+([0-9A-F]+)\s+/i );
      $ord = int($1);
      $addr = hex($2);
      $href->{$ord} = $addr;
      $res++;
    }
  }
  close $fh;
  return $res;
}

# parse pdbdump output file 

sub parse_pdmp
{
  my($fname, $href) = @_;
  my($str, $fh, $addr, $name, $res);
  open($fh, '<', $fname) or die("Cannot open $fname, error $!\n");
  $res = 0;
  while($str = <$fh> )
  {
    chomp $str;
    $str =~ s/^\s+//;
    next if ( $str eq '' );
    next if ( $str !~ /^\/\/ pubsym \\s?.*\s(\S+)$/i );
    $addr = hex($1);
    $name = $2;
    next if ( defined($opt_i) && $name =~ /^__imp__/ );
    if ( defined($opt_v) &&
         exists $href->{$addr}
       )
    {
      printf("Duplicated names %s for addr %X, ignored\n", $name, $addr);
      next;
    }
    $href->{$addr} = $name;
    $res++;
  }
  close $fh;
  return $res;
}

sub produce_idt
{
  my($dllname, $out_file, $ord_href, $pdb_href) = @_;
  my $fh;
  open($fh, '>', $out_file) or die("Cannot produce $out_file, error $!\n");
print $fh <<HEAD;

ALIGNMENT 4
;DECLARATION 
;
0 Name=$dllname
;
HEAD
 map { printf($fh "%d Name=%s\n", $_, $pdb_href->{$ord_href->{$_}}); }
    sort { $a <=> $b } keys %$ord_href
 ;
 close $fh;
}

sub make_data
{
  my $fname = shift;
  return if ( $fname eq '.' or
              $fname eq '..' or
              -d $fname
            );
  my $short_fname = (File::Spec->splitpath($fname))[2];
  # check if we already have .pdb for this file
  my $pdb = make_pdb_name $fname;
  if ( ! -f $pdb )
  {
    unlink 'log' if -f 'log';
    printf("PDB needed for %s\n", $fname) if defined $opt_v;
    `get_pdb $fname`;
    my $pdb_real = parse_log();
    if ( !defined($pdb_real) or ! -f $pdb_real )
    {
      printf("Cannot download PDB for %s\n", $fname);
      return;
    } else {
      rename($pdb_real, $pdb);
      printf("Download PDB %s for %s\n", $pdb_real, $fname) if defined $opt_v;
    }
  }
  # check if we already have .pdmp for this file
  my $pdmp = make_pdmp_name $fname;
  if ( ! -f $pdmp )
  {
    printf("PDMP needed for %s\n", $fname) if defined $opt_v;
    `$pdbdump_path $pdb > $pdmp`;
    if ( -s $pdmp )
    {
      printf("PDMP %s for %s\n", $pdmp, $fname) if defined $opt_v;
    } else {
      printf("Cannot make PDMP %s for %s\n", $pdmp, $fname);
      unlink $pdmp;
      return;
    }
  }
  # check if we already have .exp for this file
  my $exp_file = make_exp_name $fname;
  if ( ! -f $exp_file )
  {
    printf("EXP needed for %s\n", $fname) if defined $opt_v;
    my $cmd = $dumpbin_path . ' /exports ' . $fname . ' >' . $exp_file;
    `$cmd`;
    if ( -s $exp_file )
    {
      printf("EXP %s for %s\n", $exp_file, $fname) if defined $opt_v;
    } else {
      printf("Cannot make EXP %s for %s\n", $exp_file, $fname);
      unlink $exp_file;
      return;
    }
  }
  # o`k, all ready to produce final idt file
  my $idt_output = make_idt_name $fname;
  my(%ords, %p_dmp);
  parse_exp($exp_file, \%ords);
  parse_pdmp($pdmp, \%p_dmp);
  produce_idt($short_fname, $idt_output, \%ords, \%p_dmp);
  # finally run zipids.exe if we must
  if ( defined $opt_z )
  {
    my $zcmd = $zipids_path . ' ' . $idt_output;
    printf("%s\n", $zcmd) if defined $opt_v;
    `$zcmd`;
  }
  # delete all temp files
  if ( !defined $opt_n )
  {
    unlink $exp_file;
    unlink $pdmp;
    unlink $idt_output if ( defined $opt_z );
  }
}

# main
my $status = getopts("invz");
usage() if ($status == 0);
make_data $_ foreach @ARGV;