tests/secureserver.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2014, 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;        # dafault 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 dependant 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/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     $cmd  = "$stunnel $conffile ";
 268     $cmd .= ">$logfile 2>&1";
 269     # setup signal handler
 270     $SIG{INT} = \&exit_signal_handler;
 271     $SIG{TERM} = \&exit_signal_handler;
 272     # stunnel configuration file
 273     if(open(STUNCONF, ">$conffile")) {
 274         print STUNCONF "CApath = $capath\n";
 275         print STUNCONF "cert = $certfile\n";
 276         print STUNCONF "debug = $loglevel\n";
 277         print STUNCONF "socket = $socketopt\n";
 278         if($fips_support) {
 279             # disable fips in case OpenSSL doesn't support it
 280             print STUNCONF "fips = no\n";
 281         }
 282         if(!$tstunnel_windows) {
 283             # do not use Linux-specific options on Windows
 284             print STUNCONF "output = $logfile\n";
 285             print STUNCONF "pid = $pidfile\n";
 286             print STUNCONF "foreground = yes\n";
 287         }
 288         print STUNCONF "\n";
 289         print STUNCONF "[curltest]\n";
 290         print STUNCONF "accept = $accept_port\n";
 291         print STUNCONF "connect = $target_port\n";
 292         if(!close(STUNCONF)) {
 293             print "$ssltext Error closing file $conffile\n";
 294             exit 1;
 295         }
 296     }
 297     else {
 298         print "$ssltext Error writing file $conffile\n";
 299         exit 1;
 300     }
 301     if($verbose) {
 302         print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
 303         print "cmd: $cmd\n";
 304         print "CApath = $capath\n";
 305         print "cert = $certfile\n";
 306         print "debug = $loglevel\n";
 307         print "socket = $socketopt\n";
 308         if($fips_support) {
 309             print "fips = no\n";
 310         }
 311         if(!$tstunnel_windows) {
 312             print "pid = $pidfile\n";
 313             print "output = $logfile\n";
 314             print "foreground = yes\n";
 315         }
 316         print "\n";
 317         print "[curltest]\n";
 318         print "accept = $accept_port\n";
 319         print "connect = $target_port\n";
 320     }
 321 }
 322
 323 #***************************************************************************
 324 # Set file permissions on certificate pem file.
 325 #
 326 chmod(0600, $certfile) if(-f $certfile);
 327
 328 #***************************************************************************
 329 # Run tstunnel on Windows.
 330 #
 331 if($tstunnel_windows) {
 332     # Fake pidfile for tstunnel on Windows.
 333     if(open(OUT, ">$pidfile")) {
 334         print OUT $$ . "\n";
 335         close(OUT);
 336     }
 337
 338     # Put an "exec" in front of the command so that the child process
 339     # keeps this child's process ID.
 340     exec("exec $cmd") || die "Can't exec() $cmd: $!";
 341
 342     # exec() should never return back here to this process. We protect
 343     # ourselves by calling die() just in case something goes really bad.
 344     die "error: exec() has returned";
 345 }
 346
 347 #***************************************************************************
 348 # Run stunnel.
 349 #
 350 my $rc = system($cmd);
 351
 352 $rc >>= 8;
 353
 354 unlink($conffile) if($conffile && -f $conffile);
 355
 356 exit $rc;