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