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