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