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 32my $show_module_name = 1; 33my $use_indent = 1; 34my $strip_leading_underscore = 0; 35my $always_export = 0; 36my $module_name = ""; 37my $local_prefix = "SHIM_"; 38my %forward_exports = (); 39my %local_exports = (); 40 41sub 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 67sub 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 119sub 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 153sub 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 166sub 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 180print "; This is a generated file. Do not modify directly.\n"; 181print "EXPORTS\n"; 182 183for (@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