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;
$o =~ s/^CURLOPT_//;
$n =~ s/^CURLOPT_//;
$alias{$o} = $n;
- push @names, $o,
+ push @names, $o;
}
}
}
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++;
}
$suff =~ s/\(/\\(/;
$l =~ s/$prefix$bad$suff/$prefix$replace/;
goto again;
- }
+ }
$l = $bl; # restore to pre-bannedfunc content
if($warnings{"STDERR"}) {
}
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;
$opts_str .= qq{ $_ \\\n} foreach (@opts);
chomp $opts_str;
-my $tmpl = <<"EOS";
+ my $tmpl = <<"EOS";
#compdef curl
# curl zsh completion
open(H, "$f");
my $opts;
while(<H>) {
- if(/^ CURLOPT(|DEPRECATED)\(/ && ($_ !~ /OBSOLETE/)) {
+ if(/^ CURLOPT(|DEPRECATED)\(/ && ($_ !~ /OBSOLETE/)) {
$opts++;
}
}
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';
$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@.*(/|\\)@@;
# 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<certdata>] [-f] [-i] [-k] [-l] [-n] [-p<purposes:levels>] [-q] [-s<algorithms>] [-t] [-u] [-v] [-w<l>] [<outputfile>]\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 <l>\twrap base64 output lines after <l> chars (default: ${opt_w})\n";
- exit;
+
print "Usage:\t${0} [-b] [-d<certdata>] [-f] [-i] [-k] [-l] [-n] [-p<purposes:levels>] [-q] [-s<algorithms>] [-t] [-u] [-v] [-w<l>] [<outputfile>]\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 <l>\twrap base64 output lines after <l> 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(<C>) {
- chomp;
- if($_ =~ /^\#\# SHA256: (.*)/) {
- $hash = $1;
- last;
+ my $hash = "";
+ open(C, "<$_[0]") || return 0;
+ while(<C>) {
+ 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 );
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';
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];
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";
my $valid = 0;
open(TXT,"$txt") or die "Couldn't open $txt: $!\n";
-while (<TXT>) {
- if (/\*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*/) {
- print CRT;
- print if ($opt_l);
- while (<TXT>) {
- 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 <certname>".
- #
- # 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(<TXT>) {
+ if(/\*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*/) {
+ print CRT;
+ print if($opt_l);
+ while(<TXT>) {
+ 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 <certname>".
+ #
+ # 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 (<TXT>) {
- 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 (<TXT>) {
- 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(<TXT>) {
+ 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) <certname>",
- # 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(<TXT>) {
+ 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) <certname>",
+ # 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";
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).";
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 = " <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 = " <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);
}
}
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 {
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!";
+ }
}
#**********************************************************************
# 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;
}
#
# 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;
- }
- }
+ }
}
}
}
}
- 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";
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;
}
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;
}
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;
}
}
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);
# 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.
# 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.
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;
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;
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;
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;
# 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-
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;
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";
}
}
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;
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";
}
# 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;
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
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");
# 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
projects / thirdparty / curl.git / commitdiff
