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