Annotation of embedaddon/curl/tests/secureserver.pl, revision 1.1
1.1 ! misho 1: #!/usr/bin/env perl
! 2: #***************************************************************************
! 3: # _ _ ____ _
! 4: # Project ___| | | | _ \| |
! 5: # / __| | | | |_) | |
! 6: # | (__| |_| | _ <| |___
! 7: # \___|\___/|_| \_\_____|
! 8: #
! 9: # Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
! 10: #
! 11: # This software is licensed as described in the file COPYING, which
! 12: # you should have received as part of this distribution. The terms
! 13: # are also available at https://curl.haxx.se/docs/copyright.html.
! 14: #
! 15: # You may opt to use, copy, modify, merge, publish, distribute and/or sell
! 16: # copies of the Software, and permit persons to whom the Software is
! 17: # furnished to do so, under the terms of the COPYING file.
! 18: #
! 19: # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
! 20: # KIND, either express or implied.
! 21: #
! 22: #***************************************************************************
! 23:
! 24: # This is the HTTPS, FTPS, POP3S, IMAPS, SMTPS, server used for curl test
! 25: # harness. Actually just a layer that runs stunnel properly using the
! 26: # non-secure test harness servers.
! 27:
! 28: BEGIN {
! 29: push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
! 30: push(@INC, ".");
! 31: }
! 32:
! 33: use strict;
! 34: use warnings;
! 35: use Cwd;
! 36: use Cwd 'abs_path';
! 37:
! 38: use serverhelp qw(
! 39: server_pidfilename
! 40: server_logfilename
! 41: );
! 42:
! 43: use pathhelp;
! 44:
! 45: my $stunnel = "stunnel";
! 46:
! 47: my $verbose=0; # set to 1 for debugging
! 48:
! 49: my $accept_port = 8991; # just our default, weird enough
! 50: my $target_port = 8999; # default test http-server port
! 51:
! 52: my $stuncert;
! 53:
! 54: my $ver_major;
! 55: my $ver_minor;
! 56: my $fips_support;
! 57: my $stunnel_version;
! 58: my $tstunnel_windows;
! 59: my $socketopt;
! 60: my $cmd;
! 61:
! 62: my $pidfile; # stunnel pid file
! 63: my $logfile; # stunnel log file
! 64: my $loglevel = 5; # stunnel log level
! 65: my $ipvnum = 4; # default IP version of stunneled server
! 66: my $idnum = 1; # default stunneled server instance number
! 67: my $proto = 'https'; # default secure server protocol
! 68: my $conffile; # stunnel configuration file
! 69: my $capath; # certificate chain PEM folder
! 70: my $certfile; # certificate chain PEM file
! 71:
! 72: #***************************************************************************
! 73: # stunnel requires full path specification for several files.
! 74: #
! 75: my $path = getcwd();
! 76: my $srcdir = $path;
! 77: my $logdir = $path .'/log';
! 78:
! 79: #***************************************************************************
! 80: # Signal handler to remove our stunnel 4.00 and newer configuration file.
! 81: #
! 82: sub exit_signal_handler {
! 83: my $signame = shift;
! 84: local $!; # preserve errno
! 85: local $?; # preserve exit status
! 86: unlink($conffile) if($conffile && (-f $conffile));
! 87: exit;
! 88: }
! 89:
! 90: #***************************************************************************
! 91: # Process command line options
! 92: #
! 93: while(@ARGV) {
! 94: if($ARGV[0] eq '--verbose') {
! 95: $verbose = 1;
! 96: }
! 97: elsif($ARGV[0] eq '--proto') {
! 98: if($ARGV[1]) {
! 99: $proto = $ARGV[1];
! 100: shift @ARGV;
! 101: }
! 102: }
! 103: elsif($ARGV[0] eq '--accept') {
! 104: if($ARGV[1]) {
! 105: if($ARGV[1] =~ /^(\d+)$/) {
! 106: $accept_port = $1;
! 107: shift @ARGV;
! 108: }
! 109: }
! 110: }
! 111: elsif($ARGV[0] eq '--connect') {
! 112: if($ARGV[1]) {
! 113: if($ARGV[1] =~ /^(\d+)$/) {
! 114: $target_port = $1;
! 115: shift @ARGV;
! 116: }
! 117: }
! 118: }
! 119: elsif($ARGV[0] eq '--stunnel') {
! 120: if($ARGV[1]) {
! 121: if($ARGV[1] =~ /^([\w\/]+)$/) {
! 122: $stunnel = $ARGV[1];
! 123: }
! 124: else {
! 125: $stunnel = "\"". $ARGV[1] ."\"";
! 126: }
! 127: shift @ARGV;
! 128: }
! 129: }
! 130: elsif($ARGV[0] eq '--srcdir') {
! 131: if($ARGV[1]) {
! 132: $srcdir = $ARGV[1];
! 133: shift @ARGV;
! 134: }
! 135: }
! 136: elsif($ARGV[0] eq '--certfile') {
! 137: if($ARGV[1]) {
! 138: $stuncert = $ARGV[1];
! 139: shift @ARGV;
! 140: }
! 141: }
! 142: elsif($ARGV[0] eq '--id') {
! 143: if($ARGV[1]) {
! 144: if($ARGV[1] =~ /^(\d+)$/) {
! 145: $idnum = $1 if($1 > 0);
! 146: shift @ARGV;
! 147: }
! 148: }
! 149: }
! 150: elsif($ARGV[0] eq '--ipv4') {
! 151: $ipvnum = 4;
! 152: }
! 153: elsif($ARGV[0] eq '--ipv6') {
! 154: $ipvnum = 6;
! 155: }
! 156: elsif($ARGV[0] eq '--pidfile') {
! 157: if($ARGV[1]) {
! 158: $pidfile = "$path/". $ARGV[1];
! 159: shift @ARGV;
! 160: }
! 161: }
! 162: elsif($ARGV[0] eq '--logfile') {
! 163: if($ARGV[1]) {
! 164: $logfile = "$path/". $ARGV[1];
! 165: shift @ARGV;
! 166: }
! 167: }
! 168: else {
! 169: print STDERR "\nWarning: secureserver.pl unknown parameter: $ARGV[0]\n";
! 170: }
! 171: shift @ARGV;
! 172: }
! 173:
! 174: #***************************************************************************
! 175: # Initialize command line option dependent variables
! 176: #
! 177: if(!$pidfile) {
! 178: $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
! 179: }
! 180: if(!$logfile) {
! 181: $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
! 182: }
! 183:
! 184: $conffile = "$path/${proto}_stunnel.conf";
! 185:
! 186: $capath = abs_path($path);
! 187: $certfile = "$srcdir/". ($stuncert?"certs/$stuncert":"stunnel.pem");
! 188: $certfile = abs_path($certfile);
! 189:
! 190: my $ssltext = uc($proto) ." SSL/TLS:";
! 191:
! 192: #***************************************************************************
! 193: # Find out version info for the given stunnel binary
! 194: #
! 195: foreach my $veropt (('-version', '-V')) {
! 196: foreach my $verstr (qx($stunnel $veropt 2>&1)) {
! 197: if($verstr =~ /^stunnel (\d+)\.(\d+) on /) {
! 198: $ver_major = $1;
! 199: $ver_minor = $2;
! 200: }
! 201: elsif($verstr =~ /^sslVersion.*fips *= *yes/) {
! 202: # the fips option causes an error if stunnel doesn't support it
! 203: $fips_support = 1;
! 204: last
! 205: }
! 206: }
! 207: last if($ver_major);
! 208: }
! 209: if((!$ver_major) || (!$ver_minor)) {
! 210: if(-x "$stunnel" && ! -d "$stunnel") {
! 211: print "$ssltext Unknown stunnel version\n";
! 212: }
! 213: else {
! 214: print "$ssltext No stunnel\n";
! 215: }
! 216: exit 1;
! 217: }
! 218: $stunnel_version = (100*$ver_major) + $ver_minor;
! 219:
! 220: #***************************************************************************
! 221: # Verify minimum stunnel required version
! 222: #
! 223: if($stunnel_version < 310) {
! 224: print "$ssltext Unsupported stunnel version $ver_major.$ver_minor\n";
! 225: exit 1;
! 226: }
! 227:
! 228: #***************************************************************************
! 229: # Find out if we are running on Windows using the tstunnel binary
! 230: #
! 231: if($stunnel =~ /tstunnel(\.exe)?"?$/) {
! 232: $tstunnel_windows = 1;
! 233:
! 234: # convert Cygwin/MinGW paths to Win32 format
! 235: $capath = pathhelp::sys_native_abs_path($capath);
! 236: $certfile = pathhelp::sys_native_abs_path($certfile);
! 237: }
! 238:
! 239: #***************************************************************************
! 240: # Build command to execute for stunnel 3.X versions
! 241: #
! 242: if($stunnel_version < 400) {
! 243: if($stunnel_version >= 319) {
! 244: $socketopt = "-O a:SO_REUSEADDR=1";
! 245: }
! 246: $cmd = "$stunnel -p $certfile -P $pidfile ";
! 247: $cmd .= "-d $accept_port -r $target_port -f -D $loglevel ";
! 248: $cmd .= ($socketopt) ? "$socketopt " : "";
! 249: $cmd .= ">$logfile 2>&1";
! 250: if($verbose) {
! 251: print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
! 252: print "cmd: $cmd\n";
! 253: print "pem cert file: $certfile\n";
! 254: print "pid file: $pidfile\n";
! 255: print "log file: $logfile\n";
! 256: print "log level: $loglevel\n";
! 257: print "listen on port: $accept_port\n";
! 258: print "connect to port: $target_port\n";
! 259: }
! 260: }
! 261:
! 262: #***************************************************************************
! 263: # Build command to execute for stunnel 4.00 and newer
! 264: #
! 265: if($stunnel_version >= 400) {
! 266: $socketopt = "a:SO_REUSEADDR=1";
! 267: if(($stunnel_version >= 534) && $tstunnel_windows) {
! 268: # SO_EXCLUSIVEADDRUSE is on by default on Vista or newer,
! 269: # but does not work together with SO_REUSEADDR being on.
! 270: $socketopt .= "\nsocket = a:SO_EXCLUSIVEADDRUSE=0";
! 271: }
! 272: $cmd = "$stunnel $conffile ";
! 273: $cmd .= ">$logfile 2>&1";
! 274: # setup signal handler
! 275: $SIG{INT} = \&exit_signal_handler;
! 276: $SIG{TERM} = \&exit_signal_handler;
! 277: # stunnel configuration file
! 278: if(open(STUNCONF, ">$conffile")) {
! 279: print STUNCONF "CApath = $capath\n";
! 280: print STUNCONF "cert = $certfile\n";
! 281: print STUNCONF "debug = $loglevel\n";
! 282: print STUNCONF "socket = $socketopt\n";
! 283: if($fips_support) {
! 284: # disable fips in case OpenSSL doesn't support it
! 285: print STUNCONF "fips = no\n";
! 286: }
! 287: if(!$tstunnel_windows) {
! 288: # do not use Linux-specific options on Windows
! 289: print STUNCONF "output = $logfile\n";
! 290: print STUNCONF "pid = $pidfile\n";
! 291: print STUNCONF "foreground = yes\n";
! 292: }
! 293: print STUNCONF "\n";
! 294: print STUNCONF "[curltest]\n";
! 295: print STUNCONF "accept = $accept_port\n";
! 296: print STUNCONF "connect = $target_port\n";
! 297: if(!close(STUNCONF)) {
! 298: print "$ssltext Error closing file $conffile\n";
! 299: exit 1;
! 300: }
! 301: }
! 302: else {
! 303: print "$ssltext Error writing file $conffile\n";
! 304: exit 1;
! 305: }
! 306: if($verbose) {
! 307: print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
! 308: print "cmd: $cmd\n";
! 309: print "CApath = $capath\n";
! 310: print "cert = $certfile\n";
! 311: print "debug = $loglevel\n";
! 312: print "socket = $socketopt\n";
! 313: if($fips_support) {
! 314: print "fips = no\n";
! 315: }
! 316: if(!$tstunnel_windows) {
! 317: print "pid = $pidfile\n";
! 318: print "output = $logfile\n";
! 319: print "foreground = yes\n";
! 320: }
! 321: print "\n";
! 322: print "[curltest]\n";
! 323: print "accept = $accept_port\n";
! 324: print "connect = $target_port\n";
! 325: }
! 326: }
! 327:
! 328: #***************************************************************************
! 329: # Set file permissions on certificate pem file.
! 330: #
! 331: chmod(0600, $certfile) if(-f $certfile);
! 332: print STDERR "RUN: $cmd\n" if($verbose);
! 333:
! 334: #***************************************************************************
! 335: # Run tstunnel on Windows.
! 336: #
! 337: if($tstunnel_windows) {
! 338: # Fake pidfile for tstunnel on Windows.
! 339: if(open(OUT, ">$pidfile")) {
! 340: print OUT $$ . "\n";
! 341: close(OUT);
! 342: }
! 343:
! 344: # Put an "exec" in front of the command so that the child process
! 345: # keeps this child's process ID by being tied to the spawned shell.
! 346: exec("exec $cmd") || die "Can't exec() $cmd: $!";
! 347: # exec() will create a new process, but ties the existance of the
! 348: # new process to the parent waiting perl.exe and sh.exe processes.
! 349:
! 350: # exec() should never return back here to this process. We protect
! 351: # ourselves by calling die() just in case something goes really bad.
! 352: die "error: exec() has returned";
! 353: }
! 354:
! 355: #***************************************************************************
! 356: # Run stunnel.
! 357: #
! 358: my $rc = system($cmd);
! 359:
! 360: $rc >>= 8;
! 361:
! 362: unlink($conffile) if($conffile && -f $conffile);
! 363:
! 364: exit $rc;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to secureserver.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests