httpsserver.pl   [plain text]

#!/usr/bin/env perl
#
# $Id: httpsserver.pl,v 1.14 2009-09-01 17:05:24 bagder Exp $
# This is the HTTPS and FTPS server designed for the curl test suite.
#
# It is actually just a layer that runs stunnel properly.

use strict;
use Cwd;

my $stunnel = "stunnel";

#
# -p pemfile
# -P pid dir
# -d listen port
# -r target port
# -s stunnel path

my $verbose=0; # set to 1 for debugging

my $port = 8991;        # just our default, weird enough
my $target_port = 8999; # default test http-server port

my $path = getcwd();

my $srcdir=$path;

my $proto='https';

my $stuncert;

while(@ARGV) {
    if($ARGV[0] eq "-v") {
        $verbose=1;
    }
    if($ARGV[0] eq "-w") {
        return 0; # return success, means we have stunnel working!
    }
    elsif($ARGV[0] eq "-p") {
        $proto=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-r") {
        $target_port=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-s") {
        $stunnel=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-d") {
        $srcdir=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-c") {
        $stuncert=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] =~ /^(\d+)$/) {
        $port = $1;
    }
    shift @ARGV;
};

my $conffile="$path/stunnel.conf";	# stunnel configuration data
my $certfile="$srcdir/" 
            . ($stuncert?"certs/$stuncert":"stunnel.pem");	# stunnel server certificate

my $pidfile="$path/.$proto.pid";	# stunnel process pid file

# find out version info for the given stunnel binary
my $ver_major;
my $ver_minor;
foreach my $veropt (('-version', '-V')) {
    foreach my $verstr (qx($stunnel $veropt 2>&1)) {
        if($verstr =~ /^stunnel (\d+)\.(\d+) on /) {
            $ver_major = $1;
            $ver_minor = $2;
            last;
        }
    }
    last if($ver_major);
}

my $cmd;
if(!$ver_major) {
    print STDERR "no stunnel or unknown version\n";
}
elsif($ver_major < 4) {
    # stunnel version less than 4.00
    $cmd  = "$stunnel -p $certfile -P $pidfile -d $port -r $target_port ";
    $cmd .= "2>/dev/null";
}
else {
    # stunnel version 4.00 or later
    $cmd  = "$stunnel $conffile ";
    $cmd .= "2>/dev/null";
    # stunnel configuration file
    open(STUNCONF, ">$conffile") || exit 1;
    print STUNCONF "
	CApath = $path
	cert = $certfile
	pid = $pidfile
	debug = 0
	output = /dev/null
	foreground = yes
	
	[curltest]
	accept = $port
	connect = $target_port
	";
    close STUNCONF;
}

if($verbose) {
    print uc($proto)." server: $cmd\n";

   print  "
	CApath = $path
	cert = $certfile
	pid = $pidfile
	debug = 0
	output = /dev/null
	foreground = yes
	
	[curltest]
	accept = $port
	connect = $target_port
	";
}

my $rc = system($cmd);

$rc >>= 8;
#if($rc) {
#    print STDERR "stunnel exited with $rc!\n";
#}

unlink $conffile;

exit $rc;