Update networking layer w/ CURL and emscripten impl
This commit is contained in:
+202
@@ -0,0 +1,202 @@
|
||||
#!/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. Don't try to use this unless you know what you're
|
||||
# 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's 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 isn't
|
||||
# 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]}");
|
||||
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;
|
||||
}
|
||||
Reference in New Issue
Block a user