tests/secureserver.pl - third_party/curl - Git at Google

 #!/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;
	#!/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;