1#!/usr/bin/env perl 2#*************************************************************************** 3# _ _ ____ _ 4# Project ___| | | | _ \| | 5# / __| | | | |_) | | 6# | (__| |_| | _ <| |___ 7# \___|\___/|_| \_\_____| 8# 9# Copyright (C) 1998 - 2020, 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 if(($stunnel_version >= 534) && $tstunnel_windows) { 268 # SO_EXCLUSIVEADDRUSE is on by default on Vista or newer, 269 # but does not work together with SO_REUSEADDR being on. 270 $socketopt .= "\nsocket = a:SO_EXCLUSIVEADDRUSE=0"; 271 } 272 $cmd = "$stunnel $conffile "; 273 $cmd .= ">$logfile 2>&1"; 274 # setup signal handler 275 $SIG{INT} = \&exit_signal_handler; 276 $SIG{TERM} = \&exit_signal_handler; 277 # stunnel configuration file 278 if(open(STUNCONF, ">$conffile")) { 279 print STUNCONF "CApath = $capath\n"; 280 print STUNCONF "cert = $certfile\n"; 281 print STUNCONF "debug = $loglevel\n"; 282 print STUNCONF "socket = $socketopt\n"; 283 if($fips_support) { 284 # disable fips in case OpenSSL doesn't support it 285 print STUNCONF "fips = no\n"; 286 } 287 if(!$tstunnel_windows) { 288 # do not use Linux-specific options on Windows 289 print STUNCONF "output = $logfile\n"; 290 print STUNCONF "pid = $pidfile\n"; 291 print STUNCONF "foreground = yes\n"; 292 } 293 print STUNCONF "\n"; 294 print STUNCONF "[curltest]\n"; 295 print STUNCONF "accept = $accept_port\n"; 296 print STUNCONF "connect = $target_port\n"; 297 if(!close(STUNCONF)) { 298 print "$ssltext Error closing file $conffile\n"; 299 exit 1; 300 } 301 } 302 else { 303 print "$ssltext Error writing file $conffile\n"; 304 exit 1; 305 } 306 if($verbose) { 307 print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n"; 308 print "cmd: $cmd\n"; 309 print "CApath = $capath\n"; 310 print "cert = $certfile\n"; 311 print "debug = $loglevel\n"; 312 print "socket = $socketopt\n"; 313 if($fips_support) { 314 print "fips = no\n"; 315 } 316 if(!$tstunnel_windows) { 317 print "pid = $pidfile\n"; 318 print "output = $logfile\n"; 319 print "foreground = yes\n"; 320 } 321 print "\n"; 322 print "[curltest]\n"; 323 print "accept = $accept_port\n"; 324 print "connect = $target_port\n"; 325 } 326} 327 328#*************************************************************************** 329# Set file permissions on certificate pem file. 330# 331chmod(0600, $certfile) if(-f $certfile); 332print STDERR "RUN: $cmd\n" if($verbose); 333 334#*************************************************************************** 335# Run tstunnel on Windows. 336# 337if($tstunnel_windows) { 338 # Fake pidfile for tstunnel on Windows. 339 if(open(OUT, ">$pidfile")) { 340 print OUT $$ . "\n"; 341 close(OUT); 342 } 343 344 # Put an "exec" in front of the command so that the child process 345 # keeps this child's process ID by being tied to the spawned shell. 346 exec("exec $cmd") || die "Can't exec() $cmd: $!"; 347 # exec() will create a new process, but ties the existence of the 348 # new process to the parent waiting perl.exe and sh.exe processes. 349 350 # exec() should never return back here to this process. We protect 351 # ourselves by calling die() just in case something goes really bad. 352 die "error: exec() has returned"; 353} 354 355#*************************************************************************** 356# Run stunnel. 357# 358my $rc = system($cmd); 359 360$rc >>= 8; 361 362unlink($conffile) if($conffile && -f $conffile); 363 364exit $rc; 365