2
0

devtest.pl 5.8 KB

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