moparisthebest/curl
1
0
Fork 0
mirror of https://github.com/moparisthebest/curl synced 2024-08-13 17:03:50 -04:00
Code Issues Releases Wiki Activity
9a8fa076bf
curl/tests/secureserver.pl
Marc Hoersken c1951cdb38
tests: use Cygwin/msys PIDs for stunnel and sshd on Windows 
Since the Windows versions of both programs would write Windows
PIDs to their pidfiles which we cannot handle, we need to use
our known perl.exe Cygwin/msys PID together with exec() in order
to tie the spawned processes to the existance of our perl.exe

The perl.exe that is executing secureserver.pl and sshserver.pl
has a Cygwin/msys PID, because it is started inside Cygwin/msys.

Related to #5188
2020-04-11 23:46:15 +02:00

365 lines
11 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/env perl
#***************************************************************************
# _ _ ____ _
# Project ___| | | | _ \| |
# / __| | | | |_) | |
# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
# Copyright (C) 1998 - 2020, 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";
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);
print STDERR "RUN: $cmd\n" if($verbose);
#***************************************************************************
# 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 by being tied to the spawned shell.
exec("exec $cmd") || die "Can't exec() $cmd: $!";
# exec() will create a new process, but ties the existance of the
# new process to the parent waiting perl.exe and sh.exe processes.
# 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;
Reference in New Issue View Git Blame Copy Permalink