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 }