1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
#!/usr/bin/env perl
#***************************************************************************
# _ _ ____ _
# Project ___| | | | _ \| |
# / __| | | | |_) | |
# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
# Copyright (C) Daniel Fandrich, 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 script is intended for developers to test some internals of the
# runtests.pl harness. Do not try to use this unless you know what you are
# doing!
# An example command-line that starts a test http server for test 11 and waits
# for the user before stopping it:
# ./devtest.pl --verbose serverfortest https echo "Started https" protoport https preprocess 11 pause echo Stopping stopservers echo Done
# curl can connect to the server while it is running like this:
# curl -vkL https://localhost:<protoport>/11
use strict;
use warnings;
use 5.006;
BEGIN {
# Define srcdir to the location of the tests source directory. This is
# usually set by the Makefile, but for out-of-tree builds with direct
# invocation of runtests.pl, it may not be set.
if(!defined $ENV{'srcdir'}) {
use File::Basename;
$ENV{'srcdir'} = dirname(__FILE__);
}
push(@INC, $ENV{'srcdir'});
}
use globalconfig;
use servers qw(
initserverconfig
protoport
serverfortest
stopservers
);
use runner qw(
readtestkeywords
singletest_preprocess
);
use testutil qw(
setlogfunc
);
use getpart;
#######################################################################
# logmsg is our general message logging subroutine.
# This function is currently required to be here by servers.pm
# This is copied from runtests.pl
#
my $uname_release = `uname -r`;
my $is_wsl = $uname_release =~ /Microsoft$/;
sub logmsg {
for(@_) {
my $line = $_;
if($is_wsl) {
# use \r\n for WSL shell
$line =~ s/\r?\n$/\r\n/g;
}
print "$line";
}
}
#######################################################################
# Parse and store the protocols in curl's Protocols: line
# This is copied from runtests.pl
#
sub parseprotocols {
my ($line)=@_;
@protocols = split(' ', lc($line));
# Generate a "proto-ipv6" version of each protocol to match the
# IPv6 <server> name and a "proto-unix" to match the variant which
# uses Unix domain sockets. This works even if support is not
# compiled in because the <features> test will fail.
push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
# 'http-proxy' is used in test cases to do CONNECT through
push @protocols, 'http-proxy';
# 'none' is used in test cases to mean no server
push @protocols, 'none';
}
#######################################################################
# Initialize @protocols from the curl binary under test
#
sub init_protocols {
for (`$CURL -V 2>$dev_null`) {
if(m/^Protocols: (.*)$/) {
parseprotocols($1);
}
}
}
#######################################################################
# Initialize the test harness to run tests
#
sub init_tests {
setlogfunc(\&logmsg);
init_protocols();
initserverconfig();
}
#######################################################################
# Main test loop
init_tests();
#***************************************************************************
# Parse command-line options and commands
#
while(@ARGV) {
if($ARGV[0] eq "-h") {
print "Usage: devtest.pl [--verbose] [command [arg]...]\n";
print "command is one of:\n";
print " echo X\n";
print " pause\n";
print " preprocess\n";
print " protocols *|X[,Y...]\n";
print " protoport X\n";
print " serverfortest X[,Y...]\n";
print " stopservers\n";
print " sleep N\n";
exit 0;
}
elsif($ARGV[0] eq "--verbose") {
$verbose = 1;
}
elsif($ARGV[0] eq "sleep") {
shift @ARGV;
sleep $ARGV[0];
}
elsif($ARGV[0] eq "echo") {
shift @ARGV;
print $ARGV[0] . "\n";
}
elsif($ARGV[0] eq "pause") {
print "Press Enter to continue: ";
readline STDIN;
}
elsif($ARGV[0] eq "protocols") {
shift @ARGV;
if($ARGV[0] eq "*") {
init_protocols();
}
else {
@protocols = split(",", $ARGV[0]);
}
print "Set " . scalar @protocols . " protocols\n";
}
elsif($ARGV[0] eq "preprocess") {
shift @ARGV;
loadtest("${TESTDIR}/test${ARGV[0]}", 1);
readtestkeywords();
singletest_preprocess($ARGV[0]);
}
elsif($ARGV[0] eq "protoport") {
shift @ARGV;
my $port = protoport($ARGV[0]);
print "protoport: $port\n";
}
elsif($ARGV[0] eq "serverfortest") {
shift @ARGV;
my ($why, $e) = serverfortest(split(/,/, $ARGV[0]));
print "serverfortest: $e $why\n";
}
elsif($ARGV[0] eq "stopservers") {
my $err = stopservers();
print "stopservers: $err\n";
}
else {
print "Error: Unknown command: $ARGV[0]\n";
print "Continuing anyway\n";
}
shift @ARGV;
}
|
