secureserver.pl (11486B)
1 #!/usr/bin/env perl 2 #*************************************************************************** 3 # _ _ ____ _ 4 # Project ___| | | | _ \| | 5 # / __| | | | |_) | | 6 # | (__| |_| | _ <| |___ 7 # \___|\___/|_| \_\_____| 8 # 9 # Copyright (C) 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.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 # SPDX-License-Identifier: curl 23 # 24 #*************************************************************************** 25 26 # This is the HTTPS, FTPS, POP3S, IMAPS, SMTPS, server used for curl test 27 # harness. Actually just a layer that runs stunnel properly using the 28 # non-secure test harness servers. 29 30 use strict; 31 use warnings; 32 33 BEGIN { 34 push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'}); 35 push(@INC, "."); 36 } 37 38 use Cwd; 39 use Cwd 'abs_path'; 40 use File::Basename; 41 42 use serverhelp qw( 43 server_pidfilename 44 server_logfilename 45 ); 46 47 use pathhelp; 48 49 my $stunnel = "stunnel"; 50 51 my $verbose=0; # set to 1 for debugging 52 53 my $accept_port = 8991; # just our default, weird enough 54 my $target_port = 8999; # default test http-server port 55 56 my $stuncert; 57 58 my $ver_major; 59 my $ver_minor; 60 my $fips_support; 61 my $stunnel_version; 62 my $tstunnel_windows; 63 my $socketopt; 64 my $cmd; 65 66 my $pidfile; # stunnel pid file 67 my $logfile; # stunnel log file 68 my $loglevel = 5; # stunnel log level 69 my $ipvnum = 4; # default IP version of stunneled server 70 my $idnum = 1; # default stunneled server instance number 71 my $proto = 'https'; # default secure server protocol 72 my $conffile; # stunnel configuration file 73 my $cafile; # certificate CA PEM file 74 my $certfile; # certificate chain PEM file 75 my $mtls = 0; # Whether to verify client certificates 76 77 #*************************************************************************** 78 # stunnel requires full path specification for several files. 79 # 80 my $path = getcwd(); 81 my $srcdir = $path; 82 my $logdir = $path .'/log'; 83 my $piddir; 84 85 #*************************************************************************** 86 # Signal handler to remove our stunnel 4.00 and newer configuration file. 87 # 88 sub exit_signal_handler { 89 my $signame = shift; 90 local $!; # preserve errno 91 local $?; # preserve exit status 92 unlink($conffile) if($conffile && (-f $conffile)); 93 exit; 94 } 95 96 #*************************************************************************** 97 # Process command line options 98 # 99 while(@ARGV) { 100 if($ARGV[0] eq '--verbose') { 101 $verbose = 1; 102 } 103 elsif($ARGV[0] eq '--proto') { 104 if($ARGV[1]) { 105 $proto = $ARGV[1]; 106 shift @ARGV; 107 } 108 } 109 elsif($ARGV[0] eq '--accept') { 110 if($ARGV[1]) { 111 if($ARGV[1] =~ /^(\d+)$/) { 112 $accept_port = $1; 113 shift @ARGV; 114 } 115 } 116 } 117 elsif($ARGV[0] eq '--connect') { 118 if($ARGV[1]) { 119 if($ARGV[1] =~ /^(\d+)$/) { 120 $target_port = $1; 121 shift @ARGV; 122 } 123 } 124 } 125 elsif($ARGV[0] eq '--stunnel') { 126 if($ARGV[1]) { 127 $stunnel = $ARGV[1]; 128 shift @ARGV; 129 } 130 } 131 elsif($ARGV[0] eq '--srcdir') { 132 if($ARGV[1]) { 133 $srcdir = $ARGV[1]; 134 shift @ARGV; 135 } 136 } 137 elsif($ARGV[0] eq '--certfile') { 138 if($ARGV[1]) { 139 $stuncert = $ARGV[1]; 140 shift @ARGV; 141 } 142 } 143 elsif($ARGV[0] eq '--id') { 144 if($ARGV[1]) { 145 if($ARGV[1] =~ /^(\d+)$/) { 146 $idnum = $1 if($1 > 0); 147 shift @ARGV; 148 } 149 } 150 } 151 elsif($ARGV[0] eq '--ipv4') { 152 $ipvnum = 4; 153 } 154 elsif($ARGV[0] eq '--ipv6') { 155 $ipvnum = 6; 156 } 157 elsif($ARGV[0] eq '--pidfile') { 158 if($ARGV[1]) { 159 $pidfile = "$path/". $ARGV[1]; 160 shift @ARGV; 161 } 162 } 163 elsif($ARGV[0] eq '--logfile') { 164 if($ARGV[1]) { 165 $logfile = "$path/". $ARGV[1]; 166 shift @ARGV; 167 } 168 } 169 elsif($ARGV[0] eq '--logdir') { 170 if($ARGV[1]) { 171 $logdir = "$path/". $ARGV[1]; 172 shift @ARGV; 173 } 174 } 175 elsif($ARGV[0] eq '--mtls') { 176 $mtls = 1; 177 } 178 else { 179 print STDERR "\nWarning: secureserver.pl unknown parameter: $ARGV[0]\n"; 180 } 181 shift @ARGV; 182 } 183 184 #*************************************************************************** 185 # Initialize command line option dependent variables 186 # 187 if($pidfile) { 188 # Use our pidfile directory to store the conf files 189 $piddir = dirname($pidfile); 190 } 191 else { 192 # Use the current directory to store the conf files 193 $piddir = $path; 194 $pidfile = server_pidfilename($piddir, $proto, $ipvnum, $idnum); 195 } 196 if(!$logfile) { 197 $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum); 198 } 199 200 $conffile = "$piddir/${proto}_stunnel.conf"; 201 202 $cafile = abs_path("$path/certs/test-ca.cacert"); 203 $certfile = $stuncert ? "certs/$stuncert" : "certs/test-localhost.pem"; 204 $certfile = abs_path($certfile); 205 206 my $ssltext = uc($proto) ." SSL/TLS:"; 207 208 my $host_ip = ($ipvnum == 6)? '::1' : '127.0.0.1'; 209 210 #*************************************************************************** 211 # Find out version info for the given stunnel binary 212 # 213 foreach my $veropt (('-version', '-V')) { 214 foreach my $verstr (qx("$stunnel" $veropt 2>&1)) { 215 if($verstr =~ /^stunnel (\d+)\.(\d+) on /) { 216 $ver_major = $1; 217 $ver_minor = $2; 218 } 219 elsif($verstr =~ /^sslVersion.*fips *= *yes/) { 220 # the fips option causes an error if stunnel doesn't support it 221 $fips_support = 1; 222 last 223 } 224 } 225 last if($ver_major); 226 } 227 if((!$ver_major) || !defined($ver_minor)) { 228 if(-x "$stunnel" && ! -d "$stunnel") { 229 print "$ssltext Unknown stunnel version\n"; 230 } 231 else { 232 print "$ssltext No stunnel\n"; 233 } 234 exit 1; 235 } 236 $stunnel_version = (100*$ver_major) + $ver_minor; 237 238 #*************************************************************************** 239 # Verify minimum stunnel required version 240 # 241 if($stunnel_version < 310) { 242 print "$ssltext Unsupported stunnel version $ver_major.$ver_minor\n"; 243 exit 1; 244 } 245 246 #*************************************************************************** 247 # Find out if we are running on Windows using the tstunnel binary 248 # 249 if($stunnel =~ /tstunnel(\.exe)?$/) { 250 $tstunnel_windows = 1; 251 252 # convert Cygwin/MinGW paths to Windows format 253 $cafile = pathhelp::sys_native_abs_path($cafile); 254 $certfile = pathhelp::sys_native_abs_path($certfile); 255 } 256 257 #*************************************************************************** 258 # Build command to execute for stunnel 3.X versions 259 # 260 if($stunnel_version < 400) { 261 if($stunnel_version >= 319) { 262 $socketopt = "-O a:SO_REUSEADDR=1"; 263 } 264 # TODO: we do not use $host_ip in this old version. I simply find 265 # no documentation how to. But maybe ipv6 is not available anyway? 266 $cmd = "\"$stunnel\" -p $certfile -P $pidfile "; 267 $cmd .= "-d $accept_port -r $target_port -f -D $loglevel "; 268 $cmd .= ($socketopt) ? "$socketopt " : ""; 269 $cmd .= ">$logfile 2>&1"; 270 if($verbose) { 271 print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n"; 272 print "cmd: $cmd\n"; 273 print "pem cert file: $certfile\n"; 274 print "pid file: $pidfile\n"; 275 print "log file: $logfile\n"; 276 print "log level: $loglevel\n"; 277 print "listen on port: $accept_port\n"; 278 print "connect to port: $target_port\n"; 279 } 280 } 281 282 #*************************************************************************** 283 # Build command to execute for stunnel 4.00 and newer 284 # 285 if($stunnel_version >= 400) { 286 $socketopt = "a:SO_REUSEADDR=1"; 287 if(($stunnel_version >= 534) && $tstunnel_windows) { 288 # SO_EXCLUSIVEADDRUSE is on by default on Vista or newer, 289 # but does not work together with SO_REUSEADDR being on. 290 $socketopt .= "\nsocket = a:SO_EXCLUSIVEADDRUSE=0"; 291 } 292 $cmd = "\"$stunnel\" $conffile "; 293 $cmd .= ">$logfile 2>&1"; 294 # setup signal handler 295 $SIG{INT} = \&exit_signal_handler; 296 $SIG{TERM} = \&exit_signal_handler; 297 # stunnel configuration file 298 if(open(my $stunconf, ">", "$conffile")) { 299 print $stunconf "cert = $certfile\n"; 300 print $stunconf "debug = $loglevel\n"; 301 print $stunconf "socket = $socketopt\n"; 302 if($mtls) { 303 print $stunconf "CAfile = $cafile\n"; 304 print $stunconf "verifyChain = yes\n"; 305 } 306 if($fips_support) { 307 # disable fips in case OpenSSL doesn't support it 308 print $stunconf "fips = no\n"; 309 } 310 if(!$tstunnel_windows) { 311 # do not use Linux-specific options on Windows 312 print $stunconf "output = $logfile\n"; 313 print $stunconf "pid = $pidfile\n"; 314 print $stunconf "foreground = yes\n"; 315 } 316 print $stunconf "\n"; 317 print $stunconf "[curltest]\n"; 318 print $stunconf "accept = $host_ip:$accept_port\n"; 319 print $stunconf "connect = $host_ip:$target_port\n"; 320 if(!close($stunconf)) { 321 print "$ssltext Error closing file $conffile\n"; 322 exit 1; 323 } 324 } 325 else { 326 print "$ssltext Error writing file $conffile\n"; 327 exit 1; 328 } 329 if($verbose) { 330 print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n"; 331 print "cmd: $cmd\n"; 332 print "stunnel config at $conffile:\n"; 333 open (my $writtenconf, '<', "$conffile") or die "$ssltext could not open the config file after writing\n"; 334 print <$writtenconf>; 335 print "\n"; 336 close ($writtenconf); 337 } 338 } 339 340 #*************************************************************************** 341 # Set file permissions on certificate pem file. 342 # 343 chmod(0600, $certfile) if(-f $certfile); 344 print STDERR "RUN: $cmd\n" if($verbose); 345 346 #*************************************************************************** 347 # Run tstunnel on Windows. 348 # 349 if($tstunnel_windows) { 350 # Fake pidfile for tstunnel on Windows. 351 if(open(my $out, ">", "$pidfile")) { 352 print $out $$ . "\n"; 353 close($out); 354 } 355 356 # Flush output. 357 $| = 1; 358 359 # Put an "exec" in front of the command so that the child process 360 # keeps this child's process ID by being tied to the spawned shell. 361 exec("exec $cmd") || die "Can't exec() $cmd: $!"; 362 # exec() will create a new process, but ties the existence of the 363 # new process to the parent waiting perl.exe and sh.exe processes. 364 365 # exec() should never return back here to this process. We protect 366 # ourselves by calling die() just in case something goes really bad. 367 die "error: exec() has returned"; 368 } 369 370 #*************************************************************************** 371 # Run stunnel. 372 # 373 my $rc = system($cmd); 374 375 $rc >>= 8; 376 377 unlink($conffile) if($conffile && -f $conffile); 378 379 exit $rc;