cf/w32-def-from-dll.pl

   1 ########################################################################
   2 #
   3 # Copyright (c) 2010, Secure Endpoints Inc.
   4 # All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions
   8 # are met:
   9 #
  10 # - Redistributions of source code must retain the above copyright
  11 #   notice, this list of conditions and the following disclaimer.
  12 #
  13 # - Redistributions in binary form must reproduce the above copyright
  14 #   notice, this list of conditions and the following disclaimer in
  15 #   the documentation and/or other materials provided with the
  16 #   distribution.
  17 #
  18 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  19 # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  20 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  21 # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  22 # COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  23 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  24 # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  25 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  26 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  27 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  28 # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  29 # POSSIBILITY OF SUCH DAMAGE.
  30 #
  31
  32 my $show_module_name = 1;
  33 my $use_indent = 1;
  34 my $strip_leading_underscore = 0;
  35 my $always_export = 0;
  36 my $module_name = "";
  37 my $local_prefix = "SHIM_";
  38 my %forward_exports = ();
  39 my %local_exports = ();
  40
  41 sub build_forwarder_target_list($)
  42 {
  43     $fn = shift;
  44
  45     print STDERR "Processing defs from file [$fn]\n";
  46
  47     open(SP, '-|', "dumpbin /exports \"".$fn."\"") or die "Can't open pipe for $fn";
  48
  49   LINE:
  50     while (<SP>) {
  51 #        112   6F 00071CDC krb5_encrypt_size
  52
  53         /^ +([[:digit:]]+)\s+[[:xdigit:]]+\s[[:xdigit:]]{8,}\s+(\S+)(?:| = (\S*))$/ && do {
  54             my ($ordinal, $symbol, $in) = ($1, $2, $3);
  55
  56             if ($in eq "") { $in = $symbol };
  57             $forward_exports{$symbol} = $in;
  58         };
  59     }
  60
  61     close SP;
  62 }
  63
  64 # Dump all symbols for the given dll file that are defined and have
  65 # external scope.
  66
  67 sub build_def_file($)
  68 {
  69     $fn = shift;
  70
  71     print STDERR "Opening dump of DLL [$fn]\n";
  72
  73     open(SP, '-|', "dumpbin /exports \"".$fn."\"") or die "Can't open pipe for $fn";
  74
  75   LINE:
  76     while (<SP>) {
  77 #        112   6F 00071CDC krb5_encrypt_size
  78
  79         /^ +([[:digit:]]+)\s+[[:xdigit:]]+\s[[:xdigit:]]{8,}\s+(\S+)(?:| = (\S*))$/ && do {
  80             my ($ordinal, $symbol, $in) = ($1, $2, $3);
  81
  82             if ($strip_leading_underscore && $symbol =~ /_(.*)/) {
  83                 $symbol = $1;
  84             }
  85             if (exists $local_exports{$symbol}) {
  86                 print "\t".$symbol;
  87                 print " = ".$local_exports{$symbol};
  88                 if ($in ne $local_exports{$symbol} and $in ne "") {
  89                     print STDERR "Incorrect calling convention for local $symbol\n";
  90                     print STDERR "  ".$in." != ".$local_exports{$symbol}."\n";
  91                 }
  92                 print "\t@".$ordinal."\n";
  93             } elsif (exists $local_exports{$local_prefix.$symbol}) {
  94                 print "\t".$symbol;
  95                 print " = ".$local_exports{$local_prefix.$symbol};
  96                 print "\t@".$ordinal."\n";
  97             } elsif (exists $forward_exports{$symbol}) {
  98                 print "\t".$symbol;
  99                 print " = ".$module_name;
 100                 if ($in ne $forward_exports{$symbol} and $in ne "") {
 101                     print STDERR "Incorrect calling convention for $symbol\n";
 102                     print STDERR "  ".$in." != ".$forward_exports{$symbol}."\n";
 103                 }
 104                 my $texp = $forward_exports{$symbol};
 105                 if ($texp =~ /^_([^@]+)$/) { $texp = $1; }
 106                 print $texp."\t@".$ordinal."\n";
 107             } elsif ($always_export) {
 108                 print "\t".$symbol." = ".$local_prefix.$symbol;
 109                 print "\t@".$ordinal."\n";
 110             } else {
 111                 print STDERR "Symbol not found: $symbol\n";
 112             }
 113         };
 114     }
 115
 116     close SP;
 117 }
 118
 119 sub build_local_exports_list($)
 120 {
 121     $fn = shift;
 122
 123     print STDERR "Opening dump of object [$fn]\n";
 124
 125     open(SP, '-|', "dumpbin /symbols \"".$fn."\"") or die "Can't open pipe for $fn";
 126
 127   LINE:
 128     while (<SP>) {
 129         # 009 00000010 SECT3  notype ()    External     | _remove_error_table@4
 130         m/^[[:xdigit:]]{3,}\s[[:xdigit:]]{8,}\s(\w+)\s+\w*\s+(?:\(\)|  )\s+(\w+)\s+\|\s+(\S+)$/ && do {
 131             my ($section, $visibility, $symbol) = ($1, $2, $3);
 132
 133             if ($section ne "UNDEF" && $visibility eq "External") {
 134
 135                 my $exp_name = $symbol;
 136
 137                 if ($symbol =~ m/^_(\w+)(?:@.*|)$/) {
 138                     $exp_name = $1;
 139                 }
 140
 141                 if ($symbol =~ m/^_([^@]+)$/) {
 142                     $symbol = $1;
 143                 }
 144
 145                 $local_exports{$exp_name} = $symbol;
 146             }
 147         };
 148     }
 149
 150     close SP;
 151 }
 152
 153 sub process_file($)
 154 {
 155     $fn = shift;
 156
 157     if ($fn =~ m/\.dll$/i) {
 158         build_def_file($fn);
 159     } elsif ($fn =~ m/\.obj$/i) {
 160         build_local_exports_list($fn);
 161     } else {
 162         die "File type not recognized for $fn.";
 163     }
 164 }
 165
 166 sub use_response_file($)
 167 {
 168     $fn = shift;
 169
 170     open (RF, '<', $fn) or die "Can't open response file $fn";
 171
 172     while (<RF>) {
 173         /^(\S+)$/ && do {
 174             process_file($1);
 175         }
 176     }
 177     close RF;
 178 }
 179
 180 print "; This is a generated file.  Do not modify directly.\n";
 181 print "EXPORTS\n";
 182
 183 for (@ARGV) {
 184     ARG: {
 185         /^-m(.*)$/ && do {
 186             $module_name = $1.".";
 187             last ARG;
 188         };
 189
 190         /^-l(.*)$/ && do {
 191             $local_prefix = $1."_";
 192             last ARG;
 193         };
 194
 195         /^-a$/ && do {
 196             $always_export = 1;
 197             last ARG;
 198         };
 199
 200         /^-e(.*)$/ && do {
 201             build_forwarder_target_list($1);
 202             last ARG;
 203         };
 204
 205         /^@(.*)$/ && do {
 206             use_response_file($1);
 207             last ARG;
 208         };
 209
 210         process_file($_);
 211     }
 212 }