mirror of
https://github.com/moparisthebest/curl
synced 2024-12-21 07:38:49 -05:00
9e9509e46a
Otherwise, subsequent uses of stunnel overwrite the configuration file of previous invocations so they can no longer be inspected.
357 lines
10 KiB
Perl
Executable File
357 lines
10 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#***************************************************************************
|
|
# _ _ ____ _
|
|
# Project ___| | | | _ \| |
|
|
# / __| | | | |_) | |
|
|
# | (__| |_| | _ <| |___
|
|
# \___|\___/|_| \_\_____|
|
|
#
|
|
# Copyright (C) 1998 - 2017, 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; # default 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 dependent variables
|
|
#
|
|
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:";
|
|
|
|
#***************************************************************************
|
|
# 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;
|