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