From 3fcddc835caf6f5490751d18eb2bbc085319259b Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Mon, 28 Apr 2025 14:57:16 +0200 Subject: [PATCH] scripts: fix perl indentation, whitespace, semicolons Ref: #17116 Closes #17209 --- .github/scripts/spacecheck.pl | 10 +- lib/optiontable.pl | 2 +- scripts/checksrc.pl | 30 +- scripts/completion.pl | 2 +- scripts/delta | 2 +- scripts/mk-ca-bundle.pl | 814 ++++++++++++++++---------------- tests/directories.pm | 392 ++++++++-------- tests/ftpserver.pl | 112 ++--- tests/getpart.pm | 100 ++-- tests/servers.pm | 80 ++-- tests/test1173.pl | 4 +- tests/test1222.pl | 346 +++++++------- tests/test1544.pl | 114 ++--- tests/testcurl.pl | 860 +++++++++++++++++----------------- 14 files changed, 1432 insertions(+), 1436 deletions(-) diff --git a/.github/scripts/spacecheck.pl b/.github/scripts/spacecheck.pl index 11284e4f42..52d031dde1 100755 --- a/.github/scripts/spacecheck.pl +++ b/.github/scripts/spacecheck.pl @@ -65,19 +65,19 @@ sub eol_detect { my $lf = () = $content =~ /\n/g; if($cr > 0 && $lf == 0) { - return "cr" + return "cr"; } elsif($cr == 0 && $lf > 0) { - return "lf" + return "lf"; } elsif($cr == 0 && $lf == 0) { - return "bin" + return "bin"; } elsif($cr == $lf) { - return "crlf" + return "crlf"; } - return "" + return ""; } my $issues = 0; diff --git a/lib/optiontable.pl b/lib/optiontable.pl index b1fa69d982..cc38a922cc 100755 --- a/lib/optiontable.pl +++ b/lib/optiontable.pl @@ -109,7 +109,7 @@ while() { $o =~ s/^CURLOPT_//; $n =~ s/^CURLOPT_//; $alias{$o} = $n; - push @names, $o, + push @names, $o; } } } diff --git a/scripts/checksrc.pl b/scripts/checksrc.pl index 2ebb8650f6..68189b376f 100755 --- a/scripts/checksrc.pl +++ b/scripts/checksrc.pl @@ -480,10 +480,10 @@ sub scanfile { my $count = 0; while($l =~ /([\d]{4})/g) { push @copyright, { - year => $1, - line => $line, - col => index($l, $1), - code => $l + year => $1, + line => $line, + col => index($l, $1), + code => $l }; $count++; } @@ -874,7 +874,7 @@ sub scanfile { $suff =~ s/\(/\\(/; $l =~ s/$prefix$bad$suff/$prefix$replace/; goto again; - } + } $l = $bl; # restore to pre-bannedfunc content if($warnings{"STDERR"}) { @@ -1040,16 +1040,16 @@ sub scanfile { } preproc: if($prep) { - # scan for use of banned symbols on a preprocessor line - if($l =~ /^(^|.*\W) - (WIN32) - (\W|$) - /x) { - checkwarn("BANNEDPREPROC", - $line, length($1), $file, $ol, - "use of $2 is banned from preprocessor lines" . - (($2 eq "WIN32") ? ", use _WIN32 instead" : "")); - } + # scan for use of banned symbols on a preprocessor line + if($l =~ /^(^|.*\W) + (WIN32) + (\W|$) + /x) { + checkwarn("BANNEDPREPROC", + $line, length($1), $file, $ol, + "use of $2 is banned from preprocessor lines" . + (($2 eq "WIN32") ? ", use _WIN32 instead" : "")); + } } $line++; $prevp = $prep; diff --git a/scripts/completion.pl b/scripts/completion.pl index bc4cc9fea3..a7cf97bdad 100755 --- a/scripts/completion.pl +++ b/scripts/completion.pl @@ -52,7 +52,7 @@ if ($shell eq 'fish') { $opts_str .= qq{ $_ \\\n} foreach (@opts); chomp $opts_str; -my $tmpl = <<"EOS"; + my $tmpl = <<"EOS"; #compdef curl # curl zsh completion diff --git a/scripts/delta b/scripts/delta index 25ec838630..f950077774 100755 --- a/scripts/delta +++ b/scripts/delta @@ -64,7 +64,7 @@ sub setopts { open(H, "$f"); my $opts; while() { - if(/^ CURLOPT(|DEPRECATED)\(/ && ($_ !~ /OBSOLETE/)) { + if(/^ CURLOPT(|DEPRECATED)\(/ && ($_ !~ /OBSOLETE/)) { $opts++; } } diff --git a/scripts/mk-ca-bundle.pl b/scripts/mk-ca-bundle.pl index 56457afb1c..00d93c76de 100755 --- a/scripts/mk-ca-bundle.pl +++ b/scripts/mk-ca-bundle.pl @@ -43,21 +43,17 @@ use Text::Wrap; use Time::Local; my $MOD_SHA = "Digest::SHA"; eval "require $MOD_SHA"; -if ($@) { - $MOD_SHA = "Digest::SHA::PurePerl"; - eval "require $MOD_SHA"; +if($@) { + $MOD_SHA = "Digest::SHA::PurePerl"; + eval "require $MOD_SHA"; } eval "require LWP::UserAgent"; my %urls = ( - 'nss' => - 'https://hg.mozilla.org/projects/nss/raw-file/default/lib/ckfw/builtins/certdata.txt', - 'central' => - 'https://hg.mozilla.org/mozilla-central/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', - 'beta' => - 'https://hg.mozilla.org/releases/mozilla-beta/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', - 'release' => - 'https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', + 'nss' => 'https://hg.mozilla.org/projects/nss/raw-file/default/lib/ckfw/builtins/certdata.txt', + 'central' => 'https://hg.mozilla.org/mozilla-central/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', + 'beta' => 'https://hg.mozilla.org/releases/mozilla-beta/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', + 'release' => 'https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt', ); $opt_d = 'release'; @@ -76,43 +72,43 @@ my $default_mozilla_trust_levels = "TRUSTED_DELEGATOR"; $opt_p = $default_mozilla_trust_purposes . ":" . $default_mozilla_trust_levels; my @valid_mozilla_trust_purposes = ( - "DIGITAL_SIGNATURE", - "NON_REPUDIATION", - "KEY_ENCIPHERMENT", - "DATA_ENCIPHERMENT", - "KEY_AGREEMENT", - "KEY_CERT_SIGN", - "CRL_SIGN", - "SERVER_AUTH", - "CLIENT_AUTH", - "CODE_SIGNING", - "EMAIL_PROTECTION", - "IPSEC_END_SYSTEM", - "IPSEC_TUNNEL", - "IPSEC_USER", - "TIME_STAMPING", - "STEP_UP_APPROVED" + "DIGITAL_SIGNATURE", + "NON_REPUDIATION", + "KEY_ENCIPHERMENT", + "DATA_ENCIPHERMENT", + "KEY_AGREEMENT", + "KEY_CERT_SIGN", + "CRL_SIGN", + "SERVER_AUTH", + "CLIENT_AUTH", + "CODE_SIGNING", + "EMAIL_PROTECTION", + "IPSEC_END_SYSTEM", + "IPSEC_TUNNEL", + "IPSEC_USER", + "TIME_STAMPING", + "STEP_UP_APPROVED" ); my @valid_mozilla_trust_levels = ( - "TRUSTED_DELEGATOR", # CAs - "NOT_TRUSTED", # Don't trust these certs. - "MUST_VERIFY_TRUST", # This explicitly tells us that it ISN'T a CA but is - # otherwise ok. In other words, this should tell the - # app to ignore any other sources that claim this is - # a CA. - "TRUSTED" # This cert is trusted, but only for itself and not - # for delegates (i.e. it is not a CA). + "TRUSTED_DELEGATOR", # CAs + "NOT_TRUSTED", # Don't trust these certs. + "MUST_VERIFY_TRUST", # This explicitly tells us that it ISN'T a CA but is + # otherwise ok. In other words, this should tell the + # app to ignore any other sources that claim this is + # a CA. + "TRUSTED" # This cert is trusted, but only for itself and not + # for delegates (i.e. it is not a CA). ); my $default_signature_algorithms = $opt_s = "MD5"; my @valid_signature_algorithms = ( - "MD5", - "SHA1", - "SHA256", - "SHA384", - "SHA512" + "MD5", + "SHA1", + "SHA256", + "SHA384", + "SHA512" ); $0 =~ s@.*(/|\\)@@; @@ -127,155 +123,155 @@ if(!defined($opt_d)) { # Use predefined URL or else custom URL specified on command line. my $url; if(defined($urls{$opt_d})) { - $url = $urls{$opt_d}; - if(!$opt_k && $url !~ /^https:\/\//i) { - die "The URL for '$opt_d' is not HTTPS. Use -k to override (insecure).\n"; - } + $url = $urls{$opt_d}; + if(!$opt_k && $url !~ /^https:\/\//i) { + die "The URL for '$opt_d' is not HTTPS. Use -k to override (insecure).\n"; + } } else { $url = $opt_d; } -if ($opt_i) { - print ("=" x 78 . "\n"); - print "Script Version : $version\n"; - print "Perl Version : $]\n"; - print "Operating System Name : $^O\n"; - print "Getopt::Std.pm Version : ${Getopt::Std::VERSION}\n"; - print "Encode::Encoding.pm Version : ${Encode::Encoding::VERSION}\n"; - print "MIME::Base64.pm Version : ${MIME::Base64::VERSION}\n"; - print "LWP::UserAgent.pm Version : ${LWP::UserAgent::VERSION}\n" if($LWP::UserAgent::VERSION); - print "LWP.pm Version : ${LWP::VERSION}\n" if($LWP::VERSION); - print "Digest::SHA.pm Version : ${Digest::SHA::VERSION}\n" if ($Digest::SHA::VERSION); - print "Digest::SHA::PurePerl.pm Version : ${Digest::SHA::PurePerl::VERSION}\n" if ($Digest::SHA::PurePerl::VERSION); - print ("=" x 78 . "\n"); +if($opt_i) { + print ("=" x 78 . "\n"); + print "Script Version : $version\n"; + print "Perl Version : $]\n"; + print "Operating System Name : $^O\n"; + print "Getopt::Std.pm Version : ${Getopt::Std::VERSION}\n"; + print "Encode::Encoding.pm Version : ${Encode::Encoding::VERSION}\n"; + print "MIME::Base64.pm Version : ${MIME::Base64::VERSION}\n"; + print "LWP::UserAgent.pm Version : ${LWP::UserAgent::VERSION}\n" if($LWP::UserAgent::VERSION); + print "LWP.pm Version : ${LWP::VERSION}\n" if($LWP::VERSION); + print "Digest::SHA.pm Version : ${Digest::SHA::VERSION}\n" if($Digest::SHA::VERSION); + print "Digest::SHA::PurePerl.pm Version : ${Digest::SHA::PurePerl::VERSION}\n" if($Digest::SHA::PurePerl::VERSION); + print ("=" x 78 . "\n"); } sub warning_message() { - if ( $opt_d =~ m/^risk$/i ) { # Long Form Warning and Exit - print "Warning: Use of this script may pose some risk:\n"; - print "\n"; - print " 1) If you use HTTP URLs they are subject to a man in the middle attack\n"; - print " 2) Default to 'release', but more recent updates may be found in other trees\n"; - print " 3) certdata.txt file format may change, lag time to update this script\n"; - print " 4) Generally unwise to blindly trust CAs without manual review & verification\n"; - print " 5) Mozilla apps use additional security checks aren't represented in certdata\n"; - print " 6) Use of this script will make a security engineer grind his teeth and\n"; - print " swear at you. ;)\n"; - exit; - } else { # Short Form Warning - print "Warning: Use of this script may pose some risk, -d risk for more details.\n"; - } + if($opt_d =~ m/^risk$/i) { # Long Form Warning and Exit + print "Warning: Use of this script may pose some risk:\n"; + print "\n"; + print " 1) If you use HTTP URLs they are subject to a man in the middle attack\n"; + print " 2) Default to 'release', but more recent updates may be found in other trees\n"; + print " 3) certdata.txt file format may change, lag time to update this script\n"; + print " 4) Generally unwise to blindly trust CAs without manual review & verification\n"; + print " 5) Mozilla apps use additional security checks aren't represented in certdata\n"; + print " 6) Use of this script will make a security engineer grind his teeth and\n"; + print " swear at you. ;)\n"; + exit; + } else { # Short Form Warning + print "Warning: Use of this script may pose some risk, -d risk for more details.\n"; + } } sub HELP_MESSAGE() { - print "Usage:\t${0} [-b] [-d] [-f] [-i] [-k] [-l] [-n] [-p] [-q] [-s] [-t] [-u] [-v] [-w] []\n"; - print "\t-b\tbackup an existing version of ca-bundle.crt\n"; - print "\t-d\tspecify Mozilla tree to pull certdata.txt or custom URL\n"; - print "\t\t Valid names are:\n"; - print "\t\t ", join( ", ", map { ( $_ =~ m/$opt_d/ ) ? "$_ (default)" : "$_" } sort keys %urls ), "\n"; - print "\t-f\tforce rebuild even if certdata.txt is current\n"; - print "\t-i\tprint version info about used modules\n"; - print "\t-k\tallow URLs other than HTTPS, enable HTTP fallback (insecure)\n"; - print "\t-l\tprint license info about certdata.txt\n"; - print "\t-m\tinclude meta data in output\n"; - print "\t-n\tno download of certdata.txt (to use existing)\n"; - print wrap("\t","\t\t", "-p\tlist of Mozilla trust purposes and levels for certificates to include in output. Takes the form of a comma separated list of purposes, a colon, and a comma separated list of levels. (default: $default_mozilla_trust_purposes:$default_mozilla_trust_levels)"), "\n"; - print "\t\t Valid purposes are:\n"; - print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_purposes ) ), "\n"; - print "\t\t Valid levels are:\n"; - print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_levels ) ), "\n"; - print "\t-q\tbe really quiet (no progress output at all)\n"; - print wrap("\t","\t\t", "-s\tcomma separated list of certificate signatures/hashes to output in plain text mode. (default: $default_signature_algorithms)\n"); - print "\t\t Valid signature algorithms are:\n"; - print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_signature_algorithms ) ), "\n"; - print "\t-t\tinclude plain text listing of certificates\n"; - print "\t-u\tunlink (remove) certdata.txt after processing\n"; - print "\t-v\tbe verbose and print out processed CAs\n"; - print "\t-w \twrap base64 output lines after chars (default: ${opt_w})\n"; - exit; + print "Usage:\t${0} [-b] [-d] [-f] [-i] [-k] [-l] [-n] [-p] [-q] [-s] [-t] [-u] [-v] [-w] []\n"; + print "\t-b\tbackup an existing version of ca-bundle.crt\n"; + print "\t-d\tspecify Mozilla tree to pull certdata.txt or custom URL\n"; + print "\t\t Valid names are:\n"; + print "\t\t ", join( ", ", map { ( $_ =~ m/$opt_d/ ) ? "$_ (default)" : "$_" } sort keys %urls ), "\n"; + print "\t-f\tforce rebuild even if certdata.txt is current\n"; + print "\t-i\tprint version info about used modules\n"; + print "\t-k\tallow URLs other than HTTPS, enable HTTP fallback (insecure)\n"; + print "\t-l\tprint license info about certdata.txt\n"; + print "\t-m\tinclude meta data in output\n"; + print "\t-n\tno download of certdata.txt (to use existing)\n"; + print wrap("\t","\t\t", "-p\tlist of Mozilla trust purposes and levels for certificates to include in output. Takes the form of a comma separated list of purposes, a colon, and a comma separated list of levels. (default: $default_mozilla_trust_purposes:$default_mozilla_trust_levels)"), "\n"; + print "\t\t Valid purposes are:\n"; + print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_purposes ) ), "\n"; + print "\t\t Valid levels are:\n"; + print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_levels ) ), "\n"; + print "\t-q\tbe really quiet (no progress output at all)\n"; + print wrap("\t","\t\t", "-s\tcomma separated list of certificate signatures/hashes to output in plain text mode. (default: $default_signature_algorithms)\n"); + print "\t\t Valid signature algorithms are:\n"; + print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_signature_algorithms ) ), "\n"; + print "\t-t\tinclude plain text listing of certificates\n"; + print "\t-u\tunlink (remove) certdata.txt after processing\n"; + print "\t-v\tbe verbose and print out processed CAs\n"; + print "\t-w \twrap base64 output lines after chars (default: ${opt_w})\n"; + exit; } sub VERSION_MESSAGE() { - print "${0} version ${version} running Perl ${]} on ${^O}\n"; + print "${0} version ${version} running Perl ${]} on ${^O}\n"; } warning_message() unless ($opt_q || $url =~ m/^(ht|f)tps:/i ); -HELP_MESSAGE() if ($opt_h); +HELP_MESSAGE() if($opt_h); sub report($@) { - my $output = shift; + my $output = shift; - print STDERR $output . "\n" unless $opt_q; + print STDERR $output . "\n" unless $opt_q; } sub is_in_list($@) { - my $target = shift; + my $target = shift; - return defined(List::Util::first { $target eq $_ } @_); + return defined(List::Util::first { $target eq $_ } @_); } # Parses $param_string as a case insensitive comma separated list with optional # whitespace validates that only allowed parameters are supplied sub parse_csv_param($$@) { - my $description = shift; - my $param_string = shift; - my @valid_values = @_; - - my @values = map { - s/^\s+//; # strip leading spaces - s/\s+$//; # strip trailing spaces - uc $_ # return the modified string as upper case - } split( ',', $param_string ); - - # Find all values which are not in the list of valid values or "ALL" - my @invalid = grep { !is_in_list($_,"ALL",@valid_values) } @values; - - if ( scalar(@invalid) > 0 ) { - # Tell the user which parameters were invalid and print the standard help - # message which will exit - print "Error: Invalid ", $description, scalar(@invalid) == 1 ? ": " : "s: ", join( ", ", map { "\"$_\"" } @invalid ), "\n"; - HELP_MESSAGE(); - } + my $description = shift; + my $param_string = shift; + my @valid_values = @_; + + my @values = map { + s/^\s+//; # strip leading spaces + s/\s+$//; # strip trailing spaces + uc $_ # return the modified string as upper case + } split( ',', $param_string ); + + # Find all values which are not in the list of valid values or "ALL" + my @invalid = grep { !is_in_list($_,"ALL",@valid_values) } @values; + + if(scalar(@invalid) > 0) { + # Tell the user which parameters were invalid and print the standard help + # message which will exit + print "Error: Invalid ", $description, scalar(@invalid) == 1 ? ": " : "s: ", join( ", ", map { "\"$_\"" } @invalid ), "\n"; + HELP_MESSAGE(); + } - @values = @valid_values if ( is_in_list("ALL",@values) ); + @values = @valid_values if(is_in_list("ALL",@values)); - return @values; + return @values; } sub sha256 { - my $result; - if ($Digest::SHA::VERSION || $Digest::SHA::PurePerl::VERSION) { - open(FILE, $_[0]) or die "Can't open '$_[0]': $!"; - binmode(FILE); - $result = $MOD_SHA->new(256)->addfile(*FILE)->hexdigest; - close(FILE); - } else { - # Use OpenSSL command if Perl Digest::SHA modules not available - $result = `"$openssl" dgst -r -sha256 "$_[0]"`; - $result =~ s/^([0-9a-f]{64}) .+/$1/is; - } - return $result; + my $result; + if($Digest::SHA::VERSION || $Digest::SHA::PurePerl::VERSION) { + open(FILE, $_[0]) or die "Can't open '$_[0]': $!"; + binmode(FILE); + $result = $MOD_SHA->new(256)->addfile(*FILE)->hexdigest; + close(FILE); + } else { + # Use OpenSSL command if Perl Digest::SHA modules not available + $result = `"$openssl" dgst -r -sha256 "$_[0]"`; + $result =~ s/^([0-9a-f]{64}) .+/$1/is; + } + return $result; } sub oldhash { - my $hash = ""; - open(C, "<$_[0]") || return 0; - while() { - chomp; - if($_ =~ /^\#\# SHA256: (.*)/) { - $hash = $1; - last; + my $hash = ""; + open(C, "<$_[0]") || return 0; + while() { + chomp; + if($_ =~ /^\#\# SHA256: (.*)/) { + $hash = $1; + last; + } } - } - close(C); - return $hash; + close(C); + return $hash; } -if ( $opt_p !~ m/:/ ) { - print "Error: Mozilla trust identifier list must include both purposes and levels\n"; - HELP_MESSAGE(); +if( $opt_p !~ m/:/ ) { + print "Error: Mozilla trust identifier list must include both purposes and levels\n"; + HELP_MESSAGE(); } (my $included_mozilla_trust_purposes_string, my $included_mozilla_trust_levels_string) = split( ':', $opt_p ); @@ -285,15 +281,15 @@ my @included_mozilla_trust_levels = parse_csv_param( "trust level", $included_mo my @included_signature_algorithms = parse_csv_param( "signature algorithm", $opt_s, @valid_signature_algorithms ); sub should_output_cert(%) { - my %trust_purposes_by_level = @_; + my %trust_purposes_by_level = @_; - foreach my $level (@included_mozilla_trust_levels) { - # for each level we want to output, see if any of our desired purposes are - # included - return 1 if ( defined( List::Util::first { is_in_list( $_, @included_mozilla_trust_purposes ) } @{$trust_purposes_by_level{$level}} ) ); - } + foreach my $level (@included_mozilla_trust_levels) { + # for each level we want to output, see if any of our desired purposes are + # included + return 1 if( defined( List::Util::first { is_in_list( $_, @included_mozilla_trust_purposes ) } @{$trust_purposes_by_level{$level}} ) ); + } - return 0; + return 0; } my $crt = $ARGV[0] || 'ca-bundle.crt'; @@ -308,69 +304,69 @@ my $oldhash = oldhash($crt); report "SHA256 of old file: $oldhash"; if(!$opt_n) { - report "Downloading $txt ..."; - - # If we have an HTTPS URL then use curl - if($url =~ /^https:\/\//i) { - my $curl = `curl -V`; - if($curl) { - if($curl =~ /^Protocols:.* https( |$)/m) { - report "Get certdata with curl!"; - my $proto = !$opt_k ? "--proto =https" : ""; - my $quiet = $opt_q ? "-s" : ""; - my @out = `curl -Lw %{response_code} $proto $quiet -o "$txt" "$url"`; - if(!$? && @out && $out[0] == 200) { - $fetched = 1; - report "Downloaded $txt"; + report "Downloading $txt ..."; + + # If we have an HTTPS URL then use curl + if($url =~ /^https:\/\//i) { + my $curl = `curl -V`; + if($curl) { + if($curl =~ /^Protocols:.* https( |$)/m) { + report "Get certdata with curl!"; + my $proto = !$opt_k ? "--proto =https" : ""; + my $quiet = $opt_q ? "-s" : ""; + my @out = `curl -Lw %{response_code} $proto $quiet -o "$txt" "$url"`; + if(!$? && @out && $out[0] == 200) { + $fetched = 1; + report "Downloaded $txt"; + } + else { + report "Failed downloading via HTTPS with curl"; + if(-e $txt && !unlink($txt)) { + report "Failed to remove '$txt': $!"; + } + } + } + else { + report "curl lacks https support"; + } } else { - report "Failed downloading via HTTPS with curl"; - if(-e $txt && !unlink($txt)) { - report "Failed to remove '$txt': $!"; - } + report "curl not found"; } - } - else { - report "curl lacks https support"; - } } - else { - report "curl not found"; - } - } - # If nothing was fetched then use LWP - if(!$fetched) { - if($url =~ /^https:\/\//i) { - report "Falling back to HTTP"; - $url =~ s/^https:\/\//http:\/\//i; - } - if(!$opt_k) { - report "URLs other than HTTPS are disabled by default, to enable use -k"; - exit 1; - } - report "Get certdata with LWP!"; - if(!defined(${LWP::UserAgent::VERSION})) { - report "LWP is not available (LWP::UserAgent not found)"; - exit 1; - } - my $ua = new LWP::UserAgent(agent => "$0/$version"); - $ua->env_proxy(); - $resp = $ua->mirror($url, $txt); - if($resp && $resp->code eq '304') { - report "Not modified"; - exit 0 if -e $crt && !$opt_f; - } - else { - $fetched = 1; - report "Downloaded $txt"; - } - if(!$resp || $resp->code !~ /^(?:200|304)$/) { - report "Unable to download latest data: " - . ($resp? $resp->code . ' - ' . $resp->message : "LWP failed"); - exit 1 if -e $crt || ! -r $txt; + # If nothing was fetched then use LWP + if(!$fetched) { + if($url =~ /^https:\/\//i) { + report "Falling back to HTTP"; + $url =~ s/^https:\/\//http:\/\//i; + } + if(!$opt_k) { + report "URLs other than HTTPS are disabled by default, to enable use -k"; + exit 1; + } + report "Get certdata with LWP!"; + if(!defined(${LWP::UserAgent::VERSION})) { + report "LWP is not available (LWP::UserAgent not found)"; + exit 1; + } + my $ua = new LWP::UserAgent(agent => "$0/$version"); + $ua->env_proxy(); + $resp = $ua->mirror($url, $txt); + if($resp && $resp->code eq '304') { + report "Not modified"; + exit 0 if -e $crt && !$opt_f; + } + else { + $fetched = 1; + report "Downloaded $txt"; + } + if(!$resp || $resp->code !~ /^(?:200|304)$/) { + report "Unable to download latest data: " + . ($resp? $resp->code . ' - ' . $resp->message : "LWP failed"); + exit 1 if -e $crt || ! -r $txt; + } } - } } my $filedate = $resp ? $resp->last_modified : (stat($txt))[9]; @@ -397,7 +393,7 @@ report "SHA256 of new file: $newhash"; my $currentdate = scalar gmtime($filedate); my $format = $opt_t ? "plain text and " : ""; -if( $stdout ) { +if($stdout) { open(CRT, '> -') or die "Couldn't open STDOUT: $!\n"; } else { open(CRT,">$crt.~") or die "Couldn't open $crt.~: $!\n"; @@ -440,224 +436,224 @@ my $cka_value; my $valid = 0; open(TXT,"$txt") or die "Couldn't open $txt: $!\n"; -while () { - if (/\*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*/) { - print CRT; - print if ($opt_l); - while () { - print CRT; - print if ($opt_l); - last if (/\*\*\*\*\* END LICENSE BLOCK \*\*\*\*\*/); - } - next; - } - # The input file format consists of blocks of Mozilla objects. - # The blocks are separated by blank lines but may be related. - elsif(/^\s*$/) { - $main_block = 0; - $trust_block = 0; - next; - } - # Each certificate has a main block. - elsif(/^# Certificate "(.*)"/) { - (!$main_block && !$trust_block) or die "Unexpected certificate block"; - $main_block = 1; - $main_block_name = $1; - # Reset all other certificate variables. - $trust_block = 0; - $trust_block_name = ""; - $valid = 0; - $start_of_cert = 0; - $caname = ""; - $cka_value = ""; - undef @precert; - next; - } - # Each certificate's main block is followed by a trust block. - elsif(/^# Trust for (?:Certificate )?"(.*)"/) { - (!$main_block && !$trust_block) or die "Unexpected trust block"; - $trust_block = 1; - $trust_block_name = $1; - if($main_block_name ne $trust_block_name) { - die "cert name \"$main_block_name\" != trust name \"$trust_block_name\""; - } - next; - } - # Ignore other blocks. - # - # There is a documentation comment block, a BEGINDATA block, and a bunch of - # blocks starting with "# Explicitly Distrust ". - # - # The latter is for certificates that have already been removed and are not - # included. Not all explicitly distrusted certificates are ignored at this - # point, just those without an actual certificate. - elsif(!$main_block && !$trust_block) { - next; - } - elsif(/^#/) { - # The commented lines in a main block are plaintext metadata that describes - # the certificate. Issuer, Subject, Fingerprint, etc. - if($main_block) { - push @precert, $_ if not /^#$/; - if(/^# Not Valid After : (.*)/) { - my $stamp = $1; - use Time::Piece; - # Not Valid After : Thu Sep 30 14:01:15 2021 - my $t = Time::Piece->strptime($stamp, "%a %b %d %H:%M:%S %Y"); - my $delta = ($t->epoch - time()); # negative means no longer valid - if($delta < 0) { - $skipnum++; - report "Skipping: $main_block_name is not valid anymore" if ($opt_v); - $valid = 0; +while() { + if(/\*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*/) { + print CRT; + print if($opt_l); + while() { + print CRT; + print if($opt_l); + last if(/\*\*\*\*\* END LICENSE BLOCK \*\*\*\*\*/); } - else { - $valid = 1; - } - } + next; + } + # The input file format consists of blocks of Mozilla objects. + # The blocks are separated by blank lines but may be related. + elsif(/^\s*$/) { + $main_block = 0; + $trust_block = 0; + next; } - next; - } - elsif(!$valid) { - next; - } - - chomp; - - if($main_block) { - if(/^CKA_CLASS CK_OBJECT_CLASS CKO_CERTIFICATE/) { - !$start_of_cert or die "Duplicate CKO_CERTIFICATE object"; - $start_of_cert = 1; - next; + # Each certificate has a main block. + elsif(/^# Certificate "(.*)"/) { + (!$main_block && !$trust_block) or die "Unexpected certificate block"; + $main_block = 1; + $main_block_name = $1; + # Reset all other certificate variables. + $trust_block = 0; + $trust_block_name = ""; + $valid = 0; + $start_of_cert = 0; + $caname = ""; + $cka_value = ""; + undef @precert; + next; } - elsif(!$start_of_cert) { - next; + # Each certificate's main block is followed by a trust block. + elsif(/^# Trust for (?:Certificate )?"(.*)"/) { + (!$main_block && !$trust_block) or die "Unexpected trust block"; + $trust_block = 1; + $trust_block_name = $1; + if($main_block_name ne $trust_block_name) { + die "cert name \"$main_block_name\" != trust name \"$trust_block_name\""; + } + next; } - elsif(/^CKA_LABEL UTF8 \"(.*)\"/) { - ($caname eq "") or die "Duplicate CKA_LABEL attribute"; - $caname = $1; - if($caname ne $main_block_name) { - die "caname \"$caname\" != cert name \"$main_block_name\""; - } - next; + # Ignore other blocks. + # + # There is a documentation comment block, a BEGINDATA block, and a bunch of + # blocks starting with "# Explicitly Distrust ". + # + # The latter is for certificates that have already been removed and are not + # included. Not all explicitly distrusted certificates are ignored at this + # point, just those without an actual certificate. + elsif(!$main_block && !$trust_block) { + next; } - elsif(/^CKA_VALUE MULTILINE_OCTAL/) { - ($cka_value eq "") or die "Duplicate CKA_VALUE attribute"; - while () { - last if (/^END/); - chomp; - my @octets = split(/\\/); - shift @octets; - for (@octets) { - $cka_value .= chr(oct); + elsif(/^#/) { + # The commented lines in a main block are plaintext metadata that describes + # the certificate. Issuer, Subject, Fingerprint, etc. + if($main_block) { + push @precert, $_ if not /^#$/; + if(/^# Not Valid After : (.*)/) { + my $stamp = $1; + use Time::Piece; + # Not Valid After : Thu Sep 30 14:01:15 2021 + my $t = Time::Piece->strptime($stamp, "%a %b %d %H:%M:%S %Y"); + my $delta = ($t->epoch - time()); # negative means no longer valid + if($delta < 0) { + $skipnum++; + report "Skipping: $main_block_name is not valid anymore" if($opt_v); + $valid = 0; + } + else { + $valid = 1; + } + } } - } - next; + next; } - else { - next; + elsif(!$valid) { + next; } - } - - if(!$trust_block || !$start_of_cert || $caname eq "" || $cka_value eq "") { - die "Certificate extraction failed"; - } - my %trust_purposes_by_level; + chomp; - if(/^CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST/) { - # now scan the trust part to determine how we should trust this cert - while () { - if(/^\s*$/) { - $trust_block = 0; - last; - } - if (/^CKA_TRUST_([A-Z_]+)\s+CK_TRUST\s+CKT_NSS_([A-Z_]+)\s*$/) { - if ( !is_in_list($1,@valid_mozilla_trust_purposes) ) { - report "Warning: Unrecognized trust purpose for cert: $caname. Trust purpose: $1. Trust Level: $2"; - } elsif ( !is_in_list($2,@valid_mozilla_trust_levels) ) { - report "Warning: Unrecognized trust level for cert: $caname. Trust purpose: $1. Trust Level: $2"; - } else { - push @{$trust_purposes_by_level{$2}}, $1; + if($main_block) { + if(/^CKA_CLASS CK_OBJECT_CLASS CKO_CERTIFICATE/) { + !$start_of_cert or die "Duplicate CKO_CERTIFICATE object"; + $start_of_cert = 1; + next; + } + elsif(!$start_of_cert) { + next; + } + elsif(/^CKA_LABEL UTF8 \"(.*)\"/) { + ($caname eq "") or die "Duplicate CKA_LABEL attribute"; + $caname = $1; + if($caname ne $main_block_name) { + die "caname \"$caname\" != cert name \"$main_block_name\""; + } + next; + } + elsif(/^CKA_VALUE MULTILINE_OCTAL/) { + ($cka_value eq "") or die "Duplicate CKA_VALUE attribute"; + while() { + last if(/^END/); + chomp; + my @octets = split(/\\/); + shift @octets; + for(@octets) { + $cka_value .= chr(oct); + } + } + next; + } + else { + next; } - } } - # Sanity check that an explicitly distrusted certificate only has trust - # purposes with a trust level of NOT_TRUSTED. - # - # Certificate objects that are explicitly distrusted are in a certificate - # block that starts # Certificate "Explicitly Distrust(ed) ", - # where "Explicitly Distrust(ed) " was prepended to the original cert name. - if($caname =~ /distrust/i || - $main_block_name =~ /distrust/i || - $trust_block_name =~ /distrust/i) { - my @levels = keys %trust_purposes_by_level; - if(scalar(@levels) != 1 || $levels[0] ne "NOT_TRUSTED") { - die "\"$caname\" must have all trust purposes at level NOT_TRUSTED."; - } + if(!$trust_block || !$start_of_cert || $caname eq "" || $cka_value eq "") { + die "Certificate extraction failed"; } - if ( !should_output_cert(%trust_purposes_by_level) ) { - $skipnum ++; - report "Skipping: $caname lacks acceptable trust level" if ($opt_v); - } else { - my $encoded = MIME::Base64::encode_base64($cka_value, ''); - $encoded =~ s/(.{1,${opt_w}})/$1\n/g; - my $pem = "-----BEGIN CERTIFICATE-----\n" - . $encoded - . "-----END CERTIFICATE-----\n"; - print CRT "\n$caname\n"; - my $maxStringLength = length(decode('UTF-8', $caname, Encode::FB_CROAK | Encode::LEAVE_SRC)); - print CRT ("=" x $maxStringLength . "\n"); - if ($opt_t) { - foreach my $key (sort keys %trust_purposes_by_level) { - my $string = $key . ": " . join(", ", @{$trust_purposes_by_level{$key}}); - print CRT $string . "\n"; - } - } - if($opt_m) { - print CRT for @precert; - } - if (!$opt_t) { - print CRT $pem; - } else { - my $pipe = ""; - foreach my $hash (@included_signature_algorithms) { - $pipe = "|$openssl x509 -" . $hash . " -fingerprint -noout -inform PEM"; - if (!$stdout) { - $pipe .= " >> $crt.~"; - close(CRT) or die "Couldn't close $crt.~: $!"; - } - open(TMP, $pipe) or die "Couldn't open openssl pipe: $!"; - print TMP $pem; - close(TMP) or die "Couldn't close openssl pipe: $!"; - if (!$stdout) { - open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!"; - } + my %trust_purposes_by_level; + + if(/^CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST/) { + # now scan the trust part to determine how we should trust this cert + while() { + if(/^\s*$/) { + $trust_block = 0; + last; + } + if(/^CKA_TRUST_([A-Z_]+)\s+CK_TRUST\s+CKT_NSS_([A-Z_]+)\s*$/) { + if(!is_in_list($1,@valid_mozilla_trust_purposes)) { + report "Warning: Unrecognized trust purpose for cert: $caname. Trust purpose: $1. Trust Level: $2"; + } elsif(!is_in_list($2,@valid_mozilla_trust_levels)) { + report "Warning: Unrecognized trust level for cert: $caname. Trust purpose: $1. Trust Level: $2"; + } else { + push @{$trust_purposes_by_level{$2}}, $1; + } + } } - $pipe = "|$openssl x509 -text -inform PEM"; - if (!$stdout) { - $pipe .= " >> $crt.~"; - close(CRT) or die "Couldn't close $crt.~: $!"; + + # Sanity check that an explicitly distrusted certificate only has trust + # purposes with a trust level of NOT_TRUSTED. + # + # Certificate objects that are explicitly distrusted are in a certificate + # block that starts # Certificate "Explicitly Distrust(ed) ", + # where "Explicitly Distrust(ed) " was prepended to the original cert name. + if($caname =~ /distrust/i || + $main_block_name =~ /distrust/i || + $trust_block_name =~ /distrust/i) { + my @levels = keys %trust_purposes_by_level; + if(scalar(@levels) != 1 || $levels[0] ne "NOT_TRUSTED") { + die "\"$caname\" must have all trust purposes at level NOT_TRUSTED."; + } } - open(TMP, $pipe) or die "Couldn't open openssl pipe: $!"; - print TMP $pem; - close(TMP) or die "Couldn't close openssl pipe: $!"; - if (!$stdout) { - open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!"; + + if(!should_output_cert(%trust_purposes_by_level)) { + $skipnum ++; + report "Skipping: $caname lacks acceptable trust level" if($opt_v); + } else { + my $encoded = MIME::Base64::encode_base64($cka_value, ''); + $encoded =~ s/(.{1,${opt_w}})/$1\n/g; + my $pem = "-----BEGIN CERTIFICATE-----\n" + . $encoded + . "-----END CERTIFICATE-----\n"; + print CRT "\n$caname\n"; + my $maxStringLength = length(decode('UTF-8', $caname, Encode::FB_CROAK | Encode::LEAVE_SRC)); + print CRT ("=" x $maxStringLength . "\n"); + if($opt_t) { + foreach my $key (sort keys %trust_purposes_by_level) { + my $string = $key . ": " . join(", ", @{$trust_purposes_by_level{$key}}); + print CRT $string . "\n"; + } + } + if($opt_m) { + print CRT for @precert; + } + if(!$opt_t) { + print CRT $pem; + } else { + my $pipe = ""; + foreach my $hash (@included_signature_algorithms) { + $pipe = "|$openssl x509 -" . $hash . " -fingerprint -noout -inform PEM"; + if(!$stdout) { + $pipe .= " >> $crt.~"; + close(CRT) or die "Couldn't close $crt.~: $!"; + } + open(TMP, $pipe) or die "Couldn't open openssl pipe: $!"; + print TMP $pem; + close(TMP) or die "Couldn't close openssl pipe: $!"; + if(!$stdout) { + open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!"; + } + } + $pipe = "|$openssl x509 -text -inform PEM"; + if(!$stdout) { + $pipe .= " >> $crt.~"; + close(CRT) or die "Couldn't close $crt.~: $!"; + } + open(TMP, $pipe) or die "Couldn't open openssl pipe: $!"; + print TMP $pem; + close(TMP) or die "Couldn't close openssl pipe: $!"; + if(!$stdout) { + open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!"; + } + } + report "Processed: $caname" if($opt_v); + $certnum++; } - } - report "Processed: $caname" if ($opt_v); - $certnum ++; } - } } close(TXT) or die "Couldn't close $txt: $!\n"; close(CRT) or die "Couldn't close $crt.~: $!\n"; -unless( $stdout ) { - if ($opt_b && -e $crt) { +unless($stdout) { + if($opt_b && -e $crt) { my $bk = 1; - while (-e "$crt.~${bk}~") { + while(-e "$crt.~${bk}~") { $bk++; } rename $crt, "$crt.~${bk}~" or die "Failed to create backup $crt.~$bk}~: $!\n"; @@ -667,6 +663,6 @@ unless( $stdout ) { rename "$crt.~", $crt or die "Failed to rename $crt.~ to $crt: $!\n"; } if($opt_u && -e $txt && !unlink($txt)) { - report "Failed to remove $txt: $!\n"; + report "Failed to remove $txt: $!\n"; } report "Done ($certnum CA certs processed, $skipnum skipped)."; diff --git a/tests/directories.pm b/tests/directories.pm index f2114d3905..8b3c1addfa 100644 --- a/tests/directories.pm +++ b/tests/directories.pm @@ -39,268 +39,268 @@ BEGIN { my %file_chmod1 = ( - 'name' => 'chmod1', - 'content' => "This file should have permissions 444\n", - 'perm' => 'r--r--r--', - 'time' => 'Jan 11 10:00', - 'dostime' => '01-11-10 10:00AM', + 'name' => 'chmod1', + 'content' => "This file should have permissions 444\n", + 'perm' => 'r--r--r--', + 'time' => 'Jan 11 10:00', + 'dostime' => '01-11-10 10:00AM', ); my %file_chmod2 = ( - 'name' => 'chmod2', - 'content' => "This file should have permissions 666\n", - 'perm' => 'rw-rw-rw-', - 'time' => 'Feb 1 8:00', - 'dostime' => '02-01-10 08:00AM', + 'name' => 'chmod2', + 'content' => "This file should have permissions 666\n", + 'perm' => 'rw-rw-rw-', + 'time' => 'Feb 1 8:00', + 'dostime' => '02-01-10 08:00AM', ); my %file_chmod3 = ( - 'name' => 'chmod3', - 'content' => "This file should have permissions 777\n", - 'perm' => 'rwxrwxrwx', - 'time' => 'Feb 1 8:00', - 'dostime' => '02-01-10 08:00AM', + 'name' => 'chmod3', + 'content' => "This file should have permissions 777\n", + 'perm' => 'rwxrwxrwx', + 'time' => 'Feb 1 8:00', + 'dostime' => '02-01-10 08:00AM', ); my %file_chmod4 = ( - 'type' => 'd', - 'name' => 'chmod4', - 'content' => "This file should have permissions 001\n", - 'perm' => '--S--S--t', - 'time' => 'May 4 4:31', - 'dostime' => '05-04-10 04:31AM' + 'type' => 'd', + 'name' => 'chmod4', + 'content' => "This file should have permissions 001\n", + 'perm' => '--S--S--t', + 'time' => 'May 4 4:31', + 'dostime' => '05-04-10 04:31AM' ); my %file_chmod5 = ( - 'type' => 'd', - 'name' => 'chmod5', - 'content' => "This file should have permissions 110\n", - 'perm' => '--s--s--T', - 'time' => 'May 4 4:31', - 'dostime' => '05-04-10 04:31AM' + 'type' => 'd', + 'name' => 'chmod5', + 'content' => "This file should have permissions 110\n", + 'perm' => '--s--s--T', + 'time' => 'May 4 4:31', + 'dostime' => '05-04-10 04:31AM' ); my %link_link = ( - 'type' => 'l', - 'name' => 'link -> file.txt', - 'size' => '8', - 'perm' => 'rwxrwxrwx', - 'time' => 'Jan 6 4:42' + 'type' => 'l', + 'name' => 'link -> file.txt', + 'size' => '8', + 'perm' => 'rwxrwxrwx', + 'time' => 'Jan 6 4:42' ); my %link_link_absolute = ( - 'type' => 'l', - 'name' => 'link_absolute -> /data/ftp/file.txt', - 'size' => '15', - 'perm' => 'rwxrwxrwx', - 'time' => 'Jan 6 4:45' + 'type' => 'l', + 'name' => 'link_absolute -> /data/ftp/file.txt', + 'size' => '15', + 'perm' => 'rwxrwxrwx', + 'time' => 'Jan 6 4:45' ); my %dir_dot = ( - 'type' => "d", - 'name' => ".", - 'hlink' => "4", - 'time' => "Apr 27 5:12", - 'size' => "20480", - 'dostime' => "04-27-10 05:12AM", - 'perm' => "rwxrwxrwx" + 'type' => "d", + 'name' => ".", + 'hlink' => "4", + 'time' => "Apr 27 5:12", + 'size' => "20480", + 'dostime' => "04-27-10 05:12AM", + 'perm' => "rwxrwxrwx" ); my %dir_ddot = ( - 'type' => "d", - 'name' => "..", - 'hlink' => "4", - 'size' => "20480", - 'time' => "Apr 23 3:12", - 'dostime' => "04-23-10 03:12AM", - 'perm' => "rwxrwxrwx" + 'type' => "d", + 'name' => "..", + 'hlink' => "4", + 'size' => "20480", + 'time' => "Apr 23 3:12", + 'dostime' => "04-23-10 03:12AM", + 'perm' => "rwxrwxrwx" ); my %dir_weirddir_txt = ( - 'type' => "d", - 'name' => "weirddir.txt", - 'hlink' => "2", - 'size' => "4096", - 'time' => "Apr 23 3:12", - 'dostime' => "04-23-10 03:12AM", - 'perm' => "rwxr-xrwx" + 'type' => "d", + 'name' => "weirddir.txt", + 'hlink' => "2", + 'size' => "4096", + 'time' => "Apr 23 3:12", + 'dostime' => "04-23-10 03:12AM", + 'perm' => "rwxr-xrwx" ); my %dir_UNIX = ( - 'type' => "d", - 'name' => "UNIX", - 'hlink' => "11", - 'size' => "4096", - 'time' => "Nov 01 2008", - 'dostime' => "11-01-08 11:11AM", - 'perm' => "rwx--x--x" + 'type' => "d", + 'name' => "UNIX", + 'hlink' => "11", + 'size' => "4096", + 'time' => "Nov 01 2008", + 'dostime' => "11-01-08 11:11AM", + 'perm' => "rwx--x--x" ); my %dir_DOS = ( - 'type' => "d", - 'name' => "DOS", - 'hlink' => "11", - 'size' => "4096", - 'time' => "Nov 01 2008", - 'dostime' => "11-01-08 11:11AM", - 'perm' => "rwx--x--x" + 'type' => "d", + 'name' => "DOS", + 'hlink' => "11", + 'size' => "4096", + 'time' => "Nov 01 2008", + 'dostime' => "11-01-08 11:11AM", + 'perm' => "rwx--x--x" ); my %dir_dot_NeXT = ( - 'type' => "d", - 'name' => ".NeXT", - 'hlink' => "4", - 'size' => "4096", - 'time' => "Jan 23 2:05", - 'dostime' => "01-23-05 02:05AM", - 'perm' => "rwxrwxrwx" + 'type' => "d", + 'name' => ".NeXT", + 'hlink' => "4", + 'size' => "4096", + 'time' => "Jan 23 2:05", + 'dostime' => "01-23-05 02:05AM", + 'perm' => "rwxrwxrwx" ); my %file_empty_file_dat = ( - 'name' => "empty_file.dat", - 'content' => "", - 'perm' => "rw-r--r--", - 'time' => "Apr 27 11:01", - 'dostime' => "04-27-10 11:01AM" + 'name' => "empty_file.dat", + 'content' => "", + 'perm' => "rw-r--r--", + 'time' => "Apr 27 11:01", + 'dostime' => "04-27-10 11:01AM" ); my %file_file_txt = ( - 'name' => "file.txt", - 'content' => "This is content of file \"file.txt\"\n", - 'time' => "Apr 27 11:01", - 'dostime' => "04-27-10 11:01AM", - 'perm' => "rw-r--r--" + 'name' => "file.txt", + 'content' => "This is content of file \"file.txt\"\n", + 'time' => "Apr 27 11:01", + 'dostime' => "04-27-10 11:01AM", + 'perm' => "rw-r--r--" ); my %file_someothertext_txt = ( - 'name' => "someothertext.txt", - 'content' => "Some junk ;-) This file does not really exist.\n", - 'time' => "Apr 27 11:01", - 'dostime' => "04-27-10 11:01AM", - 'perm' => "rw-r--r--" + 'name' => "someothertext.txt", + 'content' => "Some junk ;-) This file does not really exist.\n", + 'time' => "Apr 27 11:01", + 'dostime' => "04-27-10 11:01AM", + 'perm' => "rw-r--r--" ); my %lists = ( - '/fully_simulated/' => { - 'files' => [ \%dir_dot, \%dir_ddot, \%dir_DOS, \%dir_UNIX ], - 'eol' => "\r\n", - 'type' => "unix" - }, - '/fully_simulated/UNIX/' => { - 'files' => [ \%dir_dot, \%dir_ddot, - \%file_chmod1, \%file_chmod2, \%file_chmod3, \%file_chmod4, \%file_chmod5, - \%file_empty_file_dat, \%file_file_txt, - \%link_link, \%link_link_absolute, \%dir_dot_NeXT, - \%file_someothertext_txt, \%dir_weirddir_txt ], - 'eol' => "\r\n", - 'type' => 'unix' - }, - '/fully_simulated/DOS/' => { - 'files' => [ \%dir_dot, \%dir_ddot, - \%file_chmod1, \%file_chmod2, \%file_chmod3, \%file_chmod4, \%file_chmod5, - \%file_empty_file_dat, \%file_file_txt, - \%dir_dot_NeXT, \%file_someothertext_txt, \%dir_weirddir_txt ], - 'eol' => "\r\n", - 'type' => 'dos' - } + '/fully_simulated/' => { + 'files' => [ \%dir_dot, \%dir_ddot, \%dir_DOS, \%dir_UNIX ], + 'eol' => "\r\n", + 'type' => "unix" + }, + '/fully_simulated/UNIX/' => { + 'files' => [ \%dir_dot, \%dir_ddot, + \%file_chmod1, \%file_chmod2, \%file_chmod3, \%file_chmod4, \%file_chmod5, + \%file_empty_file_dat, \%file_file_txt, + \%link_link, \%link_link_absolute, \%dir_dot_NeXT, + \%file_someothertext_txt, \%dir_weirddir_txt ], + 'eol' => "\r\n", + 'type' => 'unix' + }, + '/fully_simulated/DOS/' => { + 'files' => [ \%dir_dot, \%dir_ddot, + \%file_chmod1, \%file_chmod2, \%file_chmod3, \%file_chmod4, \%file_chmod5, + \%file_empty_file_dat, \%file_file_txt, + \%dir_dot_NeXT, \%file_someothertext_txt, \%dir_weirddir_txt ], + 'eol' => "\r\n", + 'type' => 'dos' + } ); sub ftp_createcontent { - my ($list) = $_[0]; + my ($list) = $_[0]; - my $type = $$list{'type'}; - my $eol = $$list{'eol'}; - my $list_ref = $$list{'files'}; + my $type = $$list{'type'}; + my $eol = $$list{'eol'}; + my $list_ref = $$list{'files'}; - my @contentlist; - if($type eq "unix") { - for(@$list_ref) { - my %file = %$_; - my $line = ""; - my $ftype = $file{'type'} ? $file{'type'} : "-"; - my $fperm = $file{'perm'} ? $file{'perm'} : "rwxr-xr-x"; - my $fuser = $file{'user'} ? sprintf("%15s", $file{'user'}) : "ftp-default"; - my $fgroup = $file{'group'} ? sprintf("%15s", $file{'group'}) : "ftp-default"; - my $fsize = ""; - if(exists($file{'type'}) && $file{'type'} eq "d") { - $fsize = $file{'size'} ? sprintf("%7s", $file{'size'}) : sprintf("%7d", 4096); - } - else { - $fsize = sprintf("%7d", exists($file{'content'}) ? length $file{'content'} : 0); - } - my $fhlink = $file{'hlink'} ? sprintf("%4d", $file{'hlink'}) : " 1"; - my $ftime = $file{'time'} ? sprintf("%10s", $file{'time'}) : "Jan 9 1933"; - push(@contentlist, "$ftype$fperm $fhlink $fuser $fgroup $fsize $ftime $file{'name'}$eol"); - } + my @contentlist; + if($type eq "unix") { + for(@$list_ref) { + my %file = %$_; + my $line = ""; + my $ftype = $file{'type'} ? $file{'type'} : "-"; + my $fperm = $file{'perm'} ? $file{'perm'} : "rwxr-xr-x"; + my $fuser = $file{'user'} ? sprintf("%15s", $file{'user'}) : "ftp-default"; + my $fgroup = $file{'group'} ? sprintf("%15s", $file{'group'}) : "ftp-default"; + my $fsize = ""; + if(exists($file{'type'}) && $file{'type'} eq "d") { + $fsize = $file{'size'} ? sprintf("%7s", $file{'size'}) : sprintf("%7d", 4096); + } + else { + $fsize = sprintf("%7d", exists($file{'content'}) ? length $file{'content'} : 0); + } + my $fhlink = $file{'hlink'} ? sprintf("%4d", $file{'hlink'}) : " 1"; + my $ftime = $file{'time'} ? sprintf("%10s", $file{'time'}) : "Jan 9 1933"; + push(@contentlist, "$ftype$fperm $fhlink $fuser $fgroup $fsize $ftime $file{'name'}$eol"); + } - return @contentlist; - } - elsif($type =~ /^dos$/) { - for(@$list_ref) { - my %file = %$_; - my $line = ""; - my $time = $file{'dostime'} ? $file{'dostime'} : "06-25-97 09:12AM"; - my $size_or_dir; - if(exists($file{'type'}) && $file{'type'} =~ /^d$/) { - $size_or_dir = " "; - } - else { - $size_or_dir = sprintf("%20d", length $file{'content'}); - } - push(@contentlist, "$time $size_or_dir $file{'name'}$eol"); + return @contentlist; + } + elsif($type =~ /^dos$/) { + for(@$list_ref) { + my %file = %$_; + my $line = ""; + my $time = $file{'dostime'} ? $file{'dostime'} : "06-25-97 09:12AM"; + my $size_or_dir; + if(exists($file{'type'}) && $file{'type'} =~ /^d$/) { + $size_or_dir = " "; + } + else { + $size_or_dir = sprintf("%20d", length $file{'content'}); + } + push(@contentlist, "$time $size_or_dir $file{'name'}$eol"); + } + return @contentlist; } - return @contentlist; - } } sub wildcard_filesize { - my ($list_type, $file) = @_; - my $list = $lists{$list_type}; - if($list) { - my $files = $list->{'files'}; - for(@$files) { - my %f = %$_; - if ($f{'name'} eq $file) { - if($f{'content'}) { - return length $f{'content'}; + my ($list_type, $file) = @_; + my $list = $lists{$list_type}; + if($list) { + my $files = $list->{'files'}; + for(@$files) { + my %f = %$_; + if($f{'name'} eq $file) { + if($f{'content'}) { + return length $f{'content'}; + } + elsif($f{'type'} ne "d"){ + return 0; + } + else { + return -1; + } + } } - elsif ($f{'type'} ne "d"){ - return 0; - } - else { - return -1; - } - } } - } - return -1; + return -1; } sub wildcard_getfile { - my ($list_type, $file) = @_; - my $list = $lists{$list_type}; - if($list) { - my $files = $list->{'files'}; - for(@$files) { - my %f = %$_; - if ($f{'name'} eq $file) { - if($f{'content'}) { - return (length $f{'content'}, $f{'content'}); - } - elsif (!exists($f{'type'}) or $f{'type'} ne "d"){ - return (0, ""); - } - else { - return (-1, 0); + my ($list_type, $file) = @_; + my $list = $lists{$list_type}; + if($list) { + my $files = $list->{'files'}; + for(@$files) { + my %f = %$_; + if($f{'name'} eq $file) { + if($f{'content'}) { + return (length $f{'content'}, $f{'content'}); + } + elsif(!exists($f{'type'}) or $f{'type'} ne "d"){ + return (0, ""); + } + else { + return (-1, 0); + } + } } - } } - } - return (-1, 0); + return (-1, 0); } sub ftp_contentlist { - my $listname = $_[0]; - my $list = $lists{$listname}; - return ftp_createcontent($list); + my $listname = $_[0]; + my $list = $lists{$listname}; + return ftp_createcontent($list); } diff --git a/tests/ftpserver.pl b/tests/ftpserver.pl index 79c28301bd..6db08b4843 100755 --- a/tests/ftpserver.pl +++ b/tests/ftpserver.pl @@ -2024,26 +2024,26 @@ sub REST_ftp { } sub switch_directory_goto { - my $target_dir = $_; + my $target_dir = $_; - if(!$ftptargetdir) { - $ftptargetdir = "/"; - } + if(!$ftptargetdir) { + $ftptargetdir = "/"; + } - if($target_dir eq "") { - $ftptargetdir = "/"; - } - elsif($target_dir eq "..") { - if($ftptargetdir eq "/") { - $ftptargetdir = "/"; + if($target_dir eq "") { + $ftptargetdir = "/"; + } + elsif($target_dir eq "..") { + if($ftptargetdir eq "/") { + $ftptargetdir = "/"; + } + else { + $ftptargetdir =~ s/[[:alnum:]]+\/$//; + } } else { - $ftptargetdir =~ s/[[:alnum:]]+\/$//; + $ftptargetdir .= $target_dir . "/"; } - } - else { - $ftptargetdir .= $target_dir . "/"; - } } sub switch_directory { @@ -2740,47 +2740,47 @@ sub PORT_ftp { sub datasockf_state { my $state = $_[0]; - if($state eq 'STOPPED') { - # Data sockfilter initial state, not running, - # not connected and not used. - $datasockf_state = $state; - $datasockf_mode = 'none'; - $datasockf_runs = 'no'; - $datasockf_conn = 'no'; - } - elsif($state eq 'PASSIVE') { - # Data sockfilter accepted connection from client. - $datasockf_state = $state; - $datasockf_mode = 'passive'; - $datasockf_runs = 'yes'; - $datasockf_conn = 'yes'; - } - elsif($state eq 'ACTIVE') { - # Data sockfilter has connected to client. - $datasockf_state = $state; - $datasockf_mode = 'active'; - $datasockf_runs = 'yes'; - $datasockf_conn = 'yes'; - } - elsif($state eq 'PASSIVE_NODATACONN') { - # Data sockfilter bound port without listening, - # client won't be able to establish data connection. - $datasockf_state = $state; - $datasockf_mode = 'passive'; - $datasockf_runs = 'yes'; - $datasockf_conn = 'no'; - } - elsif($state eq 'ACTIVE_NODATACONN') { - # Data sockfilter does not even run, - # client awaits data connection from server in vain. - $datasockf_state = $state; - $datasockf_mode = 'active'; - $datasockf_runs = 'no'; - $datasockf_conn = 'no'; - } - else { - die "Internal error. Unknown datasockf state: $state!"; - } + if($state eq 'STOPPED') { + # Data sockfilter initial state, not running, + # not connected and not used. + $datasockf_state = $state; + $datasockf_mode = 'none'; + $datasockf_runs = 'no'; + $datasockf_conn = 'no'; + } + elsif($state eq 'PASSIVE') { + # Data sockfilter accepted connection from client. + $datasockf_state = $state; + $datasockf_mode = 'passive'; + $datasockf_runs = 'yes'; + $datasockf_conn = 'yes'; + } + elsif($state eq 'ACTIVE') { + # Data sockfilter has connected to client. + $datasockf_state = $state; + $datasockf_mode = 'active'; + $datasockf_runs = 'yes'; + $datasockf_conn = 'yes'; + } + elsif($state eq 'PASSIVE_NODATACONN') { + # Data sockfilter bound port without listening, + # client won't be able to establish data connection. + $datasockf_state = $state; + $datasockf_mode = 'passive'; + $datasockf_runs = 'yes'; + $datasockf_conn = 'no'; + } + elsif($state eq 'ACTIVE_NODATACONN') { + # Data sockfilter does not even run, + # client awaits data connection from server in vain. + $datasockf_state = $state; + $datasockf_mode = 'active'; + $datasockf_runs = 'no'; + $datasockf_conn = 'no'; + } + else { + die "Internal error. Unknown datasockf state: $state!"; + } } #********************************************************************** diff --git a/tests/getpart.pm b/tests/getpart.pm index 5ecd1929e2..a15a4189db 100644 --- a/tests/getpart.pm +++ b/tests/getpart.pm @@ -293,56 +293,56 @@ sub striparray { # pass array *REFERENCES* ! # sub compareparts { - my ($firstref, $secondref)=@_; - - # we cannot compare arrays index per index since with data chunks, - # they may not be "evenly" distributed - my $first = join("", @$firstref); - my $second = join("", @$secondref); - - if($first =~ /%alternatives\[/) { - die "bad use of compareparts\n"; - } - - if($second =~ /%alternatives\[([^,]*),([^\]]*)\]/) { - # there can be many %alternatives in this chunk, so we call - # this function recursively - my $alt = $second; - $alt =~ s/%alternatives\[([^,]*),([^\]]*)\]/$1/; - - # check first alternative - { - my @f; - my @s; - push @f, $first; - push @s, $alt; - if(!compareparts(\@f, \@s)) { - return 0; - } - } - - $alt = $second; - $alt =~ s/%alternatives\[([^,]*),([^\]]*)\]/$2/; - # check second alternative - { - my @f; - my @s; - push @f, $first; - push @s, $alt; - if(!compareparts(\@f, \@s)) { - return 0; - } - } - - # neither matched - return 1; - } - - if($first ne $second) { - return 1; - } - - return 0; + my ($firstref, $secondref)=@_; + + # we cannot compare arrays index per index since with data chunks, + # they may not be "evenly" distributed + my $first = join("", @$firstref); + my $second = join("", @$secondref); + + if($first =~ /%alternatives\[/) { + die "bad use of compareparts\n"; + } + + if($second =~ /%alternatives\[([^,]*),([^\]]*)\]/) { + # there can be many %alternatives in this chunk, so we call + # this function recursively + my $alt = $second; + $alt =~ s/%alternatives\[([^,]*),([^\]]*)\]/$1/; + + # check first alternative + { + my @f; + my @s; + push @f, $first; + push @s, $alt; + if(!compareparts(\@f, \@s)) { + return 0; + } + } + + $alt = $second; + $alt =~ s/%alternatives\[([^,]*),([^\]]*)\]/$2/; + # check second alternative + { + my @f; + my @s; + push @f, $first; + push @s, $alt; + if(!compareparts(\@f, \@s)) { + return 0; + } + } + + # neither matched + return 1; + } + + if($first ne $second) { + return 1; + } + + return 0; } # diff --git a/tests/servers.pm b/tests/servers.pm index a37622fccb..9389c6fa9e 100644 --- a/tests/servers.pm +++ b/tests/servers.pm @@ -219,47 +219,47 @@ sub initserverconfig { # possible servers. # sub init_serverpidfile_hash { - for my $proto (('ftp', 'gopher', 'http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) { - for my $ssl (('', 's')) { - for my $ipvnum ((4, 6)) { - for my $idnum ((1, 2, 3)) { - my $serv = servername_id("$proto$ssl", $ipvnum, $idnum); - my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", "$proto$ssl", - $ipvnum, $idnum); - $serverpidfile{$serv} = $pidf; - my $portf = server_portfilename("$LOGDIR/$PIDDIR", "$proto$ssl", - $ipvnum, $idnum); - $serverportfile{$serv} = $portf; + for my $proto (('ftp', 'gopher', 'http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) { + for my $ssl (('', 's')) { + for my $ipvnum ((4, 6)) { + for my $idnum ((1, 2, 3)) { + my $serv = servername_id("$proto$ssl", $ipvnum, $idnum); + my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", "$proto$ssl", + $ipvnum, $idnum); + $serverpidfile{$serv} = $pidf; + my $portf = server_portfilename("$LOGDIR/$PIDDIR", "$proto$ssl", + $ipvnum, $idnum); + $serverportfile{$serv} = $portf; + } + } + } + } + for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'httptls', + 'dict', 'smb', 'smbs', 'telnet', 'mqtt', 'https-mtls', + 'dns')) { + for my $ipvnum ((4, 6)) { + for my $idnum ((1, 2)) { + my $serv = servername_id($proto, $ipvnum, $idnum); + my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum, + $idnum); + $serverpidfile{$serv} = $pidf; + my $portf = server_portfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum, + $idnum); + $serverportfile{$serv} = $portf; + } + } + } + for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) { + for my $ssl (('', 's')) { + my $serv = servername_id("$proto$ssl", "unix", 1); + my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", "$proto$ssl", + "unix", 1); + $serverpidfile{$serv} = $pidf; + my $portf = server_portfilename("$LOGDIR/$PIDDIR", "$proto$ssl", + "unix", 1); + $serverportfile{$serv} = $portf; } - } - } - } - for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'httptls', - 'dict', 'smb', 'smbs', 'telnet', 'mqtt', 'https-mtls', - 'dns')) { - for my $ipvnum ((4, 6)) { - for my $idnum ((1, 2)) { - my $serv = servername_id($proto, $ipvnum, $idnum); - my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum, - $idnum); - $serverpidfile{$serv} = $pidf; - my $portf = server_portfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum, - $idnum); - $serverportfile{$serv} = $portf; - } - } - } - for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) { - for my $ssl (('', 's')) { - my $serv = servername_id("$proto$ssl", "unix", 1); - my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", "$proto$ssl", - "unix", 1); - $serverpidfile{$serv} = $pidf; - my $portf = server_portfilename("$LOGDIR/$PIDDIR", "$proto$ssl", - "unix", 1); - $serverportfile{$serv} = $portf; - } - } + } } diff --git a/tests/test1173.pl b/tests/test1173.pl index 584c2f1015..5bd5607a28 100755 --- a/tests/test1173.pl +++ b/tests/test1173.pl @@ -195,13 +195,13 @@ sub scanmanpage { } } } - elsif($inex) { + elsif($inex) { $exsize++; if($_ =~ /[^\\]\\n/) { print STDERR "$file:$line '\\n' need to be '\\\\n'!\n"; } } - elsif($insynop) { + elsif($insynop) { $synopsize++; if(($synopsize == 1) && ($_ !~ /\.nf/)) { print STDERR "$file:$line:1:ERROR: be .nf for proper formatting\n"; diff --git a/tests/test1222.pl b/tests/test1222.pl index 8f98aa7404..c1d37da444 100755 --- a/tests/test1222.pl +++ b/tests/test1222.pl @@ -59,84 +59,84 @@ sub scan_header { open(my $h, "<", "$f"); while(<$h>) { - s/^\s*(.*?)\s*$/$1/; # Trim. - # Remove multi-line comment trail. - if($incomment) { - if($_ !~ /.*?\*\/\s*(.*)$/) { - next; + s/^\s*(.*?)\s*$/$1/; # Trim. + # Remove multi-line comment trail. + if($incomment) { + if($_ !~ /.*?\*\/\s*(.*)$/) { + next; + } + $_ = $1; + $incomment = 0; } - $_ = $1; - $incomment = 0; - } - if($line ne "") { - # Unfold line. - $_ = "$line $1"; - $line = ""; - } - # Remove comments. - while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) { - $_ = "$1 $2"; - } - if($_ =~ /^(.*)\/\*/) { - $_ = "$1 "; - $incomment = 1; - } - s/^\s*(.*?)\s*$/$1/; # Trim again. - # Ignore preprocessor directives and blank lines. - if($_ =~ /^(?:#|$)/) { - next; - } - # Handle lines that may be continued as if they were folded. - if($_ !~ /[;,{}]$/) { - # Folded line. - $line = $_; - next; - } - if($_ =~ /CURLOPTDEPRECATED\(/) { - # Handle deprecated CURLOPT_* option. - if($_ !~ /CURLOPTDEPRECATED\(\s*(\S+)\s*,(?:.*?,){2}\s*(.*?)\s*,.*"\)/) { - # Folded line. - $line = $_; - next; + if($line ne "") { + # Unfold line. + $_ = "$line $1"; + $line = ""; } - $hdr{$1} = $2; - } - elsif($_ =~ /CURLOPT\(/) { - # Handle non-deprecated CURLOPT_* option. - if($_ !~ /CURLOPT\(\s*(\S+)\s*(?:,.*?){2}\)/) { - # Folded line. - $line = $_; - next; + # Remove comments. + while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) { + $_ = "$1 $2"; } - $hdr{$1} = "X"; - } - else { - my $version = "X"; - - # Get other kind of deprecation from this line. - if($_ =~ /CURL_DEPRECATED\(/) { - if($_ !~ /^(.*)CURL_DEPRECATED\(\s*(\S+?)\s*,.*?"\)(.*)$/) { + if($_ =~ /^(.*)\/\*/) { + $_ = "$1 "; + $incomment = 1; + } + s/^\s*(.*?)\s*$/$1/; # Trim again. + # Ignore preprocessor directives and blank lines. + if($_ =~ /^(?:#|$)/) { + next; + } + # Handle lines that may be continued as if they were folded. + if($_ !~ /[;,{}]$/) { # Folded line. $line = $_; next; - } - $version = $2; - $_ = "$1 $3"; } - if($_ =~ /^CURL_EXTERN\s+.*\s+(\S+?)\s*\(/) { - # Flag public function. - $hdr{$1} = $version; + if($_ =~ /CURLOPTDEPRECATED\(/) { + # Handle deprecated CURLOPT_* option. + if($_ !~ /CURLOPTDEPRECATED\(\s*(\S+)\s*,(?:.*?,){2}\s*(.*?)\s*,.*"\)/) { + # Folded line. + $line = $_; + next; + } + $hdr{$1} = $2; } - elsif($inenum && $_ =~ /(\w+)\s*[,=}]/) { - # Flag enum value. - $hdr{$1} = $version; + elsif($_ =~ /CURLOPT\(/) { + # Handle non-deprecated CURLOPT_* option. + if($_ !~ /CURLOPT\(\s*(\S+)\s*(?:,.*?){2}\)/) { + # Folded line. + $line = $_; + next; + } + $hdr{$1} = "X"; + } + else { + my $version = "X"; + + # Get other kind of deprecation from this line. + if($_ =~ /CURL_DEPRECATED\(/) { + if($_ !~ /^(.*)CURL_DEPRECATED\(\s*(\S+?)\s*,.*?"\)(.*)$/) { + # Folded line. + $line = $_; + next; + } + $version = $2; + $_ = "$1 $3"; + } + if($_ =~ /^CURL_EXTERN\s+.*\s+(\S+?)\s*\(/) { + # Flag public function. + $hdr{$1} = $version; + } + elsif($inenum && $_ =~ /(\w+)\s*[,=}]/) { + # Flag enum value. + $hdr{$1} = $version; + } + } + # Remember if we are in an enum definition. + $inenum |= ($_ =~ /\benum\b/); + if($_ =~ /}/) { + $inenum = 0; } - } - # Remember if we are in an enum definition. - $inenum |= ($_ =~ /\benum\b/); - if($_ =~ /}/) { - $inenum = 0; - } } close $h; } @@ -151,31 +151,31 @@ sub scan_man_for_opts { open(my $m, "<", "$f"); while(<$m>) { - if($_ =~ /^\./) { - # roff directive found: end current option paragraph. - my $o = $opt; - $opt = ""; - if($_ =~ /^\.IP\s+((?:$prefix)_\w+)/) { - # A new option has been found. - $opt = $1; + if($_ =~ /^\./) { + # roff directive found: end current option paragraph. + my $o = $opt; + $opt = ""; + if($_ =~ /^\.IP\s+((?:$prefix)_\w+)/) { + # A new option has been found. + $opt = $1; + } + $_ = $line; # Get full paragraph. + $line = ""; + s/\\f.//g; # Remove font formatting. + s/\s+/ /g; # One line with single space only. + if($o) { + $funcman{$o} = "X"; + # Check if paragraph is mentioning deprecation. + while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) { + $funcman{$o} = $1 || "?"; + $_ = $2; + } + } } - $_ = $line; # Get full paragraph. - $line = ""; - s/\\f.//g; # Remove font formatting. - s/\s+/ /g; # One line with single space only. - if($o) { - $funcman{$o} = "X"; - # Check if paragraph is mentioning deprecation. - while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) { - $funcman{$o} = $1 || "?"; - $_ = $2; - } + else { + # Text line: accumulate. + $line .= $_; } - } - else { - # Text line: accumulate. - $line .= $_; - } } close $m; } @@ -186,52 +186,52 @@ sub scan_man_page { my $version = "X"; if(open(my $fh, "<", "$path")) { - my $section = ""; - my $line = ""; + my $section = ""; + my $line = ""; - while(<$fh>) { - if($_ =~ /\.so\s+man3\/(.*\.3\b)/) { - # Handle manpage inclusion. - scan_man_page(dirname($path) . "/$1", $sym, $table); - $version = exists($$table{$sym})? $$table{$sym}: $version; - } - elsif($_ =~ /^\./) { - # Line is a roff directive. - if($_ =~ /^\.SH\b\s*(\w*)/) { - # Section starts. End previous one. - my $sh = $section; + while(<$fh>) { + if($_ =~ /\.so\s+man3\/(.*\.3\b)/) { + # Handle manpage inclusion. + scan_man_page(dirname($path) . "/$1", $sym, $table); + $version = exists($$table{$sym})? $$table{$sym}: $version; + } + elsif($_ =~ /^\./) { + # Line is a roff directive. + if($_ =~ /^\.SH\b\s*(\w*)/) { + # Section starts. End previous one. + my $sh = $section; - $section = $1; - $_ = $line; # Previous section text. - $line = ""; - s/\\f.//g; - s/\s+/ /g; - s/\\f.//g; # Remove font formatting. - s/\s+/ /g; # One line with single space only. - if($sh =~ /DESCRIPTION|DEPRECATED/) { - while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) { - # Flag deprecation status. - if($version ne "X" && $version ne "?") { - if($1 && $1 ne $version) { - print "error: $sym manpage lists unmatching deprecation versions $version and $1\n"; - $errcode++; - } - } - else { - $version = $1 || "?"; + $section = $1; + $_ = $line; # Previous section text. + $line = ""; + s/\\f.//g; + s/\s+/ /g; + s/\\f.//g; # Remove font formatting. + s/\s+/ /g; # One line with single space only. + if($sh =~ /DESCRIPTION|DEPRECATED/) { + while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) { + # Flag deprecation status. + if($version ne "X" && $version ne "?") { + if($1 && $1 ne $version) { + print "error: $sym manpage lists unmatching deprecation versions $version and $1\n"; + $errcode++; + } + } + else { + $version = $1 || "?"; + } + $_ = $2; + } + } } - $_ = $2; - } } - } - } - else { - # Text line: accumulate. - $line .= $_; + else { + # Text line: accumulate. + $line .= $_; + } } - } - close $fh; - $$table{$sym} = $version; + close $fh; + $$table{$sym} = $version; } } @@ -240,14 +240,14 @@ sub scan_man_page { open(my $fh, "<", "$libdocdir/symbols-in-versions") || die "$libdocdir/symbols-in-versions"; while(<$fh>) { - if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) { - if($3 eq "") { - $syminver{$1} = "X"; - if($2 ne "" && $2 ne ".") { - $syminver{$1} = $2; - } + if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) { + if($3 eq "") { + $syminver{$1} = "X"; + if($2 ne "" && $2 ne ".") { + $syminver{$1} = $2; + } + } } - } } close($fh); @@ -258,14 +258,14 @@ closedir $dh; # Get functions and enum symbols from header files. for(@hfiles) { - scan_header("$incdir/$_"); + scan_header("$incdir/$_"); } # Get function statuses from manpages. foreach my $sym (keys %hdr) { - if($sym =~/^(?:curl|curlx)_\w/) { - scan_man_page("$libdocdir/$sym.3", $sym, \%funcman); - } + if($sym =~/^(?:curl|curlx)_\w/) { + scan_man_page("$libdocdir/$sym.3", $sym, \%funcman); + } } # Get options from function manpages. @@ -274,9 +274,9 @@ scan_man_for_opts("$libdocdir/curl_easy_getinfo.3", "CURLINFO"); # Get deprecation status from option manpages. foreach my $sym (keys %syminver) { - if($sym =~ /^(?:CURLOPT|CURLINFO)_\w+$/) { - scan_man_page("$libdocdir/opts/$sym.3", $sym, \%optman); - } + if($sym =~ /^(?:CURLOPT|CURLINFO)_\w+$/) { + scan_man_page("$libdocdir/opts/$sym.3", $sym, \%optman); + } } # Print results. @@ -293,37 +293,37 @@ Symbol symbols-in func man opt man .h HEADER ; foreach my $sym (sort {$a cmp $b} keys %keys) { - if($sym =~ /^(?:CURLOPT|CURLINFO|curl|curlx)_\w/) { - my $s = exists($syminver{$sym})? $syminver{$sym}: " "; - my $f = exists($funcman{$sym})? $funcman{$sym}: " "; - my $o = exists($optman{$sym})? $optman{$sym}: " "; - my $h = exists($hdr{$sym})? $hdr{$sym}: " "; - my $r = " "; + if($sym =~ /^(?:CURLOPT|CURLINFO|curl|curlx)_\w/) { + my $s = exists($syminver{$sym})? $syminver{$sym}: " "; + my $f = exists($funcman{$sym})? $funcman{$sym}: " "; + my $o = exists($optman{$sym})? $optman{$sym}: " "; + my $h = exists($hdr{$sym})? $hdr{$sym}: " "; + my $r = " "; - # There are deprecated symbols in symbols-in-versions that are aliases - # and thus not listed anywhere else. Ignore them. - "$f$o$h" =~ /[X ]{3}/ && next; + # There are deprecated symbols in symbols-in-versions that are aliases + # and thus not listed anywhere else. Ignore them. + "$f$o$h" =~ /[X ]{3}/ && next; - # Check for inconsistencies between deprecations from the different sources. - foreach my $k ($s, $f, $o, $h) { - $r = $r eq " "? $k: $r; - if($k ne " " && $r ne $k) { - if($r eq "?") { - $r = $k ne "X"? $k: "!"; - } - elsif($r eq "X" || $k ne "?") { - $r = "!"; + # Check for inconsistencies between deprecations from the different sources. + foreach my $k ($s, $f, $o, $h) { + $r = $r eq " "? $k: $r; + if($k ne " " && $r ne $k) { + if($r eq "?") { + $r = $k ne "X"? $k: "!"; + } + elsif($r eq "X" || $k ne "?") { + $r = "!"; + } + } } - } - } - if($r eq "!") { - print $leader; - $leader = ""; - printf("%-38s %-11s %-9s %-9s %s\n", $sym, $s, $f, $o, $h); - $errcode++; + if($r eq "!") { + print $leader; + $leader = ""; + printf("%-38s %-11s %-9s %-9s %s\n", $sym, $s, $f, $o, $h); + $errcode++; + } } - } } exit $errcode; diff --git a/tests/test1544.pl b/tests/test1544.pl index 64d036d272..beb088d5b8 100755 --- a/tests/test1544.pl +++ b/tests/test1544.pl @@ -44,47 +44,47 @@ sub scan_header { open(my $h, "<", "$f"); while(<$h>) { - s/^\s*(.*?)\s*$/$1/; # Trim. - # Remove multi-line comment trail. - if($incomment) { - if($_ !~ /.*?\*\/\s*(.*)$/) { - next; + s/^\s*(.*?)\s*$/$1/; # Trim. + # Remove multi-line comment trail. + if($incomment) { + if($_ !~ /.*?\*\/\s*(.*)$/) { + next; + } + $_ = $1; + $incomment = 0; + } + if($line ne "") { + # Unfold line. + $_ = "$line $1"; + $line = ""; + } + if($_ =~ /^(.*)\\$/) { + $line = "$1 "; + next; + } + # Remove comments. + while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) { + $_ = "$1 $2"; + } + if($_ =~ /^(.*)\/\*/) { + $_ = "$1 "; + $incomment = 1; + } + s/^\s*(.*?)\s*$/$1/; # Trim again. + # Ignore preprocessor directives and blank lines. + if($_ =~ /^(?:#|$)/) { + next; + } + # Handle lines that may be continued as if they were folded. + if($_ !~ /[;,{}]$/ || $_ =~ /[^)],$/) { + # Folded line. + $line = $_; + next; + } + # Keep string options only. + if($_ =~ /CURLOPT(?:DEPRECATED)?\s*\(\s*([^, \t]+)\s*,\s*CURLOPTTYPE_STRINGPOINT/) { + push(@stringopts, $1); } - $_ = $1; - $incomment = 0; - } - if($line ne "") { - # Unfold line. - $_ = "$line $1"; - $line = ""; - } - if($_ =~ /^(.*)\\$/) { - $line = "$1 "; - next; - } - # Remove comments. - while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) { - $_ = "$1 $2"; - } - if($_ =~ /^(.*)\/\*/) { - $_ = "$1 "; - $incomment = 1; - } - s/^\s*(.*?)\s*$/$1/; # Trim again. - # Ignore preprocessor directives and blank lines. - if($_ =~ /^(?:#|$)/) { - next; - } - # Handle lines that may be continued as if they were folded. - if($_ !~ /[;,{}]$/ || $_ =~ /[^)],$/) { - # Folded line. - $line = $_; - next; - } - # Keep string options only. - if($_ =~ /CURLOPT(?:DEPRECATED)?\s*\(\s*([^, \t]+)\s*,\s*CURLOPTTYPE_STRINGPOINT/) { - push(@stringopts, $1); - } } close $h; return @stringopts; @@ -98,12 +98,12 @@ sub scan_wrapper_for_strings { open(my $h, "<", "$f"); while(<$h>) { - if($_ =~ /(BEGIN|END) TRANSLATABLE STRING OPTIONS/) { - $inarmor = $1 eq "BEGIN"; - } - elsif($inarmor && $_ =~ /case\s+([^:]+):/) { - push(@stringopts, $1); - } + if($_ =~ /(BEGIN|END) TRANSLATABLE STRING OPTIONS/) { + $inarmor = $1 eq "BEGIN"; + } + elsif($inarmor && $_ =~ /case\s+([^:]+):/) { + push(@stringopts, $1); + } } close $h; return @stringopts; @@ -121,27 +121,27 @@ my %diff; delete @diff{@stringrefs}; foreach(keys %diff) { - print "$_ is not translated\n"; - delete $diff{$_}; - $errcount++; + print "$_ is not translated\n"; + delete $diff{$_}; + $errcount++; } @diff{@stringrefs} = 0..$#stringrefs; delete @diff{@stringdefs}; foreach(keys %diff) { - print "translated option $_ does not exist\n"; - $errcount++; + print "translated option $_ does not exist\n"; + $errcount++; } # Check translated string option cases are sorted alphanumerically. foreach(my $i = 1; $i < $#stringrefs; $i++) { - if($stringrefs[$i] lt $stringrefs[$i - 1]) { - print("Translated string options are not sorted (" . $stringrefs[$i - 1] . - "/" . $stringrefs[$i] . ")\n"); - $errcount++; - last; - } + if($stringrefs[$i] lt $stringrefs[$i - 1]) { + print("Translated string options are not sorted (" . $stringrefs[$i - 1] . + "/" . $stringrefs[$i] . ")\n"); + $errcount++; + last; + } } exit !!$errcount; diff --git a/tests/testcurl.pl b/tests/testcurl.pl index 096944b86c..6a96435a9f 100755 --- a/tests/testcurl.pl +++ b/tests/testcurl.pl @@ -83,91 +83,91 @@ $fixed=0; # Determine if we're running from git or a canned copy of curl, # or if we got a specific target option or setup file option. $CURLDIR="curl"; -if (-f ".git/config") { - $CURLDIR = "./"; +if(-f ".git/config") { + $CURLDIR = "./"; } $git=1; $setupfile = 'setup'; $configurebuild = 1; -while ($ARGV[0]) { - if ($ARGV[0] =~ /--target=/) { - $targetos = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--setup=/) { - $setupfile = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--extvercmd=/) { - $extvercmd = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--mktarball=/) { - $mktarball = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--name=/) { - $name = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--email=/) { - $email = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--desc=/) { - $desc = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--notes=/) { - $notes = (split(/=/, shift @ARGV, 2))[1]; - } - elsif ($ARGV[0] =~ /--configure=(.*)/) { - $confopts = $1; - shift @ARGV; - } - elsif (($ARGV[0] eq "--nocvsup") || ($ARGV[0] eq "--nogitpull")) { - $nogitpull=1; - shift @ARGV; - } - elsif ($ARGV[0] =~ /--nobuildconf/) { - $nobuildconf=1; - shift @ARGV; - } - elsif ($ARGV[0] =~ /--noconfigure/) { - $configurebuild=0; - shift @ARGV; - } - elsif ($ARGV[0] =~ /--crosscompile/) { - $crosscompile=1; - shift @ARGV; - } - elsif ($ARGV[0] =~ /--runtestopts=/) { - $runtestopts = (split(/=/, shift @ARGV, 2))[1]; - } - else { - $CURLDIR=shift @ARGV; - $git=0; # a given dir, assume not using git - } +while($ARGV[0]) { + if($ARGV[0] =~ /--target=/) { + $targetos = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--setup=/) { + $setupfile = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--extvercmd=/) { + $extvercmd = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--mktarball=/) { + $mktarball = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--name=/) { + $name = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--email=/) { + $email = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--desc=/) { + $desc = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--notes=/) { + $notes = (split(/=/, shift @ARGV, 2))[1]; + } + elsif($ARGV[0] =~ /--configure=(.*)/) { + $confopts = $1; + shift @ARGV; + } + elsif(($ARGV[0] eq "--nocvsup") || ($ARGV[0] eq "--nogitpull")) { + $nogitpull=1; + shift @ARGV; + } + elsif($ARGV[0] =~ /--nobuildconf/) { + $nobuildconf=1; + shift @ARGV; + } + elsif($ARGV[0] =~ /--noconfigure/) { + $configurebuild=0; + shift @ARGV; + } + elsif($ARGV[0] =~ /--crosscompile/) { + $crosscompile=1; + shift @ARGV; + } + elsif($ARGV[0] =~ /--runtestopts=/) { + $runtestopts = (split(/=/, shift @ARGV, 2))[1]; + } + else { + $CURLDIR=shift @ARGV; + $git=0; # a given dir, assume not using git + } } # Do the platform-specific stuff here $confheader = 'curl_config.h'; $binext = ''; $libext = '.la'; # .la since both libcurl and libcares are made with libtool -if ($^O eq 'MSWin32' || $targetos) { - if (!$targetos) { - # If no target defined on Windows, let's assume vc - $targetos = 'vc'; - } - if ($targetos =~ /vc/ || $targetos =~ /borland/) { - $binext = '.exe'; - $libext = '.lib'; - } - elsif ($targetos =~ /mingw/) { - $binext = '.exe'; - if ($^O eq 'MSWin32') { - $libext = '.a'; +if($^O eq 'MSWin32' || $targetos) { + if(!$targetos) { + # If no target defined on Windows, let's assume vc + $targetos = 'vc'; + } + if($targetos =~ /vc/ || $targetos =~ /borland/) { + $binext = '.exe'; + $libext = '.lib'; + } + elsif($targetos =~ /mingw/) { + $binext = '.exe'; + if($^O eq 'MSWin32') { + $libext = '.a'; + } } - } } -if (($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys') && - ($targetos =~ /vc/ || $targetos =~ /mingw32/ || - $targetos =~ /borland/)) { +if(($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys') && + ($targetos =~ /vc/ || $targetos =~ /mingw32/ || + $targetos =~ /borland/)) { # Set these things only when building ON Windows and for Win32 platform. # FOR Windows since we might be cross-compiling on another system. Non- @@ -183,24 +183,24 @@ $ENV{LANG}="C"; sub rmtree($) { my $target = $_[0]; - if ($^O eq 'MSWin32') { - foreach (glob($target)) { - s:/:\\:g; - system("rd /s /q $_"); - } + if($^O eq 'MSWin32') { + foreach (glob($target)) { + s:/:\\:g; + system("rd /s /q $_"); + } } else { - system("rm -rf $target"); + system("rm -rf $target"); } } sub grepfile($$) { my ($target, $fn) = @_; open(my $fh, "<", $fn) or die; - while (<$fh>) { - if (/$target/) { - close($fh); - return 1; - } + while(<$fh>) { + if(/$target/) { + close($fh); + return 1; + } } close($fh); return 0; @@ -208,15 +208,15 @@ sub grepfile($$) { sub logit($) { my $text=$_[0]; - if ($text) { - print "testcurl: $text\n"; + if($text) { + print "testcurl: $text\n"; } } sub logit_spaced($) { my $text=$_[0]; - if ($text) { - print "\ntestcurl: $text\n\n"; + if($text) { + print "\ntestcurl: $text\n\n"; } } @@ -225,15 +225,15 @@ sub mydie($){ logit "$text"; chdir $pwd; # cd back to the original root dir - if ($pwd && $build) { - # we have a build directory name, remove the dir - logit "removing the $build dir"; - rmtree "$pwd/$build"; + if($pwd && $build) { + # we have a build directory name, remove the dir + logit "removing the $build dir"; + rmtree "$pwd/$build"; } - if (-r $buildlog) { - # we have a build log output file left, remove it - logit "removing the $buildlogname file"; - unlink "$buildlog"; + if(-r $buildlog) { + # we have a build log output file left, remove it + logit "removing the $buildlogname file"; + unlink "$buildlog"; } logit "ENDING HERE"; # last line logged! exit 1; @@ -244,68 +244,68 @@ sub get_host_triplet { my $configfile = "$pwd/$build/lib/curl_config.h"; if(-f $configfile && -s $configfile && open(my $libconfigh, "<", "$configfile")) { - while(<$libconfigh>) { - if($_ =~ /^\#define\s+CURL_OS\s+"*([^"][^"]*)"*\s*/) { - $triplet = $1; - last; + while(<$libconfigh>) { + if($_ =~ /^\#define\s+CURL_OS\s+"*([^"][^"]*)"*\s*/) { + $triplet = $1; + last; + } } - } - close($libconfigh); + close($libconfigh); } return $triplet; } if($name && $email && $desc) { - # having these fields set are enough to continue, skip reading the setup - # file - $infixed=4; - $fixed=4; + # having these fields set are enough to continue, skip reading the setup + # file + $infixed=4; + $fixed=4; } elsif (open(my $f, "<", "$setupfile")) { - while (<$f>) { - if (/(\w+)=(.*)/) { - eval "\$$1=$2;"; + while (<$f>) { + if (/(\w+)=(.*)/) { + eval "\$$1=$2;"; + } } - } - close($f); - $infixed=$fixed; + close($f); + $infixed=$fixed; } else { - $infixed=0; # so that "additional args to configure" works properly first time... + $infixed=0; # so that "additional args to configure" works properly first time... } -if (!$name) { - print "please enter your name\n"; - $name = <>; - chomp $name; - $fixed=1; +if(!$name) { + print "please enter your name\n"; + $name = <>; + chomp $name; + $fixed=1; } -if (!$email) { - print "please enter your contact email address\n"; - $email = <>; - chomp $email; - $fixed=2; +if(!$email) { + print "please enter your contact email address\n"; + $email = <>; + chomp $email; + $fixed=2; } -if (!$desc) { - print "please enter a one line system description\n"; - $desc = <>; - chomp $desc; - $fixed=3; +if(!$desc) { + print "please enter a one line system description\n"; + $desc = <>; + chomp $desc; + $fixed=3; } -if (!$confopts) { - if ($infixed < 4) { - print "please enter your additional arguments to configure\n"; - print "examples: --with-openssl --enable-debug --enable-ipv6\n"; - $confopts = <>; - chomp $confopts; - } +if(!$confopts) { + if ($infixed < 4) { + print "please enter your additional arguments to configure\n"; + print "examples: --with-openssl --enable-debug --enable-ipv6\n"; + $confopts = <>; + chomp $confopts; + } } -if ($fixed < 4) { +if($fixed < 4) { $fixed=4; open(my $f, ">", "$setupfile") or die; print $f "name='$name'\n"; @@ -318,10 +318,10 @@ if ($fixed < 4) { } # Enable picky compiler warnings unless explicitly disabled -if (($confopts !~ /--enable-debug/) && - ($confopts !~ /--enable-warnings/) && - ($confopts !~ /--disable-warnings/)) { - $confopts .= " --enable-warnings"; +if(($confopts !~ /--enable-debug/) && + ($confopts !~ /--enable-warnings/) && + ($confopts !~ /--disable-warnings/)) { + $confopts .= " --enable-warnings"; } my $str1066os = 'o' x 1066; @@ -364,21 +364,21 @@ $pwd = getcwd(); my $have_embedded_ares = 0; -if (-d $CURLDIR) { - if ($git && -d "$CURLDIR/.git") { - logit "$CURLDIR is verified to be a fine git source dir"; - # remove the generated sources to force them to be re-generated each - # time we run this test - unlink "$CURLDIR/src/tool_hugehelp.c"; - # find out if curl source dir has an in-tree c-ares repo - $have_embedded_ares = 1 if (-f "$CURLDIR/ares/GIT-INFO"); - } elsif (!$git && -f "$CURLDIR/tests/testcurl.pl") { - logit "$CURLDIR is verified to be a fine daily source dir"; - # find out if curl source dir has an in-tree c-ares extracted tarball - $have_embedded_ares = 1 if (-f "$CURLDIR/ares/ares_build.h"); - } else { - mydie "$CURLDIR is not a daily source dir or checked out from git!" - } +if(-d $CURLDIR) { + if($git && -d "$CURLDIR/.git") { + logit "$CURLDIR is verified to be a fine git source dir"; + # remove the generated sources to force them to be re-generated each + # time we run this test + unlink "$CURLDIR/src/tool_hugehelp.c"; + # find out if curl source dir has an in-tree c-ares repo + $have_embedded_ares = 1 if (-f "$CURLDIR/ares/GIT-INFO"); + } elsif (!$git && -f "$CURLDIR/tests/testcurl.pl") { + logit "$CURLDIR is verified to be a fine daily source dir"; + # find out if curl source dir has an in-tree c-ares extracted tarball + $have_embedded_ares = 1 if (-f "$CURLDIR/ares/ares_build.h"); + } else { + mydie "$CURLDIR is not a daily source dir or checked out from git!" + } } # make the path absolute so we can use it everywhere @@ -393,153 +393,153 @@ rmtree "build-*"; rmtree "buildlog-*"; # this is to remove old build logs that ended up in the wrong dir -foreach (glob("$CURLDIR/buildlog-*")) { unlink $_; } +foreach(glob("$CURLDIR/buildlog-*")) { unlink $_; } # create a dir to build in mkdir $build, 0777; -if (-d $build) { - logit "build dir $build was created fine"; +if(-d $build) { + logit "build dir $build was created fine"; } else { - mydie "failed to create dir $build"; + mydie "failed to create dir $build"; } # get in the curl source tree root chdir $CURLDIR; # Do the git thing, or not... -if ($git) { - my $gitstat = 0; - my @commits; - - # update quietly to the latest git - if($nogitpull) { - logit "skipping git pull (--nogitpull)"; - } else { - logit "run git pull in curl"; - system("git pull 2>&1"); - $gitstat += $?; - logit "failed to update from curl git ($?), continue anyway" if ($?); - - # Set timestamp to the UTC the git update took place. - $timestamp = scalar(gmtime)." UTC" if (!$gitstat); - } - - # get the last 5 commits for show (even if no pull was made) - @commits=`git log --pretty=oneline --abbrev-commit -5`; - logit "The most recent curl git commits:"; - for (@commits) { - chomp ($_); - logit " $_"; - } - - if (-d "ares/.git") { - chdir "ares"; +if($git) { + my $gitstat = 0; + my @commits; + # update quietly to the latest git if($nogitpull) { - logit "skipping git pull (--nogitpull) in ares"; + logit "skipping git pull (--nogitpull)"; } else { - logit "run git pull in ares"; - system("git pull 2>&1"); - $gitstat += $?; - logit "failed to update from ares git ($?), continue anyway" if ($?); + logit "run git pull in curl"; + system("git pull 2>&1"); + $gitstat += $?; + logit "failed to update from curl git ($?), continue anyway" if ($?); - # Set timestamp to the UTC the git update took place. - $timestamp = scalar(gmtime)." UTC" if (!$gitstat); + # Set timestamp to the UTC the git update took place. + $timestamp = scalar(gmtime)." UTC" if (!$gitstat); } # get the last 5 commits for show (even if no pull was made) @commits=`git log --pretty=oneline --abbrev-commit -5`; - logit "The most recent ares git commits:"; - for (@commits) { - chomp ($_); - logit " $_"; + logit "The most recent curl git commits:"; + for(@commits) { + chomp ($_); + logit " $_"; } - chdir "$CURLDIR"; - } - - if($nobuildconf) { - logit "told to not run autoreconf -fi"; - } - elsif ($configurebuild) { - # remove possible left-overs from the past - unlink "configure"; - unlink "autom4te.cache"; - - # generate the build files - logit "invoke autoreconf"; - open(my $f, "-|", "autoreconf -fi 2>&1") or die; - open(my $log, ">", "$buildlog") or die; - while (<$f>) { - my $ll = $_; - print $ll; - print $log $ll; + if(-d "ares/.git") { + chdir "ares"; + + if($nogitpull) { + logit "skipping git pull (--nogitpull) in ares"; + } else { + logit "run git pull in ares"; + system("git pull 2>&1"); + $gitstat += $?; + logit "failed to update from ares git ($?), continue anyway" if ($?); + + # Set timestamp to the UTC the git update took place. + $timestamp = scalar(gmtime)." UTC" if (!$gitstat); + } + + # get the last 5 commits for show (even if no pull was made) + @commits=`git log --pretty=oneline --abbrev-commit -5`; + logit "The most recent ares git commits:"; + for (@commits) { + chomp ($_); + logit " $_"; + } + + chdir "$CURLDIR"; } - close($f); - close($log); - logit "autoreconf -fi was successful"; - } - else { - logit "autoreconf -fi was successful (dummy message)"; - } + if($nobuildconf) { + logit "told to not run autoreconf -fi"; + } + elsif($configurebuild) { + # remove possible left-overs from the past + unlink "configure"; + unlink "autom4te.cache"; + + # generate the build files + logit "invoke autoreconf"; + open(my $f, "-|", "autoreconf -fi 2>&1") or die; + open(my $log, ">", "$buildlog") or die; + while(<$f>) { + my $ll = $_; + print $ll; + print $log $ll; + } + close($f); + close($log); + + logit "autoreconf -fi was successful"; + } + else { + logit "autoreconf -fi was successful (dummy message)"; + } } else { # Show snapshot git commit when available - if (open (my $f, '<', "docs/tarball-commit.txt")) { - my $commit = <$f>; - chomp $commit; - logit "The most recent curl git commits:"; - logit " $commit"; - close($f); + if(open (my $f, '<', "docs/tarball-commit.txt")) { + my $commit = <$f>; + chomp $commit; + logit "The most recent curl git commits:"; + logit " $commit"; + close($f); } } # Set timestamp to the one in curlver.h if this isn't a git test build. -if ((-f "include/curl/curlver.h") && +if((-f "include/curl/curlver.h") && (open(my $f, "<", "include/curl/curlver.h"))) { - while (<$f>) { - chomp; - if ($_ =~ /^\#define\s+LIBCURL_TIMESTAMP\s+\"(.+)\".*$/) { - my $stampstring = $1; - if ($stampstring !~ /DEV/) { - $stampstring =~ s/\s+UTC//; - $timestamp = $stampstring." UTC"; - } - last; + while (<$f>) { + chomp; + if($_ =~ /^\#define\s+LIBCURL_TIMESTAMP\s+\"(.+)\".*$/) { + my $stampstring = $1; + if($stampstring !~ /DEV/) { + $stampstring =~ s/\s+UTC//; + $timestamp = $stampstring." UTC"; + } + last; + } } - } - close($f); + close($f); } # Show timestamp we are using for this test build. logit "timestamp = $timestamp"; if ($configurebuild) { - if (-f "configure") { - logit "configure created (at least it exists)"; - } else { - mydie "no configure created/found"; - } + if (-f "configure") { + logit "configure created (at least it exists)"; + } else { + mydie "no configure created/found"; + } } else { - logit "configure created (dummy message)"; # dummy message to feign success + logit "configure created (dummy message)"; # dummy message to feign success } sub findinpath { - my $c; - my $e; - my $x = ($^O eq 'MSWin32') ? '.exe' : ''; - my $s = ($^O eq 'MSWin32') ? ';' : ':'; - my $p=$ENV{'PATH'}; - my @pa = split($s, $p); - for $c (@_) { - for $e (@pa) { - if( -x "$e/$c$x") { - return $c; - } + my $c; + my $e; + my $x = ($^O eq 'MSWin32') ? '.exe' : ''; + my $s = ($^O eq 'MSWin32') ? ';' : ':'; + my $p=$ENV{'PATH'}; + my @pa = split($s, $p); + for $c (@_) { + for $e (@pa) { + if( -x "$e/$c$x") { + return $c; + } + } } - } } my $make = findinpath("gmake", "make", "nmake"); @@ -553,233 +553,233 @@ logit "going with $make as make"; # change to build dir chdir "$pwd/$build"; -if ($configurebuild) { - # run configure script - print `$CURLDIR/configure $confopts 2>&1`; +if($configurebuild) { + # run configure script + print `$CURLDIR/configure $confopts 2>&1`; - if (-f "lib/Makefile") { - logit "configure seems to have finished fine"; - } else { - mydie "configure didn't work"; - } + if(-f "lib/Makefile") { + logit "configure seems to have finished fine"; + } else { + mydie "configure didn't work"; + } } else { - logit "copying files to build dir ..."; - if ($^O eq 'MSWin32') { - system("xcopy /s /q \"$CURLDIR\" ."); - } + logit "copying files to build dir ..."; + if($^O eq 'MSWin32') { + system("xcopy /s /q \"$CURLDIR\" ."); + } } if(-f "./libcurl.pc") { - logit_spaced "display libcurl.pc"; - if(open(my $f, "<", "libcurl.pc")) { - while(<$f>) { - my $ll = $_; - print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/)); + logit_spaced "display libcurl.pc"; + if(open(my $f, "<", "libcurl.pc")) { + while(<$f>) { + my $ll = $_; + print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/)); + } + close($f); } - close($f); - } } logit_spaced "display lib/$confheader"; open(my $f, "<", "lib/$confheader") or die "lib/$confheader: $!"; -while (<$f>) { - print if /^ *#/; +while(<$f>) { + print if /^ *#/; } close($f); -if (($have_embedded_ares) && +if(($have_embedded_ares) && (grepfile("^#define USE_ARES", "lib/$confheader"))) { - print "\n"; - logit "setup to build ares"; - - if(-f "./ares/libcares.pc") { - logit_spaced "display ares/libcares.pc"; - if(open($f, "<", "ares/libcares.pc")) { - while(<$f>) { - my $ll = $_; - print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/)); - } - close($f); + print "\n"; + logit "setup to build ares"; + + if(-f "./ares/libcares.pc") { + logit_spaced "display ares/libcares.pc"; + if(open($f, "<", "ares/libcares.pc")) { + while(<$f>) { + my $ll = $_; + print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/)); + } + close($f); + } } - } - if(-f "./ares/ares_build.h") { - logit_spaced "display ares/ares_build.h"; - if(open($f, "<", "ares/ares_build.h")) { - while(<$f>) { - my $ll = $_; - print $ll if(($ll =~ /^ *# *define *CARES_/) && ($ll !~ /__CARES_BUILD_H/)); - } - close($f); + if(-f "./ares/ares_build.h") { + logit_spaced "display ares/ares_build.h"; + if(open($f, "<", "ares/ares_build.h")) { + while(<$f>) { + my $ll = $_; + print $ll if(($ll =~ /^ *# *define *CARES_/) && ($ll !~ /__CARES_BUILD_H/)); + } + close($f); + } + } + else { + mydie "no ares_build.h created/found"; } - } - else { - mydie "no ares_build.h created/found"; - } - $confheader =~ s/curl/ares/; - logit_spaced "display ares/$confheader"; - if(open($f, "<", "ares/$confheader")) { - while (<$f>) { - print if /^ *#/; - } - close($f); - } + $confheader =~ s/curl/ares/; + logit_spaced "display ares/$confheader"; + if(open($f, "<", "ares/$confheader")) { + while (<$f>) { + print if /^ *#/; + } + close($f); + } - print "\n"; - logit "build ares"; - chdir "ares"; + print "\n"; + logit "build ares"; + chdir "ares"; - if ($targetos && !$configurebuild) { - logit "$make -f Makefile.$targetos"; - open($f, "-|", "$make -f Makefile.$targetos 2>&1") or die; - } - else { - logit "$make"; - open($f, "-|", "$make 2>&1") or die; - } - while (<$f>) { - s/$pwd//g; - print; - } - close($f); + if($targetos && !$configurebuild) { + logit "$make -f Makefile.$targetos"; + open($f, "-|", "$make -f Makefile.$targetos 2>&1") or die; + } + else { + logit "$make"; + open($f, "-|", "$make 2>&1") or die; + } + while(<$f>) { + s/$pwd//g; + print; + } + close($f); - if (-f "libcares$libext") { - logit "ares is now built successfully (libcares$libext)"; - } else { - mydie "ares build failed (libcares$libext)"; - } + if(-f "libcares$libext") { + logit "ares is now built successfully (libcares$libext)"; + } else { + mydie "ares build failed (libcares$libext)"; + } - # cd back to the curl build dir - chdir "$pwd/$build"; + # cd back to the curl build dir + chdir "$pwd/$build"; } my $mkcmd = "$make -i" . ($targetos && !$configurebuild ? " $targetos" : ""); logit "$mkcmd"; open(my $f, "-|", "$mkcmd 2>&1") or die; while (<$f>) { - s/$pwd//g; - print; + s/$pwd//g; + print; } close($f); if (-f "lib/libcurl$libext") { - logit "libcurl was created fine (libcurl$libext)"; + logit "libcurl was created fine (libcurl$libext)"; } else { - mydie "libcurl was not created (libcurl$libext)"; + mydie "libcurl was not created (libcurl$libext)"; } if (-f "src/curl$binext") { - logit "curl was created fine (curl$binext)"; + logit "curl was created fine (curl$binext)"; } else { - mydie "curl was not created (curl$binext)"; + mydie "curl was not created (curl$binext)"; } if (!$crosscompile || (($extvercmd ne '') && (-x $extvercmd))) { - logit "display curl${binext} --version output"; - my $cmd = ($extvercmd ne '' ? $extvercmd.' ' : '')."./src/curl${binext} --version|"; - open($f, "<", $cmd); - while(<$f>) { - # strip CR from output on non-Windows platforms (WINE on Linux) - s/\r// if ($^O ne 'MSWin32'); - print; - } - close($f); -} - -if ($configurebuild && !$crosscompile) { - my $host_triplet = get_host_triplet(); - # build example programs for selected build targets - if(($host_triplet =~ /([^-]+)-([^-]+)-irix(.*)/) || - ($host_triplet =~ /([^-]+)-([^-]+)-aix(.*)/) || - ($host_triplet =~ /([^-]+)-([^-]+)-osf(.*)/) || - ($host_triplet =~ /([^-]+)-([^-]+)-solaris2(.*)/)) { - chdir "$pwd/$build/docs/examples"; - logit_spaced "build examples"; - open($f, "-|", "$make -i 2>&1") or die; + logit "display curl${binext} --version output"; + my $cmd = ($extvercmd ne '' ? $extvercmd.' ' : '')."./src/curl${binext} --version|"; + open($f, "<", $cmd); + while(<$f>) { + # strip CR from output on non-Windows platforms (WINE on Linux) + s/\r// if ($^O ne 'MSWin32'); + print; + } + close($f); +} + +if($configurebuild && !$crosscompile) { + my $host_triplet = get_host_triplet(); + # build example programs for selected build targets + if(($host_triplet =~ /([^-]+)-([^-]+)-irix(.*)/) || + ($host_triplet =~ /([^-]+)-([^-]+)-aix(.*)/) || + ($host_triplet =~ /([^-]+)-([^-]+)-osf(.*)/) || + ($host_triplet =~ /([^-]+)-([^-]+)-solaris2(.*)/)) { + chdir "$pwd/$build/docs/examples"; + logit_spaced "build examples"; + open($f, "-|", "$make -i 2>&1") or die; + open(my $log, ">", "$buildlog") or die; + while (<$f>) { + s/$pwd//g; + print; + print $log $_; + } + close($f); + close($log); + chdir "$pwd/$build"; + } + # build and run full test suite + my $o; + if($runtestopts) { + $o = "TEST_F=\"$runtestopts\" "; + } + logit "$make -k ${o}test-full"; + open($f, "-|", "$make -k ${o}test-full 2>&1") or die; open(my $log, ">", "$buildlog") or die; - while (<$f>) { - s/$pwd//g; - print; - print $log $_; + while(<$f>) { + s/$pwd//g; + print; + print $log $_; } close($f); close($log); - chdir "$pwd/$build"; - } - # build and run full test suite - my $o; - if($runtestopts) { - $o = "TEST_F=\"$runtestopts\" "; - } - logit "$make -k ${o}test-full"; - open($f, "-|", "$make -k ${o}test-full 2>&1") or die; - open(my $log, ">", "$buildlog") or die; - while (<$f>) { - s/$pwd//g; - print; - print $log $_; - } - close($f); - close($log); - if (grepfile("^TEST", $buildlog)) { - logit "tests were run"; - } else { - mydie "test suite failure"; - } + if(grepfile("^TEST", $buildlog)) { + logit "tests were run"; + } else { + mydie "test suite failure"; + } - if (grepfile("^TESTFAIL:", $buildlog)) { - logit "the tests were not successful"; - } else { - logit "the tests were successful!"; - } + if(grepfile("^TESTFAIL:", $buildlog)) { + logit "the tests were not successful"; + } else { + logit "the tests were successful!"; + } } else { - if($crosscompile) { - my $host_triplet = get_host_triplet(); - # build example programs for selected cross-compiles - if(($host_triplet =~ /([^-]+)-([^-]+)-mingw(.*)/) || - ($host_triplet =~ /([^-]+)-([^-]+)-android(.*)/)) { - chdir "$pwd/$build/docs/examples"; - logit_spaced "build examples"; - open($f, "-|", "$make -i 2>&1") or die; - open(my $log, ">", "$buildlog") or die; - while (<$f>) { - s/$pwd//g; - print; - print $log $_; - } - close($f); - close($log); - chdir "$pwd/$build"; - } - # build test harness programs for selected cross-compiles - if($host_triplet =~ /([^-]+)-([^-]+)-mingw(.*)/) { - chdir "$pwd/$build/tests"; - logit_spaced "build test harness"; - open(my $f, "-|", "$make -i 2>&1") or die; - open(my $log, ">", "$buildlog") or die; - while (<$f>) { - s/$pwd//g; - print; - print $log $_; - } - close($f); - close($log); - chdir "$pwd/$build"; + if($crosscompile) { + my $host_triplet = get_host_triplet(); + # build example programs for selected cross-compiles + if(($host_triplet =~ /([^-]+)-([^-]+)-mingw(.*)/) || + ($host_triplet =~ /([^-]+)-([^-]+)-android(.*)/)) { + chdir "$pwd/$build/docs/examples"; + logit_spaced "build examples"; + open($f, "-|", "$make -i 2>&1") or die; + open(my $log, ">", "$buildlog") or die; + while (<$f>) { + s/$pwd//g; + print; + print $log $_; + } + close($f); + close($log); + chdir "$pwd/$build"; + } + # build test harness programs for selected cross-compiles + if($host_triplet =~ /([^-]+)-([^-]+)-mingw(.*)/) { + chdir "$pwd/$build/tests"; + logit_spaced "build test harness"; + open(my $f, "-|", "$make -i 2>&1") or die; + open(my $log, ">", "$buildlog") or die; + while (<$f>) { + s/$pwd//g; + print; + print $log $_; + } + close($f); + close($log); + chdir "$pwd/$build"; + } + logit_spaced "cross-compiling, can't run tests"; } - logit_spaced "cross-compiling, can't run tests"; - } - # dummy message to feign success - print "TESTDONE: 1 tests out of 0 (dummy message)\n"; + # dummy message to feign success + print "TESTDONE: 1 tests out of 0 (dummy message)\n"; } # create a tarball if we got that option. -if (($mktarball ne '') && (-x $mktarball)) { - system($mktarball); +if(($mktarball ne '') && (-x $mktarball)) { + system($mktarball); } logit "enddate = ".scalar(gmtime)." UTC"; # When the run ends -- 2.47.3