You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
356 lines
10 KiB
356 lines
10 KiB
#!/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 |
|
); |
|
|
|
use pathhelp; |
|
|
|
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; |
|
|
|
# convert Cygwin/MinGW paths to Win32 format |
|
$capath = pathhelp::sys_native_abs_path($capath); |
|
$certfile = pathhelp::sys_native_abs_path($certfile); |
|
} |
|
|
|
#*************************************************************************** |
|
# 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;
|
|
|