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 my $stunnel = "stunnel";
  44
  45 my $verbose=0; # set to 1 for debugging
  46
  47 my $accept_port = 8991; # just our default, weird enough
  48 my $target_port = 8999; # default test http-server port
  49
  50 my $stuncert;
  51
  52 my $ver_major;
  53 my $ver_minor;
  54 my $fips_support;
  55 my $stunnel_version;
  56 my $tstunnel_windows;
  57 my $socketopt;
  58 my $cmd;
  59
  60 my $pidfile;          # stunnel pid file
  61 my $logfile;          # stunnel log file
  62 my $loglevel = 5;     # stunnel log level
  63 my $ipvnum = 4;       # default IP version of stunneled server
  64 my $idnum = 1;        # dafault stunneled server instance number
  65 my $proto = 'https';  # default secure server protocol
  66 my $conffile;         # stunnel configuration file
  67 my $capath;           # certificate chain PEM folder
  68 my $certfile;         # certificate chain PEM file
  69
  70 #***************************************************************************
  71 # stunnel requires full path specification for several files.
  72 #
  73 my $path   = getcwd();
  74 my $srcdir = $path;
  75 my $logdir = $path .'/log';
  76
  77 #***************************************************************************
  78 # Signal handler to remove our stunnel 4.00 and newer configuration file.
  79 #
  80 sub exit_signal_handler {
  81     my $signame = shift;
  82     local $!; # preserve errno
  83     local $?; # preserve exit status
  84     unlink($conffile) if($conffile && (-f $conffile));
  85     exit;
  86 }
  87
  88 #***************************************************************************
  89 # Process command line options
  90 #
  91 while(@ARGV) {
  92     if($ARGV[0] eq '--verbose') {
  93         $verbose = 1;
  94     }
  95     elsif($ARGV[0] eq '--proto') {
  96         if($ARGV[1]) {
  97             $proto = $ARGV[1];
  98             shift @ARGV;
  99         }
 100     }
 101     elsif($ARGV[0] eq '--accept') {
 102         if($ARGV[1]) {
 103             if($ARGV[1] =~ /^(\d+)$/) {
 104                 $accept_port = $1;
 105                 shift @ARGV;
 106             }
 107         }
 108     }
 109     elsif($ARGV[0] eq '--connect') {
 110         if($ARGV[1]) {
 111             if($ARGV[1] =~ /^(\d+)$/) {
 112                 $target_port = $1;
 113                 shift @ARGV;
 114             }
 115         }
 116     }
 117     elsif($ARGV[0] eq '--stunnel') {
 118         if($ARGV[1]) {
 119             if($ARGV[1] =~ /^([\w\/]+)$/) {
 120                 $stunnel = $ARGV[1];
 121             }
 122             else {
 123                 $stunnel = "\"". $ARGV[1] ."\"";
 124             }
 125             shift @ARGV;
 126         }
 127     }
 128     elsif($ARGV[0] eq '--srcdir') {
 129         if($ARGV[1]) {
 130             $srcdir = $ARGV[1];
 131             shift @ARGV;
 132         }
 133     }
 134     elsif($ARGV[0] eq '--certfile') {
 135         if($ARGV[1]) {
 136             $stuncert = $ARGV[1];
 137             shift @ARGV;
 138         }
 139     }
 140     elsif($ARGV[0] eq '--id') {
 141         if($ARGV[1]) {
 142             if($ARGV[1] =~ /^(\d+)$/) {
 143                 $idnum = $1 if($1 > 0);
 144                 shift @ARGV;
 145             }
 146         }
 147     }
 148     elsif($ARGV[0] eq '--ipv4') {
 149         $ipvnum = 4;
 150     }
 151     elsif($ARGV[0] eq '--ipv6') {
 152         $ipvnum = 6;
 153     }
 154     elsif($ARGV[0] eq '--pidfile') {
 155         if($ARGV[1]) {
 156             $pidfile = "$path/". $ARGV[1];
 157             shift @ARGV;
 158         }
 159     }
 160     elsif($ARGV[0] eq '--logfile') {
 161         if($ARGV[1]) {
 162             $logfile = "$path/". $ARGV[1];
 163             shift @ARGV;
 164         }
 165     }
 166     else {
 167         print STDERR "\nWarning: secureserver.pl unknown parameter: $ARGV[0]\n";
 168     }
 169     shift @ARGV;
 170 }
 171
 172 #***************************************************************************
 173 # Initialize command line option dependant variables
 174 #
 175 if(!$pidfile) {
 176     $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
 177 }
 178 if(!$logfile) {
 179     $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
 180 }
 181
 182 $conffile = "$path/stunnel.conf";
 183
 184 $capath = abs_path($path);
 185 $certfile = "$srcdir/". ($stuncert?"certs/$stuncert":"stunnel.pem");
 186 $certfile = abs_path($certfile);
 187
 188 my $ssltext = uc($proto) ." SSL/TLS:";
 189
 190 #***************************************************************************
 191 # Find out version info for the given stunnel binary
 192 #
 193 foreach my $veropt (('-version', '-V')) {
 194     foreach my $verstr (qx($stunnel $veropt 2>&1)) {
 195         if($verstr =~ /^stunnel (\d+)\.(\d+) on /) {
 196             $ver_major = $1;
 197             $ver_minor = $2;
 198         }
 199         elsif($verstr =~ /^sslVersion.*fips *= *yes/) {
 200             # the fips option causes an error if stunnel doesn't support it
 201             $fips_support = 1;
 202             last
 203         }
 204     }
 205     last if($ver_major);
 206 }
 207 if((!$ver_major) || (!$ver_minor)) {
 208     if(-x "$stunnel" && ! -d "$stunnel") {
 209         print "$ssltext Unknown stunnel version\n";
 210     }
 211     else {
 212         print "$ssltext No stunnel\n";
 213     }
 214     exit 1;
 215 }
 216 $stunnel_version = (100*$ver_major) + $ver_minor;
 217
 218 #***************************************************************************
 219 # Verify minimum stunnel required version
 220 #
 221 if($stunnel_version < 310) {
 222     print "$ssltext Unsupported stunnel version $ver_major.$ver_minor\n";
 223     exit 1;
 224 }
 225
 226 #***************************************************************************
 227 # Find out if we are running on Windows using the tstunnel binary
 228 #
 229 if($stunnel =~ /tstunnel(\.exe)?"?$/) {
 230     $tstunnel_windows = 1;
 231
 232     # replace Cygwin and MinGW drives within paths
 233     $capath =~ s/^(\/cygdrive)?\/(\w)\//$2\:\//;
 234     $certfile =~ s/^(\/cygdrive)?\/(\w)\//$2\:\//;
 235 }
 236
 237 #***************************************************************************
 238 # Build command to execute for stunnel 3.X versions
 239 #
 240 if($stunnel_version < 400) {
 241     if($stunnel_version >= 319) {
 242         $socketopt = "-O a:SO_REUSEADDR=1";
 243     }
 244     $cmd  = "$stunnel -p $certfile -P $pidfile ";
 245     $cmd .= "-d $accept_port -r $target_port -f -D $loglevel ";
 246     $cmd .= ($socketopt) ? "$socketopt " : "";
 247     $cmd .= ">$logfile 2>&1";
 248     if($verbose) {
 249         print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
 250         print "cmd: $cmd\n";
 251         print "pem cert file: $certfile\n";
 252         print "pid file: $pidfile\n";
 253         print "log file: $logfile\n";
 254         print "log level: $loglevel\n";
 255         print "listen on port: $accept_port\n";
 256         print "connect to port: $target_port\n";
 257     }
 258 }
 259
 260 #***************************************************************************
 261 # Build command to execute for stunnel 4.00 and newer
 262 #
 263 if($stunnel_version >= 400) {
 264     $socketopt = "a:SO_REUSEADDR=1";
 265     $cmd  = "$stunnel $conffile ";
 266     $cmd .= ">$logfile 2>&1";
 267     # setup signal handler
 268     $SIG{INT} = \&exit_signal_handler;
 269     $SIG{TERM} = \&exit_signal_handler;
 270     # stunnel configuration file
 271     if(open(STUNCONF, ">$conffile")) {
 272         print STUNCONF "CApath = $capath\n";
 273         print STUNCONF "cert = $certfile\n";
 274         print STUNCONF "debug = $loglevel\n";
 275         print STUNCONF "socket = $socketopt\n";
 276         if($fips_support) {
 277             # disable fips in case OpenSSL doesn't support it
 278             print STUNCONF "fips = no\n";
 279         }
 280         if(!$tstunnel_windows) {
 281             # do not use Linux-specific options on Windows
 282             print STUNCONF "output = $logfile\n";
 283             print STUNCONF "pid = $pidfile\n";
 284             print STUNCONF "foreground = yes\n";
 285         }
 286         print STUNCONF "\n";
 287         print STUNCONF "[curltest]\n";
 288         print STUNCONF "accept = $accept_port\n";
 289         print STUNCONF "connect = $target_port\n";
 290         if(!close(STUNCONF)) {
 291             print "$ssltext Error closing file $conffile\n";
 292             exit 1;
 293         }
 294     }
 295     else {
 296         print "$ssltext Error writing file $conffile\n";
 297         exit 1;
 298     }
 299     if($verbose) {
 300         print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
 301         print "cmd: $cmd\n";
 302         print "CApath = $capath\n";
 303         print "cert = $certfile\n";
 304         print "debug = $loglevel\n";
 305         print "socket = $socketopt\n";
 306         if($fips_support) {
 307             print "fips = no\n";
 308         }
 309         if(!$tstunnel_windows) {
 310             print "pid = $pidfile\n";
 311             print "output = $logfile\n";
 312             print "foreground = yes\n";
 313         }
 314         print "\n";
 315         print "[curltest]\n";
 316         print "accept = $accept_port\n";
 317         print "connect = $target_port\n";
 318     }
 319 }
 320
 321 #***************************************************************************
 322 # Set file permissions on certificate pem file.
 323 #
 324 chmod(0600, $certfile) if(-f $certfile);
 325
 326 #***************************************************************************
 327 # Run tstunnel on Windows.
 328 #
 329 if($tstunnel_windows) {
 330     # Fake pidfile for tstunnel on Windows.
 331     if(open(OUT, ">$pidfile")) {
 332         print OUT $$ . "\n";
 333         close(OUT);
 334     }
 335
 336     # Put an "exec" in front of the command so that the child process
 337     # keeps this child's process ID.
 338     exec("exec $cmd") || die "Can't exec() $cmd: $!";
 339
 340     # exec() should never return back here to this process. We protect
 341     # ourselves by calling die() just in case something goes really bad.
 342     die "error: exec() has returned";
 343 }
 344
 345 #***************************************************************************
 346 # Run stunnel.
 347 #
 348 my $rc = system($cmd);
 349
 350 $rc >>= 8;
 351
 352 unlink($conffile) if($conffile && -f $conffile);
 353
 354 exit $rc;