Commit d0f6bde7 authored by Yang Tse's avatar Yang Tse
Browse files

Initial refactoring step for server name strings centralized generation

parent 1bd5784a

tests/Makefile.am

+2 −1
Original line number Diff line number Diff line
@@ -27,7 +27,8 @@ PDFPAGES = testcurl.pdf runtests.pdf 
EXTRA_DIST = ftpserver.pl httpserver.pl httpsserver.pl runtests.pl getpart.pm \

 FILEFORMAT README stunnel.pem memanalyze.pl testcurl.pl valgrind.pm ftp.pm   \

 sshserver.pl sshhelp.pm testcurl.1 runtests.1 $(HTMLPAGES) $(PDFPAGES) \

 CMakeLists.txt certs/scripts/*.sh certs/Server* certs/EdelCurlRoot*

 CMakeLists.txt certs/scripts/*.sh certs/Server* certs/EdelCurlRoot* \

 serverhelp.pm



SUBDIRS = data server libtest

tests/runtests.pl

+75 −31
Original line number Diff line number Diff line
@@ -70,6 +70,11 @@ use strict; 
#use warnings;

use Cwd;



# Subs imported from serverhelp module

use serverhelp qw(

    servername_str

    );



# Variables and subs imported from sshhelp module

use sshhelp qw(

    $sshdexe
@@ -802,15 +807,18 @@ sub runhttpserver { 
    my $pidfile = $HTTPPIDFILE;

    my $port = $HTTPPORT;

    my $ip = $HOSTIP;

    my $nameext;

    my $proto = 'http';

    my $ipvnum = 4;

    my $idnum = 1;

    my $srvrname;

    my $fork = $forkserver?"--fork":"";



    if($ipv6) {

        # if IPv6, use a different setup

        $ipvnum = 6;

        $pidfile = $HTTP6PIDFILE;

        $port = $HTTP6PORT;

        $ip = $HOST6IP;

        $nameext="-ipv6";

    }



    # don't retry if the server doesn't work
@@ -818,6 +826,8 @@ sub runhttpserver { 
        return (0,0);

    }



    $srvrname = servername_str($proto, $ipvnum, $idnum);



    my $pid = processexists($pidfile);

    if($pid > 0) {

        stopserver($pid);
@@ -836,7 +846,7 @@ sub runhttpserver { 


    if($httppid <= 0 || !kill(0, $httppid)) {

        # it is NOT alive

        logmsg "RUN: failed to start the HTTP$nameext server\n";

        logmsg "RUN: failed to start the $srvrname server\n";

        stopserver("$pid2");

        displaylogs($testnumcheck);

        $doesntrun{$pidfile} = 1;
@@ -846,7 +856,7 @@ sub runhttpserver { 
    # Server is up. Verify that we can speak to it.

    my $pid3 = verifyserver("http", $ip, $port);

    if(!$pid3) {

        logmsg "RUN: HTTP$nameext server failed verification\n";

        logmsg "RUN: $srvrname server failed verification\n";

        # failed to talk to it properly. Kill the server and return failure

        stopserver("$httppid $pid2");

        displaylogs($testnumcheck);
@@ -856,7 +866,7 @@ sub runhttpserver { 
    $pid2 = $pid3;



    if($verbose) {

        logmsg "RUN: HTTP$nameext server is now running PID $httppid\n";

        logmsg "RUN: $srvrname server is now running PID $httppid\n";

    }



    sleep(1);
@@ -873,6 +883,10 @@ sub runhttpsserver { 
    my $RUNNING;

    my $ip = $HOSTIP;

    my $pidfile = $HTTPSPIDFILE;

    my $proto = 'https';

    my $ipvnum = 4;

    my $idnum = 1;

    my $srvrname;



    if(!$stunnel) {

        return 0;
@@ -880,6 +894,7 @@ sub runhttpsserver { 


    if($ipv6) {

        # not complete yet

        $ipvnum = 6;

        $ip = $HOST6IP;

    }
@@ -888,6 +903,8 @@ sub runhttpsserver { 
        return (0,0);

    }



    $srvrname = servername_str($proto, $ipvnum, $idnum);



    my $pid = processexists($pidfile);

    if($pid > 0) {

        # kill previous stunnel!
@@ -903,7 +920,7 @@ sub runhttpsserver { 


    if($httpspid <= 0 || !kill(0, $httpspid)) {

        # it is NOT alive

        logmsg "RUN: failed to start the HTTPS server\n";

        logmsg "RUN: failed to start the $srvrname server\n";

        stopservers($verbose);

        displaylogs($testnumcheck);

        $doesntrun{$pidfile} = 1;
@@ -913,7 +930,7 @@ sub runhttpsserver { 
    # Server is up. Verify that we can speak to it.

    my $pid3 = verifyserver("https", $ip, $HTTPSPORT);

    if(!$pid3) {

        logmsg "RUN: HTTPS server failed verification\n";

        logmsg "RUN: $srvrname server failed verification\n";

        # failed to talk to it properly. Kill the server and return failure

        stopserver("$httpspid $pid2");

        displaylogs($testnumcheck);
@@ -923,7 +940,7 @@ sub runhttpsserver { 
    # Here pid3 is actually the pid returned by the unsecure-http server.



    if($verbose) {

        logmsg "RUN: HTTPS server is now running PID $httpspid\n";

        logmsg "RUN: $srvrname server is now running PID $httpspid\n";

    }



    sleep(1);
@@ -941,20 +958,22 @@ sub runpingpongserver { 
    my $port;

    my $pidfile;

    my $ip=$HOSTIP;

    my $nameext;

    my $cmd;

    my $flag;

    my $ipvnum = 4;

    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;

    my $srvrname;



    if($proto eq "ftp") {

        $port = $id?$FTP2PORT:$FTPPORT;

        $pidfile = $id?$FTP2PIDFILE:$FTPPIDFILE;

        $port = ($idnum>1)?$FTP2PORT:$FTPPORT;

        $pidfile = ($idnum>1)?$FTP2PIDFILE:$FTPPIDFILE;



        if($ipv6) {

            # if IPv6, use a different setup

            $ipvnum = 6;

            $pidfile = $FTP6PIDFILE;

            $port = $FTP6PORT;

            $ip = $HOST6IP;

            $nameext="-ipv6";

        }

    }

    elsif($proto eq "pop3") {
@@ -980,6 +999,8 @@ sub runpingpongserver { 
        return (0,0);

    }



    $srvrname = servername_str($proto, $ipvnum, $idnum);



    my $pid = processexists($pidfile);

    if($pid > 0) {

        stopserver($pid);
@@ -990,8 +1011,8 @@ sub runpingpongserver { 
    $flag .= $debugprotocol?"-v ":"";

    $flag .= "-s \"$srcdir\" ";

    my $addr;

    if($id) {

        $flag .="--id $id ";

    if($idnum > 1) {

        $flag .="--id $idnum ";

    }

    if($ipv6) {

        $flag .="--ipv6 ";
@@ -1005,7 +1026,7 @@ sub runpingpongserver { 


    if($ftppid <= 0 || !kill(0, $ftppid)) {

        # it is NOT alive

        logmsg "RUN: failed to start the ". uc($proto) ."$id$nameext server\n";

        logmsg "RUN: failed to start the $srvrname server\n";

        stopserver("$pid2");

        displaylogs($testnumcheck);

        $doesntrun{$pidfile} = 1;
@@ -1015,7 +1036,7 @@ sub runpingpongserver { 
    # Server is up. Verify that we can speak to it.

    my $pid3 = verifyserver($proto, $ip, $port);

    if(!$pid3) {

        logmsg "RUN: ". uc($proto) ."$id$nameext server failed verification\n";

        logmsg "RUN: $srvrname server failed verification\n";

        # failed to talk to it properly. Kill the server and return failure

        stopserver("$ftppid $pid2");

        displaylogs($testnumcheck);
@@ -1025,8 +1046,7 @@ sub runpingpongserver { 
    $pid2 = $pid3;



    if($verbose) {

        logmsg "RUN: ". uc($proto) ."$id$nameext server is now running".

               " PID $ftppid\n";

        logmsg "RUN: $srvrname server is now running PID $ftppid\n";

    }



    sleep(1);
@@ -1043,6 +1063,10 @@ sub runftpsserver { 
    my $RUNNING;

    my $ip = $HOSTIP;

    my $pidfile = $FTPSPIDFILE;

    my $proto = 'ftps';

    my $ipvnum = 4;

    my $idnum = 1;

    my $srvrname;



    if(!$stunnel) {

        return 0;
@@ -1050,6 +1074,7 @@ sub runftpsserver { 


    if($ipv6) {

        # not complete yet

        $ipvnum = 6;

        $ip = $HOST6IP;

    }
@@ -1058,6 +1083,8 @@ sub runftpsserver { 
        return (0,0);

    }



    $srvrname = servername_str($proto, $ipvnum, $idnum);



    my $pid = processexists($pidfile);

    if($pid > 0) {

        # kill previous stunnel!
@@ -1072,7 +1099,7 @@ sub runftpsserver { 


    if($ftpspid <= 0 || !kill(0, $ftpspid)) {

        # it is NOT alive

        logmsg "RUN: failed to start the FTPS server\n";

        logmsg "RUN: failed to start the $srvrname server\n";

        stopservers($verbose);

        displaylogs($testnumcheck);

        $doesntrun{$pidfile} = 1;
@@ -1082,7 +1109,7 @@ sub runftpsserver { 
    # Server is up. Verify that we can speak to it.

    my $pid3 = verifyserver("ftps", $ip, $FTPSPORT);

    if(!$pid3) {

        logmsg "RUN: FTPS server failed verification\n";

        logmsg "RUN: $srvrname server failed verification\n";

        # failed to talk to it properly. Kill the server and return failure

        stopserver("$ftpspid $pid2");

        displaylogs($testnumcheck);
@@ -1092,7 +1119,7 @@ sub runftpsserver { 
    # Here pid3 is actually the pid returned by the unsecure-ftp server.



    if($verbose) {

        logmsg "RUN: FTPS server is now running PID $ftpspid\n";

        logmsg "RUN: $srvrname server is now running PID $ftpspid\n";

    }



    sleep(1);
@@ -1111,15 +1138,18 @@ sub runtftpserver { 
    # check for pidfile

    my $pidfile = $TFTPPIDFILE;

    my $ip=$HOSTIP;

    my $nameext;

    my $cmd;

    my $proto = 'tftp';

    my $ipvnum = 4;

    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;

    my $srvrname;



    if($ipv6) {

        # if IPv6, use a different setup

        $ipvnum = 6;

        $pidfile = $TFTP6PIDFILE;

        $port = $TFTP6PORT;

        $ip = $HOST6IP;

        $nameext="-ipv6";

    }



    # don't retry if the server doesn't work
@@ -1127,6 +1157,8 @@ sub runtftpserver { 
        return (0,0);

    }



    $srvrname = servername_str($proto, $ipvnum, $idnum);



    my $pid = processexists($pidfile);

    if($pid > 0) {

        stopserver($pid);
@@ -1136,8 +1168,8 @@ sub runtftpserver { 
    # start our server:

    my $flag=$debugprotocol?"-v ":"";

    $flag .= "-s \"$srcdir\" ";

    if($id) {

        $flag .="--id $id ";

    if($idnum > 1) {

        $flag .="--id $idnum ";

    }

    if($ipv6) {

        $flag .="--ipv6 ";
@@ -1148,7 +1180,7 @@ sub runtftpserver { 


    if($tftppid <= 0 || !kill(0, $tftppid)) {

        # it is NOT alive

        logmsg "RUN: failed to start the TFTP$id$nameext server\n";

        logmsg "RUN: failed to start the $srvrname server\n";

        stopserver("$pid2");

        displaylogs($testnumcheck);

        $doesntrun{$pidfile} = 1;
@@ -1158,7 +1190,7 @@ sub runtftpserver { 
    # Server is up. Verify that we can speak to it.

    my $pid3 = verifyserver("tftp", $ip, $port);

    if(!$pid3) {

        logmsg "RUN: TFTP$id$nameext server failed verification\n";

        logmsg "RUN: $srvrname server failed verification\n";

        # failed to talk to it properly. Kill the server and return failure

        stopserver("$tftppid $pid2");

        displaylogs($testnumcheck);
@@ -1168,7 +1200,7 @@ sub runtftpserver { 
    $pid2 = $pid3;



    if($verbose) {

        logmsg "RUN: TFTP$id$nameext server is now running PID $tftppid\n";

        logmsg "RUN: $srvrname server is now running PID $tftppid\n";

    }



    sleep(1);
@@ -1186,12 +1218,18 @@ sub runsshserver { 
    my $port = $SSHPORT;

    my $socksport = $SOCKSPORT;

    my $pidfile = $SSHPIDFILE;

    my $proto = 'ssh';

    my $ipvnum = 4;

    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;

    my $srvrname;



    # don't retry if the server doesn't work

    if ($doesntrun{$pidfile}) {

        return (0,0);

    }



    $srvrname = servername_str($proto, $ipvnum, $idnum);



    my $pid = processexists($pidfile);

    if($pid > 0) {

        stopserver($pid);
@@ -1210,7 +1248,7 @@ sub runsshserver { 


    if($sshpid <= 0 || !kill(0, $sshpid)) {

        # it is NOT alive

        logmsg "RUN: failed to start the SSH server\n";

        logmsg "RUN: failed to start the $srvrname server\n";

        stopserver("$pid2");

        $doesntrun{$pidfile} = 1;

        return (0,0);
@@ -1222,7 +1260,7 @@ sub runsshserver { 


    my $pid3 = verifyserver("ssh",$ip,$port);

    if(!$pid3) {

        logmsg "RUN: SSH server failed verification\n";

        logmsg "RUN: $srvrname server failed verification\n";

        # failed to fetch server pid. Kill the server and return failure

        stopserver("$sshpid $pid2");

        $doesntrun{$pidfile} = 1;
@@ -1247,7 +1285,7 @@ sub runsshserver { 
    }



    if($verbose) {

        logmsg "RUN: SSH server is now running PID $pid2\n";

        logmsg "RUN: $srvrname server is now running PID $pid2\n";

    }



    return ($pid2, $sshpid);
@@ -1261,12 +1299,18 @@ sub runsocksserver { 
    my $ip=$HOSTIP;

    my $port = $SOCKSPORT;

    my $pidfile = $SOCKSPIDFILE;

    my $proto = 'socks';

    my $ipvnum = 4;

    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;

    my $srvrname;



    # don't retry if the server doesn't work

    if ($doesntrun{$pidfile}) {

        return (0,0);

    }



    $srvrname = servername_str($proto, $ipvnum, $idnum);



    my $pid = processexists($pidfile);

    if($pid > 0) {

        stopserver($pid);

tests/serverhelp.pm

0 → 100644
+103 −0
Original line number Diff line number Diff line 
#***************************************************************************

#                                  _   _ ____  _

#  Project                     ___| | | |  _ \| |

#                             / __| | | | |_) | |

#                            | (__| |_| |  _ <| |___

#                             \___|\___/|_| \_\_____|

#

# Copyright (C) 1998 - 2009, Daniel Stenberg, <daniel@haxx.se>, et al.

#

# This software is licensed as described in the file COPYING, which

# you should have received as part of this distribution. The terms

# are also available at http://curl.haxx.se/docs/copyright.html.

#

# You may opt to use, copy, modify, merge, publish, distribute and/or sell

# copies of the Software, and permit persons to whom the Software is

# furnished to do so, under the terms of the COPYING file.

#

# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY

# KIND, either express or implied.

#

# $Id$

#***************************************************************************



package serverhelp;



use strict;

use warnings;

use Exporter;





#***************************************************************************

# Global symbols allowed without explicit package name

#

use vars qw(

    @ISA

    @EXPORT_OK

    );





#***************************************************************************

# Inherit Exporter's capabilities

#

@ISA = qw(Exporter);





#***************************************************************************

# Global symbols this module will export upon request

#

@EXPORT_OK = qw(

    servername_id

    servername_str

    servername_canon

    );





#***************************************************************************

# Return server name string formatted for presentation purposes

#

sub servername_str {

    my ($proto, $ipver, $idnum) = @_;



    $proto = uc($proto) if($proto);

    die "unsupported protocol: $proto" unless($proto &&

        ($proto =~ /^(((FTP|HTTP|IMAP|POP3|SMTP|TFTP)S?)|(SOCKS|SSH))$/));



    $ipver = (not $ipver) ? 'ipv4' : lc($ipver);

    die "unsupported IP version: $ipver" unless($ipver &&

        ($ipver =~ /^(4|6|ipv4|ipv6|-ipv4|-ipv6)$/));

    $ipver = ($ipver =~ /6$/) ? '-IPv6' : '';



    $idnum = 1 if(not $idnum);

    die "unsupported ID number: $idnum" unless($idnum &&

        ($idnum =~ /^(\d+)$/));

    $idnum = '' unless($idnum > 1);



    return "${proto}${idnum}${ipver}";

}





#***************************************************************************

# Return server name string formatted for identification purposes

#

sub servername_id {

    my ($proto, $ipver, $idnum) = @_;

    return lc(servername_str($proto, $ipver, $idnum));

}





#***************************************************************************

# Return server name string formatted for file name purposes

#

sub servername_canon {

    my ($proto, $ipver, $idnum) = @_;

    my $string = lc(servername_str($proto, $ipver, $idnum));

    $string =~ tr/-/_/;

    return $string;

}





#***************************************************************************

# End of library

1;