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