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