Commit 0375f70b authored by Yang Tse's avatar Yang Tse
Browse files

add serverfactors() sub which returns server characterization factors

parent 7f898011

tests/serverhelp.pm

+27 −0
Original line number Diff line number Diff line
@@ -47,6 +47,7 @@ use vars qw( 
# Global symbols this module will export upon request

#

@EXPORT_OK = qw(

    serverfactors

    servername_id

    servername_str

    servername_canon
@@ -62,6 +63,32 @@ use vars qw( 
    );





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

# Return server characterization factors given a server id string.

#

sub serverfactors {

    my $server = $_[0];

    my $proto;

    my $ipvnum;

    my $idnum;



    if($server =~ /^((ftp|http|imap|pop3|smtp)s?)(\d*)(-ipv6|)$/) {

        $proto  = $1;

        $idnum  = ($3 && ($3 > 1)) ? $3 : 1;

        $ipvnum = ($4 && ($4 =~ /6$/)) ? 6 : 4;

    }

    elsif($server =~ /^(tftp|sftp|socks|ssh)(\d*)(-ipv6|)$/) {

        $proto  = $1;

        $idnum  = ($2 && ($2 > 1)) ? $2 : 1;

        $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;

    }

    else {

        die "invalid server id: $server"

    }

    return($proto, $ipvnum, $idnum);

}





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

# Return server name string formatted for presentation purposes

#