1 #!/usr/bin/env perl 2 #*************************************************************************** 3 # _ _ ____ _ 4 # Project ___| | | | _ \| | 5 # / __| | | | |_) | | 6 # | (__| |_| | _ <| |___ 7 # \___|\___/|_| \_\_____| 8 # 9 # Copyright (C) 1998 - 2017, Daniel Stenberg, <daniel (at] 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 28 BEGIN { 29 push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'}); 30 push(@INC, "."); 31 } 32 33 use strict; 34 use warnings; 35 use Cwd; 36 use Cwd 'abs_path'; 37 38 use serverhelp qw( 39 server_pidfilename 40 server_logfilename 41 ); 42 43 use pathhelp; 44 45 my $stunnel = "stunnel"; 46 47 my $verbose=0; # set to 1 for debugging 48 49 my $accept_port = 8991; # just our default, weird enough 50 my $target_port = 8999; # default test http-server port 51 52 my $stuncert; 53 54 my $ver_major; 55 my $ver_minor; 56 my $fips_support; 57 my $stunnel_version; 58 my $tstunnel_windows; 59 my $socketopt; 60 my $cmd; 61 62 my $pidfile; # stunnel pid file 63 my $logfile; # stunnel log file 64 my $loglevel = 5; # stunnel log level 65 my $ipvnum = 4; # default IP version of stunneled server 66 my $idnum = 1; # default stunneled server instance number 67 my $proto = 'https'; # default secure server protocol 68 my $conffile; # stunnel configuration file 69 my $capath; # certificate chain PEM folder 70 my $certfile; # certificate chain PEM file 71 72 #*************************************************************************** 73 # stunnel requires full path specification for several files. 74 # 75 my $path = getcwd(); 76 my $srcdir = $path; 77 my $logdir = $path .'/log'; 78 79 #*************************************************************************** 80 # Signal handler to remove our stunnel 4.00 and newer configuration file. 81 # 82 sub 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 # 93 while(@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 # 177 if(!$pidfile) { 178 $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum); 179 } 180 if(!$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 190 my $ssltext = uc($proto) ." SSL/TLS:"; 191 192 #*************************************************************************** 193 # Find out version info for the given stunnel binary 194 # 195 foreach 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 } 209 if((!$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 # 223 if($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 # 231 if($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 # 242 if($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 # 265 if($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 # 326 chmod(0600, $certfile) if(-f $certfile); 327 328 #*************************************************************************** 329 # Run tstunnel on Windows. 330 # 331 if($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 # 350 my $rc = system($cmd); 351 352 $rc >>= 8; 353 354 unlink($conffile) if($conffile && -f $conffile); 355 356 exit $rc; 357
