mirror of
https://github.com/curl/curl.git
synced 2024-11-27 05:50:21 +08:00
tests: switch to 3-argument open in test suite
The perl 2-argument open has been considered not-quite-deprecated since the 3-argument form was introduced almost a quarter century ago.
This commit is contained in:
Dan Fandrich
parent
b133f70a52
commit
0e3ae25337
@ -57,8 +57,8 @@ sub scan_header {
|
||||
my $incomment = 0;
|
||||
my $inenum = 0;
|
||||
|
||||
open H, "<$f";
|
||||
while(<H>) {
|
||||
open(my $h, "<", "$f");
|
||||
while(<$h>) {
|
||||
s/^\s*(.*?)\s*$/$1/; # Trim.
|
||||
# Remove multi-line comment trail.
|
||||
if($incomment) {
|
||||
@ -138,7 +138,7 @@ sub scan_header {
|
||||
$inenum = 0;
|
||||
}
|
||||
}
|
||||
close H;
|
||||
close $h;
|
||||
}
|
||||
|
||||
# Scan function man page for options.
|
||||
@ -149,8 +149,8 @@ sub scan_man_for_opts {
|
||||
my $opt = "";
|
||||
my $line = "";
|
||||
|
||||
open M, "<$f";
|
||||
while(<M>) {
|
||||
open(my $m, "<", "$f");
|
||||
while(<$m>) {
|
||||
if($_ =~ /^\./) {
|
||||
# roff directive found: end current option paragraph.
|
||||
my $o = $opt;
|
||||
@ -177,16 +177,15 @@ sub scan_man_for_opts {
|
||||
$line .= $_;
|
||||
}
|
||||
}
|
||||
close M;
|
||||
close $m;
|
||||
}
|
||||
|
||||
# Scan man page for deprecation in DESCRIPTION and/or AVAILABILITY sections.
|
||||
sub scan_man_page {
|
||||
my ($path, $sym, $table)=@_;
|
||||
my $version = "X";
|
||||
my $fh;
|
||||
|
||||
if(open $fh, "<$path") {
|
||||
if(open(my $fh, "<", "$path")) {
|
||||
my $section = "";
|
||||
my $line = "";
|
||||
|
||||
@ -238,9 +237,9 @@ sub scan_man_page {
|
||||
|
||||
|
||||
# Read symbols-in-versions.
|
||||
open(F, "<$libdocdir/symbols-in-versions") ||
|
||||
open(my $fh, "<", "$libdocdir/symbols-in-versions") ||
|
||||
die "$libdocdir/symbols-in-versions";
|
||||
while(<F>) {
|
||||
while(<$fh>) {
|
||||
if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) {
|
||||
if($3 eq "") {
|
||||
$syminver{$1} = "X";
|
||||
@ -250,7 +249,7 @@ while(<F>) {
|
||||
}
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($fh);
|
||||
|
||||
# Get header file names,
|
||||
opendir(my $dh, $incdir) || die "Can't opendir $incdir";
|
||||
|
||||
@ -35,8 +35,8 @@ my %error; # from the include file
|
||||
my %docs; # from libcurl-errors.3
|
||||
|
||||
sub getdocserrors {
|
||||
open(F, "<$root/docs/libcurl/libcurl-errors.3");
|
||||
while(<F>) {
|
||||
open(my $f, "<", "$root/docs/libcurl/libcurl-errors.3");
|
||||
while(<$f>) {
|
||||
if($_ =~ /^.IP \"(CURL[EM]_[^ \t\"]*)/) {
|
||||
my ($symbol) = ($1);
|
||||
if($symbol =~ /OBSOLETE/) {
|
||||
@ -47,12 +47,12 @@ sub getdocserrors {
|
||||
}
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
|
||||
sub getincludeerrors {
|
||||
open(F, "<$root/docs/libcurl/symbols-in-versions");
|
||||
while(<F>) {
|
||||
open(my $f, "<", "$root/docs/libcurl/symbols-in-versions");
|
||||
while(<$f>) {
|
||||
if($_ =~ /^(CURL[EM]_[^ \t]*)[ \t]*([0-9.]+)[ \t]*(.*)/) {
|
||||
my ($symbol, $added, $rest) = ($1,$2,$3);
|
||||
if($rest =~ /^([0-9.]+)/) {
|
||||
@ -63,7 +63,7 @@ sub getincludeerrors {
|
||||
}
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
|
||||
getincludeerrors();
|
||||
|
||||
@ -79,9 +79,9 @@ sub pidfromfile {
|
||||
my $pidfile = $_[0];
|
||||
my $pid = 0;
|
||||
|
||||
if(-f $pidfile && -s $pidfile && open(PIDFH, "<$pidfile")) {
|
||||
$pid = 0 + <PIDFH>;
|
||||
close(PIDFH);
|
||||
if(-f $pidfile && -s $pidfile && open(my $pidfh, "<", "$pidfile")) {
|
||||
$pid = 0 + <$pidfh>;
|
||||
close($pidfh);
|
||||
$pid = 0 if($pid < 0);
|
||||
}
|
||||
return $pid;
|
||||
@ -380,7 +380,8 @@ sub killallsockfilters {
|
||||
sub set_advisor_read_lock {
|
||||
my ($filename) = @_;
|
||||
|
||||
if(open(FILEH, ">$filename") && close(FILEH)) {
|
||||
my $fileh;
|
||||
if(open($fileh, ">", "$filename") && close($fileh)) {
|
||||
return;
|
||||
}
|
||||
printf "Error creating lock file $filename error: $!";
|
||||
|
||||
@ -224,20 +224,20 @@ sub logmsg {
|
||||
localtime($seconds);
|
||||
$now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
|
||||
}
|
||||
if(open(LOGFILEFH, ">>$logfile")) {
|
||||
print LOGFILEFH $now;
|
||||
print LOGFILEFH @_;
|
||||
close(LOGFILEFH);
|
||||
if(open(my $logfilefh, ">>", "$logfile")) {
|
||||
print $logfilefh $now;
|
||||
print $logfilefh @_;
|
||||
close($logfilefh);
|
||||
}
|
||||
}
|
||||
|
||||
sub ftpmsg {
|
||||
# append to the server.input file
|
||||
open(INPUT, ">>log/server$idstr.input") ||
|
||||
open(my $input, ">>", "log/server$idstr.input") ||
|
||||
logmsg "failed to open log/server$idstr.input\n";
|
||||
|
||||
print INPUT @_;
|
||||
close(INPUT);
|
||||
print $input @_;
|
||||
close($input);
|
||||
|
||||
# use this, open->print->close system only to make the file
|
||||
# open as little as possible, to make the test suite run
|
||||
@ -915,7 +915,7 @@ sub DATA_smtp {
|
||||
|
||||
logmsg "Store test number $testno in $filename\n";
|
||||
|
||||
open(FILE, ">$filename") ||
|
||||
open(my $file, ">", "$filename") ||
|
||||
return 0; # failed to open output
|
||||
|
||||
my $line;
|
||||
@ -936,7 +936,7 @@ sub DATA_smtp {
|
||||
read_mainsockf(\$line, $size);
|
||||
|
||||
$ulsize += $size;
|
||||
print FILE $line if(!$nosave);
|
||||
print $file $line if(!$nosave);
|
||||
|
||||
$raw .= $line;
|
||||
if($raw =~ /(?:^|\x0d\x0a)\x2e\x0d\x0a/) {
|
||||
@ -963,10 +963,10 @@ sub DATA_smtp {
|
||||
}
|
||||
|
||||
if($nosave) {
|
||||
print FILE "$ulsize bytes would've been stored here\n";
|
||||
print $file "$ulsize bytes would've been stored here\n";
|
||||
}
|
||||
|
||||
close(FILE);
|
||||
close($file);
|
||||
|
||||
logmsg "received $ulsize bytes upload\n";
|
||||
|
||||
@ -1264,7 +1264,7 @@ sub APPEND_imap {
|
||||
|
||||
logmsg "Store test number $testno in $filename\n";
|
||||
|
||||
open(FILE, ">$filename") ||
|
||||
open(my $file, ">", "$filename") ||
|
||||
return 0; # failed to open output
|
||||
|
||||
my $received = 0;
|
||||
@ -1285,7 +1285,7 @@ sub APPEND_imap {
|
||||
|
||||
if($datasize > 0) {
|
||||
logmsg "> Appending $datasize bytes to file\n";
|
||||
print FILE substr($line, 0, $datasize) if(!$nosave);
|
||||
print $file substr($line, 0, $datasize) if(!$nosave);
|
||||
$line = substr($line, $datasize);
|
||||
|
||||
$received += $datasize;
|
||||
@ -1309,10 +1309,10 @@ sub APPEND_imap {
|
||||
}
|
||||
|
||||
if($nosave) {
|
||||
print FILE "$size bytes would've been stored here\n";
|
||||
print $file "$size bytes would've been stored here\n";
|
||||
}
|
||||
|
||||
close(FILE);
|
||||
close($file);
|
||||
|
||||
logmsg "received $size bytes upload\n";
|
||||
|
||||
@ -2392,7 +2392,7 @@ sub STOR_ftp {
|
||||
|
||||
sendcontrol "125 Gimme gimme gimme!\r\n";
|
||||
|
||||
open(FILE, ">$filename") ||
|
||||
open(my $file, ">", "$filename") ||
|
||||
return 0; # failed to open output
|
||||
|
||||
my $line;
|
||||
@ -2413,7 +2413,7 @@ sub STOR_ftp {
|
||||
#print STDERR " GOT: $size bytes\n";
|
||||
|
||||
$ulsize += $size;
|
||||
print FILE $line if(!$nosave);
|
||||
print $file $line if(!$nosave);
|
||||
logmsg "> Appending $size bytes to file\n";
|
||||
}
|
||||
elsif($line eq "DISC\n") {
|
||||
@ -2431,9 +2431,9 @@ sub STOR_ftp {
|
||||
}
|
||||
}
|
||||
if($nosave) {
|
||||
print FILE "$ulsize bytes would've been stored here\n";
|
||||
print $file "$ulsize bytes would've been stored here\n";
|
||||
}
|
||||
close(FILE);
|
||||
close($file);
|
||||
close_dataconn($disc);
|
||||
logmsg "received $ulsize bytes upload\n";
|
||||
if($storeresp) {
|
||||
@ -2815,12 +2815,12 @@ sub customize {
|
||||
%customcount = (); #
|
||||
%delayreply = (); #
|
||||
|
||||
open(CUSTOM, "<log/ftpserver.cmd") ||
|
||||
open(my $custom, "<", "log/ftpserver.cmd") ||
|
||||
return 1;
|
||||
|
||||
logmsg "FTPD: Getting commands from log/ftpserver.cmd\n";
|
||||
|
||||
while(<CUSTOM>) {
|
||||
while(<$custom>) {
|
||||
if($_ =~ /REPLY \"([A-Z]+ [A-Za-z0-9+-\/=\*. ]+)\" (.*)/) {
|
||||
$fulltextreply{$1}=eval "qq{$2}";
|
||||
logmsg "FTPD: set custom reply for $1\n";
|
||||
@ -2924,7 +2924,7 @@ sub customize {
|
||||
logmsg "FTPD: run test case number: $testno\n";
|
||||
}
|
||||
}
|
||||
close(CUSTOM);
|
||||
close($custom);
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------
|
||||
@ -3066,17 +3066,17 @@ startsf();
|
||||
# actual port
|
||||
if($portfile && !$port) {
|
||||
my $aport;
|
||||
open(P, "<$portfile");
|
||||
$aport = <P>;
|
||||
close(P);
|
||||
open(my $p, "<", "$portfile");
|
||||
$aport = <$p>;
|
||||
close($p);
|
||||
$port = 0 + $aport;
|
||||
}
|
||||
|
||||
logmsg sprintf("%s server listens on port IPv${ipvnum}/${port}\n", uc($proto));
|
||||
|
||||
open(PID, ">$pidfile");
|
||||
print PID $$."\n";
|
||||
close(PID);
|
||||
open(my $pid, ">", "$pidfile");
|
||||
print $pid $$."\n";
|
||||
close($pid);
|
||||
|
||||
logmsg("logged pid $$ in $pidfile\n");
|
||||
|
||||
|
||||
@ -220,12 +220,12 @@ sub loadtest {
|
||||
undef @xml;
|
||||
$xmlfile = "";
|
||||
|
||||
if(open(XML, "<$file")) {
|
||||
binmode XML; # for crapage systems, use binary
|
||||
while(<XML>) {
|
||||
if(open(my $xmlh, "<", "$file")) {
|
||||
binmode $xmlh; # for crapage systems, use binary
|
||||
while(<$xmlh>) {
|
||||
push @xml, $_;
|
||||
}
|
||||
close(XML);
|
||||
close($xmlh);
|
||||
}
|
||||
else {
|
||||
# failure
|
||||
@ -246,12 +246,12 @@ sub fulltest {
|
||||
sub savetest {
|
||||
my ($file)=@_;
|
||||
|
||||
if(open(XML, ">$file")) {
|
||||
binmode XML; # for crapage systems, use binary
|
||||
if(open(my $xmlh, ">", "$file")) {
|
||||
binmode $xmlh; # for crapage systems, use binary
|
||||
for(@xml) {
|
||||
print XML $_;
|
||||
print $xmlh $_;
|
||||
}
|
||||
close(XML);
|
||||
close($xmlh);
|
||||
}
|
||||
else {
|
||||
# failure
|
||||
@ -310,12 +310,12 @@ sub compareparts {
|
||||
sub writearray {
|
||||
my ($filename, $arrayref)=@_;
|
||||
|
||||
open(TEMP, ">$filename") || die "Failure writing file";
|
||||
binmode(TEMP,":raw"); # cygwin fix by Kevin Roth
|
||||
open(my $temp, ">", "$filename") || die "Failure writing file";
|
||||
binmode($temp,":raw"); # cygwin fix by Kevin Roth
|
||||
for(@$arrayref) {
|
||||
print TEMP $_;
|
||||
print $temp $_;
|
||||
}
|
||||
close(TEMP) || die "Failure writing file";
|
||||
close($temp) || die "Failure writing file";
|
||||
}
|
||||
|
||||
#
|
||||
@ -325,11 +325,11 @@ sub loadarray {
|
||||
my ($filename)=@_;
|
||||
my @array;
|
||||
|
||||
open(TEMP, "<$filename");
|
||||
while(<TEMP>) {
|
||||
open(my $temp, "<", "$filename");
|
||||
while(<$temp>) {
|
||||
push @array, $_;
|
||||
}
|
||||
close(TEMP);
|
||||
close($temp);
|
||||
return @array;
|
||||
}
|
||||
|
||||
@ -342,27 +342,27 @@ sub showdiff {
|
||||
my $file1="$logdir/check-generated";
|
||||
my $file2="$logdir/check-expected";
|
||||
|
||||
open(TEMP, ">$file1") || die "Failure writing diff file";
|
||||
open(my $temp, ">", "$file1") || die "Failure writing diff file";
|
||||
for(@$firstref) {
|
||||
my $l = $_;
|
||||
$l =~ s/\r/[CR]/g;
|
||||
$l =~ s/\n/[LF]/g;
|
||||
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
|
||||
print TEMP $l;
|
||||
print TEMP "\n";
|
||||
print $temp $l;
|
||||
print $temp "\n";
|
||||
}
|
||||
close(TEMP) || die "Failure writing diff file";
|
||||
close($temp) || die "Failure writing diff file";
|
||||
|
||||
open(TEMP, ">$file2") || die "Failure writing diff file";
|
||||
open($temp, ">", "$file2") || die "Failure writing diff file";
|
||||
for(@$secondref) {
|
||||
my $l = $_;
|
||||
$l =~ s/\r/[CR]/g;
|
||||
$l =~ s/\n/[LF]/g;
|
||||
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
|
||||
print TEMP $l;
|
||||
print TEMP "\n";
|
||||
print $temp $l;
|
||||
print $temp "\n";
|
||||
}
|
||||
close(TEMP) || die "Failure writing diff file";
|
||||
close($temp) || die "Failure writing diff file";
|
||||
my @out = `diff -u $file2 $file1 2>/dev/null`;
|
||||
|
||||
if(!$out[0]) {
|
||||
|
||||
@ -67,9 +67,9 @@ my %alias = (
|
||||
sub scanmanpage {
|
||||
my ($file, @words) = @_;
|
||||
|
||||
open(M, "<$file");
|
||||
open(my $mh, "<", "$file");
|
||||
my @m;
|
||||
while(<M>) {
|
||||
while(<$mh>) {
|
||||
if($_ =~ /^\.IP (.*)/) {
|
||||
my $w = $1;
|
||||
# "unquote" minuses
|
||||
@ -77,7 +77,7 @@ sub scanmanpage {
|
||||
push @m, $w;
|
||||
}
|
||||
}
|
||||
close(M);
|
||||
close($mh);
|
||||
|
||||
foreach my $m (@words) {
|
||||
my @g = grep(/$m/, @m);
|
||||
@ -88,22 +88,24 @@ sub scanmanpage {
|
||||
}
|
||||
}
|
||||
|
||||
my $r;
|
||||
|
||||
# check for define alises
|
||||
open(R, "<$curlh") ||
|
||||
open($r, "<", "$curlh") ||
|
||||
die "no curl.h";
|
||||
while(<R>) {
|
||||
while(<$r>) {
|
||||
if(/^\#define (CURL(OPT|INFO|MOPT)_\w+) (.*)/) {
|
||||
$alias{$1}=$3;
|
||||
}
|
||||
}
|
||||
close(R);
|
||||
close($r);
|
||||
|
||||
my @curlopt;
|
||||
my @curlinfo;
|
||||
my @curlmopt;
|
||||
open(R, "<$syms") ||
|
||||
open($r, "<", "$syms") ||
|
||||
die "no input file";
|
||||
while(<R>) {
|
||||
while(<$r>) {
|
||||
chomp;
|
||||
my $l= $_;
|
||||
if($l =~ /(CURL(OPT|INFO|MOPT)_\w+) *([0-9.]*) *([0-9.-]*) *([0-9.]*)/) {
|
||||
@ -133,7 +135,7 @@ while(<R>) {
|
||||
}
|
||||
}
|
||||
}
|
||||
close(R);
|
||||
close($r);
|
||||
|
||||
scanmanpage("$root/docs/libcurl/curl_easy_setopt.3", @curlopt);
|
||||
scanmanpage("$root/docs/libcurl/curl_easy_getinfo.3", @curlinfo);
|
||||
@ -174,12 +176,12 @@ my %opts = (
|
||||
|
||||
#########################################################################
|
||||
# parse the curl code that parses the command line arguments!
|
||||
open(R, "<$root/src/tool_getparam.c") ||
|
||||
open($r, "<", "$root/src/tool_getparam.c") ||
|
||||
die "no input file";
|
||||
my $list;
|
||||
my @getparam; # store all parsed parameters
|
||||
|
||||
while(<R>) {
|
||||
while(<$r>) {
|
||||
chomp;
|
||||
my $l= $_;
|
||||
if(/struct LongShort aliases/) {
|
||||
@ -206,15 +208,15 @@ while(<R>) {
|
||||
}
|
||||
}
|
||||
}
|
||||
close(R);
|
||||
close($r);
|
||||
|
||||
#########################################################################
|
||||
# parse the curl.1 man page, extract all documented command line options
|
||||
# The man page may or may not be rebuilt, so check both possible locations
|
||||
open(R, "<$buildroot/docs/curl.1") || open(R, "<$root/docs/curl.1") ||
|
||||
open($r, "<", "$buildroot/docs/curl.1") || open($r, "<", "$root/docs/curl.1") ||
|
||||
die "no input file";
|
||||
my @manpage; # store all parsed parameters
|
||||
while(<R>) {
|
||||
while(<$r>) {
|
||||
chomp;
|
||||
my $l= $_;
|
||||
$l =~ s/\\-/-/g;
|
||||
@ -235,15 +237,15 @@ while(<R>) {
|
||||
}
|
||||
}
|
||||
}
|
||||
close(R);
|
||||
close($r);
|
||||
|
||||
|
||||
#########################################################################
|
||||
# parse the curl code that outputs the curl -h list
|
||||
open(R, "<$root/src/tool_listhelp.c") ||
|
||||
open($r, "<", "$root/src/tool_listhelp.c") ||
|
||||
die "no input file";
|
||||
my @toolhelp; # store all parsed parameters
|
||||
while(<R>) {
|
||||
while(<$r>) {
|
||||
chomp;
|
||||
my $l= $_;
|
||||
if(/^ \{\" *(.*)/) {
|
||||
@ -264,7 +266,7 @@ while(<R>) {
|
||||
|
||||
}
|
||||
}
|
||||
close(R);
|
||||
close($r);
|
||||
|
||||
#
|
||||
# Now we have three arrays with options to cross-reference.
|
||||
|
||||
@ -75,9 +75,9 @@ my %deprecated = (
|
||||
CURLINFO_SSL_DATA_OUT => 1,
|
||||
);
|
||||
sub allsymbols {
|
||||
open(F, "<$symbolsinversions") ||
|
||||
open(my $f, "<", "$symbolsinversions") ||
|
||||
die "$symbolsinversions: $|";
|
||||
while(<F>) {
|
||||
while(<$f>) {
|
||||
if($_ =~ /^([^ ]*) +(.*)/) {
|
||||
my ($name, $info) = ($1, $2);
|
||||
$symbol{$name}=$name;
|
||||
@ -87,7 +87,7 @@ sub allsymbols {
|
||||
}
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
|
||||
sub scanmanpage {
|
||||
@ -102,7 +102,7 @@ sub scanmanpage {
|
||||
my @sh;
|
||||
my $SH="";
|
||||
|
||||
open(M, "<$file") || die "no such file: $file";
|
||||
open(my $m, "<", "$file") || die "no such file: $file";
|
||||
if($file =~ /[\/\\](CURL|curl_)[^\/\\]*.3/) {
|
||||
# This is a man page for libcurl. It requires an example!
|
||||
$reqex = 1;
|
||||
@ -111,11 +111,11 @@ sub scanmanpage {
|
||||
}
|
||||
}
|
||||
my $line = 1;
|
||||
while(<M>) {
|
||||
while(<$m>) {
|
||||
chomp;
|
||||
if($_ =~ /^.so /) {
|
||||
# this man page is just a referral
|
||||
close(M);
|
||||
close($m);
|
||||
return;
|
||||
}
|
||||
if(($_ =~ /^\.SH SYNOPSIS/i) && ($reqex)) {
|
||||
@ -200,7 +200,7 @@ sub scanmanpage {
|
||||
}
|
||||
$line++;
|
||||
}
|
||||
close(M);
|
||||
close($m);
|
||||
|
||||
if($reqex) {
|
||||
# only for libcurl options man-pages
|
||||
|
||||
@ -38,11 +38,11 @@ sub checkfile {
|
||||
if($f !~ /\.md\z/) {
|
||||
return;
|
||||
}
|
||||
open(F, "<$f");
|
||||
open(my $fh, "<", "$f");
|
||||
my $l = 1;
|
||||
my $prevl;
|
||||
my $ignore = 0;
|
||||
while(<F>) {
|
||||
while(<$fh>) {
|
||||
my $line = $_;
|
||||
chomp $line;
|
||||
if($line =~ /^(\`\`\`|\~\~\~)/) {
|
||||
@ -86,7 +86,7 @@ sub checkfile {
|
||||
$prevl = $line;
|
||||
$l++;
|
||||
}
|
||||
close(F);
|
||||
close($fh);
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -43,8 +43,8 @@ sub scanfile {
|
||||
|
||||
print STDERR "checking $file...\n";
|
||||
|
||||
open(F, "<$file");
|
||||
while(<F>) {
|
||||
open(my $f, "<", "$file");
|
||||
while(<$f>) {
|
||||
if($_ =~ /\W(free|alloc|strdup)\(/) {
|
||||
$memfunc++;
|
||||
}
|
||||
@ -56,14 +56,14 @@ sub scanfile {
|
||||
}
|
||||
elsif($_ =~ /mem-include-scan/) {
|
||||
# free pass
|
||||
close(F);
|
||||
close($f);
|
||||
return 0;
|
||||
}
|
||||
if($memfunc && $memdebug && $curlmem) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
|
||||
|
||||
if($memfunc) {
|
||||
|
||||
@ -81,22 +81,22 @@ if(! -f $file) {
|
||||
exit;
|
||||
}
|
||||
|
||||
open(FILE, "<$file");
|
||||
open(my $fileh, "<", "$file");
|
||||
|
||||
if($showlimit) {
|
||||
while(<FILE>) {
|
||||
while(<$fileh>) {
|
||||
if(/^LIMIT.*memlimit$/) {
|
||||
print $_;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(FILE);
|
||||
close($fileh);
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
my $lnum=0;
|
||||
while(<FILE>) {
|
||||
while(<$fileh>) {
|
||||
chomp $_;
|
||||
$line = $_;
|
||||
$lnum++;
|
||||
@ -375,7 +375,7 @@ while(<FILE>) {
|
||||
print "Not recognized prefix line: $line\n";
|
||||
}
|
||||
}
|
||||
close(FILE);
|
||||
close($fileh);
|
||||
|
||||
if($totalmem) {
|
||||
print "Leak detected: memory still allocated: $totalmem bytes\n";
|
||||
|
||||
@ -56,10 +56,10 @@ sub manpresent {
|
||||
|
||||
sub file {
|
||||
my ($f) = @_;
|
||||
open(F, "<$f") ||
|
||||
open(my $fh, "<", "$f") ||
|
||||
die "no file";
|
||||
my $line = 1;
|
||||
while(<F>) {
|
||||
while(<$fh>) {
|
||||
chomp;
|
||||
my $l = $_;
|
||||
while($l =~ s/\\f(.)([^ ]*)\\f(.)//) {
|
||||
@ -100,7 +100,7 @@ sub file {
|
||||
}
|
||||
$line++;
|
||||
}
|
||||
close(F);
|
||||
close($fh);
|
||||
}
|
||||
|
||||
foreach my $f (@f) {
|
||||
|
||||
@ -31,15 +31,15 @@ sub showline {
|
||||
|
||||
my $root = $ARGV[0];
|
||||
|
||||
open(F, "perl $root/lib/optiontable.pl < $root/include/curl/curl.h|");
|
||||
binmode F;
|
||||
my @gen=<F>;
|
||||
close(F);
|
||||
open(my $fh, "-|", "perl $root/lib/optiontable.pl < $root/include/curl/curl.h");
|
||||
binmode $fh;
|
||||
my @gen=<$fh>;
|
||||
close($fh);
|
||||
|
||||
open(F, "<$root/lib/easyoptions.c");
|
||||
binmode F;
|
||||
my @file=<F>;
|
||||
close(F);
|
||||
open($fh, "<", "$root/lib/easyoptions.c");
|
||||
binmode $fh;
|
||||
my @file=<$fh>;
|
||||
close($fh);
|
||||
|
||||
if(join("", @gen) ne join("", @file)) {
|
||||
print "easyoptions.c need to be regenerated!\n";
|
||||
|
||||
@ -50,8 +50,8 @@ sub cmdfiles {
|
||||
sub mentions {
|
||||
my ($f) = @_;
|
||||
my @options;
|
||||
open(F, "<$f");
|
||||
while(<F>) {
|
||||
open(my $fh, "<", "$f");
|
||||
while(<$fh>) {
|
||||
chomp;
|
||||
if(/(.*) +([0-9.]+)/) {
|
||||
my ($flag, $version)=($1, $2);
|
||||
@ -71,13 +71,14 @@ sub mentions {
|
||||
$oiv{$flag} = $version;
|
||||
}
|
||||
}
|
||||
close($fh);
|
||||
return @options;
|
||||
}
|
||||
|
||||
sub versioncheck {
|
||||
my ($f, $v)=@_;
|
||||
open(F, "<$cmddir/$f.d");
|
||||
while(<F>) {
|
||||
open(my $fh, "<", "$cmddir/$f.d");
|
||||
while(<$fh>) {
|
||||
chomp;
|
||||
if(/^Added: ([0-9.]+)/) {
|
||||
if($1 ne $v) {
|
||||
@ -87,7 +88,7 @@ sub versioncheck {
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($fh);
|
||||
}
|
||||
|
||||
# get all the files
|
||||
|
||||
@ -350,7 +350,7 @@ delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
|
||||
|
||||
# provide defaults from our config file for ENV vars not explicitly
|
||||
# set by the caller
|
||||
if (open(my $fd, "< config")) {
|
||||
if (open(my $fd, "<", "config")) {
|
||||
while(my $line = <$fd>) {
|
||||
next if ($line =~ /^#/);
|
||||
chomp $line;
|
||||
@ -460,9 +460,9 @@ sub startnew {
|
||||
|
||||
# Ugly hack but ssh client and gnutls-serv don't support pid files
|
||||
if ($fake) {
|
||||
if(open(OUT, ">$pidfile")) {
|
||||
print OUT $child . "\n";
|
||||
close(OUT) || die "Failure writing pidfile";
|
||||
if(open(my $out, ">", "$pidfile")) {
|
||||
print $out $child . "\n";
|
||||
close($out) || die "Failure writing pidfile";
|
||||
logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
|
||||
}
|
||||
else {
|
||||
@ -478,9 +478,9 @@ sub startnew {
|
||||
|
||||
my $count = $timeout;
|
||||
while($count--) {
|
||||
if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
|
||||
$pid2 = 0 + <PID>;
|
||||
close(PID);
|
||||
if(-f $pidfile && -s $pidfile && open(my $pidh, "<", "$pidfile")) {
|
||||
$pid2 = 0 + <$pidh>;
|
||||
close($pidh);
|
||||
if(($pid2 > 0) && pidexists($pid2)) {
|
||||
# if $pid2 is valid, then make sure this pid is alive, as
|
||||
# otherwise it is just likely to be the _previous_ pidfile or
|
||||
@ -534,15 +534,15 @@ my $disttests = "";
|
||||
sub get_disttests {
|
||||
# If a non-default $TESTDIR is being used there may not be any
|
||||
# Makefile.inc in which case there's nothing to do.
|
||||
open(D, "<$TESTDIR/Makefile.inc") or return;
|
||||
while(<D>) {
|
||||
open(my $dh, "<", "$TESTDIR/Makefile.inc") or return;
|
||||
while(<$dh>) {
|
||||
chomp $_;
|
||||
if(($_ =~ /^#/) ||($_ !~ /test/)) {
|
||||
next;
|
||||
}
|
||||
$disttests .= $_;
|
||||
}
|
||||
close(D);
|
||||
close($dh);
|
||||
}
|
||||
|
||||
#######################################################################
|
||||
@ -886,21 +886,21 @@ sub verifyhttp {
|
||||
|
||||
if($res && $verbose) {
|
||||
logmsg "RUN: curl command returned $res\n";
|
||||
if(open(FILE, "<$verifylog")) {
|
||||
while(my $string = <FILE>) {
|
||||
if(open(my $file, "<", "$verifylog")) {
|
||||
while(my $string = <$file>) {
|
||||
logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
|
||||
}
|
||||
close(FILE);
|
||||
close($file);
|
||||
}
|
||||
}
|
||||
|
||||
my $data;
|
||||
if(open(FILE, "<$verifyout")) {
|
||||
while(my $string = <FILE>) {
|
||||
if(open(my $file, "<", "$verifyout")) {
|
||||
while(my $string = <$file>) {
|
||||
$data = $string;
|
||||
last; # only want first line
|
||||
}
|
||||
close(FILE);
|
||||
close($file);
|
||||
}
|
||||
|
||||
if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
|
||||
@ -1029,21 +1029,21 @@ sub verifyrtsp {
|
||||
|
||||
if($res && $verbose) {
|
||||
logmsg "RUN: curl command returned $res\n";
|
||||
if(open(FILE, "<$verifylog")) {
|
||||
while(my $string = <FILE>) {
|
||||
if(open(my $file, "<", "$verifylog")) {
|
||||
while(my $string = <$file>) {
|
||||
logmsg "RUN: $string" if($string !~ /^[ \t]*$/);
|
||||
}
|
||||
close(FILE);
|
||||
close($file);
|
||||
}
|
||||
}
|
||||
|
||||
my $data;
|
||||
if(open(FILE, "<$verifyout")) {
|
||||
while(my $string = <FILE>) {
|
||||
if(open(my $file, "<", "$verifyout")) {
|
||||
while(my $string = <$file>) {
|
||||
$data = $string;
|
||||
last; # only want first line
|
||||
}
|
||||
close(FILE);
|
||||
close($file);
|
||||
}
|
||||
|
||||
if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
|
||||
@ -1071,9 +1071,9 @@ sub verifyssh {
|
||||
my $server = servername_id($proto, $ipvnum, $idnum);
|
||||
my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
|
||||
my $pid = 0;
|
||||
if(open(FILE, "<$pidfile")) {
|
||||
$pid=0+<FILE>;
|
||||
close(FILE);
|
||||
if(open(my $file, "<", "$pidfile")) {
|
||||
$pid=0+<$file>;
|
||||
close($file);
|
||||
}
|
||||
if($pid > 0) {
|
||||
# if we have a pid it is actually our ssh server,
|
||||
@ -1113,14 +1113,14 @@ sub verifysftp {
|
||||
my $cmd = "\"$sftp\" -b $sftpcmds -F $sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
|
||||
my $res = runclient($cmd);
|
||||
# Search for pwd command response in log file
|
||||
if(open(SFTPLOGFILE, "<$sftplog")) {
|
||||
while(<SFTPLOGFILE>) {
|
||||
if(open(my $sftplogfile, "<", "$sftplog")) {
|
||||
while(<$sftplogfile>) {
|
||||
if(/^Remote working directory: /) {
|
||||
$verified = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(SFTPLOGFILE);
|
||||
close($sftplogfile);
|
||||
}
|
||||
return $verified;
|
||||
}
|
||||
@ -1172,25 +1172,25 @@ sub verifyhttptls {
|
||||
|
||||
if($res && $verbose) {
|
||||
logmsg "RUN: curl command returned $res\n";
|
||||
if(open(FILE, "<$verifylog")) {
|
||||
while(my $string = <FILE>) {
|
||||
if(open(my $file, "<", "$verifylog")) {
|
||||
while(my $string = <$file>) {
|
||||
logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
|
||||
}
|
||||
close(FILE);
|
||||
close($file);
|
||||
}
|
||||
}
|
||||
|
||||
my $data;
|
||||
if(open(FILE, "<$verifyout")) {
|
||||
while(my $string = <FILE>) {
|
||||
if(open(my $file, "<", "$verifyout")) {
|
||||
while(my $string = <$file>) {
|
||||
$data .= $string;
|
||||
}
|
||||
close(FILE);
|
||||
close($file);
|
||||
}
|
||||
|
||||
if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(FILE, "<$pidfile")) {
|
||||
$pid=0+<FILE>;
|
||||
close(FILE);
|
||||
if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(my $file, "<", "$pidfile")) {
|
||||
$pid=0+<$file>;
|
||||
close($file);
|
||||
if($pid > 0) {
|
||||
# if we have a pid it is actually our httptls server,
|
||||
# since runhttptlsserver() unlinks previous pidfile
|
||||
@ -1223,9 +1223,9 @@ sub verifysocks {
|
||||
my $server = servername_id($proto, $ipvnum, $idnum);
|
||||
my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
|
||||
my $pid = 0;
|
||||
if(open(FILE, "<$pidfile")) {
|
||||
$pid=0+<FILE>;
|
||||
close(FILE);
|
||||
if(open(my $file, "<", "$pidfile")) {
|
||||
$pid=0+<$file>;
|
||||
close($file);
|
||||
}
|
||||
if($pid > 0) {
|
||||
# if we have a pid it is actually our socks server,
|
||||
@ -2292,9 +2292,10 @@ sub runsshserver {
|
||||
}
|
||||
|
||||
my $hstpubmd5f = "curl_host_rsa_key.pub_md5";
|
||||
if(!open(PUBMD5FILE, "<", $hstpubmd5f) ||
|
||||
(read(PUBMD5FILE, $SSHSRVMD5, 32) != 32) ||
|
||||
!close(PUBMD5FILE) ||
|
||||
my $hostfile;
|
||||
if(!open($hostfile, "<", $hstpubmd5f) ||
|
||||
(read($hostfile, $SSHSRVMD5, 32) != 32) ||
|
||||
!close($hostfile) ||
|
||||
($SSHSRVMD5 !~ /^[a-f0-9]{32}$/i))
|
||||
{
|
||||
my $msg = "Fatal: $srvrname pubkey md5 missing : \"$hstpubmd5f\" : $!";
|
||||
@ -2304,9 +2305,9 @@ sub runsshserver {
|
||||
}
|
||||
|
||||
my $hstpubsha256f = "curl_host_rsa_key.pub_sha256";
|
||||
if(!open(PUBSHA256FILE, "<", $hstpubsha256f) ||
|
||||
(read(PUBSHA256FILE, $SSHSRVSHA256, 48) == 0) ||
|
||||
!close(PUBSHA256FILE))
|
||||
if(!open($hostfile, "<", $hstpubsha256f) ||
|
||||
(read($hostfile, $SSHSRVSHA256, 48) == 0) ||
|
||||
!close($hostfile))
|
||||
{
|
||||
my $msg = "Fatal: $srvrname pubkey sha256 missing : \"$hstpubsha256f\" : $!";
|
||||
logmsg "$msg\n";
|
||||
@ -2895,13 +2896,13 @@ sub checksystemfeatures {
|
||||
$versretval = runclient($versioncmd);
|
||||
$versnoexec = $!;
|
||||
|
||||
open(VERSOUT, "<$curlverout");
|
||||
@version = <VERSOUT>;
|
||||
close(VERSOUT);
|
||||
open(my $versout, "<", "$curlverout");
|
||||
@version = <$versout>;
|
||||
close($versout);
|
||||
|
||||
open(DISABLED, "server/disabled".exe_ext('TOOL')."|");
|
||||
@disabled = <DISABLED>;
|
||||
close(DISABLED);
|
||||
open(my $disabledh, "-|", "server/disabled".exe_ext('TOOL'));
|
||||
@disabled = <$disabledh>;
|
||||
close($disabledh);
|
||||
|
||||
if($disabled[0]) {
|
||||
s/[\r\n]//g for @disabled;
|
||||
@ -3140,14 +3141,14 @@ sub checksystemfeatures {
|
||||
}
|
||||
|
||||
if(-r "../lib/curl_config.h") {
|
||||
open(CONF, "<../lib/curl_config.h");
|
||||
while(<CONF>) {
|
||||
open(my $conf, "<", "../lib/curl_config.h");
|
||||
while(<$conf>) {
|
||||
if($_ =~ /^\#define HAVE_GETRLIMIT/) {
|
||||
# set if system has getrlimit()
|
||||
$feature{"getrlimit"} = 1;
|
||||
}
|
||||
}
|
||||
close(CONF);
|
||||
close($conf);
|
||||
}
|
||||
|
||||
# disable this feature unless debug mode is also enabled
|
||||
@ -3180,8 +3181,8 @@ sub checksystemfeatures {
|
||||
$http_unix = 1 if($sws[0] =~ /unix/);
|
||||
}
|
||||
|
||||
open(M, "$CURL -M 2>&1|");
|
||||
while(my $s = <M>) {
|
||||
open(my $manh, "-|", "$CURL -M 2>&1");
|
||||
while(my $s = <$manh>) {
|
||||
if($s =~ /built-in manual was disabled at build-time/) {
|
||||
$feature{"manual"} = 0;
|
||||
last;
|
||||
@ -3189,7 +3190,7 @@ sub checksystemfeatures {
|
||||
$feature{"manual"} = 1;
|
||||
last;
|
||||
}
|
||||
close(M);
|
||||
close($manh);
|
||||
|
||||
$feature{"unittest"} = $feature{"debug"};
|
||||
$feature{"nghttpx"} = !!$ENV{'NGHTTPX'};
|
||||
@ -3813,11 +3814,11 @@ sub singletest_preprocess {
|
||||
@entiretest = prepro($testnum, @entiretest);
|
||||
|
||||
# save the new version
|
||||
open(D, ">$otest") || die "Failure writing test file";
|
||||
open(my $fulltesth, ">", "$otest") || die "Failure writing test file";
|
||||
foreach my $bytes (@entiretest) {
|
||||
print D pack('a*', $bytes) or die "Failed to print '$bytes': $!";
|
||||
print $fulltesth pack('a*', $bytes) or die "Failed to print '$bytes': $!";
|
||||
}
|
||||
close(D) || die "Failure writing test file";
|
||||
close($fulltesth) || die "Failure writing test file";
|
||||
|
||||
# in case the process changed the file, reload it
|
||||
loadtest("log/test${testnum}");
|
||||
@ -3977,14 +3978,14 @@ sub singletest_prepare {
|
||||
mkdir $d; # 0777
|
||||
}
|
||||
}
|
||||
open(OUTFILE, ">$filename");
|
||||
binmode OUTFILE; # for crapage systems, use binary
|
||||
open(my $outfile, ">", "$filename");
|
||||
binmode $outfile; # for crapage systems, use binary
|
||||
if($fileattr{'nonewline'}) {
|
||||
# cut off the final newline
|
||||
chomp($fileContent);
|
||||
}
|
||||
print OUTFILE $fileContent;
|
||||
close(OUTFILE);
|
||||
print $outfile $fileContent;
|
||||
close($outfile);
|
||||
}
|
||||
}
|
||||
return ($why, 0);
|
||||
@ -4150,20 +4151,20 @@ sub singletest_run {
|
||||
logmsg "$CMDLINE\n";
|
||||
}
|
||||
|
||||
open(CMDLOG, ">", "$LOGDIR/$CURLLOG") || die "Failure writing log file";
|
||||
print CMDLOG "$CMDLINE\n";
|
||||
close(CMDLOG) || die "Failure writing log file";
|
||||
open(my $cmdlog, ">", "$LOGDIR/$CURLLOG") || die "Failure writing log file";
|
||||
print $cmdlog "$CMDLINE\n";
|
||||
close($cmdlog) || die "Failure writing log file";
|
||||
|
||||
my $dumped_core;
|
||||
my $cmdres;
|
||||
|
||||
if($gdbthis) {
|
||||
my $gdbinit = "$TESTDIR/gdbinit$testnum";
|
||||
open(GDBCMD, ">$LOGDIR/gdbcmd") || die "Failure writing gdb file";
|
||||
print GDBCMD "set args $cmdargs\n";
|
||||
print GDBCMD "show args\n";
|
||||
print GDBCMD "source $gdbinit\n" if -e $gdbinit;
|
||||
close(GDBCMD) || die "Failure writing gdb file";
|
||||
open(my $gdbcmd, ">", "$LOGDIR/gdbcmd") || die "Failure writing gdb file";
|
||||
print $gdbcmd "set args $cmdargs\n";
|
||||
print $gdbcmd "show args\n";
|
||||
print $gdbcmd "source $gdbinit\n" if -e $gdbinit;
|
||||
close($gdbcmd) || die "Failure writing gdb file";
|
||||
}
|
||||
|
||||
# Flush output.
|
||||
@ -4211,9 +4212,9 @@ sub singletest_clean {
|
||||
logmsg "core dumped\n";
|
||||
if(0 && $gdb) {
|
||||
logmsg "running gdb for post-mortem analysis:\n";
|
||||
open(GDBCMD, ">$LOGDIR/gdbcmd2") || die "Failure writing gdb file";
|
||||
print GDBCMD "bt\n";
|
||||
close(GDBCMD) || die "Failure writing gdb file";
|
||||
open(my $gdbcmd, ">", "$LOGDIR/gdbcmd2") || die "Failure writing gdb file";
|
||||
print $gdbcmd "bt\n";
|
||||
close($gdbcmd) || die "Failure writing gdb file";
|
||||
runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
|
||||
# unlink("$LOGDIR/gdbcmd2");
|
||||
}
|
||||
@ -6009,10 +6010,10 @@ if(!$randseed) {
|
||||
localtime(time);
|
||||
# seed of the month. December 2019 becomes 201912
|
||||
$randseed = ($year+1900)*100 + $mon+1;
|
||||
open(C, "$CURL --version 2>/dev/null|") ||
|
||||
open(my $curlvh, "-|", "$CURL --version 2>/dev/null") ||
|
||||
die "could not get curl version!";
|
||||
my @c = <C>;
|
||||
close(C);
|
||||
my @c = <$curlvh>;
|
||||
close($curlvh) || die "could not get curl version!";
|
||||
# use the first line of output and get the md5 out of it
|
||||
my $str = md5($c[0]);
|
||||
$randseed += unpack('S', $str); # unsigned 16 bit value
|
||||
@ -6040,13 +6041,13 @@ if($valgrind) {
|
||||
if (($? >> 8)==0) {
|
||||
$valgrind_tool="--tool=memcheck";
|
||||
}
|
||||
open(C, "<$CURL");
|
||||
my $l = <C>;
|
||||
open(my $curlh, "<", "$CURL");
|
||||
my $l = <$curlh>;
|
||||
if($l =~ /^\#\!/) {
|
||||
# A shell script. This is typically when built with libtool,
|
||||
$valgrind="../libtool --mode=execute $valgrind";
|
||||
}
|
||||
close(C);
|
||||
close($curlh);
|
||||
|
||||
# valgrind 3 renamed the --logfile option to --log-file!!!
|
||||
my $ver=join(' ', runclientoutput("valgrind --version"));
|
||||
@ -6064,10 +6065,10 @@ if($valgrind) {
|
||||
|
||||
if ($gdbthis) {
|
||||
# open the executable curl and read the first 4 bytes of it
|
||||
open(CHECK, "<$CURL");
|
||||
open(my $check, "<", "$CURL");
|
||||
my $c;
|
||||
sysread CHECK, $c, 4;
|
||||
close(CHECK);
|
||||
sysread $check, $c, 4;
|
||||
close($check);
|
||||
if($c eq "#! /") {
|
||||
# A shell script. This is typically when built with libtool,
|
||||
$libtool = 1;
|
||||
@ -6112,15 +6113,15 @@ sub disabledtests {
|
||||
my ($file) = @_;
|
||||
my @input;
|
||||
|
||||
if(open(D, "<$file")) {
|
||||
while(<D>) {
|
||||
if(open(my $disabledh, "<", "$file")) {
|
||||
while(<$disabledh>) {
|
||||
if(/^ *\#/) {
|
||||
# allow comments
|
||||
next;
|
||||
}
|
||||
push @input, $_;
|
||||
}
|
||||
close(D);
|
||||
close($disabledh);
|
||||
|
||||
# preprocess the input to make conditionally disabled tests depending
|
||||
# on variables
|
||||
@ -6214,11 +6215,11 @@ if($scrambleorder) {
|
||||
# and excessively long files are elided
|
||||
sub displaylogcontent {
|
||||
my ($file)=@_;
|
||||
if(open(SINGLE, "<$file")) {
|
||||
if(open(my $single, "<", "$file")) {
|
||||
my $linecount = 0;
|
||||
my $truncate;
|
||||
my @tail;
|
||||
while(my $string = <SINGLE>) {
|
||||
while(my $string = <$single>) {
|
||||
$string =~ s/\r\n/\n/g;
|
||||
$string =~ s/[\r\f\032]/\n/g;
|
||||
$string .= "\n" unless ($string =~ /\n$/);
|
||||
@ -6234,7 +6235,7 @@ sub displaylogcontent {
|
||||
$truncate = $linecount > 1000;
|
||||
}
|
||||
}
|
||||
close(SINGLE);
|
||||
close($single);
|
||||
if(@tail) {
|
||||
my $tailshow = 200;
|
||||
my $tailskip = 0;
|
||||
|
||||
@ -277,26 +277,26 @@ if($stunnel_version >= 400) {
|
||||
$SIG{INT} = \&exit_signal_handler;
|
||||
$SIG{TERM} = \&exit_signal_handler;
|
||||
# stunnel configuration file
|
||||
if(open(STUNCONF, ">$conffile")) {
|
||||
print STUNCONF "CApath = $capath\n";
|
||||
print STUNCONF "cert = $certfile\n";
|
||||
print STUNCONF "debug = $loglevel\n";
|
||||
print STUNCONF "socket = $socketopt\n";
|
||||
if(open(my $stunconf, ">", "$conffile")) {
|
||||
print $stunconf "CApath = $capath\n";
|
||||
print $stunconf "cert = $certfile\n";
|
||||
print $stunconf "debug = $loglevel\n";
|
||||
print $stunconf "socket = $socketopt\n";
|
||||
if($fips_support) {
|
||||
# disable fips in case OpenSSL doesn't support it
|
||||
print STUNCONF "fips = no\n";
|
||||
print $stunconf "fips = no\n";
|
||||
}
|
||||
if(!$tstunnel_windows) {
|
||||
# do not use Linux-specific options on Windows
|
||||
print STUNCONF "output = $logfile\n";
|
||||
print STUNCONF "pid = $pidfile\n";
|
||||
print STUNCONF "foreground = yes\n";
|
||||
print $stunconf "output = $logfile\n";
|
||||
print $stunconf "pid = $pidfile\n";
|
||||
print $stunconf "foreground = yes\n";
|
||||
}
|
||||
print STUNCONF "\n";
|
||||
print STUNCONF "[curltest]\n";
|
||||
print STUNCONF "accept = $accept_port\n";
|
||||
print STUNCONF "connect = $target_port\n";
|
||||
if(!close(STUNCONF)) {
|
||||
print $stunconf "\n";
|
||||
print $stunconf "[curltest]\n";
|
||||
print $stunconf "accept = $accept_port\n";
|
||||
print $stunconf "connect = $target_port\n";
|
||||
if(!close($stunconf)) {
|
||||
print "$ssltext Error closing file $conffile\n";
|
||||
exit 1;
|
||||
}
|
||||
@ -338,9 +338,9 @@ print STDERR "RUN: $cmd\n" if($verbose);
|
||||
#
|
||||
if($tstunnel_windows) {
|
||||
# Fake pidfile for tstunnel on Windows.
|
||||
if(open(OUT, ">$pidfile")) {
|
||||
print OUT $$ . "\n";
|
||||
close(OUT);
|
||||
if(open(my $out, ">", "$pidfile")) {
|
||||
print $out $$ . "\n";
|
||||
close($out);
|
||||
}
|
||||
|
||||
# Flush output.
|
||||
|
||||
@ -210,12 +210,12 @@ sub dump_array {
|
||||
if(!$filename) {
|
||||
$error = 'Error: Missing argument 1 for dump_array()';
|
||||
}
|
||||
elsif(open(TEXTFH, ">$filename")) {
|
||||
elsif(open(my $textfh, ">", "$filename")) {
|
||||
foreach my $line (@arr) {
|
||||
$line .= "\n" if($line !~ /\n$/);
|
||||
print TEXTFH $line;
|
||||
print $textfh $line;
|
||||
}
|
||||
if(!close(TEXTFH)) {
|
||||
if(!close($textfh)) {
|
||||
$error = "Error: cannot close file $filename";
|
||||
}
|
||||
}
|
||||
@ -243,11 +243,11 @@ sub logmsg {
|
||||
sub display_file {
|
||||
my $filename = $_[0];
|
||||
print "=== Start of file $filename\n";
|
||||
if(open(DISPLAYFH, "<$filename")) {
|
||||
while(my $line = <DISPLAYFH>) {
|
||||
if(open(my $displayfh, "<", "$filename")) {
|
||||
while(my $line = <$displayfh>) {
|
||||
print "$line";
|
||||
}
|
||||
close DISPLAYFH;
|
||||
close $displayfh;
|
||||
}
|
||||
print "=== End of file $filename\n";
|
||||
}
|
||||
|
||||
@ -387,23 +387,23 @@ if((! -e $hstprvkeyf) || (! -s $hstprvkeyf) ||
|
||||
system "chmod 600 $hstprvkeyf";
|
||||
system "chmod 600 $cliprvkeyf";
|
||||
# Save md5 and sha256 hashes of public host key
|
||||
open(RSAKEYFILE, "<$hstpubkeyf");
|
||||
my @rsahostkey = do { local $/ = ' '; <RSAKEYFILE> };
|
||||
close(RSAKEYFILE);
|
||||
open(my $rsakeyfile, "<", "$hstpubkeyf");
|
||||
my @rsahostkey = do { local $/ = ' '; <$rsakeyfile> };
|
||||
close($rsakeyfile);
|
||||
if(!$rsahostkey[1]) {
|
||||
logmsg 'Failed parsing base64 encoded RSA host key';
|
||||
exit 1;
|
||||
}
|
||||
open(PUBMD5FILE, ">$hstpubmd5f");
|
||||
print PUBMD5FILE md5_hex(decode_base64($rsahostkey[1]));
|
||||
close(PUBMD5FILE);
|
||||
open(my $pubmd5file, ">", "$hstpubmd5f");
|
||||
print $pubmd5file md5_hex(decode_base64($rsahostkey[1]));
|
||||
close($pubmd5file);
|
||||
if((! -e $hstpubmd5f) || (! -s $hstpubmd5f)) {
|
||||
logmsg 'Failed writing md5 hash of RSA host key';
|
||||
exit 1;
|
||||
}
|
||||
open(PUBSHA256FILE, ">$hstpubsha256f");
|
||||
print PUBSHA256FILE sha256_base64(decode_base64($rsahostkey[1]));
|
||||
close(PUBSHA256FILE);
|
||||
open(my $pubsha256file, ">", "$hstpubsha256f");
|
||||
print $pubsha256file sha256_base64(decode_base64($rsahostkey[1]));
|
||||
close($pubsha256file);
|
||||
if((! -e $hstpubsha256f) || (! -s $hstpubsha256f)) {
|
||||
logmsg 'Failed writing sha256 hash of RSA host key';
|
||||
exit 1;
|
||||
@ -780,12 +780,12 @@ if(system "\"$sshd\" -t -f $sshdconfig > $sshdlog 2>&1") {
|
||||
if((! -e $knownhosts) || (! -s $knownhosts)) {
|
||||
logmsg 'generating ssh client known hosts file...' if($verbose);
|
||||
unlink($knownhosts);
|
||||
if(open(RSAKEYFILE, "<$hstpubkeyf")) {
|
||||
my @rsahostkey = do { local $/ = ' '; <RSAKEYFILE> };
|
||||
if(close(RSAKEYFILE)) {
|
||||
if(open(KNOWNHOSTS, ">$knownhosts")) {
|
||||
print KNOWNHOSTS "$listenaddr ssh-rsa $rsahostkey[1]\n";
|
||||
if(!close(KNOWNHOSTS)) {
|
||||
if(open(my $rsakeyfile, "<", "$hstpubkeyf")) {
|
||||
my @rsahostkey = do { local $/ = ' '; <$rsakeyfile> };
|
||||
if(close($rsakeyfile)) {
|
||||
if(open(my $knownhostsh, ">", "$knownhosts")) {
|
||||
print $knownhostsh "$listenaddr ssh-rsa $rsahostkey[1]\n";
|
||||
if(!close($knownhostsh)) {
|
||||
$error = "Error: cannot close file $knownhosts";
|
||||
}
|
||||
}
|
||||
@ -1121,9 +1121,9 @@ logmsg "RUN: $cmd" if($verbose);
|
||||
#
|
||||
if ($sshdid =~ /OpenSSH-Windows/) {
|
||||
# Fake pidfile for ssh server on Windows.
|
||||
if(open(OUT, ">$pidfile")) {
|
||||
print OUT $$ . "\n";
|
||||
close(OUT);
|
||||
if(open(my $out, ">", "$pidfile")) {
|
||||
print $out $$ . "\n";
|
||||
close($out);
|
||||
}
|
||||
|
||||
# Flush output.
|
||||
|
||||
@ -66,8 +66,8 @@ my %rem;
|
||||
# included by it, which *should* be all headers
|
||||
sub scanenum {
|
||||
my ($file) = @_;
|
||||
open H_IN, "-|", "$Cpreprocessor $i$file" || die "Cannot preprocess $file";
|
||||
while ( <H_IN> ) {
|
||||
open my $h_in, "-|", "$Cpreprocessor $i$file" || die "Cannot preprocess $file";
|
||||
while ( <$h_in> ) {
|
||||
if ( /enum\s+(\S+\s+)?{/ .. /}/ ) {
|
||||
s/^\s+//;
|
||||
next unless /^CURL/;
|
||||
@ -76,18 +76,18 @@ sub scanenum {
|
||||
push @syms, $_;
|
||||
}
|
||||
}
|
||||
close H_IN || die "Error preprocessing $file";
|
||||
close $h_in || die "Error preprocessing $file";
|
||||
}
|
||||
|
||||
sub scanheader {
|
||||
my ($f)=@_;
|
||||
open H, "<$f";
|
||||
while(<H>) {
|
||||
open my $h, "<", "$f";
|
||||
while(<$h>) {
|
||||
if (/^#define ((LIB|)CURL[A-Za-z0-9_]*)/) {
|
||||
push @syms, $1;
|
||||
}
|
||||
}
|
||||
close H;
|
||||
close $h;
|
||||
}
|
||||
|
||||
sub scanallheaders {
|
||||
@ -105,9 +105,9 @@ sub scanallheaders {
|
||||
sub checkmanpage {
|
||||
my ($m) = @_;
|
||||
|
||||
open(M, "<$m");
|
||||
open(my $mh, "<", "$m");
|
||||
my $line = 1;
|
||||
while(<M>) {
|
||||
while(<$mh>) {
|
||||
# strip off formatting
|
||||
$_ =~ s/\\f[BPRI]//;
|
||||
# detect global-looking 'CURL[BLABLA]_*' symbols
|
||||
@ -120,7 +120,7 @@ sub checkmanpage {
|
||||
}
|
||||
$line++;
|
||||
}
|
||||
close(M);
|
||||
close($mh);
|
||||
}
|
||||
|
||||
sub scanman3dir {
|
||||
@ -139,8 +139,8 @@ scanallheaders();
|
||||
scanman3dir("$root/docs/libcurl");
|
||||
scanman3dir("$root/docs/libcurl/opts");
|
||||
|
||||
open S, "<$root/docs/libcurl/symbols-in-versions";
|
||||
while(<S>) {
|
||||
open my $s, "<", "$root/docs/libcurl/symbols-in-versions";
|
||||
while(<$s>) {
|
||||
if(/(^[^ \n]+) +(.*)/) {
|
||||
my ($sym, $rest)=($1, $2);
|
||||
if($doc{$sym}) {
|
||||
@ -157,7 +157,7 @@ while(<S>) {
|
||||
}
|
||||
}
|
||||
}
|
||||
close S;
|
||||
close $s;
|
||||
|
||||
my $ignored=0;
|
||||
for my $e (sort @syms) {
|
||||
|
||||
@ -195,14 +195,14 @@ sub rmtree($) {
|
||||
|
||||
sub grepfile($$) {
|
||||
my ($target, $fn) = @_;
|
||||
open(F, $fn) or die;
|
||||
while (<F>) {
|
||||
open(my $fh, "<", $fn) or die;
|
||||
while (<$fh>) {
|
||||
if (/$target/) {
|
||||
close(F);
|
||||
close($fh);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($fh);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -243,14 +243,14 @@ sub get_host_triplet {
|
||||
my $triplet;
|
||||
my $configfile = "$pwd/$build/lib/curl_config.h";
|
||||
|
||||
if(-f $configfile && -s $configfile && open(LIBCONFIGH, "<$configfile")) {
|
||||
while(<LIBCONFIGH>) {
|
||||
if(-f $configfile && -s $configfile && open(my $libconfigh, "<", "$configfile")) {
|
||||
while(<$libconfigh>) {
|
||||
if($_ =~ /^\#define\s+OS\s+"*([^"][^"]*)"*\s*/) {
|
||||
$triplet = $1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(LIBCONFIGH);
|
||||
close($libconfigh);
|
||||
}
|
||||
return $triplet;
|
||||
}
|
||||
@ -261,13 +261,13 @@ if($name && $email && $desc) {
|
||||
$infixed=4;
|
||||
$fixed=4;
|
||||
}
|
||||
elsif (open(F, "$setupfile")) {
|
||||
while (<F>) {
|
||||
elsif (open(my $f, "<", "$setupfile")) {
|
||||
while (<$f>) {
|
||||
if (/(\w+)=(.*)/) {
|
||||
eval "\$$1=$2;";
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
$infixed=$fixed;
|
||||
}
|
||||
else {
|
||||
@ -307,14 +307,14 @@ if (!$confopts) {
|
||||
|
||||
if ($fixed < 4) {
|
||||
$fixed=4;
|
||||
open(F, ">$setupfile") or die;
|
||||
print F "name='$name'\n";
|
||||
print F "email='$email'\n";
|
||||
print F "desc='$desc'\n";
|
||||
print F "confopts='$confopts'\n";
|
||||
print F "notes='$notes'\n";
|
||||
print F "fixed='$fixed'\n";
|
||||
close(F);
|
||||
open(my $f, ">", "$setupfile") or die;
|
||||
print $f "name='$name'\n";
|
||||
print $f "email='$email'\n";
|
||||
print $f "desc='$desc'\n";
|
||||
print $f "confopts='$confopts'\n";
|
||||
print $f "notes='$notes'\n";
|
||||
print $f "fixed='$fixed'\n";
|
||||
close($f);
|
||||
}
|
||||
|
||||
# Enable picky compiler warnings unless explicitly disabled
|
||||
@ -469,15 +469,15 @@ if ($git) {
|
||||
|
||||
# generate the build files
|
||||
logit "invoke autoreconf";
|
||||
open(F, "autoreconf -fi 2>&1 |") or die;
|
||||
open(LOG, ">$buildlog") or die;
|
||||
while (<F>) {
|
||||
open(my $f, "-|", "autoreconf -fi 2>&1") or die;
|
||||
open(my $log, ">", "$buildlog") or die;
|
||||
while (<$f>) {
|
||||
my $ll = $_;
|
||||
print $ll;
|
||||
print LOG $ll;
|
||||
print $log $ll;
|
||||
}
|
||||
close(F);
|
||||
close(LOG);
|
||||
close($f);
|
||||
close($log);
|
||||
|
||||
logit "buildconf was successful";
|
||||
}
|
||||
@ -488,8 +488,8 @@ if ($git) {
|
||||
|
||||
# Set timestamp to the one in curlver.h if this isn't a git test build.
|
||||
if ((-f "include/curl/curlver.h") &&
|
||||
(open(F, "<include/curl/curlver.h"))) {
|
||||
while (<F>) {
|
||||
(open(my $f, "<", "include/curl/curlver.h"))) {
|
||||
while (<$f>) {
|
||||
chomp;
|
||||
if ($_ =~ /^\#define\s+LIBCURL_TIMESTAMP\s+\"(.+)\".*$/) {
|
||||
my $stampstring = $1;
|
||||
@ -500,7 +500,7 @@ if ((-f "include/curl/curlver.h") &&
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
|
||||
# Show timestamp we are using for this test build.
|
||||
@ -572,21 +572,21 @@ if ($configurebuild) {
|
||||
|
||||
if(-f "./libcurl.pc") {
|
||||
logit_spaced "display libcurl.pc";
|
||||
if(open(F, "<./libcurl.pc")) {
|
||||
while(<F>) {
|
||||
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(F, "lib/$confheader") or die "lib/$confheader: $!";
|
||||
while (<F>) {
|
||||
open(my $f, "<", "lib/$confheader") or die "lib/$confheader: $!";
|
||||
while (<$f>) {
|
||||
print if /^ *#/;
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
|
||||
if (($have_embedded_ares) &&
|
||||
(grepfile("^#define USE_ARES", "lib/$confheader"))) {
|
||||
@ -595,23 +595,23 @@ if (($have_embedded_ares) &&
|
||||
|
||||
if(-f "./ares/libcares.pc") {
|
||||
logit_spaced "display ares/libcares.pc";
|
||||
if(open(F, "<./ares/libcares.pc")) {
|
||||
while(<F>) {
|
||||
if(open($f, "<", "ares/libcares.pc")) {
|
||||
while(<$f>) {
|
||||
my $ll = $_;
|
||||
print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/));
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
}
|
||||
|
||||
if(-f "./ares/ares_build.h") {
|
||||
logit_spaced "display ares/ares_build.h";
|
||||
if(open(F, "<./ares/ares_build.h")) {
|
||||
while(<F>) {
|
||||
if(open($f, "<", "ares/ares_build.h")) {
|
||||
while(<$f>) {
|
||||
my $ll = $_;
|
||||
print $ll if(($ll =~ /^ *# *define *CARES_/) && ($ll !~ /__CARES_BUILD_H/));
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
}
|
||||
else {
|
||||
@ -620,11 +620,11 @@ if (($have_embedded_ares) &&
|
||||
|
||||
$confheader =~ s/curl/ares/;
|
||||
logit_spaced "display ares/$confheader";
|
||||
if(open(F, "ares/$confheader")) {
|
||||
while (<F>) {
|
||||
if(open($f, "<", "ares/$confheader")) {
|
||||
while (<$f>) {
|
||||
print if /^ *#/;
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
|
||||
print "\n";
|
||||
@ -633,17 +633,17 @@ if (($have_embedded_ares) &&
|
||||
|
||||
if ($targetos && !$configurebuild) {
|
||||
logit "$make -f Makefile.$targetos";
|
||||
open(F, "$make -f Makefile.$targetos 2>&1 |") or die;
|
||||
open($f, "-|", "$make -f Makefile.$targetos 2>&1") or die;
|
||||
}
|
||||
else {
|
||||
logit "$make";
|
||||
open(F, "$make 2>&1 |") or die;
|
||||
open($f, "-|", "$make 2>&1") or die;
|
||||
}
|
||||
while (<F>) {
|
||||
while (<$f>) {
|
||||
s/$pwd//g;
|
||||
print;
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
|
||||
if (-f "libcares$libext") {
|
||||
logit "ares is now built successfully (libcares$libext)";
|
||||
@ -657,12 +657,12 @@ if (($have_embedded_ares) &&
|
||||
|
||||
my $mkcmd = "$make -i" . ($targetos && !$configurebuild ? " $targetos" : "");
|
||||
logit "$mkcmd";
|
||||
open(F, "$mkcmd 2>&1 |") or die;
|
||||
while (<F>) {
|
||||
open(my $f, "-|", "$mkcmd 2>&1") or die;
|
||||
while (<$f>) {
|
||||
s/$pwd//g;
|
||||
print;
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
|
||||
if (-f "lib/libcurl$libext") {
|
||||
logit "libcurl was created fine (libcurl$libext)";
|
||||
@ -681,13 +681,13 @@ else {
|
||||
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>) {
|
||||
open($f, "<", $cmd);
|
||||
while(<$f>) {
|
||||
# strip CR from output on non-win32 platforms (wine on Linux)
|
||||
s/\r// if ($^O ne 'MSWin32');
|
||||
print;
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
|
||||
if ($configurebuild && !$crosscompile) {
|
||||
@ -699,15 +699,15 @@ if ($configurebuild && !$crosscompile) {
|
||||
($host_triplet =~ /([^-]+)-([^-]+)-solaris2(.*)/)) {
|
||||
chdir "$pwd/$build/docs/examples";
|
||||
logit_spaced "build examples";
|
||||
open(F, "$make -i 2>&1 |") or die;
|
||||
open(LOG, ">$buildlog") or die;
|
||||
while (<F>) {
|
||||
open($f, "-|", "$make -i 2>&1") or die;
|
||||
open(my $log, ">", "$buildlog") or die;
|
||||
while (<$f>) {
|
||||
s/$pwd//g;
|
||||
print;
|
||||
print LOG;
|
||||
print $log $_;
|
||||
}
|
||||
close(F);
|
||||
close(LOG);
|
||||
close($f);
|
||||
close($log);
|
||||
chdir "$pwd/$build";
|
||||
}
|
||||
# build and run full test suite
|
||||
@ -716,15 +716,15 @@ if ($configurebuild && !$crosscompile) {
|
||||
$o = "TEST_F=\"$runtestopts\" ";
|
||||
}
|
||||
logit "$make -k ${o}test-full";
|
||||
open(F, "$make -k ${o}test-full 2>&1 |") or die;
|
||||
open(LOG, ">$buildlog") or die;
|
||||
while (<F>) {
|
||||
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;
|
||||
print $log $_;
|
||||
}
|
||||
close(F);
|
||||
close(LOG);
|
||||
close($f);
|
||||
close($log);
|
||||
|
||||
if (grepfile("^TEST", $buildlog)) {
|
||||
logit "tests were run";
|
||||
@ -746,30 +746,30 @@ else {
|
||||
($host_triplet =~ /([^-]+)-([^-]+)-android(.*)/)) {
|
||||
chdir "$pwd/$build/docs/examples";
|
||||
logit_spaced "build examples";
|
||||
open(F, "$make -i 2>&1 |") or die;
|
||||
open(LOG, ">$buildlog") or die;
|
||||
while (<F>) {
|
||||
open($f, "-|", "$make -i 2>&1") or die;
|
||||
open(my $log, ">", "$buildlog") or die;
|
||||
while (<$f>) {
|
||||
s/$pwd//g;
|
||||
print;
|
||||
print LOG;
|
||||
print $log $_;
|
||||
}
|
||||
close(F);
|
||||
close(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(F, "$make -i 2>&1 |") or die;
|
||||
open(LOG, ">$buildlog") or die;
|
||||
while (<F>) {
|
||||
open(my $f, "-|", "$make -i 2>&1") or die;
|
||||
open(my $log, ">", "$buildlog") or die;
|
||||
while (<$f>) {
|
||||
s/$pwd//g;
|
||||
print;
|
||||
print LOG;
|
||||
print $log $_;
|
||||
}
|
||||
close(F);
|
||||
close(LOG);
|
||||
close($f);
|
||||
close($log);
|
||||
chdir "$pwd/$build";
|
||||
}
|
||||
logit_spaced "cross-compiling, can't run tests";
|
||||
|
||||
@ -30,9 +30,9 @@ use File::Basename;
|
||||
sub valgrindparse {
|
||||
my ($file) = @_;
|
||||
my @o;
|
||||
open(VAL, "<$file");
|
||||
@o = <VAL>;
|
||||
close(VAL);
|
||||
open(my $val, "<", "$file");
|
||||
@o = <$val>;
|
||||
close($val);
|
||||
return @o;
|
||||
}
|
||||
|
||||
|
||||
@ -39,8 +39,8 @@ my %manname;
|
||||
my %sourcename;
|
||||
my $error=0;
|
||||
|
||||
open(M, "<$manpage");
|
||||
while(<M>) {
|
||||
open(my $m, "<", "$manpage");
|
||||
while(<$m>) {
|
||||
if($_ =~ / mask bit: (CURL_VERSION_[A-Z0-9_]+)/i) {
|
||||
$manversion{$1}++;
|
||||
}
|
||||
@ -48,23 +48,23 @@ while(<M>) {
|
||||
$manname{$1}++;
|
||||
}
|
||||
}
|
||||
close(M);
|
||||
close($m);
|
||||
|
||||
open(H, "<$header");
|
||||
while(<H>) {
|
||||
open(my $h, "<", "$header");
|
||||
while(<$h>) {
|
||||
if($_ =~ /^\#define (CURL_VERSION_[A-Z0-9_]+)/i) {
|
||||
$headerversion{$1}++;
|
||||
}
|
||||
}
|
||||
close(H);
|
||||
close($h);
|
||||
|
||||
open(S, "<$source");
|
||||
while(<S>) {
|
||||
open(my $s, "<", "$source");
|
||||
while(<$s>) {
|
||||
if($_ =~ /FEATURE\("([^"]*)"/) {
|
||||
$sourcename{$1}++;
|
||||
}
|
||||
}
|
||||
close(S);
|
||||
close($s);
|
||||
|
||||
for my $h (keys %headerversion) {
|
||||
if(!$manversion{$h}) {
|
||||
|
||||
Loading…
Reference in New Issue
Block a user