Refactor util/mkdef.pl for clearer separation of functionality
[openssl.git] / util / mkdef.pl
1 #! /usr/bin/env perl
2 # Copyright 2018 The OpenSSL Project Authors. All Rights Reserved.
3 #
4 # Licensed under the OpenSSL license (the "License").  You may not use
5 # this file except in compliance with the License.  You can obtain a copy
6 # in the file LICENSE in the source distribution or at
7 # https://www.openssl.org/source/license.html
8
9 # Generate a linker version script suitable for the given platform
10 # from a given ordinals file.
11
12 use strict;
13 use warnings;
14
15 use Getopt::Long;
16 use FindBin;
17 use lib "$FindBin::Bin/perl";
18
19 use OpenSSL::Ordinals;
20
21 use lib '.';
22 use configdata;
23
24 my $name = undef;               # internal library/module name
25 my $ordinals_file = undef;      # the ordinals file to use
26 my $OS = undef;                 # the operating system family
27 my $verbose = 0;
28 my $ctest = 0;
29
30 GetOptions('name=s'     => \$name,
31            'ordinals=s' => \$ordinals_file,
32            'OS=s'       => \$OS,
33            'ctest'      => \$ctest,
34            'verbose'    => \$verbose)
35     or die "Error in command line arguments\n";
36
37 die "Please supply arguments\n"
38     unless $name && $ordinals_file && $OS;
39
40 # When building a "variant" shared library, with a custom SONAME, also customize
41 # all the symbol versions.  This produces a shared object that can coexist
42 # without conflict in the same address space as a default build, or an object
43 # with a different variant tag.
44 #
45 # For example, with a target definition that includes:
46 #
47 #         shlib_variant => "-opt",
48 #
49 # we build the following objects:
50 #
51 # $ perl -le '
52 #     for (@ARGV) {
53 #         if ($l = readlink) {
54 #             printf "%s -> %s\n", $_, $l
55 #         } else {
56 #             print
57 #         }
58 #     }' *.so*
59 # libcrypto-opt.so.1.1
60 # libcrypto.so -> libcrypto-opt.so.1.1
61 # libssl-opt.so.1.1
62 # libssl.so -> libssl-opt.so.1.1
63 #
64 # whose SONAMEs and dependencies are:
65 #
66 # $ for l in *.so; do
67 #     echo $l
68 #     readelf -d $l | egrep 'SONAME|NEEDED.*(ssl|crypto)'
69 #   done
70 # libcrypto.so
71 #  0x000000000000000e (SONAME)             Library soname: [libcrypto-opt.so.1.1]
72 # libssl.so
73 #  0x0000000000000001 (NEEDED)             Shared library: [libcrypto-opt.so.1.1]
74 #  0x000000000000000e (SONAME)             Library soname: [libssl-opt.so.1.1]
75 #
76 # We case-fold the variant tag to upper case and replace all non-alnum
77 # characters with "_".  This yields the following symbol versions:
78 #
79 # $ nm libcrypto.so | grep -w A
80 # 0000000000000000 A OPENSSL_OPT_1_1_0
81 # 0000000000000000 A OPENSSL_OPT_1_1_0a
82 # 0000000000000000 A OPENSSL_OPT_1_1_0c
83 # 0000000000000000 A OPENSSL_OPT_1_1_0d
84 # 0000000000000000 A OPENSSL_OPT_1_1_0f
85 # 0000000000000000 A OPENSSL_OPT_1_1_0g
86 # $ nm libssl.so | grep -w A
87 # 0000000000000000 A OPENSSL_OPT_1_1_0
88 # 0000000000000000 A OPENSSL_OPT_1_1_0d
89 #
90 (my $SO_VARIANT = uc($target{"shlib_variant"} // '')) =~ s/\W/_/g;
91
92 my $apiv = undef;
93 $apiv = sprintf "%x%02x%02x", split(/\./, $config{api})
94     if $config{api};
95
96 my $libname = $unified_info{sharednames}->{$name} // $name;
97
98 my %OS_data = (
99     solaris     => { writer     => \&writer_linux,
100                      sort       => sorter_linux(),
101                      platforms  => { UNIX                       => 1,
102                                      EXPORT_VAR_AS_FUNCTION     => 0 } },
103     linux       => 'solaris',   # alias
104     aix         => { writer     => \&writer_aix,
105                      sort       => sorter_unix(),
106                      platforms  => { UNIX                       => 1,
107                                      EXPORT_VAR_AS_FUNCTION     => 0 } },
108     VMS         => { writer     => \&writer_VMS,
109                      sort       => OpenSSL::Ordinals::by_number(),
110                      platforms  => { VMS                        => 1,
111                                      EXPORT_VAR_AS_FUNCTION     => 0 } },
112     vms         => 'VMS',       # alias
113     WINDOWS     => { writer     => \&writer_windows,
114                      sort       => OpenSSL::Ordinals::by_name(),
115                      platforms  => { WIN32                      => 1,
116                                      _WIN32                     => 1,
117                                      EXPORT_VAR_AS_FUNCTION     => 1 } },
118     windows     => 'WINDOWS',   # alias
119     WIN32       => 'WINDOWS',   # alias
120     win32       => 'WIN32',     # alias
121     32          => 'WIN32',     # alias
122     NT          => 'WIN32',     # alias
123     nt          => 'WIN32',     # alias
124     mingw       => 'WINDOWS',   # alias
125    );
126
127 do {
128     die "Unknown operating system family $OS\n"
129         unless exists $OS_data{$OS};
130     $OS = $OS_data{$OS};
131 } while(ref($OS) eq '');
132
133 my %disabled_uc = map { my $x = uc $_; $x =~ s|-|_|g; $x => 1 } keys %disabled;
134
135 my %ordinal_opts = ();
136 $ordinal_opts{sort} = $OS->{sort} if $OS->{sort};
137 $ordinal_opts{filter} =
138     sub {
139         my $item = shift;
140         return
141             $item->exists()
142             && platform_filter($item)
143             && feature_filter($item);
144     };
145 my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file);
146
147 my $writer = $OS->{writer};
148 $writer = \&writer_ctest if $ctest;
149
150 $writer->($ordinals->items(%ordinal_opts));
151
152 exit 0;
153
154 sub platform_filter {
155     my $item = shift;
156     my %platforms = ( $item->platforms() );
157
158     # True if no platforms are defined
159     return 1 if scalar keys %platforms == 0;
160
161     # For any item platform tag, return the equivalence with the
162     # current platform settings if it exists there, return 0 otherwise
163     # if the item platform tag is true
164     for (keys %platforms) {
165         if (exists $OS->{platforms}->{$_}) {
166             return $platforms{$_} == $OS->{platforms}->{$_};
167         }
168         if ($platforms{$_}) {
169             return 0;
170         }
171     }
172
173     # Found no match?  Then it's a go
174     return 1;
175 }
176
177 sub feature_filter {
178     my $item = shift;
179     my %platforms = ( $item->platforms() );
180     my @features = ( $item->features() );
181
182     # True if no features are defined
183     return 1 if scalar @features == 0 && scalar keys %platforms == 0;
184
185     my $verdict =
186         !( ( grep { $disabled_uc{$_} } @features )
187            || ( grep { $_ eq 'ZLIB' && $disabled_uc{$_} } keys %platforms ) );
188
189     if ($apiv) {
190         foreach (@features) {
191             next unless /^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/;
192             my $symdep = sprintf "%x%02x%02x", $1, $2, $3;
193             $verdict = 0 if $apiv ge $symdep;
194         }
195     }
196
197     return $verdict;
198 }
199
200 sub sorter_unix {
201     my $by_name = OpenSSL::Ordinals::by_name();
202     my %weight = (
203         'FUNCTION'      => 1,
204         'VARIABLE'      => 2
205        );
206
207     return sub {
208         my $item1 = shift;
209         my $item2 = shift;
210
211         my $verdict = $weight{$item1->type()} <=> $weight{$item2->type()};
212         if ($verdict == 0) {
213             $verdict = $by_name->($item1, $item2);
214         }
215         return $verdict;
216     };
217 }
218
219 sub sorter_linux {
220     my $by_version = OpenSSL::Ordinals::by_version();
221     my $by_unix = sorter_unix();
222
223     return sub {
224         my $item1 = shift;
225         my $item2 = shift;
226
227         my $verdict = $by_version->($item1, $item2);
228         if ($verdict == 0) {
229             $verdict = $by_unix->($item1, $item2);
230         }
231         return $verdict;
232     };
233 }
234
235 sub writer_linux {
236     my $thisversion = '';
237     my $prevversion = '';
238
239     for (@_) {
240         if ($thisversion && $_->version() ne $thisversion) {
241             print <<"_____";
242 }$prevversion;
243 _____
244             $prevversion = " OPENSSL${SO_VARIANT}_$thisversion";
245             $thisversion = '';  # Trigger start of next section
246         }
247         unless ($thisversion) {
248             $thisversion = $_->version();
249             print <<"_____";
250 OPENSSL${SO_VARIANT}_$thisversion {
251     global:
252 _____
253         }
254         print '        ', $_->name(), ";\n";
255     }
256
257     print <<"_____";
258     local: *;
259 }$prevversion;
260 _____
261 }
262
263 sub writer_aix {
264     for (@_) {
265         print $_->name(),"\n";
266     }
267 }
268
269 sub writer_windows {
270     print <<"_____";
271 ;
272 ; Definition file for the DLL version of the $libname library from OpenSSL
273 ;
274
275 LIBRARY         $libname
276
277 EXPORTS
278 _____
279     for (@_) {
280         print "    ",$_->name(),"\n";
281     }
282 }
283
284 sub writer_VMS {
285     my @slot_collection = ();
286     my $write_vector_slot_pair =
287         sub {
288             my $slot1 = shift;
289             my $slot2 = shift;
290             my $slotpair_text = " $slot1, -\n  $slot2, -\n"
291         };
292
293     my $last_num = 0;
294     foreach (@_) {
295         while (++$last_num < $_->number()) {
296             push @slot_collection, [ 'SPARE', 'SPARE' ];
297         }
298         my $type = {
299             FUNCTION    => 'PROCEDURE',
300             VARIABLE    => 'DATA'
301            } -> {$_->type()};
302         my $s = $_->name();
303         my $s_uc = uc($s);
304         if ($s_uc eq $s) {
305             push @slot_collection, [ "$s=$type", 'SPARE' ];
306         } else {
307             push @slot_collection, [ "$s_uc/$s=$type", "$s=$type" ];
308         }
309     }
310
311     print <<"_____";
312 IDENTIFICATION=$config{version}
313 CASE_SENSITIVE=YES
314 SYMBOL_VECTOR=(-
315 _____
316     # It's uncertain how long aggregated lines the linker can handle,
317     # but it has been observed that at least 1024 characters is ok.
318     # Either way, this means that we need to keep track of the total
319     # line length of each "SYMBOL_VECTOR" statement.  Fortunately, we
320     # can have more than one of those...
321     my $symvtextcount = 16;     # The length of "SYMBOL_VECTOR=("
322     while (@slot_collection) {
323         my $pair = shift @slot_collection;
324         my $pairtextlength =
325             2                   # one space indentation and comma
326             + length($pair->[0])
327             + 1                 # postdent
328             + 3                 # two space indentation and comma
329             + length($pair->[1])
330             + 1                 # postdent
331             ;
332         my $firstcomma = ',';
333
334         if ($symvtextcount + $pairtextlength > 1024) {
335             print <<"_____";
336 )
337 SYMBOL_VECTOR=(-
338 _____
339             $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
340         }
341         if ($symvtextcount == 16) {
342             $firstcomma = '';
343         }
344         print <<"_____";
345  $firstcomma$pair->[0] -
346   ,$pair->[1] -
347 _____
348         $symvtextcount += $pairtextlength;
349     }
350     print <<"_____";
351 )
352 _____
353
354     my ($libvmajor, $libvminor, $libvedit, $libvpatch) =
355         $config{version} =~ /^(\d+)_(\d+)_(\d+)([a-z]{0,2})-.*$/;
356     my $libvpatchnum = 0;
357     for (split '', $libvpatch // '') {
358         $libvpatchnum += ord(lc($_)) - 96;
359         # To compensate because the letter 'z' is always followed by another,
360         # i.e. doesn't add any value on its own
361         $libvpatchnum-- if lc($_) eq 'z';
362     }
363     my $match1 = $libvmajor * 100 + $libvminor;
364     my $match2 = $libvedit * 100 + $libvpatchnum;
365     print <<"_____";
366 GSMATCH=LEQUAL,$match1,$match2
367 _____
368 }
369
370 sub writer_ctest {
371     print <<'_____';
372 /*
373  * Test file to check all DEF file symbols are present by trying
374  * to link to all of them. This is *not* intended to be run!
375  */
376
377 int main()
378 {
379 _____
380
381     for (@_) {
382         if ($_->type() eq 'VARIABLE') {
383             print "\textern int ", $_->name(), '; /* type unknown */ /* ', $_->number(), ' ', $_->version(), " */\n";
384         } else {
385             print "\textern int ", $_->name(), '(); /* type unknown */ /* ', $_->number(), ' ', $_->version(), " */\n";
386         }
387     }
388     print <<'_____';
389 }
390 _____
391 }