Home | History | Annotate | Line # | Download | only in cf 
      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 }
    213