util/mkdef.pl

   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
  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 my $debug = 0;
  35
  36 # For VMS, some modules may have case insensitive names
  37 my $case_insensitive = 0;
  38
  39 GetOptions('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
  49 die "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
 104 my $libname = platform->sharedname($name);
 105
 106 my %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
 136 do {
 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
 142 my %disabled_uc = map { my $x = uc $_; $x =~ s|-|_|g; $x => 1 } keys %disabled;
 143
 144 my %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     };
 154 my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file);
 155
 156 my $writer = $OS->{writer};
 157 $writer = \&writer_ctest if $ctest;
 158
 159 $writer->($ordinals->items(%ordinal_opts));
 160
 161 exit 0;
 162
 163 sub 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
 186 sub 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
 208 sub 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
 227 sub 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
 243 sub 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
 280 sub writer_aix {
 281     for (@_) {
 282         print $_->name(),"\n";
 283     }
 284 }
 285
 286 sub writer_nonstop {
 287     for (@_) {
 288         print "-export ",$_->name(),"\n";
 289     }
 290 }
 291
 292 sub writer_windows {
 293     print <<"_____";
 294 ;
 295 ; Definition file for the DLL version of the $libname library from OpenSSL
 296 ;
 297
 298 LIBRARY         "$libname"
 299
 300 EXPORTS
 301 _____
 302     for (@_) {
 303         print "    ",$_->name();
 304         if (platform->can('export2internal')) {
 305             print "=". platform->export2internal($_->name());
 306         }
 307         print "\n";
 308     }
 309 }
 310
 311 sub 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
 322 sub 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
 332 sub 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;
 353 IDENTIFICATION=$version
 354 _____
 355     print <<"_____" unless $case_insensitive;
 356 CASE_SENSITIVE=YES
 357 _____
 358     print <<"_____";
 359 SYMBOL_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 )
 383 SYMBOL_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 <<"_____";
 409 GSMATCH=LEQUAL,$libvmajor,$libvminor
 410 _____
 411     }
 412 }
 413
 414 sub 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
 421 int 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 }