--- /dev/null
+#!/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 harneess. 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;
+use runner qw(
+ readtestkeywords
+ singletest_preprocess
+);
+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 {
+ 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;
+}
projects / thirdparty / curl.git / commitdiff
