luo980/curl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tests: switch to 3-argument open in test suite

Browse Source 
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 2023-03-28 13:29:36 -07:00
parent b133f70a52
commit 0e3ae25337
21 changed files with 361 additions and 357 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
tests/check-deprecated.pl
View File

@ -57,8 +57,8 @@ sub scan_header {
my $incomment = 0; my $incomment = 0;
my $inenum = 0; my $inenum = 0;
open H, "<$f"; open(my $h, "<", "$f");
while(<H>) { while(<$h>) {
s/^\s*(.*?)\s*$/$1/; # Trim. s/^\s*(.*?)\s*$/$1/; # Trim.
# Remove multi-line comment trail. # Remove multi-line comment trail.
if($incomment) { if($incomment) {
@ -138,7 +138,7 @@ sub scan_header {
$inenum = 0; $inenum = 0;
} }
} }
close H; close $h;
} }
# Scan function man page for options. # Scan function man page for options.
@ -149,8 +149,8 @@ sub scan_man_for_opts {
my $opt = ""; my $opt = "";
my $line = ""; my $line = "";
open M, "<$f"; open(my $m, "<", "$f");
while(<M>) { while(<$m>) {
if($_ =~ /^\./) { if($_ =~ /^\./) {
# roff directive found: end current option paragraph. # roff directive found: end current option paragraph.
my $o = $opt; my $o = $opt;
@ -177,16 +177,15 @@ sub scan_man_for_opts {
$line .= $_; $line .= $_;
} }
} }
close M; close $m;
} }
# Scan man page for deprecation in DESCRIPTION and/or AVAILABILITY sections. # Scan man page for deprecation in DESCRIPTION and/or AVAILABILITY sections.
sub scan_man_page { sub scan_man_page {
my ($path, $sym, $table)=@_; my ($path, $sym, $table)=@_;
my $version = "X"; my $version = "X";
my $fh;
if(open $fh, "<$path") { if(open(my $fh, "<", "$path")) {
my $section = ""; my $section = "";
my $line = ""; my $line = "";
@ -238,9 +237,9 @@ sub scan_man_page {
# Read symbols-in-versions. # Read symbols-in-versions.
open(F, "<$libdocdir/symbols-in-versions") || open(my $fh, "<", "$libdocdir/symbols-in-versions") ||
die "$libdocdir/symbols-in-versions"; die "$libdocdir/symbols-in-versions";
while(<F>) { while(<$fh>) {
if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) { if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) {
if($3 eq "") { if($3 eq "") {
$syminver{$1} = "X"; $syminver{$1} = "X";
@ -250,7 +249,7 @@ while(<F>) {
} }
} }
} }
close(F); close($fh);
# Get header file names, # Get header file names,
opendir(my $dh, $incdir) || die "Can't opendir $incdir"; opendir(my $dh, $incdir) || die "Can't opendir $incdir";

12
tests/error-codes.pl
View File

@ -35,8 +35,8 @@ my %error; # from the include file
my %docs; # from libcurl-errors.3 my %docs; # from libcurl-errors.3
sub getdocserrors { sub getdocserrors {
open(F, "<$root/docs/libcurl/libcurl-errors.3"); open(my $f, "<", "$root/docs/libcurl/libcurl-errors.3");
while(<F>) { while(<$f>) {
if($_ =~ /^.IP \"(CURL[EM]_[^ \t\"]*)/) { if($_ =~ /^.IP \"(CURL[EM]_[^ \t\"]*)/) {
my ($symbol) = ($1); my ($symbol) = ($1);
if($symbol =~ /OBSOLETE/) { if($symbol =~ /OBSOLETE/) {
@ -47,12 +47,12 @@ sub getdocserrors {
} }
} }
} }
close(F); close($f);
} }
sub getincludeerrors { sub getincludeerrors {
open(F, "<$root/docs/libcurl/symbols-in-versions"); open(my $f, "<", "$root/docs/libcurl/symbols-in-versions");
while(<F>) { while(<$f>) {
if($_ =~ /^(CURL[EM]_[^ \t]*)[ \t]*([0-9.]+)[ \t]*(.*)/) { if($_ =~ /^(CURL[EM]_[^ \t]*)[ \t]*([0-9.]+)[ \t]*(.*)/) {
my ($symbol, $added, $rest) = ($1,$2,$3); my ($symbol, $added, $rest) = ($1,$2,$3);
if($rest =~ /^([0-9.]+)/) { if($rest =~ /^([0-9.]+)/) {
@ -63,7 +63,7 @@ sub getincludeerrors {
} }
} }
} }
close(F); close($f);
} }
getincludeerrors(); getincludeerrors();

9
tests/ftp.pm
View File

@ -79,9 +79,9 @@ sub pidfromfile {
my $pidfile = $_[0]; my $pidfile = $_[0];
my $pid = 0; my $pid = 0;
if(-f $pidfile && -s $pidfile && open(PIDFH, "<$pidfile")) { if(-f $pidfile && -s $pidfile && open(my $pidfh, "<", "$pidfile")) {
$pid = 0 + <PIDFH>; $pid = 0 + <$pidfh>;
close(PIDFH); close($pidfh);
$pid = 0 if($pid < 0); $pid = 0 if($pid < 0);
} }
return $pid; return $pid;
@ -380,7 +380,8 @@ sub killallsockfilters {
sub set_advisor_read_lock { sub set_advisor_read_lock {
my ($filename) = @_; my ($filename) = @_;
if(open(FILEH, ">$filename") && close(FILEH)) { my $fileh;
if(open($fileh, ">", "$filename") && close($fileh)) {
return; return;
} }
printf "Error creating lock file $filename error: $!"; printf "Error creating lock file $filename error: $!";

56
tests/ftpserver.pl
View File

@ -224,20 +224,20 @@ sub logmsg {
localtime($seconds); localtime($seconds);
$now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec); $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
} }
if(open(LOGFILEFH, ">>$logfile")) { if(open(my $logfilefh, ">>", "$logfile")) {
print LOGFILEFH $now; print $logfilefh $now;
print LOGFILEFH @_; print $logfilefh @_;
close(LOGFILEFH); close($logfilefh);
} }
} }
sub ftpmsg { sub ftpmsg {
# append to the server.input file # 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"; logmsg "failed to open log/server$idstr.input\n";
print INPUT @_; print $input @_;
close(INPUT); close($input);
# use this, open->print->close system only to make the file # use this, open->print->close system only to make the file
# open as little as possible, to make the test suite run # 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"; logmsg "Store test number $testno in $filename\n";
open(FILE, ">$filename") || open(my $file, ">", "$filename") ||
return 0; # failed to open output return 0; # failed to open output
my $line; my $line;
@ -936,7 +936,7 @@ sub DATA_smtp {
read_mainsockf(\$line, $size); read_mainsockf(\$line, $size);
$ulsize += $size; $ulsize += $size;
print FILE $line if(!$nosave); print $file $line if(!$nosave);
$raw .= $line; $raw .= $line;
if($raw =~ /(?:^|\x0d\x0a)\x2e\x0d\x0a/) { if($raw =~ /(?:^|\x0d\x0a)\x2e\x0d\x0a/) {
@ -963,10 +963,10 @@ sub DATA_smtp {
} }
if($nosave) { 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"; logmsg "received $ulsize bytes upload\n";
@ -1264,7 +1264,7 @@ sub APPEND_imap {
logmsg "Store test number $testno in $filename\n"; logmsg "Store test number $testno in $filename\n";
open(FILE, ">$filename") || open(my $file, ">", "$filename") ||
return 0; # failed to open output return 0; # failed to open output
my $received = 0; my $received = 0;
@ -1285,7 +1285,7 @@ sub APPEND_imap {
if($datasize > 0) { if($datasize > 0) {
logmsg "> Appending $datasize bytes to file\n"; 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); $line = substr($line, $datasize);
$received += $datasize; $received += $datasize;
@ -1309,10 +1309,10 @@ sub APPEND_imap {
} }
if($nosave) { 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"; logmsg "received $size bytes upload\n";
@ -2392,7 +2392,7 @@ sub STOR_ftp {
sendcontrol "125 Gimme gimme gimme!\r\n"; sendcontrol "125 Gimme gimme gimme!\r\n";
open(FILE, ">$filename") || open(my $file, ">", "$filename") ||
return 0; # failed to open output return 0; # failed to open output
my $line; my $line;
@ -2413,7 +2413,7 @@ sub STOR_ftp {
#print STDERR " GOT: $size bytes\n"; #print STDERR " GOT: $size bytes\n";
$ulsize += $size; $ulsize += $size;
print FILE $line if(!$nosave); print $file $line if(!$nosave);
logmsg "> Appending $size bytes to file\n"; logmsg "> Appending $size bytes to file\n";
} }
elsif($line eq "DISC\n") { elsif($line eq "DISC\n") {
@ -2431,9 +2431,9 @@ sub STOR_ftp {
} }
} }
if($nosave) { 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); close_dataconn($disc);
logmsg "received $ulsize bytes upload\n"; logmsg "received $ulsize bytes upload\n";
if($storeresp) { if($storeresp) {
@ -2815,12 +2815,12 @@ sub customize {
%customcount = (); # %customcount = (); #
%delayreply = (); # %delayreply = (); #
open(CUSTOM, "<log/ftpserver.cmd") || open(my $custom, "<", "log/ftpserver.cmd") ||
return 1; return 1;
logmsg "FTPD: Getting commands from log/ftpserver.cmd\n"; logmsg "FTPD: Getting commands from log/ftpserver.cmd\n";
while(<CUSTOM>) { while(<$custom>) {
if($_ =~ /REPLY \"([A-Z]+ [A-Za-z0-9+-\/=\*. ]+)\" (.*)/) { if($_ =~ /REPLY \"([A-Z]+ [A-Za-z0-9+-\/=\*. ]+)\" (.*)/) {
$fulltextreply{$1}=eval "qq{$2}"; $fulltextreply{$1}=eval "qq{$2}";
logmsg "FTPD: set custom reply for $1\n"; logmsg "FTPD: set custom reply for $1\n";
@ -2924,7 +2924,7 @@ sub customize {
logmsg "FTPD: run test case number: $testno\n"; logmsg "FTPD: run test case number: $testno\n";
} }
} }
close(CUSTOM); close($custom);
} }
#---------------------------------------------------------------------- #----------------------------------------------------------------------
@ -3066,17 +3066,17 @@ startsf();
# actual port # actual port
if($portfile && !$port) { if($portfile && !$port) {
my $aport; my $aport;
open(P, "<$portfile"); open(my $p, "<", "$portfile");
$aport = <P>; $aport = <$p>;
close(P); close($p);
$port = 0 + $aport; $port = 0 + $aport;
} }
logmsg sprintf("%s server listens on port IPv${ipvnum}/${port}\n", uc($proto)); logmsg sprintf("%s server listens on port IPv${ipvnum}/${port}\n", uc($proto));
open(PID, ">$pidfile"); open(my $pid, ">", "$pidfile");
print PID $$."\n"; print $pid $$."\n";
close(PID); close($pid);
logmsg("logged pid $$ in $pidfile\n"); logmsg("logged pid $$ in $pidfile\n");

46
tests/getpart.pm
View File

@ -220,12 +220,12 @@ sub loadtest {
undef @xml; undef @xml;
$xmlfile = ""; $xmlfile = "";
if(open(XML, "<$file")) { if(open(my $xmlh, "<", "$file")) {
binmode XML; # for crapage systems, use binary binmode $xmlh; # for crapage systems, use binary
while(<XML>) { while(<$xmlh>) {
push @xml, $_; push @xml, $_;
} }
close(XML); close($xmlh);
} }
else { else {
# failure # failure
@ -246,12 +246,12 @@ sub fulltest {
sub savetest { sub savetest {
my ($file)=@_; my ($file)=@_;
if(open(XML, ">$file")) { if(open(my $xmlh, ">", "$file")) {
binmode XML; # for crapage systems, use binary binmode $xmlh; # for crapage systems, use binary
for(@xml) { for(@xml) {
print XML $_; print $xmlh $_;
} }
close(XML); close($xmlh);
} }
else { else {
# failure # failure
@ -310,12 +310,12 @@ sub compareparts {
sub writearray { sub writearray {
my ($filename, $arrayref)=@_; my ($filename, $arrayref)=@_;
open(TEMP, ">$filename") || die "Failure writing file"; open(my $temp, ">", "$filename") || die "Failure writing file";
binmode(TEMP,":raw"); # cygwin fix by Kevin Roth binmode($temp,":raw"); # cygwin fix by Kevin Roth
for(@$arrayref) { 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 ($filename)=@_;
my @array; my @array;
open(TEMP, "<$filename"); open(my $temp, "<", "$filename");
while(<TEMP>) { while(<$temp>) {
push @array, $_; push @array, $_;
} }
close(TEMP); close($temp);
return @array; return @array;
} }
@ -342,27 +342,27 @@ sub showdiff {
my $file1="$logdir/check-generated"; my $file1="$logdir/check-generated";
my $file2="$logdir/check-expected"; my $file2="$logdir/check-expected";
open(TEMP, ">$file1") || die "Failure writing diff file"; open(my $temp, ">", "$file1") || die "Failure writing diff file";
for(@$firstref) { for(@$firstref) {
my $l = $_; my $l = $_;
$l =~ s/\r/[CR]/g; $l =~ s/\r/[CR]/g;
$l =~ s/\n/[LF]/g; $l =~ s/\n/[LF]/g;
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg; $l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
print TEMP $l; print $temp $l;
print TEMP "\n"; 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) { for(@$secondref) {
my $l = $_; my $l = $_;
$l =~ s/\r/[CR]/g; $l =~ s/\r/[CR]/g;
$l =~ s/\n/[LF]/g; $l =~ s/\n/[LF]/g;
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg; $l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
print TEMP $l; print $temp $l;
print TEMP "\n"; 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`; my @out = `diff -u $file2 $file1 2>/dev/null`;
if(!$out[0]) { if(!$out[0]) {

38
tests/manpage-scan.pl
View File

@ -67,9 +67,9 @@ my %alias = (
sub scanmanpage { sub scanmanpage {
my ($file, @words) = @_; my ($file, @words) = @_;
open(M, "<$file"); open(my $mh, "<", "$file");
my @m; my @m;
while(<M>) { while(<$mh>) {
if($_ =~ /^\.IP (.*)/) { if($_ =~ /^\.IP (.*)/) {
my $w = $1; my $w = $1;
# "unquote" minuses # "unquote" minuses
@ -77,7 +77,7 @@ sub scanmanpage {
push @m, $w; push @m, $w;
} }
} }
close(M); close($mh);
foreach my $m (@words) { foreach my $m (@words) {
my @g = grep(/$m/, @m); my @g = grep(/$m/, @m);
@ -88,22 +88,24 @@ sub scanmanpage {
} }
} }
my $r;
# check for define alises # check for define alises
open(R, "<$curlh") || open($r, "<", "$curlh") ||
die "no curl.h"; die "no curl.h";
while(<R>) { while(<$r>) {
if(/^\#define (CURL(OPT|INFO|MOPT)_\w+) (.*)/) { if(/^\#define (CURL(OPT|INFO|MOPT)_\w+) (.*)/) {
$alias{$1}=$3; $alias{$1}=$3;
} }
} }
close(R); close($r);
my @curlopt; my @curlopt;
my @curlinfo; my @curlinfo;
my @curlmopt; my @curlmopt;
open(R, "<$syms") || open($r, "<", "$syms") ||
die "no input file"; die "no input file";
while(<R>) { while(<$r>) {
chomp; chomp;
my $l= $_; my $l= $_;
if($l =~ /(CURL(OPT|INFO|MOPT)_\w+) *([0-9.]*) *([0-9.-]*) *([0-9.]*)/) { 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_setopt.3", @curlopt);
scanmanpage("$root/docs/libcurl/curl_easy_getinfo.3", @curlinfo); 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! # 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"; die "no input file";
my $list; my $list;
my @getparam; # store all parsed parameters my @getparam; # store all parsed parameters
while(<R>) { while(<$r>) {
chomp; chomp;
my $l= $_; my $l= $_;
if(/struct LongShort aliases/) { 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 # 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 # 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"; die "no input file";
my @manpage; # store all parsed parameters my @manpage; # store all parsed parameters
while(<R>) { while(<$r>) {
chomp; chomp;
my $l= $_; my $l= $_;
$l =~ s/\\-/-/g; $l =~ s/\\-/-/g;
@ -235,15 +237,15 @@ while(<R>) {
} }
} }
} }
close(R); close($r);
######################################################################### #########################################################################
# parse the curl code that outputs the curl -h list # 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"; die "no input file";
my @toolhelp; # store all parsed parameters my @toolhelp; # store all parsed parameters
while(<R>) { while(<$r>) {
chomp; chomp;
my $l= $_; my $l= $_;
if(/^ \{\" *(.*)/) { if(/^ \{\" *(.*)/) {
@ -264,7 +266,7 @@ while(<R>) {
} }
} }
close(R); close($r);
# #
# Now we have three arrays with options to cross-reference. # Now we have three arrays with options to cross-reference.

14
tests/manpage-syntax.pl
View File

@ -75,9 +75,9 @@ my %deprecated = (
CURLINFO_SSL_DATA_OUT => 1, CURLINFO_SSL_DATA_OUT => 1,
); );
sub allsymbols { sub allsymbols {
open(F, "<$symbolsinversions") || open(my $f, "<", "$symbolsinversions") ||
die "$symbolsinversions: $|"; die "$symbolsinversions: $|";
while(<F>) { while(<$f>) {
if($_ =~ /^([^ ]*) +(.*)/) { if($_ =~ /^([^ ]*) +(.*)/) {
my ($name, $info) = ($1, $2); my ($name, $info) = ($1, $2);
$symbol{$name}=$name; $symbol{$name}=$name;
@ -87,7 +87,7 @@ sub allsymbols {
} }
} }
} }
close(F); close($f);
} }
sub scanmanpage { sub scanmanpage {
@ -102,7 +102,7 @@ sub scanmanpage {
my @sh; my @sh;
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/) { if($file =~ /[\/\\](CURL|curl_)[^\/\\]*.3/) {
# This is a man page for libcurl. It requires an example! # This is a man page for libcurl. It requires an example!
$reqex = 1; $reqex = 1;
@ -111,11 +111,11 @@ sub scanmanpage {
} }
} }
my $line = 1; my $line = 1;
while(<M>) { while(<$m>) {
chomp; chomp;
if($_ =~ /^.so /) { if($_ =~ /^.so /) {
# this man page is just a referral # this man page is just a referral
close(M); close($m);
return; return;
} }
if(($_ =~ /^\.SH SYNOPSIS/i) && ($reqex)) { if(($_ =~ /^\.SH SYNOPSIS/i) && ($reqex)) {
@ -200,7 +200,7 @@ sub scanmanpage {
} }
$line++; $line++;
} }
close(M); close($m);
if($reqex) { if($reqex) {
# only for libcurl options man-pages # only for libcurl options man-pages

6
tests/markdown-uppercase.pl
View File

@ -38,11 +38,11 @@ sub checkfile {
if($f !~ /\.md\z/) { if($f !~ /\.md\z/) {
return; return;
} }
open(F, "<$f"); open(my $fh, "<", "$f");
my $l = 1; my $l = 1;
my $prevl; my $prevl;
my $ignore = 0; my $ignore = 0;
while(<F>) { while(<$fh>) {
my $line = $_; my $line = $_;
chomp $line; chomp $line;
if($line =~ /^(\`\`\`|\~\~\~)/) { if($line =~ /^(\`\`\`|\~\~\~)/) {
@ -86,7 +86,7 @@ sub checkfile {
$prevl = $line; $prevl = $line;
$l++; $l++;
} }
close(F); close($fh);
} }

8
tests/mem-include-scan.pl
View File

@ -43,8 +43,8 @@ sub scanfile {
print STDERR "checking $file...\n"; print STDERR "checking $file...\n";
open(F, "<$file"); open(my $f, "<", "$file");
while(<F>) { while(<$f>) {
if($_ =~ /\W(free|alloc|strdup)\(/) { if($_ =~ /\W(free|alloc|strdup)\(/) {
$memfunc++; $memfunc++;
} }
@ -56,14 +56,14 @@ sub scanfile {
} }
elsif($_ =~ /mem-include-scan/) { elsif($_ =~ /mem-include-scan/) {
# free pass # free pass
close(F); close($f);
return 0; return 0;
} }
if($memfunc && $memdebug && $curlmem) { if($memfunc && $memdebug && $curlmem) {
last; last;
} }
} }
close(F); close($f);
if($memfunc) { if($memfunc) {

10
tests/memanalyze.pl
View File

@ -81,22 +81,22 @@ if(! -f $file) {
exit; exit;
} }
open(FILE, "<$file"); open(my $fileh, "<", "$file");
if($showlimit) { if($showlimit) {
while(<FILE>) { while(<$fileh>) {
if(/^LIMIT.*memlimit$/) { if(/^LIMIT.*memlimit$/) {
print $_; print $_;
last; last;
} }
} }
close(FILE); close($fileh);
exit; exit;
} }
my $lnum=0; my $lnum=0;
while(<FILE>) { while(<$fileh>) {
chomp $_; chomp $_;
$line = $_; $line = $_;
$lnum++; $lnum++;
@ -375,7 +375,7 @@ while(<FILE>) {
print "Not recognized prefix line: $line\n"; print "Not recognized prefix line: $line\n";
} }
} }
close(FILE); close($fileh);
if($totalmem) { if($totalmem) {
print "Leak detected: memory still allocated: $totalmem bytes\n"; print "Leak detected: memory still allocated: $totalmem bytes\n";

6
tests/nroff-scan.pl
View File

@ -56,10 +56,10 @@ sub manpresent {
sub file { sub file {
my ($f) = @_; my ($f) = @_;
open(F, "<$f") || open(my $fh, "<", "$f") ||
die "no file"; die "no file";
my $line = 1; my $line = 1;
while(<F>) { while(<$fh>) {
chomp; chomp;
my $l = $_; my $l = $_;
while($l =~ s/\\f(.)([^ ]*)\\f(.)//) { while($l =~ s/\\f(.)([^ ]*)\\f(.)//) {
@ -100,7 +100,7 @@ sub file {
} }
$line++; $line++;
} }
close(F); close($fh);
} }
foreach my $f (@f) { foreach my $f (@f) {

16
tests/option-check.pl
View File

@ -31,15 +31,15 @@ sub showline {
my $root = $ARGV[0]; my $root = $ARGV[0];
open(F, "perl $root/lib/optiontable.pl < $root/include/curl/curl.h|"); open(my $fh, "-|", "perl $root/lib/optiontable.pl < $root/include/curl/curl.h");
binmode F; binmode $fh;
my @gen=<F>; my @gen=<$fh>;
close(F); close($fh);
open(F, "<$root/lib/easyoptions.c"); open($fh, "<", "$root/lib/easyoptions.c");
binmode F; binmode $fh;
my @file=<F>; my @file=<$fh>;
close(F); close($fh);
if(join("", @gen) ne join("", @file)) { if(join("", @gen) ne join("", @file)) {
print "easyoptions.c need to be regenerated!\n"; print "easyoptions.c need to be regenerated!\n";

11
tests/options-scan.pl
View File

@ -50,8 +50,8 @@ sub cmdfiles {
sub mentions { sub mentions {
my ($f) = @_; my ($f) = @_;
my @options; my @options;
open(F, "<$f"); open(my $fh, "<", "$f");
while(<F>) { while(<$fh>) {
chomp; chomp;
if(/(.*) +([0-9.]+)/) { if(/(.*) +([0-9.]+)/) {
my ($flag, $version)=($1, $2); my ($flag, $version)=($1, $2);
@ -71,13 +71,14 @@ sub mentions {
$oiv{$flag} = $version; $oiv{$flag} = $version;
} }
} }
close($fh);
return @options; return @options;
} }
sub versioncheck { sub versioncheck {
my ($f, $v)=@_; my ($f, $v)=@_;
open(F, "<$cmddir/$f.d"); open(my $fh, "<", "$cmddir/$f.d");
while(<F>) { while(<$fh>) {
chomp; chomp;
if(/^Added: ([0-9.]+)/) { if(/^Added: ([0-9.]+)/) {
if($1 ne $v) { if($1 ne $v) {
@ -87,7 +88,7 @@ sub versioncheck {
last; last;
} }
} }
close(F); close($fh);
} }
# get all the files # get all the files

183
tests/runtests.pl
View File

@ -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 # provide defaults from our config file for ENV vars not explicitly
# set by the caller # set by the caller
if (open(my $fd, "< config")) { if (open(my $fd, "<", "config")) {
while(my $line = <$fd>) { while(my $line = <$fd>) {
next if ($line =~ /^#/); next if ($line =~ /^#/);
chomp $line; chomp $line;
@ -460,9 +460,9 @@ sub startnew {
# Ugly hack but ssh client and gnutls-serv don't support pid files # Ugly hack but ssh client and gnutls-serv don't support pid files
if ($fake) { if ($fake) {
if(open(OUT, ">$pidfile")) { if(open(my $out, ">", "$pidfile")) {
print OUT $child . "\n"; print $out $child . "\n";
close(OUT) || die "Failure writing pidfile"; close($out) || die "Failure writing pidfile";
logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose); logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
} }
else { else {
@ -478,9 +478,9 @@ sub startnew {
my $count = $timeout; my $count = $timeout;
while($count--) { while($count--) {
if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) { if(-f $pidfile && -s $pidfile && open(my $pidh, "<", "$pidfile")) {
$pid2 = 0 + <PID>; $pid2 = 0 + <$pidh>;
close(PID); close($pidh);
if(($pid2 > 0) && pidexists($pid2)) { if(($pid2 > 0) && pidexists($pid2)) {
# if $pid2 is valid, then make sure this pid is alive, as # if $pid2 is valid, then make sure this pid is alive, as
# otherwise it is just likely to be the _previous_ pidfile or # otherwise it is just likely to be the _previous_ pidfile or
@ -534,15 +534,15 @@ my $disttests = "";
sub get_disttests { sub get_disttests {
# If a non-default $TESTDIR is being used there may not be any # If a non-default $TESTDIR is being used there may not be any
# Makefile.inc in which case there's nothing to do. # Makefile.inc in which case there's nothing to do.
open(D, "<$TESTDIR/Makefile.inc") or return; open(my $dh, "<", "$TESTDIR/Makefile.inc") or return;
while(<D>) { while(<$dh>) {
chomp $_; chomp $_;
if(($_ =~ /^#/) ||($_ !~ /test/)) { if(($_ =~ /^#/) ||($_ !~ /test/)) {
next; next;
} }
$disttests .= $_; $disttests .= $_;
} }
close(D); close($dh);
} }
####################################################################### #######################################################################
@ -886,21 +886,21 @@ sub verifyhttp {
if($res && $verbose) { if($res && $verbose) {
logmsg "RUN: curl command returned $res\n"; logmsg "RUN: curl command returned $res\n";
if(open(FILE, "<$verifylog")) { if(open(my $file, "<", "$verifylog")) {
while(my $string = <FILE>) { while(my $string = <$file>) {
logmsg "RUN: $string" if($string !~ /^([ \t]*)$/); logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
} }
close(FILE); close($file);
} }
} }
my $data; my $data;
if(open(FILE, "<$verifyout")) { if(open(my $file, "<", "$verifyout")) {
while(my $string = <FILE>) { while(my $string = <$file>) {
$data = $string; $data = $string;
last; # only want first line last; # only want first line
} }
close(FILE); close($file);
} }
if($data && ($data =~ /WE ROOLZ: (\d+)/)) { if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
@ -1029,21 +1029,21 @@ sub verifyrtsp {
if($res && $verbose) { if($res && $verbose) {
logmsg "RUN: curl command returned $res\n"; logmsg "RUN: curl command returned $res\n";
if(open(FILE, "<$verifylog")) { if(open(my $file, "<", "$verifylog")) {
while(my $string = <FILE>) { while(my $string = <$file>) {
logmsg "RUN: $string" if($string !~ /^[ \t]*$/); logmsg "RUN: $string" if($string !~ /^[ \t]*$/);
} }
close(FILE); close($file);
} }
} }
my $data; my $data;
if(open(FILE, "<$verifyout")) { if(open(my $file, "<", "$verifyout")) {
while(my $string = <FILE>) { while(my $string = <$file>) {
$data = $string; $data = $string;
last; # only want first line last; # only want first line
} }
close(FILE); close($file);
} }
if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) { if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
@ -1071,9 +1071,9 @@ sub verifyssh {
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
my $pidfile = server_pidfilename($proto, $ipvnum, $idnum); my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
my $pid = 0; my $pid = 0;
if(open(FILE, "<$pidfile")) { if(open(my $file, "<", "$pidfile")) {
$pid=0+<FILE>; $pid=0+<$file>;
close(FILE); close($file);
} }
if($pid > 0) { if($pid > 0) {
# if we have a pid it is actually our ssh server, # 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 $cmd = "\"$sftp\" -b $sftpcmds -F $sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
my $res = runclient($cmd); my $res = runclient($cmd);
# Search for pwd command response in log file # Search for pwd command response in log file
if(open(SFTPLOGFILE, "<$sftplog")) { if(open(my $sftplogfile, "<", "$sftplog")) {
while(<SFTPLOGFILE>) { while(<$sftplogfile>) {
if(/^Remote working directory: /) { if(/^Remote working directory: /) {
$verified = 1; $verified = 1;
last; last;
} }
} }
close(SFTPLOGFILE); close($sftplogfile);
} }
return $verified; return $verified;
} }
@ -1172,25 +1172,25 @@ sub verifyhttptls {
if($res && $verbose) { if($res && $verbose) {
logmsg "RUN: curl command returned $res\n"; logmsg "RUN: curl command returned $res\n";
if(open(FILE, "<$verifylog")) { if(open(my $file, "<", "$verifylog")) {
while(my $string = <FILE>) { while(my $string = <$file>) {
logmsg "RUN: $string" if($string !~ /^([ \t]*)$/); logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
} }
close(FILE); close($file);
} }
} }
my $data; my $data;
if(open(FILE, "<$verifyout")) { if(open(my $file, "<", "$verifyout")) {
while(my $string = <FILE>) { while(my $string = <$file>) {
$data .= $string; $data .= $string;
} }
close(FILE); close($file);
} }
if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(FILE, "<$pidfile")) { if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(my $file, "<", "$pidfile")) {
$pid=0+<FILE>; $pid=0+<$file>;
close(FILE); close($file);
if($pid > 0) { if($pid > 0) {
# if we have a pid it is actually our httptls server, # if we have a pid it is actually our httptls server,
# since runhttptlsserver() unlinks previous pidfile # since runhttptlsserver() unlinks previous pidfile
@ -1223,9 +1223,9 @@ sub verifysocks {
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
my $pidfile = server_pidfilename($proto, $ipvnum, $idnum); my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
my $pid = 0; my $pid = 0;
if(open(FILE, "<$pidfile")) { if(open(my $file, "<", "$pidfile")) {
$pid=0+<FILE>; $pid=0+<$file>;
close(FILE); close($file);
} }
if($pid > 0) { if($pid > 0) {
# if we have a pid it is actually our socks server, # 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"; my $hstpubmd5f = "curl_host_rsa_key.pub_md5";
if(!open(PUBMD5FILE, "<", $hstpubmd5f) || my $hostfile;
(read(PUBMD5FILE, $SSHSRVMD5, 32) != 32) || if(!open($hostfile, "<", $hstpubmd5f) ||
!close(PUBMD5FILE) || (read($hostfile, $SSHSRVMD5, 32) != 32) ||
!close($hostfile) ||
($SSHSRVMD5 !~ /^[a-f0-9]{32}$/i)) ($SSHSRVMD5 !~ /^[a-f0-9]{32}$/i))
{ {
my $msg = "Fatal: $srvrname pubkey md5 missing : \"$hstpubmd5f\" : $!"; my $msg = "Fatal: $srvrname pubkey md5 missing : \"$hstpubmd5f\" : $!";
@ -2304,9 +2305,9 @@ sub runsshserver {
} }
my $hstpubsha256f = "curl_host_rsa_key.pub_sha256"; my $hstpubsha256f = "curl_host_rsa_key.pub_sha256";
if(!open(PUBSHA256FILE, "<", $hstpubsha256f) || if(!open($hostfile, "<", $hstpubsha256f) ||
(read(PUBSHA256FILE, $SSHSRVSHA256, 48) == 0) || (read($hostfile, $SSHSRVSHA256, 48) == 0) ||
!close(PUBSHA256FILE)) !close($hostfile))
{ {
my $msg = "Fatal: $srvrname pubkey sha256 missing : \"$hstpubsha256f\" : $!"; my $msg = "Fatal: $srvrname pubkey sha256 missing : \"$hstpubsha256f\" : $!";
logmsg "$msg\n"; logmsg "$msg\n";
@ -2895,13 +2896,13 @@ sub checksystemfeatures {
$versretval = runclient($versioncmd); $versretval = runclient($versioncmd);
$versnoexec = $!; $versnoexec = $!;
open(VERSOUT, "<$curlverout"); open(my $versout, "<", "$curlverout");
@version = <VERSOUT>; @version = <$versout>;
close(VERSOUT); close($versout);
open(DISABLED, "server/disabled".exe_ext('TOOL')."|"); open(my $disabledh, "-|", "server/disabled".exe_ext('TOOL'));
@disabled = <DISABLED>; @disabled = <$disabledh>;
close(DISABLED); close($disabledh);
if($disabled[0]) { if($disabled[0]) {
s/[\r\n]//g for @disabled; s/[\r\n]//g for @disabled;
@ -3140,14 +3141,14 @@ sub checksystemfeatures {
} }
if(-r "../lib/curl_config.h") { if(-r "../lib/curl_config.h") {
open(CONF, "<../lib/curl_config.h"); open(my $conf, "<", "../lib/curl_config.h");
while(<CONF>) { while(<$conf>) {
if($_ =~ /^\#define HAVE_GETRLIMIT/) { if($_ =~ /^\#define HAVE_GETRLIMIT/) {
# set if system has getrlimit() # set if system has getrlimit()
$feature{"getrlimit"} = 1; $feature{"getrlimit"} = 1;
} }
} }
close(CONF); close($conf);
} }
# disable this feature unless debug mode is also enabled # disable this feature unless debug mode is also enabled
@ -3180,8 +3181,8 @@ sub checksystemfeatures {
$http_unix = 1 if($sws[0] =~ /unix/); $http_unix = 1 if($sws[0] =~ /unix/);
} }
open(M, "$CURL -M 2>&1|"); open(my $manh, "-|", "$CURL -M 2>&1");
while(my $s = <M>) { while(my $s = <$manh>) {
if($s =~ /built-in manual was disabled at build-time/) { if($s =~ /built-in manual was disabled at build-time/) {
$feature{"manual"} = 0; $feature{"manual"} = 0;
last; last;
@ -3189,7 +3190,7 @@ sub checksystemfeatures {
$feature{"manual"} = 1; $feature{"manual"} = 1;
last; last;
} }
close(M); close($manh);
$feature{"unittest"} = $feature{"debug"}; $feature{"unittest"} = $feature{"debug"};
$feature{"nghttpx"} = !!$ENV{'NGHTTPX'}; $feature{"nghttpx"} = !!$ENV{'NGHTTPX'};
@ -3813,11 +3814,11 @@ sub singletest_preprocess {
@entiretest = prepro($testnum, @entiretest); @entiretest = prepro($testnum, @entiretest);
# save the new version # 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) { 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 # in case the process changed the file, reload it
loadtest("log/test${testnum}"); loadtest("log/test${testnum}");
@ -3977,14 +3978,14 @@ sub singletest_prepare {
mkdir $d; # 0777 mkdir $d; # 0777
} }
} }
open(OUTFILE, ">$filename"); open(my $outfile, ">", "$filename");
binmode OUTFILE; # for crapage systems, use binary binmode $outfile; # for crapage systems, use binary
if($fileattr{'nonewline'}) { if($fileattr{'nonewline'}) {
# cut off the final newline # cut off the final newline
chomp($fileContent); chomp($fileContent);
} }
print OUTFILE $fileContent; print $outfile $fileContent;
close(OUTFILE); close($outfile);
} }
} }
return ($why, 0); return ($why, 0);
@ -4150,20 +4151,20 @@ sub singletest_run {
logmsg "$CMDLINE\n"; logmsg "$CMDLINE\n";
} }
open(CMDLOG, ">", "$LOGDIR/$CURLLOG") || die "Failure writing log file"; open(my $cmdlog, ">", "$LOGDIR/$CURLLOG") || die "Failure writing log file";
print CMDLOG "$CMDLINE\n"; print $cmdlog "$CMDLINE\n";
close(CMDLOG) || die "Failure writing log file"; close($cmdlog) || die "Failure writing log file";
my $dumped_core; my $dumped_core;
my $cmdres; my $cmdres;
if($gdbthis) { if($gdbthis) {
my $gdbinit = "$TESTDIR/gdbinit$testnum"; my $gdbinit = "$TESTDIR/gdbinit$testnum";
open(GDBCMD, ">$LOGDIR/gdbcmd") || die "Failure writing gdb file"; open(my $gdbcmd, ">", "$LOGDIR/gdbcmd") || die "Failure writing gdb file";
print GDBCMD "set args $cmdargs\n"; print $gdbcmd "set args $cmdargs\n";
print GDBCMD "show args\n"; print $gdbcmd "show args\n";
print GDBCMD "source $gdbinit\n" if -e $gdbinit; print $gdbcmd "source $gdbinit\n" if -e $gdbinit;
close(GDBCMD) || die "Failure writing gdb file"; close($gdbcmd) || die "Failure writing gdb file";
} }
# Flush output. # Flush output.
@ -4211,9 +4212,9 @@ sub singletest_clean {
logmsg "core dumped\n"; logmsg "core dumped\n";
if(0 && $gdb) { if(0 && $gdb) {
logmsg "running gdb for post-mortem analysis:\n"; logmsg "running gdb for post-mortem analysis:\n";
open(GDBCMD, ">$LOGDIR/gdbcmd2") || die "Failure writing gdb file"; open(my $gdbcmd, ">", "$LOGDIR/gdbcmd2") || die "Failure writing gdb file";
print GDBCMD "bt\n"; print $gdbcmd "bt\n";
close(GDBCMD) || die "Failure writing gdb file"; close($gdbcmd) || die "Failure writing gdb file";
runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core "); runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
# unlink("$LOGDIR/gdbcmd2"); # unlink("$LOGDIR/gdbcmd2");
} }
@ -6009,10 +6010,10 @@ if(!$randseed) {
localtime(time); localtime(time);
# seed of the month. December 2019 becomes 201912 # seed of the month. December 2019 becomes 201912
$randseed = ($year+1900)*100 + $mon+1; $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!"; die "could not get curl version!";
my @c = <C>; my @c = <$curlvh>;
close(C); close($curlvh) || die "could not get curl version!";
# use the first line of output and get the md5 out of it # use the first line of output and get the md5 out of it
my $str = md5($c[0]); my $str = md5($c[0]);
$randseed += unpack('S', $str); # unsigned 16 bit value $randseed += unpack('S', $str); # unsigned 16 bit value
@ -6040,13 +6041,13 @@ if($valgrind) {
if (($? >> 8)==0) { if (($? >> 8)==0) {
$valgrind_tool="--tool=memcheck"; $valgrind_tool="--tool=memcheck";
} }
open(C, "<$CURL"); open(my $curlh, "<", "$CURL");
my $l = <C>; my $l = <$curlh>;
if($l =~ /^\#\!/) { if($l =~ /^\#\!/) {
# A shell script. This is typically when built with libtool, # A shell script. This is typically when built with libtool,
$valgrind="../libtool --mode=execute $valgrind"; $valgrind="../libtool --mode=execute $valgrind";
} }
close(C); close($curlh);
# valgrind 3 renamed the --logfile option to --log-file!!! # valgrind 3 renamed the --logfile option to --log-file!!!
my $ver=join(' ', runclientoutput("valgrind --version")); my $ver=join(' ', runclientoutput("valgrind --version"));
@ -6064,10 +6065,10 @@ if($valgrind) {
if ($gdbthis) { if ($gdbthis) {
# open the executable curl and read the first 4 bytes of it # open the executable curl and read the first 4 bytes of it
open(CHECK, "<$CURL"); open(my $check, "<", "$CURL");
my $c; my $c;
sysread CHECK, $c, 4; sysread $check, $c, 4;
close(CHECK); close($check);
if($c eq "#! /") { if($c eq "#! /") {
# A shell script. This is typically when built with libtool, # A shell script. This is typically when built with libtool,
$libtool = 1; $libtool = 1;
@ -6112,15 +6113,15 @@ sub disabledtests {
my ($file) = @_; my ($file) = @_;
my @input; my @input;
if(open(D, "<$file")) { if(open(my $disabledh, "<", "$file")) {
while(<D>) { while(<$disabledh>) {
if(/^ *\#/) { if(/^ *\#/) {
# allow comments # allow comments
next; next;
} }
push @input, $_; push @input, $_;
} }
close(D); close($disabledh);
# preprocess the input to make conditionally disabled tests depending # preprocess the input to make conditionally disabled tests depending
# on variables # on variables
@ -6214,11 +6215,11 @@ if($scrambleorder) {
# and excessively long files are elided # and excessively long files are elided
sub displaylogcontent { sub displaylogcontent {
my ($file)=@_; my ($file)=@_;
if(open(SINGLE, "<$file")) { if(open(my $single, "<", "$file")) {
my $linecount = 0; my $linecount = 0;
my $truncate; my $truncate;
my @tail; my @tail;
while(my $string = <SINGLE>) { while(my $string = <$single>) {
$string =~ s/\r\n/\n/g; $string =~ s/\r\n/\n/g;
$string =~ s/[\r\f\032]/\n/g; $string =~ s/[\r\f\032]/\n/g;
$string .= "\n" unless ($string =~ /\n$/); $string .= "\n" unless ($string =~ /\n$/);
@ -6234,7 +6235,7 @@ sub displaylogcontent {
$truncate = $linecount > 1000; $truncate = $linecount > 1000;
} }
} }
close(SINGLE); close($single);
if(@tail) { if(@tail) {
my $tailshow = 200; my $tailshow = 200;
my $tailskip = 0; my $tailskip = 0;

34
tests/secureserver.pl
View File

@ -277,26 +277,26 @@ if($stunnel_version >= 400) {
$SIG{INT} = \&exit_signal_handler; $SIG{INT} = \&exit_signal_handler;
$SIG{TERM} = \&exit_signal_handler; $SIG{TERM} = \&exit_signal_handler;
# stunnel configuration file # stunnel configuration file
if(open(STUNCONF, ">$conffile")) { if(open(my $stunconf, ">", "$conffile")) {
print STUNCONF "CApath = $capath\n"; print $stunconf "CApath = $capath\n";
print STUNCONF "cert = $certfile\n"; print $stunconf "cert = $certfile\n";
print STUNCONF "debug = $loglevel\n"; print $stunconf "debug = $loglevel\n";
print STUNCONF "socket = $socketopt\n"; print $stunconf "socket = $socketopt\n";
if($fips_support) { if($fips_support) {
# disable fips in case OpenSSL doesn't support it # disable fips in case OpenSSL doesn't support it
print STUNCONF "fips = no\n"; print $stunconf "fips = no\n";
} }
if(!$tstunnel_windows) { if(!$tstunnel_windows) {
# do not use Linux-specific options on Windows # do not use Linux-specific options on Windows
print STUNCONF "output = $logfile\n"; print $stunconf "output = $logfile\n";
print STUNCONF "pid = $pidfile\n"; print $stunconf "pid = $pidfile\n";
print STUNCONF "foreground = yes\n"; print $stunconf "foreground = yes\n";
} }
print STUNCONF "\n"; print $stunconf "\n";
print STUNCONF "[curltest]\n"; print $stunconf "[curltest]\n";
print STUNCONF "accept = $accept_port\n"; print $stunconf "accept = $accept_port\n";
print STUNCONF "connect = $target_port\n"; print $stunconf "connect = $target_port\n";
if(!close(STUNCONF)) { if(!close($stunconf)) {
print "$ssltext Error closing file $conffile\n"; print "$ssltext Error closing file $conffile\n";
exit 1; exit 1;
} }
@ -338,9 +338,9 @@ print STDERR "RUN: $cmd\n" if($verbose);
# #
if($tstunnel_windows) { if($tstunnel_windows) {
# Fake pidfile for tstunnel on Windows. # Fake pidfile for tstunnel on Windows.
if(open(OUT, ">$pidfile")) { if(open(my $out, ">", "$pidfile")) {
print OUT $$ . "\n"; print $out $$ . "\n";
close(OUT); close($out);
} }
# Flush output. # Flush output.

12
tests/sshhelp.pm
View File

@ -210,12 +210,12 @@ sub dump_array {
if(!$filename) { if(!$filename) {
$error = 'Error: Missing argument 1 for dump_array()'; $error = 'Error: Missing argument 1 for dump_array()';
} }
elsif(open(TEXTFH, ">$filename")) { elsif(open(my $textfh, ">", "$filename")) {
foreach my $line (@arr) { foreach my $line (@arr) {
$line .= "\n" if($line !~ /\n$/); $line .= "\n" if($line !~ /\n$/);
print TEXTFH $line; print $textfh $line;
} }
if(!close(TEXTFH)) { if(!close($textfh)) {
$error = "Error: cannot close file $filename"; $error = "Error: cannot close file $filename";
} }
} }
@ -243,11 +243,11 @@ sub logmsg {
sub display_file { sub display_file {
my $filename = $_[0]; my $filename = $_[0];
print "=== Start of file $filename\n"; print "=== Start of file $filename\n";
if(open(DISPLAYFH, "<$filename")) { if(open(my $displayfh, "<", "$filename")) {
while(my $line = <DISPLAYFH>) { while(my $line = <$displayfh>) {
print "$line"; print "$line";
} }
close DISPLAYFH; close $displayfh;
} }
print "=== End of file $filename\n"; print "=== End of file $filename\n";
} }

36
tests/sshserver.pl
View File

@ -387,23 +387,23 @@ if((! -e $hstprvkeyf) || (! -s $hstprvkeyf) ||
system "chmod 600 $hstprvkeyf"; system "chmod 600 $hstprvkeyf";
system "chmod 600 $cliprvkeyf"; system "chmod 600 $cliprvkeyf";
# Save md5 and sha256 hashes of public host key # Save md5 and sha256 hashes of public host key
open(RSAKEYFILE, "<$hstpubkeyf"); open(my $rsakeyfile, "<", "$hstpubkeyf");
my @rsahostkey = do { local $/ = ' '; <RSAKEYFILE> }; my @rsahostkey = do { local $/ = ' '; <$rsakeyfile> };
close(RSAKEYFILE); close($rsakeyfile);
if(!$rsahostkey[1]) { if(!$rsahostkey[1]) {
logmsg 'Failed parsing base64 encoded RSA host key'; logmsg 'Failed parsing base64 encoded RSA host key';
exit 1; exit 1;
} }
open(PUBMD5FILE, ">$hstpubmd5f"); open(my $pubmd5file, ">", "$hstpubmd5f");
print PUBMD5FILE md5_hex(decode_base64($rsahostkey[1])); print $pubmd5file md5_hex(decode_base64($rsahostkey[1]));
close(PUBMD5FILE); close($pubmd5file);
if((! -e $hstpubmd5f) || (! -s $hstpubmd5f)) { if((! -e $hstpubmd5f) || (! -s $hstpubmd5f)) {
logmsg 'Failed writing md5 hash of RSA host key'; logmsg 'Failed writing md5 hash of RSA host key';
exit 1; exit 1;
} }
open(PUBSHA256FILE, ">$hstpubsha256f"); open(my $pubsha256file, ">", "$hstpubsha256f");
print PUBSHA256FILE sha256_base64(decode_base64($rsahostkey[1])); print $pubsha256file sha256_base64(decode_base64($rsahostkey[1]));
close(PUBSHA256FILE); close($pubsha256file);
if((! -e $hstpubsha256f) || (! -s $hstpubsha256f)) { if((! -e $hstpubsha256f) || (! -s $hstpubsha256f)) {
logmsg 'Failed writing sha256 hash of RSA host key'; logmsg 'Failed writing sha256 hash of RSA host key';
exit 1; exit 1;
@ -780,12 +780,12 @@ if(system "\"$sshd\" -t -f $sshdconfig > $sshdlog 2>&1") {
if((! -e $knownhosts) || (! -s $knownhosts)) { if((! -e $knownhosts) || (! -s $knownhosts)) {
logmsg 'generating ssh client known hosts file...' if($verbose); logmsg 'generating ssh client known hosts file...' if($verbose);
unlink($knownhosts); unlink($knownhosts);
if(open(RSAKEYFILE, "<$hstpubkeyf")) { if(open(my $rsakeyfile, "<", "$hstpubkeyf")) {
my @rsahostkey = do { local $/ = ' '; <RSAKEYFILE> }; my @rsahostkey = do { local $/ = ' '; <$rsakeyfile> };
if(close(RSAKEYFILE)) { if(close($rsakeyfile)) {
if(open(KNOWNHOSTS, ">$knownhosts")) { if(open(my $knownhostsh, ">", "$knownhosts")) {
print KNOWNHOSTS "$listenaddr ssh-rsa $rsahostkey[1]\n"; print $knownhostsh "$listenaddr ssh-rsa $rsahostkey[1]\n";
if(!close(KNOWNHOSTS)) { if(!close($knownhostsh)) {
$error = "Error: cannot close file $knownhosts"; $error = "Error: cannot close file $knownhosts";
} }
} }
@ -1121,9 +1121,9 @@ logmsg "RUN: $cmd" if($verbose);
# #
if ($sshdid =~ /OpenSSH-Windows/) { if ($sshdid =~ /OpenSSH-Windows/) {
# Fake pidfile for ssh server on Windows. # Fake pidfile for ssh server on Windows.
if(open(OUT, ">$pidfile")) { if(open(my $out, ">", "$pidfile")) {
print OUT $$ . "\n"; print $out $$ . "\n";
close(OUT); close($out);
} }
# Flush output. # Flush output.

24
tests/symbol-scan.pl
View File

@ -66,8 +66,8 @@ my %rem;
# included by it, which *should* be all headers # included by it, which *should* be all headers
sub scanenum { sub scanenum {
my ($file) = @_; my ($file) = @_;
open H_IN, "-|", "$Cpreprocessor $i$file" || die "Cannot preprocess $file"; open my $h_in, "-|", "$Cpreprocessor $i$file" || die "Cannot preprocess $file";
while ( <H_IN> ) { while ( <$h_in> ) {
if ( /enum\s+(\S+\s+)?{/ .. /}/ ) { if ( /enum\s+(\S+\s+)?{/ .. /}/ ) {
s/^\s+//; s/^\s+//;
next unless /^CURL/; next unless /^CURL/;
@ -76,18 +76,18 @@ sub scanenum {
push @syms, $_; push @syms, $_;
} }
} }
close H_IN || die "Error preprocessing $file"; close $h_in || die "Error preprocessing $file";
} }
sub scanheader { sub scanheader {
my ($f)=@_; my ($f)=@_;
open H, "<$f"; open my $h, "<", "$f";
while(<H>) { while(<$h>) {
if (/^#define ((LIB|)CURL[A-Za-z0-9_]*)/) { if (/^#define ((LIB|)CURL[A-Za-z0-9_]*)/) {
push @syms, $1; push @syms, $1;
} }
} }
close H; close $h;
} }
sub scanallheaders { sub scanallheaders {
@ -105,9 +105,9 @@ sub scanallheaders {
sub checkmanpage { sub checkmanpage {
my ($m) = @_; my ($m) = @_;
open(M, "<$m"); open(my $mh, "<", "$m");
my $line = 1; my $line = 1;
while(<M>) { while(<$mh>) {
# strip off formatting # strip off formatting
$_ =~ s/\\f[BPRI]//; $_ =~ s/\\f[BPRI]//;
# detect global-looking 'CURL[BLABLA]_*' symbols # detect global-looking 'CURL[BLABLA]_*' symbols
@ -120,7 +120,7 @@ sub checkmanpage {
} }
$line++; $line++;
} }
close(M); close($mh);
} }
sub scanman3dir { sub scanman3dir {
@ -139,8 +139,8 @@ scanallheaders();
scanman3dir("$root/docs/libcurl"); scanman3dir("$root/docs/libcurl");
scanman3dir("$root/docs/libcurl/opts"); scanman3dir("$root/docs/libcurl/opts");
open S, "<$root/docs/libcurl/symbols-in-versions"; open my $s, "<", "$root/docs/libcurl/symbols-in-versions";
while(<S>) { while(<$s>) {
if(/(^[^ \n]+) +(.*)/) { if(/(^[^ \n]+) +(.*)/) {
my ($sym, $rest)=($1, $2); my ($sym, $rest)=($1, $2);
if($doc{$sym}) { if($doc{$sym}) {
@ -157,7 +157,7 @@ while(<S>) {
} }
} }
} }
close S; close $s;
my $ignored=0; my $ignored=0;
for my $e (sort @syms) { for my $e (sort @syms) {

152
tests/testcurl.pl
View File

@ -195,14 +195,14 @@ sub rmtree($) {
sub grepfile($$) { sub grepfile($$) {
my ($target, $fn) = @_; my ($target, $fn) = @_;
open(F, $fn) or die; open(my $fh, "<", $fn) or die;
while (<F>) { while (<$fh>) {
if (/$target/) { if (/$target/) {
close(F); close($fh);
return 1; return 1;
} }
} }
close(F); close($fh);
return 0; return 0;
} }
@ -243,14 +243,14 @@ sub get_host_triplet {
my $triplet; my $triplet;
my $configfile = "$pwd/$build/lib/curl_config.h"; my $configfile = "$pwd/$build/lib/curl_config.h";
if(-f $configfile && -s $configfile && open(LIBCONFIGH, "<$configfile")) { if(-f $configfile && -s $configfile && open(my $libconfigh, "<", "$configfile")) {
while(<LIBCONFIGH>) { while(<$libconfigh>) {
if($_ =~ /^\#define\s+OS\s+"*([^"][^"]*)"*\s*/) { if($_ =~ /^\#define\s+OS\s+"*([^"][^"]*)"*\s*/) {
$triplet = $1; $triplet = $1;
last; last;
} }
} }
close(LIBCONFIGH); close($libconfigh);
} }
return $triplet; return $triplet;
} }
@ -261,13 +261,13 @@ if($name && $email && $desc) {
$infixed=4; $infixed=4;
$fixed=4; $fixed=4;
} }
elsif (open(F, "$setupfile")) { elsif (open(my $f, "<", "$setupfile")) {
while (<F>) { while (<$f>) {
if (/(\w+)=(.*)/) { if (/(\w+)=(.*)/) {
eval "\$$1=$2;"; eval "\$$1=$2;";
} }
} }
close(F); close($f);
$infixed=$fixed; $infixed=$fixed;
} }
else { else {
@ -307,14 +307,14 @@ if (!$confopts) {
if ($fixed < 4) { if ($fixed < 4) {
$fixed=4; $fixed=4;
open(F, ">$setupfile") or die; open(my $f, ">", "$setupfile") or die;
print F "name='$name'\n"; print $f "name='$name'\n";
print F "email='$email'\n"; print $f "email='$email'\n";
print F "desc='$desc'\n"; print $f "desc='$desc'\n";
print F "confopts='$confopts'\n"; print $f "confopts='$confopts'\n";
print F "notes='$notes'\n"; print $f "notes='$notes'\n";
print F "fixed='$fixed'\n"; print $f "fixed='$fixed'\n";
close(F); close($f);
} }
# Enable picky compiler warnings unless explicitly disabled # Enable picky compiler warnings unless explicitly disabled
@ -469,15 +469,15 @@ if ($git) {
# generate the build files # generate the build files
logit "invoke autoreconf"; logit "invoke autoreconf";
open(F, "autoreconf -fi 2>&1 |") or die; open(my $f, "-|", "autoreconf -fi 2>&1") or die;
open(LOG, ">$buildlog") or die; open(my $log, ">", "$buildlog") or die;
while (<F>) { while (<$f>) {
my $ll = $_; my $ll = $_;
print $ll; print $ll;
print LOG $ll; print $log $ll;
} }
close(F); close($f);
close(LOG); close($log);
logit "buildconf was successful"; 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. # 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(F, "<include/curl/curlver.h"))) { (open(my $f, "<", "include/curl/curlver.h"))) {
while (<F>) { while (<$f>) {
chomp; chomp;
if ($_ =~ /^\#define\s+LIBCURL_TIMESTAMP\s+\"(.+)\".*$/) { if ($_ =~ /^\#define\s+LIBCURL_TIMESTAMP\s+\"(.+)\".*$/) {
my $stampstring = $1; my $stampstring = $1;
@ -500,7 +500,7 @@ if ((-f "include/curl/curlver.h") &&
last; last;
} }
} }
close(F); close($f);
} }
# Show timestamp we are using for this test build. # Show timestamp we are using for this test build.
@ -572,21 +572,21 @@ if ($configurebuild) {
if(-f "./libcurl.pc") { if(-f "./libcurl.pc") {
logit_spaced "display libcurl.pc"; logit_spaced "display libcurl.pc";
if(open(F, "<./libcurl.pc")) { if(open(my $f, "<", "libcurl.pc")) {
while(<F>) { while(<$f>) {
my $ll = $_; my $ll = $_;
print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/)); print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/));
} }
close(F); close($f);
} }
} }
logit_spaced "display lib/$confheader"; logit_spaced "display lib/$confheader";
open(F, "lib/$confheader") or die "lib/$confheader: $!"; open(my $f, "<", "lib/$confheader") or die "lib/$confheader: $!";
while (<F>) { while (<$f>) {
print if /^ *#/; print if /^ *#/;
} }
close(F); close($f);
if (($have_embedded_ares) && if (($have_embedded_ares) &&
(grepfile("^#define USE_ARES", "lib/$confheader"))) { (grepfile("^#define USE_ARES", "lib/$confheader"))) {
@ -595,23 +595,23 @@ if (($have_embedded_ares) &&
if(-f "./ares/libcares.pc") { if(-f "./ares/libcares.pc") {
logit_spaced "display ares/libcares.pc"; logit_spaced "display ares/libcares.pc";
if(open(F, "<./ares/libcares.pc")) { if(open($f, "<", "ares/libcares.pc")) {
while(<F>) { while(<$f>) {
my $ll = $_; my $ll = $_;
print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/)); print $ll if(($ll !~ /^ *#/) && ($ll !~ /^ *$/));
} }
close(F); close($f);
} }
} }
if(-f "./ares/ares_build.h") { if(-f "./ares/ares_build.h") {
logit_spaced "display ares/ares_build.h"; logit_spaced "display ares/ares_build.h";
if(open(F, "<./ares/ares_build.h")) { if(open($f, "<", "ares/ares_build.h")) {
while(<F>) { while(<$f>) {
my $ll = $_; my $ll = $_;
print $ll if(($ll =~ /^ *# *define *CARES_/) && ($ll !~ /__CARES_BUILD_H/)); print $ll if(($ll =~ /^ *# *define *CARES_/) && ($ll !~ /__CARES_BUILD_H/));
} }
close(F); close($f);
} }
} }
else { else {
@ -620,11 +620,11 @@ if (($have_embedded_ares) &&
$confheader =~ s/curl/ares/; $confheader =~ s/curl/ares/;
logit_spaced "display ares/$confheader"; logit_spaced "display ares/$confheader";
if(open(F, "ares/$confheader")) { if(open($f, "<", "ares/$confheader")) {
while (<F>) { while (<$f>) {
print if /^ *#/; print if /^ *#/;
} }
close(F); close($f);
} }
print "\n"; print "\n";
@ -633,17 +633,17 @@ if (($have_embedded_ares) &&
if ($targetos && !$configurebuild) { if ($targetos && !$configurebuild) {
logit "$make -f Makefile.$targetos"; 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 { else {
logit "$make"; logit "$make";
open(F, "$make 2>&1 |") or die; open($f, "-|", "$make 2>&1") or die;
} }
while (<F>) { while (<$f>) {
s/$pwd//g; s/$pwd//g;
print; print;
} }
close(F); close($f);
if (-f "libcares$libext") { if (-f "libcares$libext") {
logit "ares is now built successfully (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" : ""); my $mkcmd = "$make -i" . ($targetos && !$configurebuild ? " $targetos" : "");
logit "$mkcmd"; logit "$mkcmd";
open(F, "$mkcmd 2>&1 |") or die; open(my $f, "-|", "$mkcmd 2>&1") or die;
while (<F>) { while (<$f>) {
s/$pwd//g; s/$pwd//g;
print; print;
} }
close(F); close($f);
if (-f "lib/libcurl$libext") { if (-f "lib/libcurl$libext") {
logit "libcurl was created fine (libcurl$libext)"; logit "libcurl was created fine (libcurl$libext)";
@ -681,13 +681,13 @@ else {
if (!$crosscompile || (($extvercmd ne '') && (-x $extvercmd))) { if (!$crosscompile || (($extvercmd ne '') && (-x $extvercmd))) {
logit "display curl${binext} --version output"; logit "display curl${binext} --version output";
my $cmd = ($extvercmd ne '' ? $extvercmd.' ' : '')."./src/curl${binext} --version|"; my $cmd = ($extvercmd ne '' ? $extvercmd.' ' : '')."./src/curl${binext} --version|";
open(F, $cmd); open($f, "<", $cmd);
while(<F>) { while(<$f>) {
# strip CR from output on non-win32 platforms (wine on Linux) # strip CR from output on non-win32 platforms (wine on Linux)
s/\r// if ($^O ne 'MSWin32'); s/\r// if ($^O ne 'MSWin32');
print; print;
} }
close(F); close($f);
} }
if ($configurebuild && !$crosscompile) { if ($configurebuild && !$crosscompile) {
@ -699,15 +699,15 @@ if ($configurebuild && !$crosscompile) {
($host_triplet =~ /([^-]+)-([^-]+)-solaris2(.*)/)) { ($host_triplet =~ /([^-]+)-([^-]+)-solaris2(.*)/)) {
chdir "$pwd/$build/docs/examples"; chdir "$pwd/$build/docs/examples";
logit_spaced "build examples"; logit_spaced "build examples";
open(F, "$make -i 2>&1 |") or die; open($f, "-|", "$make -i 2>&1") or die;
open(LOG, ">$buildlog") or die; open(my $log, ">", "$buildlog") or die;
while (<F>) { while (<$f>) {
s/$pwd//g; s/$pwd//g;
print; print;
print LOG; print $log $_;
} }
close(F); close($f);
close(LOG); close($log);
chdir "$pwd/$build"; chdir "$pwd/$build";
} }
# build and run full test suite # build and run full test suite
@ -716,15 +716,15 @@ if ($configurebuild && !$crosscompile) {
$o = "TEST_F=\"$runtestopts\" "; $o = "TEST_F=\"$runtestopts\" ";
} }
logit "$make -k ${o}test-full"; logit "$make -k ${o}test-full";
open(F, "$make -k ${o}test-full 2>&1 |") or die; open($f, "-|", "$make -k ${o}test-full 2>&1") or die;
open(LOG, ">$buildlog") or die; open(my $log, ">", "$buildlog") or die;
while (<F>) { while (<$f>) {
s/$pwd//g; s/$pwd//g;
print; print;
print LOG; print $log $_;
} }
close(F); close($f);
close(LOG); close($log);
if (grepfile("^TEST", $buildlog)) { if (grepfile("^TEST", $buildlog)) {
logit "tests were run"; logit "tests were run";
@ -746,30 +746,30 @@ else {
($host_triplet =~ /([^-]+)-([^-]+)-android(.*)/)) { ($host_triplet =~ /([^-]+)-([^-]+)-android(.*)/)) {
chdir "$pwd/$build/docs/examples"; chdir "$pwd/$build/docs/examples";
logit_spaced "build examples"; logit_spaced "build examples";
open(F, "$make -i 2>&1 |") or die; open($f, "-|", "$make -i 2>&1") or die;
open(LOG, ">$buildlog") or die; open(my $log, ">", "$buildlog") or die;
while (<F>) { while (<$f>) {
s/$pwd//g; s/$pwd//g;
print; print;
print LOG; print $log $_;
} }
close(F); close($f);
close(LOG); close($log);
chdir "$pwd/$build"; chdir "$pwd/$build";
} }
# build test harness programs for selected cross-compiles # build test harness programs for selected cross-compiles
if($host_triplet =~ /([^-]+)-([^-]+)-mingw(.*)/) { if($host_triplet =~ /([^-]+)-([^-]+)-mingw(.*)/) {
chdir "$pwd/$build/tests"; chdir "$pwd/$build/tests";
logit_spaced "build test harness"; logit_spaced "build test harness";
open(F, "$make -i 2>&1 |") or die; open(my $f, "-|", "$make -i 2>&1") or die;
open(LOG, ">$buildlog") or die; open(my $log, ">", "$buildlog") or die;
while (<F>) { while (<$f>) {
s/$pwd//g; s/$pwd//g;
print; print;
print LOG; print $log $_;
} }
close(F); close($f);
close(LOG); close($log);
chdir "$pwd/$build"; chdir "$pwd/$build";
} }
logit_spaced "cross-compiling, can't run tests"; logit_spaced "cross-compiling, can't run tests";

6
tests/valgrind.pm
View File

@ -30,9 +30,9 @@ use File::Basename;
sub valgrindparse { sub valgrindparse {
my ($file) = @_; my ($file) = @_;
my @o; my @o;
open(VAL, "<$file"); open(my $val, "<", "$file");
@o = <VAL>; @o = <$val>;
close(VAL); close($val);
return @o; return @o;
} }

18
tests/version-scan.pl
View File

@ -39,8 +39,8 @@ my %manname;
my %sourcename; my %sourcename;
my $error=0; my $error=0;
open(M, "<$manpage"); open(my $m, "<", "$manpage");
while(<M>) { while(<$m>) {
if($_ =~ / mask bit: (CURL_VERSION_[A-Z0-9_]+)/i) { if($_ =~ / mask bit: (CURL_VERSION_[A-Z0-9_]+)/i) {
$manversion{$1}++; $manversion{$1}++;
} }
@ -48,23 +48,23 @@ while(<M>) {
$manname{$1}++; $manname{$1}++;
} }
} }
close(M); close($m);
open(H, "<$header"); open(my $h, "<", "$header");
while(<H>) { while(<$h>) {
if($_ =~ /^\#define (CURL_VERSION_[A-Z0-9_]+)/i) { if($_ =~ /^\#define (CURL_VERSION_[A-Z0-9_]+)/i) {
$headerversion{$1}++; $headerversion{$1}++;
} }
} }
close(H); close($h);
open(S, "<$source"); open(my $s, "<", "$source");
while(<S>) { while(<$s>) {
if($_ =~ /FEATURE\("([^"]*)"/) { if($_ =~ /FEATURE\("([^"]*)"/) {
$sourcename{$1}++; $sourcename{$1}++;
} }
} }
close(S); close($s);
for my $h (keys %headerversion) { for my $h (keys %headerversion) {
if(!$manversion{$h}) { if(!$manversion{$h}) {