fixes
This commit is contained in:
parent
adf00f5b2e
commit
7bb7550e23
@ -3,6 +3,8 @@ EXTRA_DIST = ftpserver.pl httpserver.pl runtests.pl ftpsserver.pl stunnel.pm \
|
||||
|
||||
SUBDIRS = data
|
||||
|
||||
PERLFLAGS = -I$(srcdir)
|
||||
|
||||
all:
|
||||
install:
|
||||
|
||||
@ -11,11 +13,11 @@ curl:
|
||||
|
||||
test:
|
||||
$(MAKE) -C data test
|
||||
srcdir=$(srcdir) $(PERL) $(srcdir)/runtests.pl
|
||||
srcdir=$(srcdir) $(PERL) $(PERLFLAGS) $(srcdir)/runtests.pl
|
||||
|
||||
quiet-test:
|
||||
$(MAKE) -C data test
|
||||
srcdir=$(srcdir) $(PERL) $(srcdir)/runtests.pl -s -a
|
||||
srcdir=$(srcdir) $(PERL) $(PERLFLAGS) $(srcdir)/runtests.pl -s -a
|
||||
|
||||
clean:
|
||||
rm -rf log
|
||||
|
@ -3,6 +3,46 @@ use strict;
|
||||
|
||||
my @xml;
|
||||
|
||||
sub getpartattr {
|
||||
my ($section, $part)=@_;
|
||||
|
||||
my %hash;
|
||||
my $inside=0;
|
||||
|
||||
# print "Section: $section, part: $part\n";
|
||||
|
||||
for(@xml) {
|
||||
# print "$inside: $_";
|
||||
if(!$inside && ($_ =~ /^ *\<$section/)) {
|
||||
$inside++;
|
||||
}
|
||||
elsif((1 ==$inside) && ($_ =~ /^ *\<$part([^>]*)/)) {
|
||||
$inside++;
|
||||
my $attr=$1;
|
||||
my @p=split("[ \t]", $attr);
|
||||
my $assign;
|
||||
|
||||
foreach $assign (@p) {
|
||||
# $assign is a 'name="contents"' pair
|
||||
|
||||
if($assign =~ / *([^=]*)=\"([^\"]*)\"/) {
|
||||
# *with* quotes
|
||||
$hash{$1}=$2;
|
||||
}
|
||||
elsif($assign =~ / *([^=]*)=([^\"]*)/) {
|
||||
# *without* quotes
|
||||
$hash{$1}=$2;
|
||||
}
|
||||
}
|
||||
last;
|
||||
}
|
||||
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
|
||||
$inside--;
|
||||
}
|
||||
}
|
||||
return %hash;
|
||||
}
|
||||
|
||||
sub getpart {
|
||||
my ($section, $part)=@_;
|
||||
|
||||
@ -16,7 +56,7 @@ sub getpart {
|
||||
if(!$inside && ($_ =~ /^ *\<$section/)) {
|
||||
$inside++;
|
||||
}
|
||||
elsif((1 ==$inside) && ($_ =~ /^ *\<$part/)) {
|
||||
elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) {
|
||||
$inside++;
|
||||
}
|
||||
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
|
||||
|
@ -121,10 +121,6 @@ for ( $waitedpid = 0;
|
||||
my $testnum;
|
||||
if($path =~ /.*\/(\d*)/) {
|
||||
$testnum=$1;
|
||||
|
||||
if($verbose) {
|
||||
print STDERR "OUT: sending reply $testnum\n";
|
||||
}
|
||||
}
|
||||
else {
|
||||
$testnum=0;
|
||||
@ -142,9 +138,18 @@ for ( $waitedpid = 0;
|
||||
"You must enter a test number to get good data back\r\n";
|
||||
}
|
||||
else {
|
||||
my $part="";
|
||||
if($testnum > 10000) {
|
||||
$part = $testnum % 10000;
|
||||
$testnum = sprintf("%d", $testnum/10000);
|
||||
}
|
||||
if($verbose) {
|
||||
print STDERR "OUT: sending reply $testnum (part $part)\n";
|
||||
}
|
||||
|
||||
loadtest("data/test$testnum");
|
||||
# send a custom reply to the client
|
||||
my @data = getpart("reply", "data");
|
||||
my @data = getpart("reply", "data$part");
|
||||
for(@data) {
|
||||
print $_;
|
||||
if($verbose) {
|
||||
|
Loading…
Reference in New Issue
Block a user