| #*************************************************************************** |
| # _ _ ____ _ |
| # Project ___| | | | _ \| | |
| # / __| | | | |_) | | |
| # | (__| |_| | _ <| |___ |
| # \___|\___/|_| \_\_____| |
| # |
| # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al. |
| # |
| # This software is licensed as described in the file COPYING, which |
| # you should have received as part of this distribution. The terms |
| # are also available at https://curl.se/docs/copyright.html. |
| # |
| # You may opt to use, copy, modify, merge, publish, distribute and/or sell |
| # copies of the Software, and permit persons to whom the Software is |
| # furnished to do so, under the terms of the COPYING file. |
| # |
| # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY |
| # KIND, either express or implied. |
| # |
| # SPDX-License-Identifier: curl |
| # |
| ########################################################################### |
| |
| # This module contains entry points to run a single test. runner_init |
| # determines whether they will run in a separate process or in the process of |
| # the caller. The relevant interface is asynchronous so it will work in either |
| # case. Program arguments are marshalled and then written to the end of a pipe |
| # (in controlleripccall) which is later read from and the arguments |
| # unmarshalled (in ipcrecv) before the desired function is called normally. |
| # The function return values are then marshalled and written into another pipe |
| # (again in ipcrecv) when is later read from and unmarshalled (in runnerar) |
| # before being returned to the caller. |
| |
| package runner; |
| |
| use strict; |
| use warnings; |
| use 5.006; |
| |
| BEGIN { |
| use base qw(Exporter); |
| |
| our @EXPORT = qw( |
| checktestcmd |
| prepro |
| readtestkeywords |
| restore_test_env |
| runner_init |
| runnerac_clearlocks |
| runnerac_shutdown |
| runnerac_stopservers |
| runnerac_test_preprocess |
| runnerac_test_run |
| runnerar |
| runnerar_ready |
| stderrfilename |
| stdoutfilename |
| $DBGCURL |
| $gdb |
| $gdbthis |
| $gdbxwin |
| $shallow |
| $tortalloc |
| $valgrind_logfile |
| $valgrind_tool |
| ); |
| |
| # these are for debugging only |
| our @EXPORT_OK = qw( |
| singletest_preprocess |
| ); |
| } |
| |
| use B qw( |
| svref_2object |
| ); |
| use Storable qw( |
| freeze |
| thaw |
| ); |
| |
| use pathhelp qw( |
| exe_ext |
| ); |
| use processhelp qw( |
| portable_sleep |
| ); |
| use servers qw( |
| checkcmd |
| clearlocks |
| initserverconfig |
| serverfortest |
| stopserver |
| stopservers |
| subvariables |
| ); |
| use getpart; |
| use globalconfig; |
| use testutil qw( |
| clearlogs |
| logmsg |
| runclient |
| shell_quote |
| subbase64 |
| subnewlines |
| ); |
| use valgrind; |
| |
| |
| ####################################################################### |
| # Global variables set elsewhere but used only by this package |
| # These may only be set *before* runner_init is called |
| our $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging |
| our $valgrind_logfile="--log-file"; # the option name for valgrind >=3 |
| our $valgrind_tool="--tool=memcheck"; |
| our $gdb = checktestcmd("gdb"); |
| our $gdbthis = 0; # run test case with debugger (gdb or lldb) |
| our $gdbxwin; # use windowed gdb when using gdb |
| |
| # torture test variables |
| our $shallow; |
| our $tortalloc; |
| |
| # local variables |
| my %oldenv; # environment variables before test is started |
| my $UNITDIR="./unit"; |
| my $CURLLOG="$LOGDIR/commands.log"; # all command lines run |
| my $defserverlogslocktimeout = 5; # timeout to await server logs lock removal |
| my $defpostcommanddelay = 0; # delay between command and postcheck sections |
| my $multiprocess; # nonzero with a separate test runner process |
| |
| # pipes |
| my $runnerr; # pipe that runner reads from |
| my $runnerw; # pipe that runner writes to |
| |
| # per-runner variables, indexed by runner ID; these are used by controller only |
| my %controllerr; # pipe that controller reads from |
| my %controllerw; # pipe that controller writes to |
| |
| # redirected stdout/stderr to these files |
| sub stdoutfilename { |
| my ($logdir, $testnum)=@_; |
| return "$logdir/stdout$testnum"; |
| } |
| |
| sub stderrfilename { |
| my ($logdir, $testnum)=@_; |
| return "$logdir/stderr$testnum"; |
| } |
| |
| ####################################################################### |
| # Initialize the runner and prepare it to run tests |
| # The runner ID returned by this function must be passed into the other |
| # runnerac_* functions |
| # Called by controller |
| sub runner_init { |
| my ($logdir, $jobs)=@_; |
| |
| $multiprocess = !!$jobs; |
| |
| # enable memory debugging if curl is compiled with it |
| $ENV{'CURL_MEMDEBUG'} = "$logdir/$MEMDUMP"; |
| $ENV{'CURL_ENTROPY'}="12345678"; |
| $ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic |
| $ENV{'CURL_GLOBAL_INIT'}=1; # debug curl_global_init/cleanup use |
| $ENV{'HOME'}=$pwd; |
| $ENV{'CURL_HOME'}=$ENV{'HOME'}; |
| $ENV{'XDG_CONFIG_HOME'}=$ENV{'HOME'}; |
| $ENV{'COLUMNS'}=79; # screen width! |
| |
| # Incorporate the $logdir into the random seed and re-seed the PRNG. |
| # This gives each runner a unique yet consistent seed which provides |
| # more unique port number selection in each runner, yet is deterministic |
| # across runs. |
| $randseed += unpack('%16C*', $logdir); |
| srand $randseed; |
| |
| # create pipes for communication with runner |
| my ($thisrunnerr, $thiscontrollerw, $thiscontrollerr, $thisrunnerw); |
| pipe $thisrunnerr, $thiscontrollerw; |
| pipe $thiscontrollerr, $thisrunnerw; |
| |
| my $thisrunnerid; |
| if($multiprocess) { |
| # Create a separate process in multiprocess mode |
| my $child = fork(); |
| if(0 == $child) { |
| # TODO: set up better signal handlers |
| $SIG{INT} = 'IGNORE'; |
| $SIG{TERM} = 'IGNORE'; |
| eval { |
| # some msys2 perl versions don't define SIGUSR1 |
| $SIG{USR1} = 'IGNORE'; |
| }; |
| |
| $thisrunnerid = $$; |
| print "Runner $thisrunnerid starting\n" if($verbose); |
| |
| # Here we are the child (runner). |
| close($thiscontrollerw); |
| close($thiscontrollerr); |
| $runnerr = $thisrunnerr; |
| $runnerw = $thisrunnerw; |
| |
| # Set this directory as ours |
| $LOGDIR = $logdir; |
| mkdir("$LOGDIR/$PIDDIR", 0777); |
| mkdir("$LOGDIR/$LOCKDIR", 0777); |
| |
| # Initialize various server variables |
| initserverconfig(); |
| |
| # handle IPC calls |
| event_loop(); |
| |
| # Can't rely on logmsg here in case it's buffered |
| print "Runner $thisrunnerid exiting\n" if($verbose); |
| |
| # To reach this point, either the controller has sent |
| # runnerac_stopservers() and runnerac_shutdown() or we have called |
| # runnerabort(). In both cases, there are no more of our servers |
| # running and we can safely exit. |
| exit 0; |
| } |
| |
| # Here we are the parent (controller). |
| close($thisrunnerw); |
| close($thisrunnerr); |
| |
| $thisrunnerid = $child; |
| |
| } else { |
| # Create our pid directory |
| mkdir("$LOGDIR/$PIDDIR", 0777); |
| |
| # Don't create a separate process |
| $thisrunnerid = "integrated"; |
| } |
| |
| $controllerw{$thisrunnerid} = $thiscontrollerw; |
| $runnerr = $thisrunnerr; |
| $runnerw = $thisrunnerw; |
| $controllerr{$thisrunnerid} = $thiscontrollerr; |
| |
| return $thisrunnerid; |
| } |
| |
| ####################################################################### |
| # Loop to execute incoming IPC calls until the shutdown call |
| sub event_loop { |
| while () { |
| if(ipcrecv()) { |
| last; |
| } |
| } |
| } |
| |
| ####################################################################### |
| # Check for a command in the PATH of the machine running curl. |
| # |
| sub checktestcmd { |
| my ($cmd)=@_; |
| my @testpaths=("$LIBDIR/.libs", "$LIBDIR"); |
| return checkcmd($cmd, @testpaths); |
| } |
| |
| # See if Valgrind should actually be used |
| sub use_valgrind { |
| if($valgrind) { |
| my @valgrindoption = getpart("verify", "valgrind"); |
| if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) { |
| return 1; |
| } |
| } |
| return 0; |
| } |
| |
| # Massage the command result code into a useful form |
| sub normalize_cmdres { |
| my $cmdres = $_[0]; |
| my $signal_num = $cmdres & 127; |
| my $dumped_core = $cmdres & 128; |
| |
| if(!$anyway && ($signal_num || $dumped_core)) { |
| $cmdres = 1000; |
| } |
| else { |
| $cmdres >>= 8; |
| $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres); |
| } |
| return ($cmdres, $dumped_core); |
| } |
| |
| # 'prepro' processes the input array and replaces %-variables in the array |
| # etc. Returns the processed version of the array |
| sub prepro { |
| my $testnum = shift; |
| my (@entiretest) = @_; |
| my $show = 1; |
| my @out; |
| my $data_crlf; |
| my @pshow; |
| my @altshow; |
| my $plvl; |
| my $line; |
| for my $s (@entiretest) { |
| my $f = $s; |
| $line++; |
| if($s =~ /^ *%if (.*)/) { |
| my $cond = $1; |
| my $rev = 0; |
| |
| if($cond =~ /^!(.*)/) { |
| $cond = $1; |
| $rev = 1; |
| } |
| $rev ^= $feature{$cond} ? 1 : 0; |
| push @pshow, $show; # push the previous state |
| $plvl++; |
| if($show) { |
| # only if this was showing before we can allow the alternative |
| # to go showing as well |
| push @altshow, $rev ^ 1; # push the reversed show state |
| } |
| else { |
| push @altshow, 0; # the alt should still hide |
| } |
| if($show) { |
| # we only allow show if already showing |
| $show = $rev; |
| } |
| next; |
| } |
| elsif($s =~ /^ *%else/) { |
| if(!$plvl) { |
| print STDERR "error: test$testnum:$line: %else no %if\n"; |
| last; |
| } |
| $show = pop @altshow; |
| push @altshow, $show; # put it back for consistency |
| next; |
| } |
| elsif($s =~ /^ *%endif/) { |
| if(!$plvl--) { |
| print STDERR "error: test$testnum:$line: %endif had no %if\n"; |
| last; |
| } |
| $show = pop @pshow; |
| pop @altshow; # not used here but we must pop it |
| next; |
| } |
| if($show) { |
| # The processor does CRLF replacements in the <data*> sections if |
| # necessary since those parts might be read by separate servers. |
| if($s =~ /^ *<data(.*)\>/) { |
| if($1 =~ /crlf="yes"/ || |
| ($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) { |
| $data_crlf = 1; |
| } |
| } |
| elsif(($s =~ /^ *<\/data/) && $data_crlf) { |
| $data_crlf = 0; |
| } |
| subvariables(\$s, $testnum, "%"); |
| subbase64(\$s); |
| subnewlines(0, \$s) if($data_crlf); |
| push @out, $s; |
| } |
| } |
| return @out; |
| } |
| |
| |
| ####################################################################### |
| # Load test keywords into %keywords hash |
| # |
| sub readtestkeywords { |
| my @info_keywords = getpart("info", "keywords"); |
| |
| # Clear the list of keywords from the last test |
| %keywords = (); |
| for my $k (@info_keywords) { |
| chomp $k; |
| $keywords{$k} = 1; |
| } |
| } |
| |
| |
| ####################################################################### |
| # Return a list of log locks that still exist |
| # |
| sub logslocked { |
| opendir(my $lockdir, "$LOGDIR/$LOCKDIR"); |
| my @locks; |
| foreach (readdir $lockdir) { |
| if(/^(.*)\.lock$/) { |
| push @locks, $1; |
| } |
| } |
| return @locks; |
| } |
| |
| ####################################################################### |
| # Memory allocation test and failure torture testing. |
| # |
| sub torture { |
| my ($testcmd, $testnum, $gdbline) = @_; |
| |
| # remove memdump first to be sure we get a new nice and clean one |
| unlink("$LOGDIR/$MEMDUMP"); |
| |
| # First get URL from test server, ignore the output/result |
| runclient($testcmd); |
| |
| logmsg " CMD: $testcmd\n" if($verbose); |
| |
| # memanalyze -v is our friend, get the number of allocations made |
| my $count=0; |
| my @out = `$memanalyze -v "$LOGDIR/$MEMDUMP"`; |
| for(@out) { |
| if(/^Operations: (\d+)/) { |
| $count = $1; |
| last; |
| } |
| } |
| if(!$count) { |
| logmsg " found no functions to make fail\n"; |
| return 0; |
| } |
| |
| my @ttests = (1 .. $count); |
| if($shallow && ($shallow < $count)) { |
| my $discard = scalar(@ttests) - $shallow; |
| my $percent = sprintf("%.2f%%", $shallow * 100 / scalar(@ttests)); |
| logmsg " $count functions found, but only fail $shallow ($percent)\n"; |
| while($discard) { |
| my $rm; |
| do { |
| # find a test to discard |
| $rm = rand(scalar(@ttests)); |
| } while(!$ttests[$rm]); |
| $ttests[$rm] = undef; |
| $discard--; |
| } |
| } |
| else { |
| logmsg " $count functions to make fail\n"; |
| } |
| |
| for (@ttests) { |
| my $limit = $_; |
| my $fail; |
| my $dumped_core; |
| |
| if(!defined($limit)) { |
| # --shallow can undefine them |
| next; |
| } |
| if($tortalloc && ($tortalloc != $limit)) { |
| next; |
| } |
| |
| if($verbose) { |
| my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
| localtime(time()); |
| my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec); |
| logmsg "Fail function no: $limit at $now\r"; |
| } |
| |
| # make the memory allocation function number $limit return failure |
| $ENV{'CURL_MEMLIMIT'} = $limit; |
| |
| # remove memdump first to be sure we get a new nice and clean one |
| unlink("$LOGDIR/$MEMDUMP"); |
| |
| my $cmd = $testcmd; |
| if($valgrind && !$gdbthis) { |
| my @valgrindoption = getpart("verify", "valgrind"); |
| if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) { |
| my $valgrindcmd = "$valgrind "; |
| $valgrindcmd .= "$valgrind_tool " if($valgrind_tool); |
| $valgrindcmd .= "--quiet --leak-check=yes "; |
| $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp "; |
| # $valgrindcmd .= "--gen-suppressions=all "; |
| $valgrindcmd .= "--num-callers=16 "; |
| $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum"; |
| $cmd = "$valgrindcmd $testcmd"; |
| } |
| } |
| logmsg "*** Function number $limit is now set to fail ***\n" if($gdbthis); |
| |
| my $ret = 0; |
| if($gdbthis) { |
| runclient($gdbline); |
| } |
| else { |
| $ret = runclient($cmd); |
| } |
| #logmsg "$_ Returned " . ($ret >> 8) . "\n"; |
| |
| # Now clear the variable again |
| delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'}); |
| |
| if(-r "core") { |
| # there's core file present now! |
| logmsg " core dumped\n"; |
| $dumped_core = 1; |
| $fail = 2; |
| } |
| |
| if($valgrind) { |
| my @e = valgrindparse("$LOGDIR/valgrind$testnum"); |
| if(@e && $e[0]) { |
| if($automakestyle) { |
| logmsg "FAIL: torture $testnum - valgrind\n"; |
| } |
| else { |
| logmsg " valgrind ERROR "; |
| logmsg @e; |
| } |
| $fail = 1; |
| } |
| } |
| |
| # verify that it returns a proper error code, doesn't leak memory |
| # and doesn't core dump |
| if(($ret & 255) || ($ret >> 8) >= 128) { |
| logmsg " system() returned $ret\n"; |
| $fail=1; |
| } |
| else { |
| my @memdata=`$memanalyze "$LOGDIR/$MEMDUMP"`; |
| my $leak=0; |
| for(@memdata) { |
| if($_ ne "") { |
| # well it could be other memory problems as well, but |
| # we call it leak for short here |
| $leak=1; |
| } |
| } |
| if($leak) { |
| logmsg "** MEMORY FAILURE\n"; |
| logmsg @memdata; |
| logmsg `$memanalyze -l "$LOGDIR/$MEMDUMP"`; |
| $fail = 1; |
| } |
| } |
| if($fail) { |
| logmsg " $testnum: torture FAILED: function number $limit in test.\n", |
| " invoke with \"-t$limit\" to repeat this single case.\n"; |
| stopservers($verbose); |
| return 1; |
| } |
| } |
| |
| logmsg "\n" if($verbose); |
| logmsg "torture OK\n"; |
| return 0; |
| } |
| |
| |
| ####################################################################### |
| # restore environment variables that were modified in test |
| sub restore_test_env { |
| my $deleteoldenv = $_[0]; # 1 to delete the saved contents after restore |
| foreach my $var (keys %oldenv) { |
| if($oldenv{$var} eq 'notset') { |
| delete $ENV{$var} if($ENV{$var}); |
| } |
| else { |
| $ENV{$var} = $oldenv{$var}; |
| } |
| if($deleteoldenv) { |
| delete $oldenv{$var}; |
| } |
| } |
| } |
| |
| |
| ####################################################################### |
| # Start the servers needed to run this test case |
| sub singletest_startservers { |
| my ($testnum, $testtimings) = @_; |
| |
| # remove old test server files before servers are started/verified |
| unlink("$LOGDIR/$SERVERCMD"); |
| unlink("$LOGDIR/$SERVERIN"); |
| unlink("$LOGDIR/$PROXYIN"); |
| |
| # timestamp required servers verification start |
| $$testtimings{"timesrvrini"} = Time::HiRes::time(); |
| |
| my $why; |
| my $error; |
| if (!$listonly) { |
| my @what = getpart("client", "server"); |
| if(!$what[0]) { |
| warn "Test case $testnum has no server(s) specified"; |
| $why = "no server specified"; |
| $error = -1; |
| } else { |
| my $err; |
| ($why, $err) = serverfortest(@what); |
| if($err == 1) { |
| # Error indicates an actual problem starting the server |
| $error = -2; |
| } else { |
| $error = -1; |
| } |
| } |
| } |
| |
| # timestamp required servers verification end |
| $$testtimings{"timesrvrend"} = Time::HiRes::time(); |
| |
| return ($why, $error); |
| } |
| |
| |
| ####################################################################### |
| # Generate preprocessed test file |
| sub singletest_preprocess { |
| my $testnum = $_[0]; |
| |
| # Save a preprocessed version of the entire test file. This allows more |
| # "basic" test case readers to enjoy variable replacements. |
| my @entiretest = fulltest(); |
| my $otest = "$LOGDIR/test$testnum"; |
| |
| @entiretest = prepro($testnum, @entiretest); |
| |
| # save the new version |
| open(my $fulltesth, ">", "$otest") || die "Failure writing test file"; |
| foreach my $bytes (@entiretest) { |
| print $fulltesth pack('a*', $bytes) or die "Failed to print '$bytes': $!"; |
| } |
| close($fulltesth) || die "Failure writing test file"; |
| |
| # in case the process changed the file, reload it |
| loadtest("$LOGDIR/test${testnum}"); |
| } |
| |
| |
| ####################################################################### |
| # Set up the test environment to run this test case |
| sub singletest_setenv { |
| my @setenv = getpart("client", "setenv"); |
| foreach my $s (@setenv) { |
| chomp $s; |
| if($s =~ /([^=]*)=(.*)/) { |
| my ($var, $content) = ($1, $2); |
| # remember current setting, to restore it once test runs |
| $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset'; |
| # set new value |
| if(!$content) { |
| delete $ENV{$var} if($ENV{$var}); |
| } |
| else { |
| if($var =~ /^LD_PRELOAD/) { |
| if(exe_ext('TOOL') && (exe_ext('TOOL') eq '.exe')) { |
| logmsg "Skipping LD_PRELOAD due to lack of OS support\n" if($verbose); |
| next; |
| } |
| if($feature{"debug"} || !$has_shared) { |
| logmsg "Skipping LD_PRELOAD due to no release shared build\n" if($verbose); |
| next; |
| } |
| } |
| $ENV{$var} = "$content"; |
| logmsg "setenv $var = $content\n" if($verbose); |
| } |
| } |
| } |
| if($proxy_address) { |
| $ENV{http_proxy} = $proxy_address; |
| $ENV{HTTPS_PROXY} = $proxy_address; |
| } |
| } |
| |
| |
| ####################################################################### |
| # Check that test environment is fine to run this test case |
| sub singletest_precheck { |
| my $testnum = $_[0]; |
| my $why; |
| my @precheck = getpart("client", "precheck"); |
| if(@precheck) { |
| my $cmd = $precheck[0]; |
| chomp $cmd; |
| if($cmd) { |
| my @p = split(/ /, $cmd); |
| if($p[0] !~ /\//) { |
| # the first word, the command, does not contain a slash so |
| # we will scan the "improved" PATH to find the command to |
| # be able to run it |
| my $fullp = checktestcmd($p[0]); |
| |
| if($fullp) { |
| $p[0] = $fullp; |
| } |
| $cmd = join(" ", @p); |
| } |
| |
| my @o = `$cmd 2> $LOGDIR/precheck-$testnum`; |
| if($o[0]) { |
| $why = $o[0]; |
| $why =~ s/[\r\n]//g; |
| } |
| elsif($?) { |
| $why = "precheck command error"; |
| } |
| logmsg "prechecked $cmd\n" if($verbose); |
| } |
| } |
| return $why; |
| } |
| |
| |
| ####################################################################### |
| # Prepare the test environment to run this test case |
| sub singletest_prepare { |
| my ($testnum) = @_; |
| |
| if($feature{"TrackMemory"}) { |
| unlink("$LOGDIR/$MEMDUMP"); |
| } |
| unlink("core"); |
| |
| # remove server output logfiles after servers are started/verified |
| unlink("$LOGDIR/$SERVERIN"); |
| unlink("$LOGDIR/$PROXYIN"); |
| |
| # if this section exists, it might be FTP server instructions: |
| my @ftpservercmd = getpart("reply", "servercmd"); |
| push @ftpservercmd, "Testnum $testnum\n"; |
| # write the instructions to file |
| writearray("$LOGDIR/$SERVERCMD", \@ftpservercmd); |
| |
| # create (possibly-empty) files before starting the test |
| for my $partsuffix (('', '1', '2', '3', '4')) { |
| my @inputfile=getpart("client", "file".$partsuffix); |
| my %fileattr = getpartattr("client", "file".$partsuffix); |
| my $filename=$fileattr{'name'}; |
| if(@inputfile || $filename) { |
| if(!$filename) { |
| logmsg " $testnum: IGNORED: section client=>file has no name attribute\n"; |
| return -1; |
| } |
| my $fileContent = join('', @inputfile); |
| |
| # make directories if needed |
| my $path = $filename; |
| # cut off the file name part |
| $path =~ s/^(.*)\/[^\/]*/$1/; |
| my @ldparts = split(/\//, $LOGDIR); |
| my $nparts = @ldparts; |
| my @parts = split(/\//, $path); |
| if(join("/", @parts[0..$nparts-1]) eq $LOGDIR) { |
| # the file is in $LOGDIR/ |
| my $d = shift @parts; |
| for(@parts) { |
| $d .= "/$_"; |
| mkdir $d; # 0777 |
| } |
| } |
| if (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); |
| } else { |
| logmsg "ERROR: cannot write $filename\n"; |
| } |
| } |
| } |
| return 0; |
| } |
| |
| |
| ####################################################################### |
| # Run the test command |
| sub singletest_run { |
| my ($testnum, $testtimings) = @_; |
| |
| # get the command line options to use |
| my ($cmd, @blaha)= getpart("client", "command"); |
| if($cmd) { |
| # make some nice replace operations |
| $cmd =~ s/\n//g; # no newlines please |
| # substitute variables in the command line |
| } |
| else { |
| # there was no command given, use something silly |
| $cmd="-"; |
| } |
| |
| my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout |
| |
| # if stdout section exists, we verify that the stdout contained this: |
| my $out=""; |
| my %cmdhash = getpartattr("client", "command"); |
| if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) { |
| #We may slap on --output! |
| if (!partexists("verify", "stdout") || |
| ($cmdhash{'option'} && $cmdhash{'option'} =~ /force-output/)) { |
| $out=" --output $CURLOUT "; |
| } |
| } |
| |
| my @codepieces = getpart("client", "tool"); |
| my $tool=""; |
| if(@codepieces) { |
| $tool = $codepieces[0]; |
| chomp $tool; |
| $tool .= exe_ext('TOOL'); |
| } |
| |
| my $disablevalgrind; |
| my $CMDLINE=""; |
| my $cmdargs; |
| my $cmdtype = $cmdhash{'type'} || "default"; |
| my $fail_due_event_based = $run_event_based; |
| if($cmdtype eq "perl") { |
| # run the command line prepended with "perl" |
| $cmdargs ="$cmd"; |
| $CMDLINE = "$perl "; |
| $tool=$CMDLINE; |
| $disablevalgrind=1; |
| } |
| elsif($cmdtype eq "shell") { |
| # run the command line prepended with "/bin/sh" |
| $cmdargs ="$cmd"; |
| $CMDLINE = "/bin/sh "; |
| $tool=$CMDLINE; |
| $disablevalgrind=1; |
| } |
| elsif(!$tool && !$keywords{"unittest"}) { |
| # run curl, add suitable command line options |
| my $inc=""; |
| if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) { |
| $inc = " --include"; |
| } |
| $cmdargs = "$out$inc "; |
| |
| if($cmdhash{'option'} && ($cmdhash{'option'} =~ /binary-trace/)) { |
| $cmdargs .= "--trace $LOGDIR/trace$testnum "; |
| } |
| else { |
| $cmdargs .= "--trace-ascii $LOGDIR/trace$testnum "; |
| } |
| $cmdargs .= "--trace-time "; |
| if($run_event_based) { |
| $cmdargs .= "--test-event "; |
| $fail_due_event_based--; |
| } |
| $cmdargs .= $cmd; |
| if ($proxy_address) { |
| $cmdargs .= " --proxy $proxy_address "; |
| } |
| } |
| else { |
| $cmdargs = " $cmd"; # $cmd is the command line for the test file |
| $CURLOUT = stdoutfilename($LOGDIR, $testnum); # sends received data to stdout |
| |
| # Default the tool to a unit test with the same name as the test spec |
| if($keywords{"unittest"} && !$tool) { |
| $tool="unit$testnum"; |
| } |
| |
| if($tool =~ /^lib/) { |
| $CMDLINE="$LIBDIR/$tool"; |
| } |
| elsif($tool =~ /^unit/) { |
| $CMDLINE="$UNITDIR/$tool"; |
| } |
| |
| if(! -f $CMDLINE) { |
| logmsg " $testnum: IGNORED: The tool set in the test case for this: '$tool' does not exist\n"; |
| return (-1, 0, 0, "", "", 0); |
| } |
| $DBGCURL=$CMDLINE; |
| } |
| |
| if($fail_due_event_based) { |
| logmsg " $testnum: IGNORED: This test cannot run event based\n"; |
| return (-1, 0, 0, "", "", 0); |
| } |
| |
| if($gdbthis) { |
| # gdb is incompatible with valgrind, so disable it when debugging |
| # Perhaps a better approach would be to run it under valgrind anyway |
| # with --db-attach=yes or --vgdb=yes. |
| $disablevalgrind=1; |
| } |
| |
| my @stdintest = getpart("client", "stdin"); |
| |
| if(@stdintest) { |
| my $stdinfile="$LOGDIR/stdin-for-$testnum"; |
| |
| my %hash = getpartattr("client", "stdin"); |
| if($hash{'nonewline'}) { |
| # cut off the final newline from the final line of the stdin data |
| chomp($stdintest[-1]); |
| } |
| |
| writearray($stdinfile, \@stdintest); |
| |
| $cmdargs .= " <$stdinfile"; |
| } |
| |
| if(!$tool) { |
| $CMDLINE=shell_quote($CURL); |
| } |
| |
| if(use_valgrind() && !$disablevalgrind) { |
| my $valgrindcmd = "$valgrind "; |
| $valgrindcmd .= "$valgrind_tool " if($valgrind_tool); |
| $valgrindcmd .= "--quiet --leak-check=yes "; |
| $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp "; |
| # $valgrindcmd .= "--gen-suppressions=all "; |
| $valgrindcmd .= "--num-callers=16 "; |
| $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum"; |
| $CMDLINE = "$valgrindcmd $CMDLINE"; |
| } |
| |
| $CMDLINE .= "$cmdargs > " . stdoutfilename($LOGDIR, $testnum) . |
| " 2> " . stderrfilename($LOGDIR, $testnum); |
| |
| if($verbose) { |
| logmsg "$CMDLINE\n"; |
| } |
| |
| open(my $cmdlog, ">", $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(my $gdbcmd, ">", "$LOGDIR/gdbcmd") || die "Failure writing gdb file"; |
| if($gdbthis == 1) { |
| # gdb mode |
| print $gdbcmd "set args $cmdargs\n"; |
| print $gdbcmd "show args\n"; |
| print $gdbcmd "source $gdbinit\n" if -e $gdbinit; |
| } |
| else { |
| # lldb mode |
| print $gdbcmd "set args $cmdargs\n"; |
| } |
| close($gdbcmd) || die "Failure writing gdb file"; |
| } |
| |
| # Flush output. |
| $| = 1; |
| |
| # timestamp starting of test command |
| $$testtimings{"timetoolini"} = Time::HiRes::time(); |
| |
| # run the command line we built |
| if ($torture) { |
| $cmdres = torture($CMDLINE, |
| $testnum, |
| "$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " -x $LOGDIR/gdbcmd"); |
| } |
| elsif($gdbthis == 1) { |
| # gdb |
| my $GDBW = ($gdbxwin) ? "-w" : ""; |
| runclient("$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " $GDBW -x $LOGDIR/gdbcmd"); |
| $cmdres=0; # makes it always continue after a debugged run |
| } |
| elsif($gdbthis == 2) { |
| # $gdb is "lldb" |
| print "runs lldb -- $CURL $cmdargs\n"; |
| runclient("lldb -- $CURL $cmdargs"); |
| $cmdres=0; # makes it always continue after a debugged run |
| } |
| else { |
| # Convert the raw result code into a more useful one |
| ($cmdres, $dumped_core) = normalize_cmdres(runclient("$CMDLINE")); |
| } |
| |
| # timestamp finishing of test command |
| $$testtimings{"timetoolend"} = Time::HiRes::time(); |
| |
| return (0, $cmdres, $dumped_core, $CURLOUT, $tool, use_valgrind() && !$disablevalgrind); |
| } |
| |
| |
| ####################################################################### |
| # Clean up after test command |
| sub singletest_clean { |
| my ($testnum, $dumped_core, $testtimings)=@_; |
| |
| if(!$dumped_core) { |
| if(-r "core") { |
| # there's core file present now! |
| $dumped_core = 1; |
| } |
| } |
| |
| if($dumped_core) { |
| logmsg "core dumped\n"; |
| if(0 && $gdb) { |
| logmsg "running gdb for post-mortem analysis:\n"; |
| 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 " . shell_quote($DBGCURL) . " core "); |
| # unlink("$LOGDIR/gdbcmd2"); |
| } |
| } |
| |
| # If a server logs advisor read lock file exists, it is an indication |
| # that the server has not yet finished writing out all its log files, |
| # including server request log files used for protocol verification. |
| # So, if the lock file exists the script waits here a certain amount |
| # of time until the server removes it, or the given time expires. |
| my $serverlogslocktimeout = $defserverlogslocktimeout; |
| my %cmdhash = getpartattr("client", "command"); |
| if($cmdhash{'timeout'}) { |
| # test is allowed to override default server logs lock timeout |
| if($cmdhash{'timeout'} =~ /(\d+)/) { |
| $serverlogslocktimeout = $1 if($1 >= 0); |
| } |
| } |
| if($serverlogslocktimeout) { |
| my $lockretry = $serverlogslocktimeout * 20; |
| my @locks; |
| while((@locks = logslocked()) && $lockretry--) { |
| portable_sleep(0.05); |
| } |
| if(($lockretry < 0) && |
| ($serverlogslocktimeout >= $defserverlogslocktimeout)) { |
| logmsg "Warning: server logs lock timeout ", |
| "($serverlogslocktimeout seconds) expired (locks: " . |
| join(", ", @locks) . ")\n"; |
| } |
| } |
| |
| # Test harness ssh server does not have this synchronization mechanism, |
| # this implies that some ssh server based tests might need a small delay |
| # once that the client command has run to avoid false test failures. |
| # |
| # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv |
| # based tests might need a small delay once that the client command has |
| # run to avoid false test failures. |
| my $postcommanddelay = $defpostcommanddelay; |
| if($cmdhash{'delay'}) { |
| # test is allowed to specify a delay after command is executed |
| if($cmdhash{'delay'} =~ /(\d+)/) { |
| $postcommanddelay = $1 if($1 > 0); |
| } |
| } |
| |
| portable_sleep($postcommanddelay) if($postcommanddelay); |
| |
| # timestamp removal of server logs advisor read lock |
| $$testtimings{"timesrvrlog"} = Time::HiRes::time(); |
| |
| # test definition might instruct to stop some servers |
| # stop also all servers relative to the given one |
| |
| my @killtestservers = getpart("client", "killserver"); |
| if(@killtestservers) { |
| foreach my $server (@killtestservers) { |
| chomp $server; |
| if(stopserver($server)) { |
| logmsg " $testnum: killserver FAILED\n"; |
| return 1; # normal error if asked to fail on unexpected alive |
| } |
| } |
| } |
| return 0; |
| } |
| |
| ####################################################################### |
| # Verify that the postcheck succeeded |
| sub singletest_postcheck { |
| my ($testnum)=@_; |
| |
| # run the postcheck command |
| my @postcheck= getpart("client", "postcheck"); |
| if(@postcheck) { |
| my $cmd = join("", @postcheck); |
| chomp $cmd; |
| if($cmd) { |
| logmsg "postcheck $cmd\n" if($verbose); |
| my $rc = runclient("$cmd"); |
| # Must run the postcheck command in torture mode in order |
| # to clean up, but the result can't be relied upon. |
| if($rc != 0 && !$torture) { |
| logmsg " $testnum: postcheck FAILED\n"; |
| return -1; |
| } |
| } |
| } |
| return 0; |
| } |
| |
| |
| |
| ################################################################### |
| # Get ready to run a single test case |
| sub runner_test_preprocess { |
| my ($testnum)=@_; |
| my %testtimings; |
| |
| if(clearlogs()) { |
| logmsg "Warning: log messages were lost\n"; |
| } |
| |
| # timestamp test preparation start |
| # TODO: this metric now shows only a portion of the prep time; better would |
| # be to time singletest_preprocess below instead |
| $testtimings{"timeprepini"} = Time::HiRes::time(); |
| |
| ################################################################### |
| # Load test metadata |
| # ignore any error here--if there were one, it would have been |
| # caught during the selection phase and this test would not be |
| # running now |
| loadtest("${TESTDIR}/test${testnum}"); |
| readtestkeywords(); |
| |
| ################################################################### |
| # Restore environment variables that were modified in a previous run. |
| # Test definition may instruct to (un)set environment vars. |
| restore_test_env(1); |
| |
| ################################################################### |
| # Start the servers needed to run this test case |
| my ($why, $error) = singletest_startservers($testnum, \%testtimings); |
| |
| if(!$why) { |
| |
| ############################################################### |
| # Generate preprocessed test file |
| # This must be done after the servers are started so server |
| # variables are available for substitution. |
| singletest_preprocess($testnum); |
| |
| ############################################################### |
| # Set up the test environment to run this test case |
| singletest_setenv(); |
| |
| ############################################################### |
| # Check that the test environment is fine to run this test case |
| if (!$listonly) { |
| $why = singletest_precheck($testnum); |
| $error = -1; |
| } |
| } |
| return ($why, $error, clearlogs(), \%testtimings); |
| } |
| |
| |
| ################################################################### |
| # Run a single test case with an environment that already been prepared |
| # Returns 0=success, -1=skippable failure, -2=permanent error, |
| # 1=unskippable test failure, as first integer, plus any log messages, |
| # plus more return values when error is 0 |
| sub runner_test_run { |
| my ($testnum)=@_; |
| |
| if(clearlogs()) { |
| logmsg "Warning: log messages were lost\n"; |
| } |
| |
| ####################################################################### |
| # Prepare the test environment to run this test case |
| my $error = singletest_prepare($testnum); |
| if($error) { |
| return (-2, clearlogs()); |
| } |
| |
| ####################################################################### |
| # Run the test command |
| my %testtimings; |
| my $cmdres; |
| my $dumped_core; |
| my $CURLOUT; |
| my $tool; |
| my $usedvalgrind; |
| ($error, $cmdres, $dumped_core, $CURLOUT, $tool, $usedvalgrind) = singletest_run($testnum, \%testtimings); |
| if($error) { |
| return (-2, clearlogs(), \%testtimings); |
| } |
| |
| ####################################################################### |
| # Clean up after test command |
| $error = singletest_clean($testnum, $dumped_core, \%testtimings); |
| if($error) { |
| return ($error, clearlogs(), \%testtimings); |
| } |
| |
| ####################################################################### |
| # Verify that the postcheck succeeded |
| $error = singletest_postcheck($testnum); |
| if($error) { |
| return ($error, clearlogs(), \%testtimings); |
| } |
| |
| ####################################################################### |
| # restore environment variables that were modified |
| restore_test_env(0); |
| |
| return (0, clearlogs(), \%testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind); |
| } |
| |
| # Async call runner_clearlocks |
| # Called by controller |
| sub runnerac_clearlocks { |
| return controlleripccall(\&runner_clearlocks, @_); |
| } |
| |
| # Async call runner_shutdown |
| # This call does NOT generate an IPC response and must be the last IPC call |
| # received. |
| # Called by controller |
| sub runnerac_shutdown { |
| my ($runnerid)=$_[0]; |
| my $err = controlleripccall(\&runner_shutdown, @_); |
| |
| # These have no more use |
| close($controllerw{$runnerid}); |
| undef $controllerw{$runnerid}; |
| close($controllerr{$runnerid}); |
| undef $controllerr{$runnerid}; |
| return $err; |
| } |
| |
| # Async call of runner_stopservers |
| # Called by controller |
| sub runnerac_stopservers { |
| return controlleripccall(\&runner_stopservers, @_); |
| } |
| |
| # Async call of runner_test_preprocess |
| # Called by controller |
| sub runnerac_test_preprocess { |
| return controlleripccall(\&runner_test_preprocess, @_); |
| } |
| |
| # Async call of runner_test_run |
| # Called by controller |
| sub runnerac_test_run { |
| return controlleripccall(\&runner_test_run, @_); |
| } |
| |
| ################################################################### |
| # Call an arbitrary function via IPC |
| # The first argument is the function reference, the second is the runner ID |
| # Returns 0 on success, -1 on error writing to runner |
| # Called by controller (indirectly, via a more specific function) |
| sub controlleripccall { |
| my $funcref = shift @_; |
| my $runnerid = shift @_; |
| # Get the name of the function from the reference |
| my $cv = svref_2object($funcref); |
| my $gv = $cv->GV; |
| # Prepend the name to the function arguments so it's marshalled along with them |
| unshift @_, $gv->NAME; |
| # Marshall the arguments into a flat string |
| my $margs = freeze \@_; |
| |
| # Send IPC call via pipe |
| my $err; |
| while(! defined ($err = syswrite($controllerw{$runnerid}, (pack "L", length($margs)) . $margs)) || $err <= 0) { |
| if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { |
| # Runner has likely died |
| return -1; |
| } |
| # system call was interrupted, probably by ^C; restart it so we stay in sync |
| } |
| |
| if(!$multiprocess) { |
| # Call the remote function here in single process mode |
| ipcrecv(); |
| } |
| return 0; |
| } |
| |
| ################################################################### |
| # Receive async response of a previous call via IPC |
| # The first return value is the runner ID or undef on error |
| # Called by controller |
| sub runnerar { |
| my ($runnerid) = @_; |
| my $err; |
| my $datalen; |
| while(! defined ($err = sysread($controllerr{$runnerid}, $datalen, 4)) || $err <= 0) { |
| if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { |
| # Runner is likely dead and closed the pipe |
| return undef; |
| } |
| # system call was interrupted, probably by ^C; restart it so we stay in sync |
| } |
| my $len=unpack("L", $datalen); |
| my $buf; |
| while(! defined ($err = sysread($controllerr{$runnerid}, $buf, $len)) || $err <= 0) { |
| if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { |
| # Runner is likely dead and closed the pipe |
| return undef; |
| } |
| # system call was interrupted, probably by ^C; restart it so we stay in sync |
| } |
| |
| # Decode response values |
| my $resarrayref = thaw $buf; |
| |
| # First argument is runner ID |
| # TODO: remove this; it's unneeded since it's passed in |
| unshift @$resarrayref, $runnerid; |
| return @$resarrayref; |
| } |
| |
| ################################################################### |
| # Returns runner ID if a response from an async call is ready or error |
| # First value is ready, second is error, however an error case shows up |
| # as ready in Linux, so you can't trust it. |
| # argument is 0 for nonblocking, undef for blocking, anything else for timeout |
| # Called by controller |
| sub runnerar_ready { |
| my ($blocking) = @_; |
| my $rin = ""; |
| my %idbyfileno; |
| my $maxfileno=0; |
| foreach my $p (keys(%controllerr)) { |
| my $fd = fileno($controllerr{$p}); |
| vec($rin, $fd, 1) = 1; |
| $idbyfileno{$fd} = $p; # save the runner ID for each pipe fd |
| if($fd > $maxfileno) { |
| $maxfileno = $fd; |
| } |
| } |
| $maxfileno || die "Internal error: no runners are available to wait on\n"; |
| |
| # Wait for any pipe from any runner to be ready |
| # This may be interrupted and return EINTR, but this is ignored and the |
| # caller will need to later call this function again. |
| # TODO: this is relatively slow with hundreds of fds |
| my $ein = $rin; |
| if(select(my $rout=$rin, undef, my $eout=$ein, $blocking) >= 1) { |
| for my $fd (0..$maxfileno) { |
| # Return an error condition first in case it's both |
| if(vec($eout, $fd, 1)) { |
| return (undef, $idbyfileno{$fd}); |
| } |
| if(vec($rout, $fd, 1)) { |
| return ($idbyfileno{$fd}, undef); |
| } |
| } |
| die "Internal pipe readiness inconsistency\n"; |
| } |
| return (undef, undef); |
| } |
| |
| |
| ################################################################### |
| # Cleanly abort and exit the runner |
| # This uses print since there is no longer any controller to write logs. |
| sub runnerabort{ |
| print "Controller is gone: runner $$ for $LOGDIR exiting\n"; |
| my ($error, $logs) = runner_stopservers(); |
| print $logs; |
| runner_shutdown(); |
| } |
| |
| ################################################################### |
| # Receive an IPC call in the runner and execute it |
| # The IPC is read from the $runnerr pipe and the response is |
| # written to the $runnerw pipe |
| # Returns 0 if more IPC calls are expected or 1 if the runner should exit |
| sub ipcrecv { |
| my $err; |
| my $datalen; |
| while(! defined ($err = sysread($runnerr, $datalen, 4)) || $err <= 0) { |
| if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { |
| # pipe has closed; controller is gone and we must exit |
| runnerabort(); |
| # Special case: no response will be forthcoming |
| return 1; |
| } |
| # system call was interrupted, probably by ^C; restart it so we stay in sync |
| } |
| my $len=unpack("L", $datalen); |
| my $buf; |
| while(! defined ($err = sysread($runnerr, $buf, $len)) || $err <= 0) { |
| if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { |
| # pipe has closed; controller is gone and we must exit |
| runnerabort(); |
| # Special case: no response will be forthcoming |
| return 1; |
| } |
| # system call was interrupted, probably by ^C; restart it so we stay in sync |
| } |
| |
| # Decode the function name and arguments |
| my $argsarrayref = thaw $buf; |
| |
| # The name of the function to call is the first argument |
| my $funcname = shift @$argsarrayref; |
| |
| # print "ipcrecv $funcname\n"; |
| # Synchronously call the desired function |
| my @res; |
| if($funcname eq "runner_clearlocks") { |
| @res = runner_clearlocks(@$argsarrayref); |
| } |
| elsif($funcname eq "runner_shutdown") { |
| runner_shutdown(@$argsarrayref); |
| # Special case: no response will be forthcoming |
| return 1; |
| } |
| elsif($funcname eq "runner_stopservers") { |
| @res = runner_stopservers(@$argsarrayref); |
| } |
| elsif($funcname eq "runner_test_preprocess") { |
| @res = runner_test_preprocess(@$argsarrayref); |
| } |
| elsif($funcname eq "runner_test_run") { |
| @res = runner_test_run(@$argsarrayref); |
| } else { |
| die "Unknown IPC function $funcname\n"; |
| } |
| # print "ipcrecv results\n"; |
| |
| # Marshall the results to return |
| $buf = freeze \@res; |
| |
| while(! defined ($err = syswrite($runnerw, (pack "L", length($buf)) . $buf)) || $err <= 0) { |
| if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { |
| # pipe has closed; controller is gone and we must exit |
| runnerabort(); |
| # Special case: no response will be forthcoming |
| return 1; |
| } |
| # system call was interrupted, probably by ^C; restart it so we stay in sync |
| } |
| |
| return 0; |
| } |
| |
| ################################################################### |
| # Kill the server processes that still have lock files in a directory |
| sub runner_clearlocks { |
| my ($lockdir)=@_; |
| if(clearlogs()) { |
| logmsg "Warning: log messages were lost\n"; |
| } |
| clearlocks($lockdir); |
| return clearlogs(); |
| } |
| |
| |
| ################################################################### |
| # Kill all server processes |
| sub runner_stopservers { |
| my $error = stopservers($verbose); |
| my $logs = clearlogs(); |
| return ($error, $logs); |
| } |
| |
| ################################################################### |
| # Shut down this runner |
| sub runner_shutdown { |
| close($runnerr); |
| undef $runnerr; |
| close($runnerw); |
| undef $runnerw; |
| } |
| |
| |
| 1; |
