#!/usr/bin/env perl #*************************************************************************** # _ _ ____ _ # Project ___| | | | _ \| | # / __| | | | |_) | | # | (__| |_| | _ <| |___ # \___|\___/|_| \_\_____| # # Copyright (C) 1998 - 2014, Daniel Stenberg, <daniel@haxx.se>, et al. # # This software is licensed as described in the file COPYING, which # you should have received as part of this distribution. The terms # are also available at https://curl.haxx.se/docs/copyright.html. # # You may opt to use, copy, modify, merge, publish, distribute and/or sell # copies of the Software, and permit persons to whom the Software is # furnished to do so, under the terms of the COPYING file. # # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY # KIND, either express or implied. # #*************************************************************************** # This is the HTTPS, FTPS, POP3S, IMAPS, SMTPS, server used for curl test # harness. Actually just a layer that runs stunnel properly using the # non-secure test harness servers. BEGIN { push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'}); push(@INC, "."); } use strict; use warnings; use Cwd; use Cwd 'abs_path'; use serverhelp qw( server_pidfilename server_logfilename ); my $stunnel = "stunnel"; my $verbose=0; # set to 1 for debugging my $accept_port = 8991; # just our default, weird enough my $target_port = 8999; # default test http-server port my $stuncert; my $ver_major; my $ver_minor; my $fips_support; my $stunnel_version; my $tstunnel_windows; my $socketopt; my $cmd; my $pidfile; # stunnel pid file my $logfile; # stunnel log file my $loglevel = 5; # stunnel log level my $ipvnum = 4; # default IP version of stunneled server my $idnum = 1; # dafault stunneled server instance number my $proto = 'https'; # default secure server protocol my $conffile; # stunnel configuration file my $capath; # certificate chain PEM folder my $certfile; # certificate chain PEM file #*************************************************************************** # stunnel requires full path specification for several files. # my $path = getcwd(); my $srcdir = $path; my $logdir = $path .'/log'; #*************************************************************************** # Signal handler to remove our stunnel 4.00 and newer configuration file. # sub exit_signal_handler { my $signame = shift; local $!; # preserve errno local $?; # preserve exit status unlink($conffile) if($conffile && (-f $conffile)); exit; } #*************************************************************************** # Process command line options # while(@ARGV) { if($ARGV[0] eq '--verbose') { $verbose = 1; } elsif($ARGV[0] eq '--proto') { if($ARGV[1]) { $proto = $ARGV[1]; shift @ARGV; } } elsif($ARGV[0] eq '--accept') { if($ARGV[1]) { if($ARGV[1] =~ /^(\d+)$/) { $accept_port = $1; shift @ARGV; } } } elsif($ARGV[0] eq '--connect') { if($ARGV[1]) { if($ARGV[1] =~ /^(\d+)$/) { $target_port = $1; shift @ARGV; } } } elsif($ARGV[0] eq '--stunnel') { if($ARGV[1]) { if($ARGV[1] =~ /^([\w\/]+)$/) { $stunnel = $ARGV[1]; } else { $stunnel = "\"". $ARGV[1] ."\""; } shift @ARGV; } } elsif($ARGV[0] eq '--srcdir') { if($ARGV[1]) { $srcdir = $ARGV[1]; shift @ARGV; } } elsif($ARGV[0] eq '--certfile') { if($ARGV[1]) { $stuncert = $ARGV[1]; shift @ARGV; } } elsif($ARGV[0] eq '--id') { if($ARGV[1]) { if($ARGV[1] =~ /^(\d+)$/) { $idnum = $1 if($1 > 0); shift @ARGV; } } } elsif($ARGV[0] eq '--ipv4') { $ipvnum = 4; } elsif($ARGV[0] eq '--ipv6') { $ipvnum = 6; } elsif($ARGV[0] eq '--pidfile') { if($ARGV[1]) { $pidfile = "$path/". $ARGV[1]; shift @ARGV; } } elsif($ARGV[0] eq '--logfile') { if($ARGV[1]) { $logfile = "$path/". $ARGV[1]; shift @ARGV; } } else { print STDERR "\nWarning: secureserver.pl unknown parameter: $ARGV[0]\n"; } shift @ARGV; } #*************************************************************************** # Initialize command line option dependant variables # if(!$pidfile) { $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum); } if(!$logfile) { $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum); } $conffile = "$path/stunnel.conf"; $capath = abs_path($path); $certfile = "$srcdir/". ($stuncert?"certs/$stuncert":"stunnel.pem"); $certfile = abs_path($certfile); my $ssltext = uc($proto) ." SSL/TLS:"; #*************************************************************************** # Find out version info for the given stunnel binary # foreach my $veropt (('-version', '-V')) { foreach my $verstr (qx($stunnel $veropt 2>&1)) { if($verstr =~ /^stunnel (\d+)\.(\d+) on /) { $ver_major = $1; $ver_minor = $2; } elsif($verstr =~ /^sslVersion.*fips *= *yes/) { # the fips option causes an error if stunnel doesn't support it $fips_support = 1; last } } last if($ver_major); } if((!$ver_major) || (!$ver_minor)) { if(-x "$stunnel" && ! -d "$stunnel") { print "$ssltext Unknown stunnel version\n"; } else { print "$ssltext No stunnel\n"; } exit 1; } $stunnel_version = (100*$ver_major) + $ver_minor; #*************************************************************************** # Verify minimum stunnel required version # if($stunnel_version < 310) { print "$ssltext Unsupported stunnel version $ver_major.$ver_minor\n"; exit 1; } #*************************************************************************** # Find out if we are running on Windows using the tstunnel binary # if($stunnel =~ /tstunnel(\.exe)?"?$/) { $tstunnel_windows = 1; # replace Cygwin and MinGW drives within paths $capath =~ s/^(\/cygdrive)?\/(\w)\//$2\:\//; $certfile =~ s/^(\/cygdrive)?\/(\w)\//$2\:\//; } #*************************************************************************** # Build command to execute for stunnel 3.X versions # if($stunnel_version < 400) { if($stunnel_version >= 319) { $socketopt = "-O a:SO_REUSEADDR=1"; } $cmd = "$stunnel -p $certfile -P $pidfile "; $cmd .= "-d $accept_port -r $target_port -f -D $loglevel "; $cmd .= ($socketopt) ? "$socketopt " : ""; $cmd .= ">$logfile 2>&1"; if($verbose) { print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n"; print "cmd: $cmd\n"; print "pem cert file: $certfile\n"; print "pid file: $pidfile\n"; print "log file: $logfile\n"; print "log level: $loglevel\n"; print "listen on port: $accept_port\n"; print "connect to port: $target_port\n"; } } #*************************************************************************** # Build command to execute for stunnel 4.00 and newer # if($stunnel_version >= 400) { $socketopt = "a:SO_REUSEADDR=1"; $cmd = "$stunnel $conffile "; $cmd .= ">$logfile 2>&1"; # setup signal handler $SIG{INT} = \&exit_signal_handler; $SIG{TERM} = \&exit_signal_handler; # stunnel configuration file if(open(STUNCONF, ">$conffile")) { print STUNCONF "CApath = $capath\n"; print STUNCONF "cert = $certfile\n"; print STUNCONF "debug = $loglevel\n"; print STUNCONF "socket = $socketopt\n"; if($fips_support) { # disable fips in case OpenSSL doesn't support it print STUNCONF "fips = no\n"; } if(!$tstunnel_windows) { # do not use Linux-specific options on Windows print STUNCONF "output = $logfile\n"; print STUNCONF "pid = $pidfile\n"; print STUNCONF "foreground = yes\n"; } print STUNCONF "\n"; print STUNCONF "[curltest]\n"; print STUNCONF "accept = $accept_port\n"; print STUNCONF "connect = $target_port\n"; if(!close(STUNCONF)) { print "$ssltext Error closing file $conffile\n"; exit 1; } } else { print "$ssltext Error writing file $conffile\n"; exit 1; } if($verbose) { print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n"; print "cmd: $cmd\n"; print "CApath = $capath\n"; print "cert = $certfile\n"; print "debug = $loglevel\n"; print "socket = $socketopt\n"; if($fips_support) { print "fips = no\n"; } if(!$tstunnel_windows) { print "pid = $pidfile\n"; print "output = $logfile\n"; print "foreground = yes\n"; } print "\n"; print "[curltest]\n"; print "accept = $accept_port\n"; print "connect = $target_port\n"; } } #*************************************************************************** # Set file permissions on certificate pem file. # chmod(0600, $certfile) if(-f $certfile); #*************************************************************************** # Run tstunnel on Windows. # if($tstunnel_windows) { # Fake pidfile for tstunnel on Windows. if(open(OUT, ">$pidfile")) { print OUT $$ . "\n"; close(OUT); } # Put an "exec" in front of the command so that the child process # keeps this child's process ID. exec("exec $cmd") || die "Can't exec() $cmd: $!"; # exec() should never return back here to this process. We protect # ourselves by calling die() just in case something goes really bad. die "error: exec() has returned"; } #*************************************************************************** # Run stunnel. # my $rc = system($cmd); $rc >>= 8; unlink($conffile) if($conffile && -f $conffile); exit $rc;