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