Annotation of embedaddon/curl/tests/secureserver.pl, revision 1.1.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>