1 #!/usr/bin/env perl 2 #*************************************************************************** 3 # _ _ ____ _ 4 # Project ___| | | | _ \| | 5 # / __| | | | |_) | | 6 # | (__| |_| | _ <| |___ 7 # \___|\___/|_| \_\_____| 8 # 9 # Copyright (C) 1998 - 2014, 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 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 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 my $stunnel = "stunnel"; 44 45 my $verbose=0; # set to 1 for debugging 46 47 my $accept_port = 8991; # just our default, weird enough 48 my $target_port = 8999; # default test http-server port 49 50 my $stuncert; 51 52 my $ver_major; 53 my $ver_minor; 54 my $fips_support; 55 my $stunnel_version; 56 my $tstunnel_windows; 57 my $socketopt; 58 my $cmd; 59 60 my $pidfile; # stunnel pid file 61 my $logfile; # stunnel log file 62 my $loglevel = 5; # stunnel log level 63 my $ipvnum = 4; # default IP version of stunneled server 64 my $idnum = 1; # dafault stunneled server instance number 65 my $proto = 'https'; # default secure server protocol 66 my $conffile; # stunnel configuration file 67 my $capath; # certificate chain PEM folder 68 my $certfile; # certificate chain PEM file 69 70 #*************************************************************************** 71 # stunnel requires full path specification for several files. 72 # 73 my $path = getcwd(); 74 my $srcdir = $path; 75 my $logdir = $path .'/log'; 76 77 #*************************************************************************** 78 # Signal handler to remove our stunnel 4.00 and newer configuration file. 79 # 80 sub 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 # 91 while(@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 # 175 if(!$pidfile) { 176 $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum); 177 } 178 if(!$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 188 my $ssltext = uc($proto) ." SSL/TLS:"; 189 190 #*************************************************************************** 191 # Find out version info for the given stunnel binary 192 # 193 foreach 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 } 207 if((!$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 # 221 if($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 # 229 if($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 # 240 if($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 # 263 if($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 # 324 chmod(0600, $certfile) if(-f $certfile); 325 326 #*************************************************************************** 327 # Run tstunnel on Windows. 328 # 329 if($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 # 348 my $rc = system($cmd); 349 350 $rc >>= 8; 351 352 unlink($conffile) if($conffile && -f $conffile); 353 354 exit $rc; 355
