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