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 $libname = platform->sharedname($name);
 104
 105 my %OS_data = (
 106     solaris     => { writer     => \&writer_linux,
 107                      sort       => sorter_linux(),
 108                      platforms  => { UNIX                       => 1 } },
 109     linux       => 'solaris',   # alias
 110     "bsd-gcc"   => 'solaris',   # alias
 111     aix         => { writer     => \&writer_aix,
 112                      sort       => sorter_unix(),
 113                      platforms  => { UNIX                       => 1 } },
 114     VMS         => { writer     => \&writer_VMS,
 115                      sort       => OpenSSL::Ordinals::by_number(),
 116                      platforms  => { VMS                        => 1 } },
 117     vms         => 'VMS',       # alias
 118     WINDOWS     => { writer     => \&writer_windows,
 119                      sort       => OpenSSL::Ordinals::by_name(),
 120                      platforms  => { WIN32                      => 1,
 121                                      _WIN32                     => 1 } },
 122     windows     => 'WINDOWS',   # alias
 123     WIN32       => 'WINDOWS',   # alias
 124     win32       => 'WIN32',     # alias
 125     32          => 'WIN32',     # alias
 126     NT          => 'WIN32',     # alias
 127     nt          => 'WIN32',     # alias
 128     mingw       => 'WINDOWS',   # alias
 129    );
 130
 131 do {
 132     die "Unknown operating system family $OS\n"
 133         unless exists $OS_data{$OS};
 134     $OS = $OS_data{$OS};
 135 } while(ref($OS) eq '');
 136
 137 my %disabled_uc = map { my $x = uc $_; $x =~ s|-|_|g; $x => 1 } keys %disabled;
 138
 139 my %ordinal_opts = ();
 140 $ordinal_opts{sort} = $OS->{sort} if $OS->{sort};
 141 $ordinal_opts{filter} =
 142     sub {
 143         my $item = shift;
 144         return
 145             $item->exists()
 146             && platform_filter($item)
 147             && feature_filter($item);
 148     };
 149 my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file);
 150
 151 my $writer = $OS->{writer};
 152 $writer = \&writer_ctest if $ctest;
 153
 154 $writer->($ordinals->items(%ordinal_opts));
 155
 156 exit 0;
 157
 158 sub platform_filter {
 159     my $item = shift;
 160     my %platforms = ( $item->platforms() );
 161
 162     # True if no platforms are defined
 163     return 1 if scalar keys %platforms == 0;
 164
 165     # For any item platform tag, return the equivalence with the
 166     # current platform settings if it exists there, return 0 otherwise
 167     # if the item platform tag is true
 168     for (keys %platforms) {
 169         if (exists $OS->{platforms}->{$_}) {
 170             return $platforms{$_} == $OS->{platforms}->{$_};
 171         }
 172         if ($platforms{$_}) {
 173             return 0;
 174         }
 175     }
 176
 177     # Found no match?  Then it's a go
 178     return 1;
 179 }
 180
 181 sub feature_filter {
 182     my $item = shift;
 183     my @features = ( $item->features() );
 184
 185     # True if no features are defined
 186     return 1 if scalar @features == 0;
 187
 188     my $verdict = ! grep { $disabled_uc{$_} } @features;
 189
 190     if ($disabled{deprecated}) {
 191         foreach (@features) {
 192             next unless /^DEPRECATEDIN_(\d+)_(\d+)(?:_(\d+))?$/;
 193             my $symdep = $1 * 10000 + $2 * 100 + ($3 // 0);
 194             $verdict = 0 if $config{api} >= $symdep;
 195             print STDERR "DEBUG: \$symdep = $symdep, \$verdict = $verdict\n"
 196                 if $1 == 0;
 197         }
 198     }
 199
 200     return $verdict;
 201 }
 202
 203 sub sorter_unix {
 204     my $by_name = OpenSSL::Ordinals::by_name();
 205     my %weight = (
 206         'FUNCTION'      => 1,
 207         'VARIABLE'      => 2
 208        );
 209
 210     return sub {
 211         my $item1 = shift;
 212         my $item2 = shift;
 213
 214         my $verdict = $weight{$item1->type()} <=> $weight{$item2->type()};
 215         if ($verdict == 0) {
 216             $verdict = $by_name->($item1, $item2);
 217         }
 218         return $verdict;
 219     };
 220 }
 221
 222 sub sorter_linux {
 223     my $by_version = OpenSSL::Ordinals::by_version();
 224     my $by_unix = sorter_unix();
 225
 226     return sub {
 227         my $item1 = shift;
 228         my $item2 = shift;
 229
 230         my $verdict = $by_version->($item1, $item2);
 231         if ($verdict == 0) {
 232             $verdict = $by_unix->($item1, $item2);
 233         }
 234         return $verdict;
 235     };
 236 }
 237
 238 sub writer_linux {
 239     my $thisversion = '';
 240     my $currversion_s = '';
 241     my $prevversion_s = '';
 242     my $indent = 0;
 243
 244     for (@_) {
 245         if ($thisversion && $_->version() ne $thisversion) {
 246             die "$ordinals_file: It doesn't make sense to have both versioned ",
 247                 "and unversioned symbols"
 248                 if $thisversion eq '*';
 249             print <<"_____";
 250 }${prevversion_s};
 251 _____
 252             $prevversion_s = " OPENSSL${SO_VARIANT}_$thisversion";
 253             $thisversion = '';  # Trigger start of next section
 254         }
 255         unless ($thisversion) {
 256             $indent = 0;
 257             $thisversion = $_->version();
 258             $currversion_s = '';
 259             $currversion_s = "OPENSSL${SO_VARIANT}_$thisversion "
 260                 if $thisversion ne '*';
 261             print <<"_____";
 262 ${currversion_s}{
 263     global:
 264 _____
 265         }
 266         print '        ', $_->name(), ";\n";
 267     }
 268
 269     print <<"_____";
 270     local: *;
 271 }${prevversion_s};
 272 _____
 273 }
 274
 275 sub writer_aix {
 276     for (@_) {
 277         print $_->name(),"\n";
 278     }
 279 }
 280
 281 sub writer_windows {
 282     print <<"_____";
 283 ;
 284 ; Definition file for the DLL version of the $libname library from OpenSSL
 285 ;
 286
 287 LIBRARY         $libname
 288
 289 EXPORTS
 290 _____
 291     for (@_) {
 292         print "    ",$_->name(),"\n";
 293     }
 294 }
 295
 296 sub collect_VMS_mixedcase {
 297     return [ 'SPARE', 'SPARE' ] unless @_;
 298
 299     my $s = shift;
 300     my $s_uc = uc($s);
 301     my $type = shift;
 302
 303     return [ "$s=$type", 'SPARE' ] if $s_uc eq $s;
 304     return [ "$s_uc/$s=$type", "$s=$type" ];
 305 }
 306
 307 sub collect_VMS_uppercase {
 308     return [ 'SPARE' ] unless @_;
 309
 310     my $s = shift;
 311     my $s_uc = uc($s);
 312     my $type = shift;
 313
 314     return [ "$s_uc=$type" ];
 315 }
 316
 317 sub writer_VMS {
 318     my @slot_collection = ();
 319     my $collector =
 320         $case_insensitive ? \&collect_VMS_uppercase : \&collect_VMS_mixedcase;
 321
 322     my $last_num = 0;
 323     foreach (@_) {
 324         my $this_num = $_->number();
 325         $this_num = $last_num + 1 if $this_num =~ m|^\?|;
 326
 327         while (++$last_num < $this_num) {
 328             push @slot_collection, $collector->(); # Just occupy a slot
 329         }
 330         my $type = {
 331             FUNCTION    => 'PROCEDURE',
 332             VARIABLE    => 'DATA'
 333            } -> {$_->type()};
 334         push @slot_collection, $collector->($_->name(), $type);
 335     }
 336
 337     print <<"_____" if defined $version;
 338 IDENTIFICATION=$version
 339 _____
 340     print <<"_____" unless $case_insensitive;
 341 CASE_SENSITIVE=YES
 342 _____
 343     print <<"_____";
 344 SYMBOL_VECTOR=(-
 345 _____
 346     # It's uncertain how long aggregated lines the linker can handle,
 347     # but it has been observed that at least 1024 characters is ok.
 348     # Either way, this means that we need to keep track of the total
 349     # line length of each "SYMBOL_VECTOR" statement.  Fortunately, we
 350     # can have more than one of those...
 351     my $symvtextcount = 16;     # The length of "SYMBOL_VECTOR=("
 352     while (@slot_collection) {
 353         my $set = shift @slot_collection;
 354         my $settextlength = 0;
 355         foreach (@$set) {
 356             $settextlength +=
 357                 + 3             # two space indentation and comma
 358                 + length($_)
 359                 + 1             # postdent
 360                 ;
 361         }
 362         $settextlength--;       # only one space indentation on the first one
 363         my $firstcomma = ',';
 364
 365         if ($symvtextcount + $settextlength > 1024) {
 366             print <<"_____";
 367 )
 368 SYMBOL_VECTOR=(-
 369 _____
 370             $symvtextcount = 16; # The length of "SYMBOL_VECTOR=("
 371         }
 372         if ($symvtextcount == 16) {
 373             $firstcomma = '';
 374         }
 375
 376         my $indent = ' '.$firstcomma;
 377         foreach (@$set) {
 378             print <<"_____";
 379 $indent$_ -
 380 _____
 381             $symvtextcount += length($indent) + length($_) + 1;
 382             $indent = '  ,';
 383         }
 384     }
 385     print <<"_____";
 386 )
 387 _____
 388
 389     if (defined $version) {
 390         $version =~ /^(\d+)\.(\d+)\.(\d+)/;
 391         my $libvmajor = $1;
 392         my $libvminor = $2 * 100 + $3;
 393         print <<"_____";
 394 GSMATCH=LEQUAL,$libvmajor,$libvminor
 395 _____
 396     }
 397 }
 398
 399 sub writer_ctest {
 400     print <<'_____';
 401 /*
 402  * Test file to check all DEF file symbols are present by trying
 403  * to link to all of them. This is *not* intended to be run!
 404  */
 405
 406 int main()
 407 {
 408 _____
 409
 410     my $last_num = 0;
 411     for (@_) {
 412         my $this_num = $_->number();
 413         $this_num = $last_num + 1 if $this_num =~ m|^\?|;
 414
 415         if ($_->type() eq 'VARIABLE') {
 416             print "\textern int ", $_->name(), '; /* type unknown */ /* ',
 417                   $this_num, ' ', $_->version(), " */\n";
 418         } else {
 419             print "\textern int ", $_->name(), '(); /* type unknown */ /* ',
 420                   $this_num, ' ', $_->version(), " */\n";
 421         }
 422
 423         $last_num = $this_num;
 424     }
 425     print <<'_____';
 426 }
 427 _____
 428 }