| 1 | #! /usr/bin/env perl
|
|---|
| 2 | # Copyright 1995-2019 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 | #
|
|---|
| 10 | # generate a .def file
|
|---|
| 11 | #
|
|---|
| 12 | # It does this by parsing the header files and looking for the
|
|---|
| 13 | # prototyped functions: it then prunes the output.
|
|---|
| 14 | #
|
|---|
| 15 | # Intermediary files are created, call libcrypto.num and libssl.num,
|
|---|
| 16 | # The format of these files is:
|
|---|
| 17 | #
|
|---|
| 18 | # routine-name nnnn vers info
|
|---|
| 19 | #
|
|---|
| 20 | # The "nnnn" and "vers" fields are the numeric id and version for the symbol
|
|---|
| 21 | # respectively. The "info" part is actually a colon-separated string of fields
|
|---|
| 22 | # with the following meaning:
|
|---|
| 23 | #
|
|---|
| 24 | # existence:platform:kind:algorithms
|
|---|
| 25 | #
|
|---|
| 26 | # - "existence" can be "EXIST" or "NOEXIST" depending on if the symbol is
|
|---|
| 27 | # found somewhere in the source,
|
|---|
| 28 | # - "platforms" is empty if it exists on all platforms, otherwise it contains
|
|---|
| 29 | # comma-separated list of the platform, just as they are if the symbol exists
|
|---|
| 30 | # for those platforms, or prepended with a "!" if not. This helps resolve
|
|---|
| 31 | # symbol name variants for platforms where the names are too long for the
|
|---|
| 32 | # compiler or linker, or if the systems is case insensitive and there is a
|
|---|
| 33 | # clash, or the symbol is implemented differently (see
|
|---|
| 34 | # EXPORT_VAR_AS_FUNCTION). This script assumes renaming of symbols is found
|
|---|
| 35 | # in the file crypto/symhacks.h.
|
|---|
| 36 | # The semantics for the platforms is that every item is checked against the
|
|---|
| 37 | # environment. For the negative items ("!FOO"), if any of them is false
|
|---|
| 38 | # (i.e. "FOO" is true) in the environment, the corresponding symbol can't be
|
|---|
| 39 | # used. For the positive items, if all of them are false in the environment,
|
|---|
| 40 | # the corresponding symbol can't be used. Any combination of positive and
|
|---|
| 41 | # negative items are possible, and of course leave room for some redundancy.
|
|---|
| 42 | # - "kind" is "FUNCTION" or "VARIABLE". The meaning of that is obvious.
|
|---|
| 43 | # - "algorithms" is a comma-separated list of algorithm names. This helps
|
|---|
| 44 | # exclude symbols that are part of an algorithm that some user wants to
|
|---|
| 45 | # exclude.
|
|---|
| 46 | #
|
|---|
| 47 |
|
|---|
| 48 | use lib ".";
|
|---|
| 49 | use configdata;
|
|---|
| 50 | use File::Spec::Functions;
|
|---|
| 51 | use File::Basename;
|
|---|
| 52 | use FindBin;
|
|---|
| 53 | use lib "$FindBin::Bin/perl";
|
|---|
| 54 | use OpenSSL::Glob;
|
|---|
| 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 upper case 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 = qq{\U$target{"shlib_variant"}}) =~ s/\W/_/g;
|
|---|
| 107 |
|
|---|
| 108 | my $debug=0;
|
|---|
| 109 | my $trace=0;
|
|---|
| 110 | my $verbose=0;
|
|---|
| 111 |
|
|---|
| 112 | my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num");
|
|---|
| 113 | my $ssl_num= catfile($config{sourcedir},"util","libssl.num");
|
|---|
| 114 | my $libname;
|
|---|
| 115 |
|
|---|
| 116 | my $do_update = 0;
|
|---|
| 117 | my $do_rewrite = 1;
|
|---|
| 118 | my $do_crypto = 0;
|
|---|
| 119 | my $do_ssl = 0;
|
|---|
| 120 | my $do_ctest = 0;
|
|---|
| 121 | my $do_ctestall = 0;
|
|---|
| 122 | my $do_checkexist = 0;
|
|---|
| 123 |
|
|---|
| 124 | my $VMS=0;
|
|---|
| 125 | my $W32=0;
|
|---|
| 126 | my $NT=0;
|
|---|
| 127 | my $UNIX=0;
|
|---|
| 128 | my $linux=0;
|
|---|
| 129 | my $aix=0;
|
|---|
| 130 | # Set this to make typesafe STACK definitions appear in DEF
|
|---|
| 131 | my $safe_stack_def = 0;
|
|---|
| 132 |
|
|---|
| 133 | my @known_platforms = ( "__FreeBSD__", "PERL5",
|
|---|
| 134 | "EXPORT_VAR_AS_FUNCTION", "ZLIB", "_WIN32"
|
|---|
| 135 | );
|
|---|
| 136 | my @known_ossl_platforms = ( "UNIX", "VMS", "WIN32", "WINNT", "OS2" );
|
|---|
| 137 | my @known_algorithms = ( # These are algorithms we know are guarded in relevant
|
|---|
| 138 | # header files, but aren't actually disablable.
|
|---|
| 139 | # Without these, this script will warn a lot.
|
|---|
| 140 | "RSA", "MD5",
|
|---|
| 141 | # @disablables comes from configdata.pm
|
|---|
| 142 | map { (my $x = uc $_) =~ s|-|_|g; $x; } @disablables,
|
|---|
| 143 | # Deprecated functions. Not really algorithmss, but
|
|---|
| 144 | # treated as such here for the sake of simplicity
|
|---|
| 145 | "DEPRECATEDIN_0_9_8",
|
|---|
| 146 | "DEPRECATEDIN_1_0_0",
|
|---|
| 147 | "DEPRECATEDIN_1_1_0",
|
|---|
| 148 | "DEPRECATEDIN_1_2_0",
|
|---|
| 149 | );
|
|---|
| 150 |
|
|---|
| 151 | # %disabled comes from configdata.pm
|
|---|
| 152 | my %disabled_algorithms =
|
|---|
| 153 | map { (my $x = uc $_) =~ s|-|_|g; $x => 1; } keys %disabled;
|
|---|
| 154 |
|
|---|
| 155 | my $apiv = sprintf "%x%02x%02x", split(/\./, $config{api});
|
|---|
| 156 | foreach (@known_algorithms) {
|
|---|
| 157 | if (/^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/) {
|
|---|
| 158 | my $depv = sprintf "%x%02x%02x", $1, $2, $3;
|
|---|
| 159 | $disabled_algorithms{$_} = 1 if $apiv ge $depv;
|
|---|
| 160 | }
|
|---|
| 161 | }
|
|---|
| 162 |
|
|---|
| 163 | my $zlib;
|
|---|
| 164 |
|
|---|
| 165 | foreach (@ARGV, split(/ /, $config{options}))
|
|---|
| 166 | {
|
|---|
| 167 | $debug=1 if $_ eq "debug";
|
|---|
| 168 | $trace=1 if $_ eq "trace";
|
|---|
| 169 | $verbose=1 if $_ eq "verbose";
|
|---|
| 170 | $W32=1 if $_ eq "32";
|
|---|
| 171 | die "win16 not supported" if $_ eq "16";
|
|---|
| 172 | if($_ eq "NT") {
|
|---|
| 173 | $W32 = 1;
|
|---|
| 174 | $NT = 1;
|
|---|
| 175 | } elsif ($_ eq "linux") {
|
|---|
| 176 | $linux=1;
|
|---|
| 177 | $UNIX=1;
|
|---|
| 178 | } elsif ($_ eq "aix") {
|
|---|
| 179 | $aix=1;
|
|---|
| 180 | $UNIX=1;
|
|---|
| 181 | } elsif ($_ eq "VMS") {
|
|---|
| 182 | $VMS=1;
|
|---|
| 183 | }
|
|---|
| 184 | if ($_ eq "zlib" || $_ eq "enable-zlib" || $_ eq "zlib-dynamic"
|
|---|
| 185 | || $_ eq "enable-zlib-dynamic") {
|
|---|
| 186 | $zlib = 1;
|
|---|
| 187 | }
|
|---|
| 188 |
|
|---|
| 189 | $do_crypto=1 if $_ eq "libcrypto" || $_ eq "crypto";
|
|---|
| 190 | $do_ssl=1 if $_ eq "libssl" || $_ eq "ssl";
|
|---|
| 191 |
|
|---|
| 192 | $do_update=1 if $_ eq "update";
|
|---|
| 193 | $do_rewrite=1 if $_ eq "rewrite";
|
|---|
| 194 | $do_ctest=1 if $_ eq "ctest";
|
|---|
| 195 | $do_ctestall=1 if $_ eq "ctestall";
|
|---|
| 196 | $do_checkexist=1 if $_ eq "exist";
|
|---|
| 197 | }
|
|---|
| 198 | $libname = $unified_info{sharednames}->{libcrypto} if $do_crypto;
|
|---|
| 199 | $libname = $unified_info{sharednames}->{libssl} if $do_ssl;
|
|---|
| 200 |
|
|---|
| 201 | if (!$libname) {
|
|---|
| 202 | if ($do_ssl) {
|
|---|
| 203 | $libname="LIBSSL";
|
|---|
| 204 | }
|
|---|
| 205 | if ($do_crypto) {
|
|---|
| 206 | $libname="LIBCRYPTO";
|
|---|
| 207 | }
|
|---|
| 208 | }
|
|---|
| 209 |
|
|---|
| 210 | # If no platform is given, assume WIN32
|
|---|
| 211 | if ($W32 + $VMS + $linux + $aix == 0) {
|
|---|
| 212 | $W32 = 1;
|
|---|
| 213 | }
|
|---|
| 214 | die "Please, only one platform at a time"
|
|---|
| 215 | if ($W32 + $VMS + $linux + $aix > 1);
|
|---|
| 216 |
|
|---|
| 217 | if (!$do_ssl && !$do_crypto)
|
|---|
| 218 | {
|
|---|
| 219 | print STDERR "usage: $0 ( ssl | crypto ) [ 16 | 32 | NT | OS2 | linux | VMS ]\n";
|
|---|
| 220 | exit(1);
|
|---|
| 221 | }
|
|---|
| 222 |
|
|---|
| 223 | %ssl_list=&load_numbers($ssl_num);
|
|---|
| 224 | $max_ssl = $max_num;
|
|---|
| 225 | %crypto_list=&load_numbers($crypto_num);
|
|---|
| 226 | $max_crypto = $max_num;
|
|---|
| 227 |
|
|---|
| 228 | my $ssl="include/openssl/ssl.h";
|
|---|
| 229 | $ssl.=" include/openssl/sslerr.h";
|
|---|
| 230 | $ssl.=" include/openssl/tls1.h";
|
|---|
| 231 | $ssl.=" include/openssl/srtp.h";
|
|---|
| 232 |
|
|---|
| 233 | # When scanning include/openssl, skip all SSL files and some internal ones.
|
|---|
| 234 | my %skipthese;
|
|---|
| 235 | foreach my $f ( split(/\s+/, $ssl) ) {
|
|---|
| 236 | $skipthese{$f} = 1;
|
|---|
| 237 | }
|
|---|
| 238 | $skipthese{'include/openssl/conf_api.h'} = 1;
|
|---|
| 239 | $skipthese{'include/openssl/ebcdic.h'} = 1;
|
|---|
| 240 | $skipthese{'include/openssl/opensslconf.h'} = 1;
|
|---|
| 241 |
|
|---|
| 242 | # We use headers found in include/openssl and include/internal only.
|
|---|
| 243 | # The latter is needed so libssl.so/.dll/.exe can link properly.
|
|---|
| 244 | my $crypto ="include/internal/dso.h";
|
|---|
| 245 | $crypto.=" include/internal/o_dir.h";
|
|---|
| 246 | $crypto.=" include/internal/o_str.h";
|
|---|
| 247 | $crypto.=" include/internal/err.h";
|
|---|
| 248 | $crypto.=" include/internal/sslconf.h";
|
|---|
| 249 | foreach my $f ( glob(catfile($config{sourcedir},'include/openssl/*.h')) ) {
|
|---|
| 250 | my $fn = "include/openssl/" . basename($f);
|
|---|
| 251 | $crypto .= " $fn" if !defined $skipthese{$fn};
|
|---|
| 252 | }
|
|---|
| 253 |
|
|---|
| 254 | my $symhacks="include/openssl/symhacks.h";
|
|---|
| 255 |
|
|---|
| 256 | my @ssl_symbols = &do_defs("LIBSSL", $ssl, $symhacks);
|
|---|
| 257 | my @crypto_symbols = &do_defs("LIBCRYPTO", $crypto, $symhacks);
|
|---|
| 258 |
|
|---|
| 259 | if ($do_update) {
|
|---|
| 260 |
|
|---|
| 261 | if ($do_ssl == 1) {
|
|---|
| 262 |
|
|---|
| 263 | &maybe_add_info("LIBSSL",*ssl_list,@ssl_symbols);
|
|---|
| 264 | if ($do_rewrite == 1) {
|
|---|
| 265 | open(OUT, ">$ssl_num");
|
|---|
| 266 | &rewrite_numbers(*OUT,"LIBSSL",*ssl_list,@ssl_symbols);
|
|---|
| 267 | } else {
|
|---|
| 268 | open(OUT, ">>$ssl_num");
|
|---|
| 269 | }
|
|---|
| 270 | &update_numbers(*OUT,"LIBSSL",*ssl_list,$max_ssl,@ssl_symbols);
|
|---|
| 271 | close OUT;
|
|---|
| 272 | }
|
|---|
| 273 |
|
|---|
| 274 | if($do_crypto == 1) {
|
|---|
| 275 |
|
|---|
| 276 | &maybe_add_info("LIBCRYPTO",*crypto_list,@crypto_symbols);
|
|---|
| 277 | if ($do_rewrite == 1) {
|
|---|
| 278 | open(OUT, ">$crypto_num");
|
|---|
| 279 | &rewrite_numbers(*OUT,"LIBCRYPTO",*crypto_list,@crypto_symbols);
|
|---|
| 280 | } else {
|
|---|
| 281 | open(OUT, ">>$crypto_num");
|
|---|
| 282 | }
|
|---|
| 283 | &update_numbers(*OUT,"LIBCRYPTO",*crypto_list,$max_crypto,@crypto_symbols);
|
|---|
| 284 | close OUT;
|
|---|
| 285 | }
|
|---|
| 286 |
|
|---|
| 287 | } elsif ($do_checkexist) {
|
|---|
| 288 | &check_existing(*ssl_list, @ssl_symbols)
|
|---|
| 289 | if $do_ssl == 1;
|
|---|
| 290 | &check_existing(*crypto_list, @crypto_symbols)
|
|---|
| 291 | if $do_crypto == 1;
|
|---|
| 292 | } elsif ($do_ctest || $do_ctestall) {
|
|---|
| 293 |
|
|---|
| 294 | print <<"EOF";
|
|---|
| 295 |
|
|---|
| 296 | /* Test file to check all DEF file symbols are present by trying
|
|---|
| 297 | * to link to all of them. This is *not* intended to be run!
|
|---|
| 298 | */
|
|---|
| 299 |
|
|---|
| 300 | int main()
|
|---|
| 301 | {
|
|---|
| 302 | EOF
|
|---|
| 303 | &print_test_file(*STDOUT,"LIBSSL",*ssl_list,$do_ctestall,@ssl_symbols)
|
|---|
| 304 | if $do_ssl == 1;
|
|---|
| 305 |
|
|---|
| 306 | &print_test_file(*STDOUT,"LIBCRYPTO",*crypto_list,$do_ctestall,@crypto_symbols)
|
|---|
| 307 | if $do_crypto == 1;
|
|---|
| 308 |
|
|---|
| 309 | print "}\n";
|
|---|
| 310 |
|
|---|
| 311 | } else {
|
|---|
| 312 |
|
|---|
| 313 | &print_def_file(*STDOUT,$libname,*ssl_list,@ssl_symbols)
|
|---|
| 314 | if $do_ssl == 1;
|
|---|
| 315 |
|
|---|
| 316 | &print_def_file(*STDOUT,$libname,*crypto_list,@crypto_symbols)
|
|---|
| 317 | if $do_crypto == 1;
|
|---|
| 318 |
|
|---|
| 319 | }
|
|---|
| 320 |
|
|---|
| 321 |
|
|---|
| 322 | sub do_defs
|
|---|
| 323 | {
|
|---|
| 324 | my($name,$files,$symhacksfile)=@_;
|
|---|
| 325 | my $file;
|
|---|
| 326 | my @ret;
|
|---|
| 327 | my %syms;
|
|---|
| 328 | my %platform; # For anything undefined, we assume ""
|
|---|
| 329 | my %kind; # For anything undefined, we assume "FUNCTION"
|
|---|
| 330 | my %algorithm; # For anything undefined, we assume ""
|
|---|
| 331 | my %variant;
|
|---|
| 332 | my %variant_cnt; # To be able to allocate "name{n}" if "name"
|
|---|
| 333 | # is the same name as the original.
|
|---|
| 334 | my $cpp;
|
|---|
| 335 | my %unknown_algorithms = ();
|
|---|
| 336 | my $parens = 0;
|
|---|
| 337 |
|
|---|
| 338 | foreach $file (split(/\s+/,$symhacksfile." ".$files))
|
|---|
| 339 | {
|
|---|
| 340 | my $fn = catfile($config{sourcedir},$file);
|
|---|
| 341 | print STDERR "DEBUG: starting on $fn:\n" if $debug;
|
|---|
| 342 | print STDERR "TRACE: start reading $fn\n" if $trace;
|
|---|
| 343 | open(IN,"<$fn") || die "Can't open $fn, $!,";
|
|---|
| 344 | my $line = "", my $def= "";
|
|---|
| 345 | my %tag = (
|
|---|
| 346 | (map { $_ => 0 } @known_platforms),
|
|---|
| 347 | (map { "OPENSSL_SYS_".$_ => 0 } @known_ossl_platforms),
|
|---|
| 348 | (map { "OPENSSL_NO_".$_ => 0 } @known_algorithms),
|
|---|
| 349 | (map { "OPENSSL_USE_".$_ => 0 } @known_algorithms),
|
|---|
| 350 | (grep /^DEPRECATED_/, @known_algorithms),
|
|---|
| 351 | NOPROTO => 0,
|
|---|
| 352 | PERL5 => 0,
|
|---|
| 353 | _WINDLL => 0,
|
|---|
| 354 | CONST_STRICT => 0,
|
|---|
| 355 | TRUE => 1,
|
|---|
| 356 | );
|
|---|
| 357 | my $symhacking = $file eq $symhacksfile;
|
|---|
| 358 | my @current_platforms = ();
|
|---|
| 359 | my @current_algorithms = ();
|
|---|
| 360 |
|
|---|
| 361 | # params: symbol, alias, platforms, kind
|
|---|
| 362 | # The reason to put this subroutine in a variable is that
|
|---|
| 363 | # it will otherwise create its own, unshared, version of
|
|---|
| 364 | # %tag and %variant...
|
|---|
| 365 | my $make_variant = sub
|
|---|
| 366 | {
|
|---|
| 367 | my ($s, $a, $p, $k) = @_;
|
|---|
| 368 | my ($a1, $a2);
|
|---|
| 369 |
|
|---|
| 370 | print STDERR "DEBUG: make_variant: Entered with ",$s,", ",$a,", ",(defined($p)?$p:""),", ",(defined($k)?$k:""),"\n" if $debug;
|
|---|
| 371 | if (defined($p))
|
|---|
| 372 | {
|
|---|
| 373 | $a1 = join(",",$p,
|
|---|
| 374 | grep(!/^$/,
|
|---|
| 375 | map { $tag{$_} == 1 ? $_ : "" }
|
|---|
| 376 | @known_platforms));
|
|---|
| 377 | }
|
|---|
| 378 | else
|
|---|
| 379 | {
|
|---|
| 380 | $a1 = join(",",
|
|---|
| 381 | grep(!/^$/,
|
|---|
| 382 | map { $tag{$_} == 1 ? $_ : "" }
|
|---|
| 383 | @known_platforms));
|
|---|
| 384 | }
|
|---|
| 385 | $a2 = join(",",
|
|---|
| 386 | grep(!/^$/,
|
|---|
| 387 | map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ : "" }
|
|---|
| 388 | @known_ossl_platforms));
|
|---|
| 389 | print STDERR "DEBUG: make_variant: a1 = $a1; a2 = $a2\n" if $debug;
|
|---|
| 390 | if ($a1 eq "") { $a1 = $a2; }
|
|---|
| 391 | elsif ($a1 ne "" && $a2 ne "") { $a1 .= ",".$a2; }
|
|---|
| 392 | if ($a eq $s)
|
|---|
| 393 | {
|
|---|
| 394 | if (!defined($variant_cnt{$s}))
|
|---|
| 395 | {
|
|---|
| 396 | $variant_cnt{$s} = 0;
|
|---|
| 397 | }
|
|---|
| 398 | $variant_cnt{$s}++;
|
|---|
| 399 | $a .= "{$variant_cnt{$s}}";
|
|---|
| 400 | }
|
|---|
| 401 | my $toadd = $a.":".$a1.(defined($k)?":".$k:"");
|
|---|
| 402 | my $togrep = $s.'(\{[0-9]+\})?:'.$a1.(defined($k)?":".$k:"");
|
|---|
| 403 | if (!grep(/^$togrep$/,
|
|---|
| 404 | split(/;/, defined($variant{$s})?$variant{$s}:""))) {
|
|---|
| 405 | if (defined($variant{$s})) { $variant{$s} .= ";"; }
|
|---|
| 406 | $variant{$s} .= $toadd;
|
|---|
| 407 | }
|
|---|
| 408 | print STDERR "DEBUG: make_variant: Exit with variant of ",$s," = ",$variant{$s},"\n" if $debug;
|
|---|
| 409 | };
|
|---|
| 410 |
|
|---|
| 411 | print STDERR "DEBUG: parsing ----------\n" if $debug;
|
|---|
| 412 | while(<IN>) {
|
|---|
| 413 | s|\R$||; # Better chomp
|
|---|
| 414 | if($parens > 0) {
|
|---|
| 415 | #Inside a DEPRECATEDIN
|
|---|
| 416 | $stored_multiline .= $_;
|
|---|
| 417 | print STDERR "DEBUG: Continuing multiline DEPRECATEDIN: $stored_multiline\n" if $debug;
|
|---|
| 418 | $parens = count_parens($stored_multiline);
|
|---|
| 419 | if ($parens == 0) {
|
|---|
| 420 | $def .= do_deprecated($stored_multiline,
|
|---|
| 421 | \@current_platforms,
|
|---|
| 422 | \@current_algorithms);
|
|---|
| 423 | }
|
|---|
| 424 | next;
|
|---|
| 425 | }
|
|---|
| 426 | if (/\/\* Error codes for the \w+ functions\. \*\//)
|
|---|
| 427 | {
|
|---|
| 428 | undef @tag;
|
|---|
| 429 | last;
|
|---|
| 430 | }
|
|---|
| 431 | if ($line ne '') {
|
|---|
| 432 | $_ = $line . $_;
|
|---|
| 433 | $line = '';
|
|---|
| 434 | }
|
|---|
| 435 |
|
|---|
| 436 | if (/\\$/) {
|
|---|
| 437 | $line = $`; # keep what was before the backslash
|
|---|
| 438 | next;
|
|---|
| 439 | }
|
|---|
| 440 |
|
|---|
| 441 | if(/\/\*/) {
|
|---|
| 442 | if (not /\*\//) { # multi-line comment...
|
|---|
| 443 | $line = $_; # ... just accumulate
|
|---|
| 444 | next;
|
|---|
| 445 | } else {
|
|---|
| 446 | s/\/\*.*?\*\///gs;# wipe it
|
|---|
| 447 | }
|
|---|
| 448 | }
|
|---|
| 449 |
|
|---|
| 450 | if ($cpp) {
|
|---|
| 451 | $cpp++ if /^#\s*if/;
|
|---|
| 452 | $cpp-- if /^#\s*endif/;
|
|---|
| 453 | next;
|
|---|
| 454 | }
|
|---|
| 455 | if (/^#.*ifdef.*cplusplus/) {
|
|---|
| 456 | $cpp = 1;
|
|---|
| 457 | next;
|
|---|
| 458 | }
|
|---|
| 459 |
|
|---|
| 460 | s/{[^{}]*}//gs; # ignore {} blocks
|
|---|
| 461 | print STDERR "DEBUG: \$def=\"$def\"\n" if $debug && $def ne "";
|
|---|
| 462 | print STDERR "DEBUG: \$_=\"$_\"\n" if $debug;
|
|---|
| 463 | if (/^\#\s*if\s+OPENSSL_API_COMPAT\s*(\S)\s*(0x[0-9a-fA-F]{8})L\s*$/) {
|
|---|
| 464 | my $op = $1;
|
|---|
| 465 | my $v = hex($2);
|
|---|
| 466 | if ($op ne '<' && $op ne '>=') {
|
|---|
| 467 | die "$file unacceptable operator $op: $_\n";
|
|---|
| 468 | }
|
|---|
| 469 | my ($one, $major, $minor) =
|
|---|
| 470 | ( ($v >> 28) & 0xf,
|
|---|
| 471 | ($v >> 20) & 0xff,
|
|---|
| 472 | ($v >> 12) & 0xff );
|
|---|
| 473 | my $t = "DEPRECATEDIN_${one}_${major}_${minor}";
|
|---|
| 474 | push(@tag,"-");
|
|---|
| 475 | push(@tag,$t);
|
|---|
| 476 | $tag{$t}=($op eq '<' ? 1 : -1);
|
|---|
| 477 | print STDERR "DEBUG: $file: found tag $t = $tag{$t}\n" if $debug;
|
|---|
| 478 | } elsif (/^\#\s*ifndef\s+(.*)/) {
|
|---|
| 479 | push(@tag,"-");
|
|---|
| 480 | push(@tag,$1);
|
|---|
| 481 | $tag{$1}=-1;
|
|---|
| 482 | print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
|
|---|
| 483 | } elsif (/^\#\s*if\s+!defined\s*\(([^\)]+)\)/) {
|
|---|
| 484 | push(@tag,"-");
|
|---|
| 485 | if (/^\#\s*if\s+(!defined\s*\(([^\)]+)\)(\s+\&\&\s+!defined\s*\(([^\)]+)\))*)$/) {
|
|---|
| 486 | my $tmp_1 = $1;
|
|---|
| 487 | my $tmp_;
|
|---|
| 488 | foreach $tmp_ (split '\&\&',$tmp_1) {
|
|---|
| 489 | $tmp_ =~ /!defined\s*\(([^\)]+)\)/;
|
|---|
| 490 | print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
|
|---|
| 491 | push(@tag,$1);
|
|---|
| 492 | $tag{$1}=-1;
|
|---|
| 493 | }
|
|---|
| 494 | } else {
|
|---|
| 495 | print STDERR "Warning: $file: taking only '!defined($1)' of complicated expression: $_" if $verbose; # because it is O...
|
|---|
| 496 | print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
|
|---|
| 497 | push(@tag,$1);
|
|---|
| 498 | $tag{$1}=-1;
|
|---|
| 499 | }
|
|---|
| 500 | } elsif (/^\#\s*ifdef\s+(\S*)/) {
|
|---|
| 501 | push(@tag,"-");
|
|---|
| 502 | push(@tag,$1);
|
|---|
| 503 | $tag{$1}=1;
|
|---|
| 504 | print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
|
|---|
| 505 | } elsif (/^\#\s*if\s+defined\s*\(([^\)]+)\)/) {
|
|---|
| 506 | push(@tag,"-");
|
|---|
| 507 | if (/^\#\s*if\s+(defined\s*\(([^\)]+)\)(\s+\|\|\s+defined\s*\(([^\)]+)\))*)$/) {
|
|---|
| 508 | my $tmp_1 = $1;
|
|---|
| 509 | my $tmp_;
|
|---|
| 510 | foreach $tmp_ (split '\|\|',$tmp_1) {
|
|---|
| 511 | $tmp_ =~ /defined\s*\(([^\)]+)\)/;
|
|---|
| 512 | print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
|
|---|
| 513 | push(@tag,$1);
|
|---|
| 514 | $tag{$1}=1;
|
|---|
| 515 | }
|
|---|
| 516 | } else {
|
|---|
| 517 | print STDERR "Warning: $file: taking only 'defined($1)' of complicated expression: $_\n" if $verbose; # because it is O...
|
|---|
| 518 | print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
|
|---|
| 519 | push(@tag,$1);
|
|---|
| 520 | $tag{$1}=1;
|
|---|
| 521 | }
|
|---|
| 522 | } elsif (/^\#\s*error\s+(\w+) is disabled\./) {
|
|---|
| 523 | my $tag_i = $#tag;
|
|---|
| 524 | while($tag[$tag_i] ne "-") {
|
|---|
| 525 | if ($tag[$tag_i] eq "OPENSSL_NO_".$1) {
|
|---|
| 526 | $tag{$tag[$tag_i]}=2;
|
|---|
| 527 | print STDERR "DEBUG: $file: changed tag $1 = 2\n" if $debug;
|
|---|
| 528 | }
|
|---|
| 529 | $tag_i--;
|
|---|
| 530 | }
|
|---|
| 531 | } elsif (/^\#\s*endif/) {
|
|---|
| 532 | my $tag_i = $#tag;
|
|---|
| 533 | while($tag_i > 0 && $tag[$tag_i] ne "-") {
|
|---|
| 534 | my $t=$tag[$tag_i];
|
|---|
| 535 | print STDERR "DEBUG: \$t=\"$t\"\n" if $debug;
|
|---|
| 536 | if ($tag{$t}==2) {
|
|---|
| 537 | $tag{$t}=-1;
|
|---|
| 538 | } else {
|
|---|
| 539 | $tag{$t}=0;
|
|---|
| 540 | }
|
|---|
| 541 | print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
|
|---|
| 542 | pop(@tag);
|
|---|
| 543 | if ($t =~ /^OPENSSL_NO_([A-Z0-9_]+)$/) {
|
|---|
| 544 | $t=$1;
|
|---|
| 545 | } elsif($t =~ /^OPENSSL_USE_([A-Z0-9_]+)$/) {
|
|---|
| 546 | $t=$1;
|
|---|
| 547 | } else {
|
|---|
| 548 | $t="";
|
|---|
| 549 | }
|
|---|
| 550 | if ($t ne ""
|
|---|
| 551 | && !grep(/^$t$/, @known_algorithms)) {
|
|---|
| 552 | $unknown_algorithms{$t} = 1;
|
|---|
| 553 | #print STDERR "DEBUG: Added as unknown algorithm: $t\n" if $debug;
|
|---|
| 554 | }
|
|---|
| 555 | $tag_i--;
|
|---|
| 556 | }
|
|---|
| 557 | pop(@tag);
|
|---|
| 558 | } elsif (/^\#\s*else/) {
|
|---|
| 559 | my $tag_i = $#tag;
|
|---|
| 560 | die "$file unmatched else\n" if $tag_i < 0;
|
|---|
| 561 | while($tag[$tag_i] ne "-") {
|
|---|
| 562 | my $t=$tag[$tag_i];
|
|---|
| 563 | $tag{$t}= -$tag{$t};
|
|---|
| 564 | print STDERR "DEBUG: $file: changed tag ",$t," = ",$tag{$t},"\n" if $debug;
|
|---|
| 565 | $tag_i--;
|
|---|
| 566 | }
|
|---|
| 567 | } elsif (/^\#\s*if\s+1/) {
|
|---|
| 568 | push(@tag,"-");
|
|---|
| 569 | # Dummy tag
|
|---|
| 570 | push(@tag,"TRUE");
|
|---|
| 571 | $tag{"TRUE"}=1;
|
|---|
| 572 | print STDERR "DEBUG: $file: found 1\n" if $debug;
|
|---|
| 573 | } elsif (/^\#\s*if\s+0/) {
|
|---|
| 574 | push(@tag,"-");
|
|---|
| 575 | # Dummy tag
|
|---|
| 576 | push(@tag,"TRUE");
|
|---|
| 577 | $tag{"TRUE"}=-1;
|
|---|
| 578 | print STDERR "DEBUG: $file: found 0\n" if $debug;
|
|---|
| 579 | } elsif (/^\#\s*if\s+/) {
|
|---|
| 580 | #Some other unrecognized "if" style
|
|---|
| 581 | push(@tag,"-");
|
|---|
| 582 | print STDERR "Warning: $file: ignoring unrecognized expression: $_\n" if $verbose; # because it is O...
|
|---|
| 583 | } elsif (/^\#\s*define\s+(\w+)\s+(\w+)/
|
|---|
| 584 | && $symhacking && $tag{'TRUE'} != -1) {
|
|---|
| 585 | # This is for aliasing. When we find an alias,
|
|---|
| 586 | # we have to invert
|
|---|
| 587 | &$make_variant($1,$2);
|
|---|
| 588 | print STDERR "DEBUG: $file: defined $1 = $2\n" if $debug;
|
|---|
| 589 | }
|
|---|
| 590 | if (/^\#/) {
|
|---|
| 591 | @current_platforms =
|
|---|
| 592 | grep(!/^$/,
|
|---|
| 593 | map { $tag{$_} == 1 ? $_ :
|
|---|
| 594 | $tag{$_} == -1 ? "!".$_ : "" }
|
|---|
| 595 | @known_platforms);
|
|---|
| 596 | push @current_platforms
|
|---|
| 597 | , grep(!/^$/,
|
|---|
| 598 | map { $tag{"OPENSSL_SYS_".$_} == 1 ? $_ :
|
|---|
| 599 | $tag{"OPENSSL_SYS_".$_} == -1 ? "!".$_ : "" }
|
|---|
| 600 | @known_ossl_platforms);
|
|---|
| 601 | @current_algorithms = ();
|
|---|
| 602 | @current_algorithms =
|
|---|
| 603 | grep(!/^$/,
|
|---|
| 604 | map { $tag{"OPENSSL_NO_".$_} == -1 ? $_ : "" }
|
|---|
| 605 | @known_algorithms);
|
|---|
| 606 | push @current_algorithms
|
|---|
| 607 | , grep(!/^$/,
|
|---|
| 608 | map { $tag{"OPENSSL_USE_".$_} == 1 ? $_ : "" }
|
|---|
| 609 | @known_algorithms);
|
|---|
| 610 | push @current_algorithms,
|
|---|
| 611 | grep { /^DEPRECATEDIN_/ && $tag{$_} == 1 }
|
|---|
| 612 | @known_algorithms;
|
|---|
| 613 | $def .=
|
|---|
| 614 | "#INFO:"
|
|---|
| 615 | .join(',',@current_platforms).":"
|
|---|
| 616 | .join(',',@current_algorithms).";";
|
|---|
| 617 | next;
|
|---|
| 618 | }
|
|---|
| 619 | if ($tag{'TRUE'} != -1) {
|
|---|
| 620 | if (/^\s*DEFINE_STACK_OF\s*\(\s*(\w*)\s*\)/
|
|---|
| 621 | || /^\s*DEFINE_STACK_OF_CONST\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 622 | next;
|
|---|
| 623 | } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
|
|---|
| 624 | $def .= "int d2i_$3(void);";
|
|---|
| 625 | $def .= "int i2d_$3(void);";
|
|---|
| 626 | # Variant for platforms that do not
|
|---|
| 627 | # have to access global variables
|
|---|
| 628 | # in shared libraries through functions
|
|---|
| 629 | $def .=
|
|---|
| 630 | "#INFO:"
|
|---|
| 631 | .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
|
|---|
| 632 | .join(',',@current_algorithms).";";
|
|---|
| 633 | $def .= "OPENSSL_EXTERN int $2_it;";
|
|---|
| 634 | $def .=
|
|---|
| 635 | "#INFO:"
|
|---|
| 636 | .join(',',@current_platforms).":"
|
|---|
| 637 | .join(',',@current_algorithms).";";
|
|---|
| 638 | # Variant for platforms that have to
|
|---|
| 639 | # access global variables in shared
|
|---|
| 640 | # libraries through functions
|
|---|
| 641 | &$make_variant("$2_it","$2_it",
|
|---|
| 642 | "EXPORT_VAR_AS_FUNCTION",
|
|---|
| 643 | "FUNCTION");
|
|---|
| 644 | next;
|
|---|
| 645 | } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_fname\s*\(\s*(\w*)\s*,\s*(\w*)\s*,\s*(\w*)\s*\)/) {
|
|---|
| 646 | $def .= "int d2i_$3(void);";
|
|---|
| 647 | $def .= "int i2d_$3(void);";
|
|---|
| 648 | $def .= "int $3_free(void);";
|
|---|
| 649 | $def .= "int $3_new(void);";
|
|---|
| 650 | # Variant for platforms that do not
|
|---|
| 651 | # have to access global variables
|
|---|
| 652 | # in shared libraries through functions
|
|---|
| 653 | $def .=
|
|---|
| 654 | "#INFO:"
|
|---|
| 655 | .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
|
|---|
| 656 | .join(',',@current_algorithms).";";
|
|---|
| 657 | $def .= "OPENSSL_EXTERN int $2_it;";
|
|---|
| 658 | $def .=
|
|---|
| 659 | "#INFO:"
|
|---|
| 660 | .join(',',@current_platforms).":"
|
|---|
| 661 | .join(',',@current_algorithms).";";
|
|---|
| 662 | # Variant for platforms that have to
|
|---|
| 663 | # access global variables in shared
|
|---|
| 664 | # libraries through functions
|
|---|
| 665 | &$make_variant("$2_it","$2_it",
|
|---|
| 666 | "EXPORT_VAR_AS_FUNCTION",
|
|---|
| 667 | "FUNCTION");
|
|---|
| 668 | next;
|
|---|
| 669 | } elsif (/^\s*DECLARE_ASN1_FUNCTIONS\s*\(\s*(\w*)\s*\)/ ||
|
|---|
| 670 | /^\s*DECLARE_ASN1_FUNCTIONS_const\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 671 | $def .= "int d2i_$1(void);";
|
|---|
| 672 | $def .= "int i2d_$1(void);";
|
|---|
| 673 | $def .= "int $1_free(void);";
|
|---|
| 674 | $def .= "int $1_new(void);";
|
|---|
| 675 | # Variant for platforms that do not
|
|---|
| 676 | # have to access global variables
|
|---|
| 677 | # in shared libraries through functions
|
|---|
| 678 | $def .=
|
|---|
| 679 | "#INFO:"
|
|---|
| 680 | .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
|
|---|
| 681 | .join(',',@current_algorithms).";";
|
|---|
| 682 | $def .= "OPENSSL_EXTERN int $1_it;";
|
|---|
| 683 | $def .=
|
|---|
| 684 | "#INFO:"
|
|---|
| 685 | .join(',',@current_platforms).":"
|
|---|
| 686 | .join(',',@current_algorithms).";";
|
|---|
| 687 | # Variant for platforms that have to
|
|---|
| 688 | # access global variables in shared
|
|---|
| 689 | # libraries through functions
|
|---|
| 690 | &$make_variant("$1_it","$1_it",
|
|---|
| 691 | "EXPORT_VAR_AS_FUNCTION",
|
|---|
| 692 | "FUNCTION");
|
|---|
| 693 | next;
|
|---|
| 694 | } elsif (/^\s*DECLARE_ASN1_ENCODE_FUNCTIONS_const\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
|
|---|
| 695 | $def .= "int d2i_$2(void);";
|
|---|
| 696 | $def .= "int i2d_$2(void);";
|
|---|
| 697 | # Variant for platforms that do not
|
|---|
| 698 | # have to access global variables
|
|---|
| 699 | # in shared libraries through functions
|
|---|
| 700 | $def .=
|
|---|
| 701 | "#INFO:"
|
|---|
| 702 | .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
|
|---|
| 703 | .join(',',@current_algorithms).";";
|
|---|
| 704 | $def .= "OPENSSL_EXTERN int $2_it;";
|
|---|
| 705 | $def .=
|
|---|
| 706 | "#INFO:"
|
|---|
| 707 | .join(',',@current_platforms).":"
|
|---|
| 708 | .join(',',@current_algorithms).";";
|
|---|
| 709 | # Variant for platforms that have to
|
|---|
| 710 | # access global variables in shared
|
|---|
| 711 | # libraries through functions
|
|---|
| 712 | &$make_variant("$2_it","$2_it",
|
|---|
| 713 | "EXPORT_VAR_AS_FUNCTION",
|
|---|
| 714 | "FUNCTION");
|
|---|
| 715 | next;
|
|---|
| 716 | } elsif (/^\s*DECLARE_ASN1_ALLOC_FUNCTIONS\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 717 | $def .= "int $1_free(void);";
|
|---|
| 718 | $def .= "int $1_new(void);";
|
|---|
| 719 | next;
|
|---|
| 720 | } elsif (/^\s*DECLARE_ASN1_FUNCTIONS_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
|
|---|
| 721 | $def .= "int d2i_$2(void);";
|
|---|
| 722 | $def .= "int i2d_$2(void);";
|
|---|
| 723 | $def .= "int $2_free(void);";
|
|---|
| 724 | $def .= "int $2_new(void);";
|
|---|
| 725 | # Variant for platforms that do not
|
|---|
| 726 | # have to access global variables
|
|---|
| 727 | # in shared libraries through functions
|
|---|
| 728 | $def .=
|
|---|
| 729 | "#INFO:"
|
|---|
| 730 | .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
|
|---|
| 731 | .join(',',@current_algorithms).";";
|
|---|
| 732 | $def .= "OPENSSL_EXTERN int $2_it;";
|
|---|
| 733 | $def .=
|
|---|
| 734 | "#INFO:"
|
|---|
| 735 | .join(',',@current_platforms).":"
|
|---|
| 736 | .join(',',@current_algorithms).";";
|
|---|
| 737 | # Variant for platforms that have to
|
|---|
| 738 | # access global variables in shared
|
|---|
| 739 | # libraries through functions
|
|---|
| 740 | &$make_variant("$2_it","$2_it",
|
|---|
| 741 | "EXPORT_VAR_AS_FUNCTION",
|
|---|
| 742 | "FUNCTION");
|
|---|
| 743 | next;
|
|---|
| 744 | } elsif (/^\s*DECLARE_ASN1_ITEM\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 745 | # Variant for platforms that do not
|
|---|
| 746 | # have to access global variables
|
|---|
| 747 | # in shared libraries through functions
|
|---|
| 748 | $def .=
|
|---|
| 749 | "#INFO:"
|
|---|
| 750 | .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
|
|---|
| 751 | .join(',',@current_algorithms).";";
|
|---|
| 752 | $def .= "OPENSSL_EXTERN int $1_it;";
|
|---|
| 753 | $def .=
|
|---|
| 754 | "#INFO:"
|
|---|
| 755 | .join(',',@current_platforms).":"
|
|---|
| 756 | .join(',',@current_algorithms).";";
|
|---|
| 757 | # Variant for platforms that have to
|
|---|
| 758 | # access global variables in shared
|
|---|
| 759 | # libraries through functions
|
|---|
| 760 | &$make_variant("$1_it","$1_it",
|
|---|
| 761 | "EXPORT_VAR_AS_FUNCTION",
|
|---|
| 762 | "FUNCTION");
|
|---|
| 763 | next;
|
|---|
| 764 | } elsif (/^\s*DECLARE_ASN1_NDEF_FUNCTION\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 765 | $def .= "int i2d_$1_NDEF(void);";
|
|---|
| 766 | } elsif (/^\s*DECLARE_ASN1_SET_OF\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 767 | next;
|
|---|
| 768 | } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 769 | $def .= "int $1_print_ctx(void);";
|
|---|
| 770 | next;
|
|---|
| 771 | } elsif (/^\s*DECLARE_ASN1_PRINT_FUNCTION_name\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
|
|---|
| 772 | $def .= "int $2_print_ctx(void);";
|
|---|
| 773 | next;
|
|---|
| 774 | } elsif (/^\s*DECLARE_PKCS12_STACK_OF\s*\(\s*(\w*)\s*\)/) {
|
|---|
| 775 | next;
|
|---|
| 776 | } elsif (/^DECLARE_PEM_rw\s*\(\s*(\w*)\s*,/ ||
|
|---|
| 777 | /^DECLARE_PEM_rw_cb\s*\(\s*(\w*)\s*,/ ||
|
|---|
| 778 | /^DECLARE_PEM_rw_const\s*\(\s*(\w*)\s*,/ ) {
|
|---|
| 779 | $def .=
|
|---|
| 780 | "#INFO:"
|
|---|
| 781 | .join(',',@current_platforms).":"
|
|---|
| 782 | .join(',',"STDIO",@current_algorithms).";";
|
|---|
| 783 | $def .= "int PEM_read_$1(void);";
|
|---|
| 784 | $def .= "int PEM_write_$1(void);";
|
|---|
| 785 | $def .=
|
|---|
| 786 | "#INFO:"
|
|---|
| 787 | .join(',',@current_platforms).":"
|
|---|
| 788 | .join(',',@current_algorithms).";";
|
|---|
| 789 | # Things that are everywhere
|
|---|
| 790 | $def .= "int PEM_read_bio_$1(void);";
|
|---|
| 791 | $def .= "int PEM_write_bio_$1(void);";
|
|---|
| 792 | next;
|
|---|
| 793 | } elsif (/^DECLARE_PEM_write\s*\(\s*(\w*)\s*,/ ||
|
|---|
| 794 | /^DECLARE_PEM_write_const\s*\(\s*(\w*)\s*,/ ||
|
|---|
| 795 | /^DECLARE_PEM_write_cb\s*\(\s*(\w*)\s*,/ ) {
|
|---|
| 796 | $def .=
|
|---|
| 797 | "#INFO:"
|
|---|
| 798 | .join(',',@current_platforms).":"
|
|---|
| 799 | .join(',',"STDIO",@current_algorithms).";";
|
|---|
| 800 | $def .= "int PEM_write_$1(void);";
|
|---|
| 801 | $def .=
|
|---|
| 802 | "#INFO:"
|
|---|
| 803 | .join(',',@current_platforms).":"
|
|---|
| 804 | .join(',',@current_algorithms).";";
|
|---|
| 805 | # Things that are everywhere
|
|---|
| 806 | $def .= "int PEM_write_bio_$1(void);";
|
|---|
| 807 | next;
|
|---|
| 808 | } elsif (/^DECLARE_PEM_read\s*\(\s*(\w*)\s*,/ ||
|
|---|
| 809 | /^DECLARE_PEM_read_cb\s*\(\s*(\w*)\s*,/ ) {
|
|---|
| 810 | $def .=
|
|---|
| 811 | "#INFO:"
|
|---|
| 812 | .join(',',@current_platforms).":"
|
|---|
| 813 | .join(',',"STDIO",@current_algorithms).";";
|
|---|
| 814 | $def .= "int PEM_read_$1(void);";
|
|---|
| 815 | $def .=
|
|---|
| 816 | "#INFO:"
|
|---|
| 817 | .join(',',@current_platforms).":"
|
|---|
| 818 | .join(',',"STDIO",@current_algorithms).";";
|
|---|
| 819 | # Things that are everywhere
|
|---|
| 820 | $def .= "int PEM_read_bio_$1(void);";
|
|---|
| 821 | next;
|
|---|
| 822 | } elsif (/^OPENSSL_DECLARE_GLOBAL\s*\(\s*(\w*)\s*,\s*(\w*)\s*\)/) {
|
|---|
| 823 | # Variant for platforms that do not
|
|---|
| 824 | # have to access global variables
|
|---|
| 825 | # in shared libraries through functions
|
|---|
| 826 | $def .=
|
|---|
| 827 | "#INFO:"
|
|---|
| 828 | .join(',',"!EXPORT_VAR_AS_FUNCTION",@current_platforms).":"
|
|---|
| 829 | .join(',',@current_algorithms).";";
|
|---|
| 830 | $def .= "OPENSSL_EXTERN int _shadow_$2;";
|
|---|
| 831 | $def .=
|
|---|
| 832 | "#INFO:"
|
|---|
| 833 | .join(',',@current_platforms).":"
|
|---|
| 834 | .join(',',@current_algorithms).";";
|
|---|
| 835 | # Variant for platforms that have to
|
|---|
| 836 | # access global variables in shared
|
|---|
| 837 | # libraries through functions
|
|---|
| 838 | &$make_variant("_shadow_$2","_shadow_$2",
|
|---|
| 839 | "EXPORT_VAR_AS_FUNCTION",
|
|---|
| 840 | "FUNCTION");
|
|---|
| 841 | } elsif (/^\s*DEPRECATEDIN/) {
|
|---|
| 842 | $parens = count_parens($_);
|
|---|
| 843 | if ($parens == 0) {
|
|---|
| 844 | $def .= do_deprecated($_,
|
|---|
| 845 | \@current_platforms,
|
|---|
| 846 | \@current_algorithms);
|
|---|
| 847 | } else {
|
|---|
| 848 | $stored_multiline = $_;
|
|---|
| 849 | print STDERR "DEBUG: Found multiline DEPRECATEDIN starting with: $stored_multiline\n" if $debug;
|
|---|
| 850 | next;
|
|---|
| 851 | }
|
|---|
| 852 | } elsif ($tag{'CONST_STRICT'} != 1) {
|
|---|
| 853 | if (/\{|\/\*|\([^\)]*$/) {
|
|---|
| 854 | $line = $_;
|
|---|
| 855 | } else {
|
|---|
| 856 | $def .= $_;
|
|---|
| 857 | }
|
|---|
| 858 | }
|
|---|
| 859 | }
|
|---|
| 860 | }
|
|---|
| 861 | close(IN);
|
|---|
| 862 | die "$file: Unmatched tags\n" if $#tag >= 0;
|
|---|
| 863 |
|
|---|
| 864 | my $algs;
|
|---|
| 865 | my $plays;
|
|---|
| 866 |
|
|---|
| 867 | print STDERR "DEBUG: postprocessing ----------\n" if $debug;
|
|---|
| 868 | foreach (split /;/, $def) {
|
|---|
| 869 | my $s; my $k = "FUNCTION"; my $p; my $a;
|
|---|
| 870 | s/^[\n\s]*//g;
|
|---|
| 871 | s/[\n\s]*$//g;
|
|---|
| 872 | next if(/\#undef/);
|
|---|
| 873 | next if(/typedef\W/);
|
|---|
| 874 | next if(/\#define/);
|
|---|
| 875 |
|
|---|
| 876 | print STDERR "TRACE: processing $_\n" if $trace && !/^\#INFO:/;
|
|---|
| 877 | # Reduce argument lists to empty ()
|
|---|
| 878 | # fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {}
|
|---|
| 879 | my $nsubst = 1; # prevent infinite loop, e.g., on int fn()
|
|---|
| 880 | while($nsubst && /\(.*\)/s) {
|
|---|
| 881 | $nsubst = s/\([^\(\)]+\)/\{\}/gs;
|
|---|
| 882 | $nsubst+= s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f
|
|---|
| 883 | }
|
|---|
| 884 | # pretend as we didn't use curly braces: {} -> ()
|
|---|
| 885 | s/\{\}/\(\)/gs;
|
|---|
| 886 |
|
|---|
| 887 | s/STACK_OF\(\)/void/gs;
|
|---|
| 888 | s/LHASH_OF\(\)/void/gs;
|
|---|
| 889 |
|
|---|
| 890 | print STDERR "DEBUG: \$_ = \"$_\"\n" if $debug;
|
|---|
| 891 | if (/^\#INFO:([^:]*):(.*)$/) {
|
|---|
| 892 | $plats = $1;
|
|---|
| 893 | $algs = $2;
|
|---|
| 894 | print STDERR "DEBUG: found info on platforms ($plats) and algorithms ($algs)\n" if $debug;
|
|---|
| 895 | next;
|
|---|
| 896 | } elsif (/^\s*OPENSSL_EXTERN\s.*?(\w+(\{[0-9]+\})?)(\[[0-9]*\])*\s*$/) {
|
|---|
| 897 | $s = $1;
|
|---|
| 898 | $k = "VARIABLE";
|
|---|
| 899 | print STDERR "DEBUG: found external variable $s\n" if $debug;
|
|---|
| 900 | } elsif (/TYPEDEF_\w+_OF/s) {
|
|---|
| 901 | next;
|
|---|
| 902 | } elsif (/(\w+)\s*\(\).*/s) { # first token prior [first] () is
|
|---|
| 903 | $s = $1; # a function name!
|
|---|
| 904 | print STDERR "DEBUG: found function $s\n" if $debug;
|
|---|
| 905 | } elsif (/\(/ and not (/=/)) {
|
|---|
| 906 | print STDERR "File $file: cannot parse: $_;\n";
|
|---|
| 907 | next;
|
|---|
| 908 | } else {
|
|---|
| 909 | next;
|
|---|
| 910 | }
|
|---|
| 911 |
|
|---|
| 912 | $syms{$s} = 1;
|
|---|
| 913 | $kind{$s} = $k;
|
|---|
| 914 |
|
|---|
| 915 | $p = $plats;
|
|---|
| 916 | $a = $algs;
|
|---|
| 917 |
|
|---|
| 918 | $platform{$s} =
|
|---|
| 919 | &reduce_platforms((defined($platform{$s})?$platform{$s}.',':"").$p);
|
|---|
| 920 | $algorithm{$s} .= ','.$a;
|
|---|
| 921 |
|
|---|
| 922 | if (defined($variant{$s})) {
|
|---|
| 923 | foreach $v (split /;/,$variant{$s}) {
|
|---|
| 924 | (my $r, my $p, my $k) = split(/:/,$v);
|
|---|
| 925 | my $ip = join ',',map({ /^!(.*)$/ ? $1 : "!".$_ } split /,/, $p);
|
|---|
| 926 | $syms{$r} = 1;
|
|---|
| 927 | if (!defined($k)) { $k = $kind{$s}; }
|
|---|
| 928 | $kind{$r} = $k."(".$s.")";
|
|---|
| 929 | $algorithm{$r} = $algorithm{$s};
|
|---|
| 930 | $platform{$r} = &reduce_platforms($platform{$s}.",".$p.",".$p);
|
|---|
| 931 | $platform{$s} = &reduce_platforms($platform{$s}.','.$ip.','.$ip);
|
|---|
| 932 | print STDERR "DEBUG: \$variant{\"$s\"} = ",$v,"; \$r = $r; \$p = ",$platform{$r},"; \$a = ",$algorithm{$r},"; \$kind = ",$kind{$r},"\n" if $debug;
|
|---|
| 933 | }
|
|---|
| 934 | }
|
|---|
| 935 | print STDERR "DEBUG: \$s = $s; \$p = ",$platform{$s},"; \$a = ",$algorithm{$s},"; \$kind = ",$kind{$s},"\n" if $debug;
|
|---|
| 936 | }
|
|---|
| 937 | }
|
|---|
| 938 |
|
|---|
| 939 | # Info we know about
|
|---|
| 940 |
|
|---|
| 941 | push @ret, map { $_."\\".&info_string($_,"EXIST",
|
|---|
| 942 | $platform{$_},
|
|---|
| 943 | $kind{$_},
|
|---|
| 944 | $algorithm{$_}) } keys %syms;
|
|---|
| 945 |
|
|---|
| 946 | if (keys %unknown_algorithms) {
|
|---|
| 947 | print STDERR "WARNING: mkdef.pl doesn't know the following algorithms:\n";
|
|---|
| 948 | print STDERR "\t",join("\n\t",keys %unknown_algorithms),"\n";
|
|---|
| 949 | }
|
|---|
| 950 | return(@ret);
|
|---|
| 951 | }
|
|---|
| 952 |
|
|---|
| 953 | # Param: string of comma-separated platform-specs.
|
|---|
| 954 | sub reduce_platforms
|
|---|
| 955 | {
|
|---|
| 956 | my ($platforms) = @_;
|
|---|
| 957 | my $pl = defined($platforms) ? $platforms : "";
|
|---|
| 958 | my %p = map { $_ => 0 } split /,/, $pl;
|
|---|
| 959 | my $ret;
|
|---|
| 960 |
|
|---|
| 961 | print STDERR "DEBUG: Entered reduce_platforms with \"$platforms\"\n"
|
|---|
| 962 | if $debug;
|
|---|
| 963 | # We do this, because if there's code like the following, it really
|
|---|
| 964 | # means the function exists in all cases and should therefore be
|
|---|
| 965 | # everywhere. By increasing and decreasing, we may attain 0:
|
|---|
| 966 | #
|
|---|
| 967 | # ifndef WIN16
|
|---|
| 968 | # int foo();
|
|---|
| 969 | # else
|
|---|
| 970 | # int _fat foo();
|
|---|
| 971 | # endif
|
|---|
| 972 | foreach $platform (split /,/, $pl) {
|
|---|
| 973 | if ($platform =~ /^!(.*)$/) {
|
|---|
| 974 | $p{$1}--;
|
|---|
| 975 | } else {
|
|---|
| 976 | $p{$platform}++;
|
|---|
| 977 | }
|
|---|
| 978 | }
|
|---|
| 979 | foreach $platform (keys %p) {
|
|---|
| 980 | if ($p{$platform} == 0) { delete $p{$platform}; }
|
|---|
| 981 | }
|
|---|
| 982 |
|
|---|
| 983 | delete $p{""};
|
|---|
| 984 |
|
|---|
| 985 | $ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p));
|
|---|
| 986 | print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n"
|
|---|
| 987 | if $debug;
|
|---|
| 988 | return $ret;
|
|---|
| 989 | }
|
|---|
| 990 |
|
|---|
| 991 | sub info_string
|
|---|
| 992 | {
|
|---|
| 993 | (my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_;
|
|---|
| 994 |
|
|---|
| 995 | my %a = defined($algorithms) ?
|
|---|
| 996 | map { $_ => 1 } split /,/, $algorithms : ();
|
|---|
| 997 | my $k = defined($kind) ? $kind : "FUNCTION";
|
|---|
| 998 | my $ret;
|
|---|
| 999 | my $p = &reduce_platforms($platforms);
|
|---|
| 1000 |
|
|---|
| 1001 | delete $a{""};
|
|---|
| 1002 |
|
|---|
| 1003 | $ret = $exist;
|
|---|
| 1004 | $ret .= ":".$p;
|
|---|
| 1005 | $ret .= ":".$k;
|
|---|
| 1006 | $ret .= ":".join(',',sort keys %a);
|
|---|
| 1007 | return $ret;
|
|---|
| 1008 | }
|
|---|
| 1009 |
|
|---|
| 1010 | sub maybe_add_info
|
|---|
| 1011 | {
|
|---|
| 1012 | (my $name, *nums, my @symbols) = @_;
|
|---|
| 1013 | my $sym;
|
|---|
| 1014 | my $new_info = 0;
|
|---|
| 1015 | my %syms=();
|
|---|
| 1016 |
|
|---|
| 1017 | foreach $sym (@symbols) {
|
|---|
| 1018 | (my $s, my $i) = split /\\/, $sym;
|
|---|
| 1019 | if (defined($nums{$s})) {
|
|---|
| 1020 | $i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/;
|
|---|
| 1021 | (my $n, my $vers, my $dummy) = split /\\/, $nums{$s};
|
|---|
| 1022 | if (!defined($dummy) || $i ne $dummy) {
|
|---|
| 1023 | $nums{$s} = $n."\\".$vers."\\".$i;
|
|---|
| 1024 | $new_info++;
|
|---|
| 1025 | print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug;
|
|---|
| 1026 | }
|
|---|
| 1027 | }
|
|---|
| 1028 | $syms{$s} = 1;
|
|---|
| 1029 | }
|
|---|
| 1030 |
|
|---|
| 1031 | my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums;
|
|---|
| 1032 | foreach $sym (@s) {
|
|---|
| 1033 | (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
|
|---|
| 1034 | if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) {
|
|---|
| 1035 | $new_info++;
|
|---|
| 1036 | print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug;
|
|---|
| 1037 | }
|
|---|
| 1038 | }
|
|---|
| 1039 | if ($new_info) {
|
|---|
| 1040 | print STDERR "$name: $new_info old symbols have updated info\n";
|
|---|
| 1041 | if (!$do_rewrite) {
|
|---|
| 1042 | print STDERR "You should do a rewrite to fix this.\n";
|
|---|
| 1043 | }
|
|---|
| 1044 | } else {
|
|---|
| 1045 | }
|
|---|
| 1046 | }
|
|---|
| 1047 |
|
|---|
| 1048 | # Param: string of comma-separated keywords, each possibly prefixed with a "!"
|
|---|
| 1049 | sub is_valid
|
|---|
| 1050 | {
|
|---|
| 1051 | my ($keywords_txt,$platforms) = @_;
|
|---|
| 1052 | my (@keywords) = split /,/,$keywords_txt;
|
|---|
| 1053 | my ($falsesum, $truesum) = (0, 1);
|
|---|
| 1054 |
|
|---|
| 1055 | # Param: one keyword
|
|---|
| 1056 | sub recognise
|
|---|
| 1057 | {
|
|---|
| 1058 | my ($keyword,$platforms) = @_;
|
|---|
| 1059 |
|
|---|
| 1060 | if ($platforms) {
|
|---|
| 1061 | # platforms
|
|---|
| 1062 | if ($keyword eq "UNIX" && $UNIX) { return 1; }
|
|---|
| 1063 | if ($keyword eq "VMS" && $VMS) { return 1; }
|
|---|
| 1064 | if ($keyword eq "WIN32" && $W32) { return 1; }
|
|---|
| 1065 | if ($keyword eq "_WIN32" && $W32) { return 1; }
|
|---|
| 1066 | if ($keyword eq "WINNT" && $NT) { return 1; }
|
|---|
| 1067 | # Special platforms:
|
|---|
| 1068 | # EXPORT_VAR_AS_FUNCTION means that global variables
|
|---|
| 1069 | # will be represented as functions.
|
|---|
| 1070 | if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && $W32) {
|
|---|
| 1071 | return 1;
|
|---|
| 1072 | }
|
|---|
| 1073 | if ($keyword eq "ZLIB" && $zlib) { return 1; }
|
|---|
| 1074 | return 0;
|
|---|
| 1075 | } else {
|
|---|
| 1076 | # algorithms
|
|---|
| 1077 | if ($disabled_algorithms{$keyword}) { return 0;}
|
|---|
| 1078 |
|
|---|
| 1079 | # Nothing recognise as true
|
|---|
| 1080 | return 1;
|
|---|
| 1081 | }
|
|---|
| 1082 | }
|
|---|
| 1083 |
|
|---|
| 1084 | foreach $k (@keywords) {
|
|---|
| 1085 | if ($k =~ /^!(.*)$/) {
|
|---|
| 1086 | $falsesum += &recognise($1,$platforms);
|
|---|
| 1087 | } else {
|
|---|
| 1088 | $truesum *= &recognise($k,$platforms);
|
|---|
| 1089 | }
|
|---|
| 1090 | }
|
|---|
| 1091 | print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug;
|
|---|
| 1092 | return (!$falsesum) && $truesum;
|
|---|
| 1093 | }
|
|---|
| 1094 |
|
|---|
| 1095 | sub print_test_file
|
|---|
| 1096 | {
|
|---|
| 1097 | (*OUT,my $name,*nums,my $testall,my @symbols)=@_;
|
|---|
| 1098 | my $n = 1; my @e; my @r;
|
|---|
| 1099 | my $sym; my $prev = ""; my $prefSSLeay;
|
|---|
| 1100 |
|
|---|
| 1101 | (@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
|
|---|
| 1102 | (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
|
|---|
| 1103 | @symbols=((sort @e),(sort @r));
|
|---|
| 1104 |
|
|---|
| 1105 | foreach $sym (@symbols) {
|
|---|
| 1106 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
|
|---|
| 1107 | my $v = 0;
|
|---|
| 1108 | $v = 1 if $i=~ /^.*?:.*?:VARIABLE/;
|
|---|
| 1109 | my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
|
|---|
| 1110 | my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
|
|---|
| 1111 | if (!defined($nums{$s})) {
|
|---|
| 1112 | print STDERR "Warning: $s does not have a number assigned\n"
|
|---|
| 1113 | if(!$do_update);
|
|---|
| 1114 | } elsif (is_valid($p,1) && is_valid($a,0)) {
|
|---|
| 1115 | my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
|
|---|
| 1116 | if ($prev eq $s2) {
|
|---|
| 1117 | print OUT "\t/* The following has already appeared previously */\n";
|
|---|
| 1118 | print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
|
|---|
| 1119 | }
|
|---|
| 1120 | $prev = $s2; # To warn about duplicates...
|
|---|
| 1121 |
|
|---|
| 1122 | (my $nn, my $vers, my $ni) = split /\\/, $nums{$s2};
|
|---|
| 1123 | if ($v) {
|
|---|
| 1124 | print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n";
|
|---|
| 1125 | } else {
|
|---|
| 1126 | print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n";
|
|---|
| 1127 | }
|
|---|
| 1128 | }
|
|---|
| 1129 | }
|
|---|
| 1130 | }
|
|---|
| 1131 |
|
|---|
| 1132 | sub get_version
|
|---|
| 1133 | {
|
|---|
| 1134 | return $config{version};
|
|---|
| 1135 | }
|
|---|
| 1136 |
|
|---|
| 1137 | sub print_def_file
|
|---|
| 1138 | {
|
|---|
| 1139 | (*OUT,my $name,*nums,my @symbols)=@_;
|
|---|
| 1140 | my $n = 1; my @e; my @r; my @v; my $prev="";
|
|---|
| 1141 | my $liboptions="";
|
|---|
| 1142 | my $libname = $name;
|
|---|
| 1143 | my $http_vendor = 'www.openssl.org/';
|
|---|
| 1144 | my $version = get_version();
|
|---|
| 1145 | my $what = "OpenSSL: implementation of Secure Socket Layer";
|
|---|
| 1146 | my $description = "$what $version, $name - http://$http_vendor";
|
|---|
| 1147 | my $prevsymversion = "", $prevprevsymversion = "";
|
|---|
| 1148 | # For VMS
|
|---|
| 1149 | my $prevnum = 0;
|
|---|
| 1150 | my $symvtextcount = 0;
|
|---|
| 1151 |
|
|---|
| 1152 | if ($W32)
|
|---|
| 1153 | {
|
|---|
| 1154 | print OUT <<"EOF";
|
|---|
| 1155 | ;
|
|---|
| 1156 | ; Definition file for the DLL version of the $name library from OpenSSL
|
|---|
| 1157 | ;
|
|---|
| 1158 |
|
|---|
| 1159 | LIBRARY $libname $liboptions
|
|---|
| 1160 |
|
|---|
| 1161 | EOF
|
|---|
| 1162 |
|
|---|
| 1163 | print "EXPORTS\n";
|
|---|
| 1164 | }
|
|---|
| 1165 | elsif ($VMS)
|
|---|
| 1166 | {
|
|---|
| 1167 | print OUT <<"EOF";
|
|---|
| 1168 | IDENTIFICATION=$version
|
|---|
| 1169 | CASE_SENSITIVE=YES
|
|---|
| 1170 | SYMBOL_VECTOR=(-
|
|---|
| 1171 | EOF
|
|---|
| 1172 | $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
|
|---|
| 1173 | }
|
|---|
| 1174 |
|
|---|
| 1175 | (@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
|
|---|
| 1176 | (@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols);
|
|---|
| 1177 | if ($VMS) {
|
|---|
| 1178 | # VMS needs to have the symbols on slot number order
|
|---|
| 1179 | @symbols=(map { $_->[1] }
|
|---|
| 1180 | sort { $a->[0] <=> $b->[0] }
|
|---|
| 1181 | map { (my $s, my $i) = $_ =~ /^(.*?)\\(.*)$/;
|
|---|
| 1182 | die "Error: $s doesn't have a number assigned\n"
|
|---|
| 1183 | if !defined($nums{$s});
|
|---|
| 1184 | (my $n, my @rest) = split /\\/, $nums{$s};
|
|---|
| 1185 | [ $n, $_ ] } (@e, @r, @v));
|
|---|
| 1186 | } else {
|
|---|
| 1187 | @symbols=((sort @e),(sort @r), (sort @v));
|
|---|
| 1188 | }
|
|---|
| 1189 |
|
|---|
| 1190 | my ($baseversion, $currversion) = get_openssl_version();
|
|---|
| 1191 | my $thisversion;
|
|---|
| 1192 | do {
|
|---|
| 1193 | if (!defined($thisversion)) {
|
|---|
| 1194 | $thisversion = $baseversion;
|
|---|
| 1195 | } else {
|
|---|
| 1196 | $thisversion = get_next_version($thisversion);
|
|---|
| 1197 | }
|
|---|
| 1198 | foreach $sym (@symbols) {
|
|---|
| 1199 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
|
|---|
| 1200 | my $v = 0;
|
|---|
| 1201 | $v = 1 if $i =~ /^.*?:.*?:VARIABLE/;
|
|---|
| 1202 | if (!defined($nums{$s})) {
|
|---|
| 1203 | die "Error: $s does not have a number assigned\n"
|
|---|
| 1204 | if(!$do_update);
|
|---|
| 1205 | } else {
|
|---|
| 1206 | (my $n, my $symversion, my $dummy) = split /\\/, $nums{$s};
|
|---|
| 1207 | my %pf = ();
|
|---|
| 1208 | my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
|
|---|
| 1209 | my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
|
|---|
| 1210 | if (is_valid($p,1) && is_valid($a,0)) {
|
|---|
| 1211 | my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
|
|---|
| 1212 | if ($prev eq $s2) {
|
|---|
| 1213 | print STDERR "Warning: Symbol '",$s2,
|
|---|
| 1214 | "' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),
|
|---|
| 1215 | ", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
|
|---|
| 1216 | }
|
|---|
| 1217 | $prev = $s2; # To warn about duplicates...
|
|---|
| 1218 | if($linux) {
|
|---|
| 1219 | next if $symversion ne $thisversion;
|
|---|
| 1220 | if ($symversion ne $prevsymversion) {
|
|---|
| 1221 | if ($prevsymversion ne "") {
|
|---|
| 1222 | if ($prevprevsymversion ne "") {
|
|---|
| 1223 | print OUT "} OPENSSL${SO_VARIANT}_"
|
|---|
| 1224 | ."$prevprevsymversion;\n\n";
|
|---|
| 1225 | } else {
|
|---|
| 1226 | print OUT "};\n\n";
|
|---|
| 1227 | }
|
|---|
| 1228 | }
|
|---|
| 1229 | print OUT "OPENSSL${SO_VARIANT}_$symversion {\n global:\n";
|
|---|
| 1230 | $prevprevsymversion = $prevsymversion;
|
|---|
| 1231 | $prevsymversion = $symversion;
|
|---|
| 1232 | }
|
|---|
| 1233 | print OUT " $s2;\n";
|
|---|
| 1234 | } elsif ($aix) {
|
|---|
| 1235 | print OUT "$s2\n";
|
|---|
| 1236 | } elsif ($VMS) {
|
|---|
| 1237 | while(++$prevnum < $n) {
|
|---|
| 1238 | my $symline=" ,SPARE -\n ,SPARE -\n";
|
|---|
| 1239 | if ($symvtextcount + length($symline) - 2 > 1024) {
|
|---|
| 1240 | print OUT ")\nSYMBOL_VECTOR=(-\n";
|
|---|
| 1241 | $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
|
|---|
| 1242 | }
|
|---|
| 1243 | if ($symvtextcount == 16) {
|
|---|
| 1244 | # Take away first comma
|
|---|
| 1245 | $symline =~ s/,//;
|
|---|
| 1246 | }
|
|---|
| 1247 | print OUT $symline;
|
|---|
| 1248 | $symvtextcount += length($symline) - 2;
|
|---|
| 1249 | }
|
|---|
| 1250 | (my $s_uc = $s) =~ tr/a-z/A-Z/;
|
|---|
| 1251 | my $symtype=
|
|---|
| 1252 | $v ? "DATA" : "PROCEDURE";
|
|---|
| 1253 | my $symline=
|
|---|
| 1254 | ($s_uc ne $s
|
|---|
| 1255 | ? " ,$s_uc/$s=$symtype -\n ,$s=$symtype -\n"
|
|---|
| 1256 | : " ,$s=$symtype -\n ,SPARE -\n");
|
|---|
| 1257 | if ($symvtextcount + length($symline) - 2 > 1024) {
|
|---|
| 1258 | print OUT ")\nSYMBOL_VECTOR=(-\n";
|
|---|
| 1259 | $symvtextcount = 16; # length of "SYMBOL_VECTOR=(-"
|
|---|
| 1260 | }
|
|---|
| 1261 | if ($symvtextcount == 16) {
|
|---|
| 1262 | # Take away first comma
|
|---|
| 1263 | $symline =~ s/,//;
|
|---|
| 1264 | }
|
|---|
| 1265 | print OUT $symline;
|
|---|
| 1266 | $symvtextcount += length($symline) - 2;
|
|---|
| 1267 | } elsif($v) {
|
|---|
| 1268 | printf OUT " %s%-39s DATA\n",
|
|---|
| 1269 | ($W32)?"":"_",$s2;
|
|---|
| 1270 | } else {
|
|---|
| 1271 | printf OUT " %s%s\n",
|
|---|
| 1272 | ($W32)?"":"_",$s2;
|
|---|
| 1273 | }
|
|---|
| 1274 | }
|
|---|
| 1275 | }
|
|---|
| 1276 | }
|
|---|
| 1277 | } while ($linux && $thisversion ne $currversion);
|
|---|
| 1278 | if ($linux) {
|
|---|
| 1279 | if ($prevprevsymversion ne "") {
|
|---|
| 1280 | print OUT " local: *;\n} OPENSSL${SO_VARIANT}_$prevprevsymversion;\n\n";
|
|---|
| 1281 | } else {
|
|---|
| 1282 | print OUT " local: *;\n};\n\n";
|
|---|
| 1283 | }
|
|---|
| 1284 | } elsif ($VMS) {
|
|---|
| 1285 | print OUT ")\n";
|
|---|
| 1286 | (my $libvmaj, my $libvmin, my $libvedit) =
|
|---|
| 1287 | $currversion =~ /^(\d+)_(\d+)_(\d+)[a-z]{0,2}$/;
|
|---|
| 1288 | # The reason to multiply the edit number with 100 is to make space
|
|---|
| 1289 | # for the possibility that we want to encode the patch letters
|
|---|
| 1290 | print OUT "GSMATCH=LEQUAL,",($libvmaj * 100 + $libvmin),",",($libvedit * 100),"\n";
|
|---|
| 1291 | }
|
|---|
| 1292 | printf OUT "\n";
|
|---|
| 1293 | }
|
|---|
| 1294 |
|
|---|
| 1295 | sub load_numbers
|
|---|
| 1296 | {
|
|---|
| 1297 | my($name)=@_;
|
|---|
| 1298 | my(@a,%ret);
|
|---|
| 1299 | my $prevversion;
|
|---|
| 1300 |
|
|---|
| 1301 | $max_num = 0;
|
|---|
| 1302 | $num_noinfo = 0;
|
|---|
| 1303 | $prev = "";
|
|---|
| 1304 | $prev_cnt = 0;
|
|---|
| 1305 |
|
|---|
| 1306 | my ($baseversion, $currversion) = get_openssl_version();
|
|---|
| 1307 |
|
|---|
| 1308 | open(IN,"<$name") || die "unable to open $name:$!\n";
|
|---|
| 1309 | while (<IN>) {
|
|---|
| 1310 | s|\R$||; # Better chomp
|
|---|
| 1311 | s/#.*$//;
|
|---|
| 1312 | next if /^\s*$/;
|
|---|
| 1313 | @a=split;
|
|---|
| 1314 | if (defined $ret{$a[0]}) {
|
|---|
| 1315 | # This is actually perfectly OK
|
|---|
| 1316 | #print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n";
|
|---|
| 1317 | }
|
|---|
| 1318 | if ($max_num > $a[1]) {
|
|---|
| 1319 | print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n";
|
|---|
| 1320 | }
|
|---|
| 1321 | elsif ($max_num == $a[1]) {
|
|---|
| 1322 | # This is actually perfectly OK
|
|---|
| 1323 | #print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n";
|
|---|
| 1324 | if ($a[0] eq $prev) {
|
|---|
| 1325 | $prev_cnt++;
|
|---|
| 1326 | $a[0] .= "{$prev_cnt}";
|
|---|
| 1327 | }
|
|---|
| 1328 | }
|
|---|
| 1329 | else {
|
|---|
| 1330 | $prev_cnt = 0;
|
|---|
| 1331 | }
|
|---|
| 1332 | if ($#a < 2) {
|
|---|
| 1333 | # Existence will be proven later, in do_defs
|
|---|
| 1334 | $ret{$a[0]}=$a[1];
|
|---|
| 1335 | $num_noinfo++;
|
|---|
| 1336 | } else {
|
|---|
| 1337 | #Sanity check the version number
|
|---|
| 1338 | if (defined $prevversion) {
|
|---|
| 1339 | check_version_lte($prevversion, $a[2]);
|
|---|
| 1340 | }
|
|---|
| 1341 | check_version_lte($a[2], $currversion);
|
|---|
| 1342 | $prevversion = $a[2];
|
|---|
| 1343 | $ret{$a[0]}=$a[1]."\\".$a[2]."\\".$a[3]; # \\ is a special marker
|
|---|
| 1344 | }
|
|---|
| 1345 | $max_num = $a[1] if $a[1] > $max_num;
|
|---|
| 1346 | $prev=$a[0];
|
|---|
| 1347 | }
|
|---|
| 1348 | if ($num_noinfo) {
|
|---|
| 1349 | print STDERR "Warning: $num_noinfo symbols were without info." if $verbose || !$do_rewrite;
|
|---|
| 1350 | if ($do_rewrite) {
|
|---|
| 1351 | printf STDERR " The rewrite will fix this.\n" if $verbose;
|
|---|
| 1352 | } else {
|
|---|
| 1353 | printf STDERR " You should do a rewrite to fix this.\n";
|
|---|
| 1354 | }
|
|---|
| 1355 | }
|
|---|
| 1356 | close(IN);
|
|---|
| 1357 | return(%ret);
|
|---|
| 1358 | }
|
|---|
| 1359 |
|
|---|
| 1360 | sub parse_number
|
|---|
| 1361 | {
|
|---|
| 1362 | (my $str, my $what) = @_;
|
|---|
| 1363 | (my $n, my $v, my $i) = split(/\\/,$str);
|
|---|
| 1364 | if ($what eq "n") {
|
|---|
| 1365 | return $n;
|
|---|
| 1366 | } else {
|
|---|
| 1367 | return $i;
|
|---|
| 1368 | }
|
|---|
| 1369 | }
|
|---|
| 1370 |
|
|---|
| 1371 | sub rewrite_numbers
|
|---|
| 1372 | {
|
|---|
| 1373 | (*OUT,$name,*nums,@symbols)=@_;
|
|---|
| 1374 | my $thing;
|
|---|
| 1375 |
|
|---|
| 1376 | my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
|
|---|
| 1377 | my $r; my %r; my %rsyms;
|
|---|
| 1378 | foreach $r (@r) {
|
|---|
| 1379 | (my $s, my $i) = split /\\/, $r;
|
|---|
| 1380 | my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
|
|---|
| 1381 | $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
|
|---|
| 1382 | $r{$a} = $s."\\".$i;
|
|---|
| 1383 | $rsyms{$s} = 1;
|
|---|
| 1384 | }
|
|---|
| 1385 |
|
|---|
| 1386 | my %syms = ();
|
|---|
| 1387 | foreach $_ (@symbols) {
|
|---|
| 1388 | (my $n, my $i) = split /\\/;
|
|---|
| 1389 | $syms{$n} = 1;
|
|---|
| 1390 | }
|
|---|
| 1391 |
|
|---|
| 1392 | my @s=sort {
|
|---|
| 1393 | &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n")
|
|---|
| 1394 | || $a cmp $b
|
|---|
| 1395 | } keys %nums;
|
|---|
| 1396 | foreach $sym (@s) {
|
|---|
| 1397 | (my $n, my $vers, my $i) = split /\\/, $nums{$sym};
|
|---|
| 1398 | next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/;
|
|---|
| 1399 | next if defined($rsyms{$sym});
|
|---|
| 1400 | print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug;
|
|---|
| 1401 | $i="NOEXIST::FUNCTION:"
|
|---|
| 1402 | if !defined($i) || $i eq "" || !defined($syms{$sym});
|
|---|
| 1403 | my $s2 = $sym;
|
|---|
| 1404 | $s2 =~ s/\{[0-9]+\}$//;
|
|---|
| 1405 | printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
|
|---|
| 1406 | if (exists $r{$sym}) {
|
|---|
| 1407 | (my $s, $i) = split /\\/,$r{$sym};
|
|---|
| 1408 | my $s2 = $s;
|
|---|
| 1409 | $s2 =~ s/\{[0-9]+\}$//;
|
|---|
| 1410 | printf OUT "%s%-39s %d\t%s\t%s\n","",$s2,$n,$vers,$i;
|
|---|
| 1411 | }
|
|---|
| 1412 | }
|
|---|
| 1413 | }
|
|---|
| 1414 |
|
|---|
| 1415 | sub update_numbers
|
|---|
| 1416 | {
|
|---|
| 1417 | (*OUT,$name,*nums,my $start_num, my @symbols)=@_;
|
|---|
| 1418 | my $new_syms = 0;
|
|---|
| 1419 | my $basevers;
|
|---|
| 1420 | my $vers;
|
|---|
| 1421 |
|
|---|
| 1422 | ($basevers, $vers) = get_openssl_version();
|
|---|
| 1423 |
|
|---|
| 1424 | my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
|
|---|
| 1425 | my $r; my %r; my %rsyms;
|
|---|
| 1426 | foreach $r (@r) {
|
|---|
| 1427 | (my $s, my $i) = split /\\/, $r;
|
|---|
| 1428 | my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
|
|---|
| 1429 | $i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
|
|---|
| 1430 | $r{$a} = $s."\\".$i;
|
|---|
| 1431 | $rsyms{$s} = 1;
|
|---|
| 1432 | }
|
|---|
| 1433 |
|
|---|
| 1434 | foreach $sym (@symbols) {
|
|---|
| 1435 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
|
|---|
| 1436 | next if $i =~ /^.*?:.*?:\w+\(\w+\)/;
|
|---|
| 1437 | next if defined($rsyms{$sym});
|
|---|
| 1438 | die "ERROR: Symbol $sym had no info attached to it."
|
|---|
| 1439 | if $i eq "";
|
|---|
| 1440 | if (!exists $nums{$s}) {
|
|---|
| 1441 | $new_syms++;
|
|---|
| 1442 | my $s2 = $s;
|
|---|
| 1443 | $s2 =~ s/\{[0-9]+\}$//;
|
|---|
| 1444 | printf OUT "%s%-39s %d\t%s\t%s\n","",$s2, ++$start_num,$vers,$i;
|
|---|
| 1445 | if (exists $r{$s}) {
|
|---|
| 1446 | ($s, $i) = split /\\/,$r{$s};
|
|---|
| 1447 | $s =~ s/\{[0-9]+\}$//;
|
|---|
| 1448 | printf OUT "%s%-39s %d\t%s\t%s\n","",$s, $start_num,$vers,$i;
|
|---|
| 1449 | }
|
|---|
| 1450 | }
|
|---|
| 1451 | }
|
|---|
| 1452 | if($new_syms) {
|
|---|
| 1453 | print STDERR "$name: Added $new_syms new symbols\n";
|
|---|
| 1454 | } else {
|
|---|
| 1455 | print STDERR "$name: No new symbols added\n";
|
|---|
| 1456 | }
|
|---|
| 1457 | }
|
|---|
| 1458 |
|
|---|
| 1459 | sub check_existing
|
|---|
| 1460 | {
|
|---|
| 1461 | (*nums, my @symbols)=@_;
|
|---|
| 1462 | my %existing; my @remaining;
|
|---|
| 1463 | @remaining=();
|
|---|
| 1464 | foreach $sym (@symbols) {
|
|---|
| 1465 | (my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
|
|---|
| 1466 | $existing{$s}=1;
|
|---|
| 1467 | }
|
|---|
| 1468 | foreach $sym (keys %nums) {
|
|---|
| 1469 | if (!exists $existing{$sym}) {
|
|---|
| 1470 | push @remaining, $sym;
|
|---|
| 1471 | }
|
|---|
| 1472 | }
|
|---|
| 1473 | if(@remaining) {
|
|---|
| 1474 | print STDERR "The following symbols do not seem to exist:\n";
|
|---|
| 1475 | foreach $sym (@remaining) {
|
|---|
| 1476 | print STDERR "\t",$sym,"\n";
|
|---|
| 1477 | }
|
|---|
| 1478 | }
|
|---|
| 1479 | }
|
|---|
| 1480 |
|
|---|
| 1481 | sub count_parens
|
|---|
| 1482 | {
|
|---|
| 1483 | my $line = shift(@_);
|
|---|
| 1484 |
|
|---|
| 1485 | my $open = $line =~ tr/\(//;
|
|---|
| 1486 | my $close = $line =~ tr/\)//;
|
|---|
| 1487 |
|
|---|
| 1488 | return $open - $close;
|
|---|
| 1489 | }
|
|---|
| 1490 |
|
|---|
| 1491 | #Parse opensslv.h to get the current version number. Also work out the base
|
|---|
| 1492 | #version, i.e. the lowest version number that is binary compatible with this
|
|---|
| 1493 | #version
|
|---|
| 1494 | sub get_openssl_version()
|
|---|
| 1495 | {
|
|---|
| 1496 | my $fn = catfile($config{sourcedir},"include","openssl","opensslv.h");
|
|---|
| 1497 | open (IN, "$fn") || die "Can't open opensslv.h";
|
|---|
| 1498 |
|
|---|
| 1499 | while(<IN>) {
|
|---|
| 1500 | if (/OPENSSL_VERSION_TEXT\s+"OpenSSL (\d\.\d\.)(\d[a-z]*)(-| )/) {
|
|---|
| 1501 | my $suffix = $2;
|
|---|
| 1502 | (my $baseversion = $1) =~ s/\./_/g;
|
|---|
| 1503 | close IN;
|
|---|
| 1504 | return ($baseversion."0", $baseversion.$suffix);
|
|---|
| 1505 | }
|
|---|
| 1506 | }
|
|---|
| 1507 | die "Can't find OpenSSL version number\n";
|
|---|
| 1508 | }
|
|---|
| 1509 |
|
|---|
| 1510 | #Given an OpenSSL version number, calculate the next version number. If the
|
|---|
| 1511 | #version number gets to a.b.czz then we go to a.b.(c+1)
|
|---|
| 1512 | sub get_next_version()
|
|---|
| 1513 | {
|
|---|
| 1514 | my $thisversion = shift;
|
|---|
| 1515 |
|
|---|
| 1516 | my ($base, $letter) = $thisversion =~ /^(\d_\d_\d)([a-z]{0,2})$/;
|
|---|
| 1517 |
|
|---|
| 1518 | if ($letter eq "zz") {
|
|---|
| 1519 | my $lastnum = substr($base, -1);
|
|---|
| 1520 | return substr($base, 0, length($base)-1).(++$lastnum);
|
|---|
| 1521 | }
|
|---|
| 1522 | return $base.get_next_letter($letter);
|
|---|
| 1523 | }
|
|---|
| 1524 |
|
|---|
| 1525 | #Given the letters off the end of an OpenSSL version string, calculate what
|
|---|
| 1526 | #the letters for the next release would be.
|
|---|
| 1527 | sub get_next_letter()
|
|---|
| 1528 | {
|
|---|
| 1529 | my $thisletter = shift;
|
|---|
| 1530 | my $baseletter = "";
|
|---|
| 1531 | my $endletter;
|
|---|
| 1532 |
|
|---|
| 1533 | if ($thisletter eq "") {
|
|---|
| 1534 | return "a";
|
|---|
| 1535 | }
|
|---|
| 1536 | if ((length $thisletter) > 1) {
|
|---|
| 1537 | ($baseletter, $endletter) = $thisletter =~ /([a-z]+)([a-z])/;
|
|---|
| 1538 | } else {
|
|---|
| 1539 | $endletter = $thisletter;
|
|---|
| 1540 | }
|
|---|
| 1541 |
|
|---|
| 1542 | if ($endletter eq "z") {
|
|---|
| 1543 | return $thisletter."a";
|
|---|
| 1544 | } else {
|
|---|
| 1545 | return $baseletter.(++$endletter);
|
|---|
| 1546 | }
|
|---|
| 1547 | }
|
|---|
| 1548 |
|
|---|
| 1549 | #Check if a version is less than or equal to the current version. Its a fatal
|
|---|
| 1550 | #error if not. They must also only differ in letters, or the last number (i.e.
|
|---|
| 1551 | #the first two numbers must be the same)
|
|---|
| 1552 | sub check_version_lte()
|
|---|
| 1553 | {
|
|---|
| 1554 | my ($testversion, $currversion) = @_;
|
|---|
| 1555 | my $lentv;
|
|---|
| 1556 | my $lencv;
|
|---|
| 1557 | my $cvbase;
|
|---|
| 1558 |
|
|---|
| 1559 | my ($cvnums) = $currversion =~ /^(\d_\d_\d)[a-z]*$/;
|
|---|
| 1560 | my ($tvnums) = $testversion =~ /^(\d_\d_\d)[a-z]*$/;
|
|---|
| 1561 |
|
|---|
| 1562 | #Die if we can't parse the version numbers or they don't look sane
|
|---|
| 1563 | die "Invalid version number: $testversion and $currversion\n"
|
|---|
| 1564 | if (!defined($cvnums) || !defined($tvnums)
|
|---|
| 1565 | || length($cvnums) != 5
|
|---|
| 1566 | || length($tvnums) != 5);
|
|---|
| 1567 |
|
|---|
| 1568 | #If the base versions (without letters) don't match check they only differ
|
|---|
| 1569 | #in the last number
|
|---|
| 1570 | if ($cvnums ne $tvnums) {
|
|---|
| 1571 | die "Invalid version number: $testversion "
|
|---|
| 1572 | ."for current version $currversion\n"
|
|---|
| 1573 | if (substr($cvnums, 0, 4) ne substr($tvnums, 0, 4));
|
|---|
| 1574 | return;
|
|---|
| 1575 | }
|
|---|
| 1576 | #If we get here then the base version (i.e. the numbers) are the same - they
|
|---|
| 1577 | #only differ in the letters
|
|---|
| 1578 |
|
|---|
| 1579 | $lentv = length $testversion;
|
|---|
| 1580 | $lencv = length $currversion;
|
|---|
| 1581 |
|
|---|
| 1582 | #If the testversion has more letters than the current version then it must
|
|---|
| 1583 | #be later (or malformed)
|
|---|
| 1584 | if ($lentv > $lencv) {
|
|---|
| 1585 | die "Invalid version number: $testversion "
|
|---|
| 1586 | ."is greater than $currversion\n";
|
|---|
| 1587 | }
|
|---|
| 1588 |
|
|---|
| 1589 | #Get the last letter from the current version
|
|---|
| 1590 | my ($cvletter) = $currversion =~ /([a-z])$/;
|
|---|
| 1591 | if (defined $cvletter) {
|
|---|
| 1592 | ($cvbase) = $currversion =~ /(\d_\d_\d[a-z]*)$cvletter$/;
|
|---|
| 1593 | } else {
|
|---|
| 1594 | $cvbase = $currversion;
|
|---|
| 1595 | }
|
|---|
| 1596 | die "Unable to parse version number $currversion" if (!defined $cvbase);
|
|---|
| 1597 | my $tvbase;
|
|---|
| 1598 | my ($tvletter) = $testversion =~ /([a-z])$/;
|
|---|
| 1599 | if (defined $tvletter) {
|
|---|
| 1600 | ($tvbase) = $testversion =~ /(\d_\d_\d[a-z]*)$tvletter$/;
|
|---|
| 1601 | } else {
|
|---|
| 1602 | $tvbase = $testversion;
|
|---|
| 1603 | }
|
|---|
| 1604 | die "Unable to parse version number $testversion" if (!defined $tvbase);
|
|---|
| 1605 |
|
|---|
| 1606 | if ($lencv > $lentv) {
|
|---|
| 1607 | #If current version has more letters than testversion then testversion
|
|---|
| 1608 | #minus the final letter must be a substring of the current version
|
|---|
| 1609 | die "Invalid version number $testversion "
|
|---|
| 1610 | ."is greater than $currversion or is invalid\n"
|
|---|
| 1611 | if (index($cvbase, $tvbase) != 0);
|
|---|
| 1612 | } else {
|
|---|
| 1613 | #If both versions have the same number of letters then they must be
|
|---|
| 1614 | #equal up to the last letter, and the last letter in testversion must
|
|---|
| 1615 | #be less than or equal to the last letter in current version.
|
|---|
| 1616 | die "Invalid version number $testversion "
|
|---|
| 1617 | ."is greater than $currversion\n"
|
|---|
| 1618 | if (($cvbase ne $tvbase) && ($tvletter gt $cvletter));
|
|---|
| 1619 | }
|
|---|
| 1620 | }
|
|---|
| 1621 |
|
|---|
| 1622 | sub do_deprecated()
|
|---|
| 1623 | {
|
|---|
| 1624 | my ($decl, $plats, $algs) = @_;
|
|---|
| 1625 | $decl =~ /^\s*(DEPRECATEDIN_\d+_\d+_\d+)\s*\((.*)\)\s*$/
|
|---|
| 1626 | or die "Bad DEPRECATEDIN: $decl\n";
|
|---|
| 1627 | my $info1 .= "#INFO:";
|
|---|
| 1628 | $info1 .= join(',', @{$plats}) . ":";
|
|---|
| 1629 | my $info2 = $info1;
|
|---|
| 1630 | $info1 .= join(',',@{$algs}, $1) . ";";
|
|---|
| 1631 | $info2 .= join(',',@{$algs}) . ";";
|
|---|
| 1632 | return $info1 . $2 . ";" . $info2;
|
|---|
| 1633 | }
|
|---|
