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;
my $accept_port = 8991; my $target_port = 8999;
my $stuncert;
my $ver_major;
my $ver_minor;
my $fips_support;
my $stunnel_version;
my $tstunnel_windows;
my $socketopt;
my $cmd;
my $pidfile; my $logfile; my $loglevel = 5; my $ipvnum = 4; my $idnum = 1; my $proto = 'https'; my $conffile; my $capath; my $certfile;
my $path = getcwd();
my $srcdir = $path;
my $logdir = $path .'/log';
sub exit_signal_handler {
my $signame = shift;
local $!; local $?; unlink($conffile) if($conffile && (-f $conffile));
exit;
}
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;
}
if(!$pidfile) {
$pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
}
if(!$logfile) {
$logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
}
$conffile = "$path/${proto}_stunnel.conf";
$capath = abs_path($path);
$certfile = "$srcdir/". ($stuncert?"certs/$stuncert":"stunnel.pem");
$certfile = abs_path($certfile);
my $ssltext = uc($proto) ." SSL/TLS:";
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/) {
$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;
if($stunnel_version < 310) {
print "$ssltext Unsupported stunnel version $ver_major.$ver_minor\n";
exit 1;
}
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";
if(($stunnel_version >= 534) && $tstunnel_windows) {
# SO_EXCLUSIVEADDRUSE is on by default on Vista or newer,
# but does not work together with SO_REUSEADDR being on.
$socketopt .= "\nsocket = a:SO_EXCLUSIVEADDRUSE=0";
}
$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;