* Some rand() implementations aren't good, but we're not
* dealing with secure randomness here.
*/
-#ifdef _WIN32
-# define random() rand()
-#endif
+# ifdef _WIN32
+# define random() rand()
+# endif
/*
* See if the current malloc should fail.
*/
{
int roll = (int)(random() % 100);
int shoulditfail = roll < md_fail_percent;
+# ifndef _WIN32
+/* suppressed on Windows as POSIX-like file descriptors are non-inheritable */
int len;
char buff[80];
len = strlen(buff);
if (write(md_tracefd, buff, len) != len)
perror("shouldfail write failed");
-#ifndef OPENSSL_NO_CRYPTO_MDEBUG_BACKTRACE
+# ifndef OPENSSL_NO_CRYPTO_MDEBUG_BACKTRACE
if (shoulditfail) {
void *addrs[30];
int num = backtrace(addrs, OSSL_NELEM(addrs));
backtrace_symbols_fd(addrs, num, md_tracefd);
}
-#endif
+# endif
}
+# endif
if (md_count) {
/* If we used up this one, go to the next. */
(my $SO_VARIANT = qq{\U$target{"shlib_variant"}}) =~ s/\W/_/g;
my $debug=0;
+my $trace=0;
+my $verbose=0;
my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num");
my $ssl_num= catfile($config{sourcedir},"util","libssl.num");
foreach (@ARGV, split(/ /, $config{options}))
{
$debug=1 if $_ eq "debug";
+ $trace=1 if $_ eq "trace";
+ $verbose=1 if $_ eq "verbose";
$W32=1 if $_ eq "32";
die "win16 not supported" if $_ eq "16";
if($_ eq "NT") {
{
my $fn = catfile($config{sourcedir},$file);
print STDERR "DEBUG: starting on $fn:\n" if $debug;
+ print STDERR "TRACE: start reading $fn\n" if $trace;
open(IN,"<$fn") || die "Can't open $fn, $!,";
my $line = "", my $def= "";
my %tag = (
push(@tag,$1);
$tag{$1}=-1;
print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
- } elsif (/^\#\s*if\s+!defined\(([^\)]+)\)/) {
+ } elsif (/^\#\s*if\s+!defined\s*\(([^\)]+)\)/) {
push(@tag,"-");
- if (/^\#\s*if\s+(!defined\(([^\)]+)\)(\s+\&\&\s+!defined\(([^\)]+)\))*)$/) {
+ if (/^\#\s*if\s+(!defined\s*\(([^\)]+)\)(\s+\&\&\s+!defined\s*\(([^\)]+)\))*)$/) {
my $tmp_1 = $1;
my $tmp_;
foreach $tmp_ (split '\&\&',$tmp_1) {
- $tmp_ =~ /!defined\(([^\)]+)\)/;
+ $tmp_ =~ /!defined\s*\(([^\)]+)\)/;
print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
push(@tag,$1);
$tag{$1}=-1;
}
} else {
- print STDERR "Warning: $file: complicated expression: $_" if $debug; # because it is O...
+ print STDERR "Warning: $file: taking only '!defined($1)' of complicated expression: $_" if $verbose; # because it is O...
print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
push(@tag,$1);
$tag{$1}=-1;
push(@tag,$1);
$tag{$1}=1;
print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
- } elsif (/^\#\s*if\s+defined\(([^\)]+)\)/) {
+ } elsif (/^\#\s*if\s+defined\s*\(([^\)]+)\)/) {
push(@tag,"-");
- if (/^\#\s*if\s+(defined\(([^\)]+)\)(\s+\|\|\s+defined\(([^\)]+)\))*)$/) {
+ if (/^\#\s*if\s+(defined\s*\(([^\)]+)\)(\s+\|\|\s+defined\s*\(([^\)]+)\))*)$/) {
my $tmp_1 = $1;
my $tmp_;
foreach $tmp_ (split '\|\|',$tmp_1) {
- $tmp_ =~ /defined\(([^\)]+)\)/;
+ $tmp_ =~ /defined\s*\(([^\)]+)\)/;
print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
push(@tag,$1);
$tag{$1}=1;
}
} else {
- print STDERR "Warning: $file: complicated expression: $_\n" if $debug; # because it is O...
+ print STDERR "Warning: $file: taking only 'defined($1)' of complicated expression: $_\n" if $verbose; # because it is O...
print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
push(@tag,$1);
$tag{$1}=1;
} elsif (/^\#\s*if\s+/) {
#Some other unrecognized "if" style
push(@tag,"-");
+ print STDERR "Warning: $file: ignoring unrecognized expression: $_\n" if $verbose; # because it is O...
} elsif (/^\#\s*define\s+(\w+)\s+(\w+)/
&& $symhacking && $tag{'TRUE'} != -1) {
# This is for aliasing. When we find an alias,
next if(/typedef\W/);
next if(/\#define/);
+ print STDERR "TRACE: processing $_\n" if $trace && !/^\#INFO:/;
# Reduce argument lists to empty ()
# fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {}
- while(/\(.*\)/s) {
- s/\([^\(\)]+\)/\{\}/gs;
- s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f
+ my $nsubst = 1; # prevent infinite loop, e.g., on int fn()
+ while($nsubst && /\(.*\)/s) {
+ $nsubst = s/\([^\(\)]+\)/\{\}/gs;
+ $nsubst+= s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f
}
# pretend as we didn't use curly braces: {} -> ()
s/\{\}/\(\)/gs;
$prev=$a[0];
}
if ($num_noinfo) {
- print STDERR "Warning: $num_noinfo symbols were without info.";
+ print STDERR "Warning: $num_noinfo symbols were without info." if $verbose || !$do_rewrite;
if ($do_rewrite) {
- printf STDERR " The rewrite will fix this.\n";
+ printf STDERR " The rewrite will fix this.\n" if $verbose;
} else {
printf STDERR " You should do a rewrite to fix this.\n";
}