xref: /curl/tests/secureserver.pl (revision f5189827) 
1#!/usr/bin/env perl
2#***************************************************************************
3#                                  _   _ ____  _
4#  Project                     ___| | | |  _ \| |
5#                             / __| | | | |_) | |
6#                            | (__| |_| |  _ <| |___
7#                             \___|\___/|_| \_\_____|
8#
9# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, 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 is the HTTPS, FTPS, POP3S, IMAPS, SMTPS, server used for curl test
27# harness. Actually just a layer that runs stunnel properly using the
28# non-secure test harness servers.
29
30use strict;
31use warnings;
32
33BEGIN {
34    push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
35    push(@INC, ".");
36}
37
38use Cwd;
39use Cwd 'abs_path';
40use File::Basename;
41
42use serverhelp qw(
43    server_pidfilename
44    server_logfilename
45    );
46
47use pathhelp;
48
49my $stunnel = "stunnel";
50
51my $verbose=0; # set to 1 for debugging
52
53my $accept_port = 8991; # just our default, weird enough
54my $target_port = 8999; # default test http-server port
55
56my $stuncert;
57
58my $ver_major;
59my $ver_minor;
60my $fips_support;
61my $stunnel_version;
62my $tstunnel_windows;
63my $socketopt;
64my $cmd;
65
66my $pidfile;          # stunnel pid file
67my $logfile;          # stunnel log file
68my $loglevel = 5;     # stunnel log level
69my $ipvnum = 4;       # default IP version of stunneled server
70my $idnum = 1;        # default stunneled server instance number
71my $proto = 'https';  # default secure server protocol
72my $conffile;         # stunnel configuration file
73my $capath;           # certificate chain PEM folder
74my $certfile;         # certificate chain PEM file
75
76#***************************************************************************
77# stunnel requires full path specification for several files.
78#
79my $path   = getcwd();
80my $srcdir = $path;
81my $logdir = $path .'/log';
82my $piddir;
83
84#***************************************************************************
85# Signal handler to remove our stunnel 4.00 and newer configuration file.
86#
87sub exit_signal_handler {
88    my $signame = shift;
89    local $!; # preserve errno
90    local $?; # preserve exit status
91    unlink($conffile) if($conffile && (-f $conffile));
92    exit;
93}
94
95#***************************************************************************
96# Process command line options
97#
98while(@ARGV) {
99    if($ARGV[0] eq '--verbose') {
100        $verbose = 1;
101    }
102    elsif($ARGV[0] eq '--proto') {
103        if($ARGV[1]) {
104            $proto = $ARGV[1];
105            shift @ARGV;
106        }
107    }
108    elsif($ARGV[0] eq '--accept') {
109        if($ARGV[1]) {
110            if($ARGV[1] =~ /^(\d+)$/) {
111                $accept_port = $1;
112                shift @ARGV;
113            }
114        }
115    }
116    elsif($ARGV[0] eq '--connect') {
117        if($ARGV[1]) {
118            if($ARGV[1] =~ /^(\d+)$/) {
119                $target_port = $1;
120                shift @ARGV;
121            }
122        }
123    }
124    elsif($ARGV[0] eq '--stunnel') {
125        if($ARGV[1]) {
126            $stunnel = $ARGV[1];
127            shift @ARGV;
128        }
129    }
130    elsif($ARGV[0] eq '--srcdir') {
131        if($ARGV[1]) {
132            $srcdir = $ARGV[1];
133            shift @ARGV;
134        }
135    }
136    elsif($ARGV[0] eq '--certfile') {
137        if($ARGV[1]) {
138            $stuncert = $ARGV[1];
139            shift @ARGV;
140        }
141    }
142    elsif($ARGV[0] eq '--id') {
143        if($ARGV[1]) {
144            if($ARGV[1] =~ /^(\d+)$/) {
145                $idnum = $1 if($1 > 0);
146                shift @ARGV;
147            }
148        }
149    }
150    elsif($ARGV[0] eq '--ipv4') {
151        $ipvnum = 4;
152    }
153    elsif($ARGV[0] eq '--ipv6') {
154        $ipvnum = 6;
155    }
156    elsif($ARGV[0] eq '--pidfile') {
157        if($ARGV[1]) {
158            $pidfile = "$path/". $ARGV[1];
159            shift @ARGV;
160        }
161    }
162    elsif($ARGV[0] eq '--logfile') {
163        if($ARGV[1]) {
164            $logfile = "$path/". $ARGV[1];
165            shift @ARGV;
166        }
167    }
168    elsif($ARGV[0] eq '--logdir') {
169        if($ARGV[1]) {
170            $logdir = "$path/". $ARGV[1];
171            shift @ARGV;
172        }
173    }
174    else {
175        print STDERR "\nWarning: secureserver.pl unknown parameter: $ARGV[0]\n";
176    }
177    shift @ARGV;
178}
179
180#***************************************************************************
181# Initialize command line option dependent variables
182#
183if($pidfile) {
184    # Use our pidfile directory to store the conf files
185    $piddir = dirname($pidfile);
186}
187else {
188    # Use the current directory to store the conf files
189    $piddir = $path;
190    $pidfile = server_pidfilename($piddir, $proto, $ipvnum, $idnum);
191}
192if(!$logfile) {
193    $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
194}
195
196$conffile = "$piddir/${proto}_stunnel.conf";
197
198$capath = abs_path($path);
199$certfile = "$srcdir/". ($stuncert?"certs/$stuncert":"stunnel.pem");
200$certfile = abs_path($certfile);
201
202my $ssltext = uc($proto) ." SSL/TLS:";
203
204my $host_ip = ($ipvnum == 6)? '::1' : '127.0.0.1';
205
206#***************************************************************************
207# Find out version info for the given stunnel binary
208#
209foreach my $veropt (('-version', '-V')) {
210    foreach my $verstr (qx("$stunnel" $veropt 2>&1)) {
211        if($verstr =~ /^stunnel (\d+)\.(\d+) on /) {
212            $ver_major = $1;
213            $ver_minor = $2;
214        }
215        elsif($verstr =~ /^sslVersion.*fips *= *yes/) {
216            # the fips option causes an error if stunnel doesn't support it
217            $fips_support = 1;
218            last
219        }
220    }
221    last if($ver_major);
222}
223if((!$ver_major) || !defined($ver_minor)) {
224    if(-x "$stunnel" && ! -d "$stunnel") {
225        print "$ssltext Unknown stunnel version\n";
226    }
227    else {
228        print "$ssltext No stunnel\n";
229    }
230    exit 1;
231}
232$stunnel_version = (100*$ver_major) + $ver_minor;
233
234#***************************************************************************
235# Verify minimum stunnel required version
236#
237if($stunnel_version < 310) {
238    print "$ssltext Unsupported stunnel version $ver_major.$ver_minor\n";
239    exit 1;
240}
241
242#***************************************************************************
243# Find out if we are running on Windows using the tstunnel binary
244#
245if($stunnel =~ /tstunnel(\.exe)?$/) {
246    $tstunnel_windows = 1;
247
248    # convert Cygwin/MinGW paths to Windows format
249    $capath = pathhelp::sys_native_abs_path($capath);
250    $certfile = pathhelp::sys_native_abs_path($certfile);
251}
252
253#***************************************************************************
254# Build command to execute for stunnel 3.X versions
255#
256if($stunnel_version < 400) {
257    if($stunnel_version >= 319) {
258        $socketopt = "-O a:SO_REUSEADDR=1";
259    }
260    # TODO: we do not use $host_ip in this old version. I simply find
261    # no documentation how to. But maybe ipv6 is not available anyway?
262    $cmd  = "\"$stunnel\" -p $certfile -P $pidfile ";
263    $cmd .= "-d $accept_port -r $target_port -f -D $loglevel ";
264    $cmd .= ($socketopt) ? "$socketopt " : "";
265    $cmd .= ">$logfile 2>&1";
266    if($verbose) {
267        print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
268        print "cmd: $cmd\n";
269        print "pem cert file: $certfile\n";
270        print "pid file: $pidfile\n";
271        print "log file: $logfile\n";
272        print "log level: $loglevel\n";
273        print "listen on port: $accept_port\n";
274        print "connect to port: $target_port\n";
275    }
276}
277
278#***************************************************************************
279# Build command to execute for stunnel 4.00 and newer
280#
281if($stunnel_version >= 400) {
282    $socketopt = "a:SO_REUSEADDR=1";
283    if(($stunnel_version >= 534) && $tstunnel_windows) {
284        # SO_EXCLUSIVEADDRUSE is on by default on Vista or newer,
285        # but does not work together with SO_REUSEADDR being on.
286        $socketopt .= "\nsocket = a:SO_EXCLUSIVEADDRUSE=0";
287    }
288    $cmd  = "\"$stunnel\" $conffile ";
289    $cmd .= ">$logfile 2>&1";
290    # setup signal handler
291    $SIG{INT} = \&exit_signal_handler;
292    $SIG{TERM} = \&exit_signal_handler;
293    # stunnel configuration file
294    if(open(my $stunconf, ">", "$conffile")) {
295        print $stunconf "CApath = $capath\n";
296        print $stunconf "cert = $certfile\n";
297        print $stunconf "debug = $loglevel\n";
298        print $stunconf "socket = $socketopt\n";
299        if($fips_support) {
300            # disable fips in case OpenSSL doesn't support it
301            print $stunconf "fips = no\n";
302        }
303        if(!$tstunnel_windows) {
304            # do not use Linux-specific options on Windows
305            print $stunconf "output = $logfile\n";
306            print $stunconf "pid = $pidfile\n";
307            print $stunconf "foreground = yes\n";
308        }
309        print $stunconf "\n";
310        print $stunconf "[curltest]\n";
311        print $stunconf "accept = $host_ip:$accept_port\n";
312        print $stunconf "connect = $host_ip:$target_port\n";
313        if(!close($stunconf)) {
314            print "$ssltext Error closing file $conffile\n";
315            exit 1;
316        }
317    }
318    else {
319        print "$ssltext Error writing file $conffile\n";
320        exit 1;
321    }
322    if($verbose) {
323        print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
324        print "cmd: $cmd\n";
325        print "CApath = $capath\n";
326        print "cert = $certfile\n";
327        print "debug = $loglevel\n";
328        print "socket = $socketopt\n";
329        if($fips_support) {
330            print "fips = no\n";
331        }
332        if(!$tstunnel_windows) {
333            print "pid = $pidfile\n";
334            print "output = $logfile\n";
335            print "foreground = yes\n";
336        }
337        print "\n";
338        print "[curltest]\n";
339        print "accept = $host_ip:$accept_port\n";
340        print "connect = $host_ip:$target_port\n";
341    }
342}
343
344#***************************************************************************
345# Set file permissions on certificate pem file.
346#
347chmod(0600, $certfile) if(-f $certfile);
348print STDERR "RUN: $cmd\n" if($verbose);
349
350#***************************************************************************
351# Run tstunnel on Windows.
352#
353if($tstunnel_windows) {
354    # Fake pidfile for tstunnel on Windows.
355    if(open(my $out, ">", "$pidfile")) {
356        print $out $$ . "\n";
357        close($out);
358    }
359
360    # Flush output.
361    $| = 1;
362
363    # Put an "exec" in front of the command so that the child process
364    # keeps this child's process ID by being tied to the spawned shell.
365    exec("exec $cmd") || die "Can't exec() $cmd: $!";
366    # exec() will create a new process, but ties the existence of the
367    # new process to the parent waiting perl.exe and sh.exe processes.
368
369    # exec() should never return back here to this process. We protect
370    # ourselves by calling die() just in case something goes really bad.
371    die "error: exec() has returned";
372}
373
374#***************************************************************************
375# Run stunnel.
376#
377my $rc = system($cmd);
378
379$rc >>= 8;
380
381unlink($conffile) if($conffile && -f $conffile);
382
383exit $rc;
384