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