diff options
| -rw-r--r-- | tests/serverhelp.pm | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/tests/serverhelp.pm b/tests/serverhelp.pm index 53aeb79cb..d34a821a1 100644 --- a/tests/serverhelp.pm +++ b/tests/serverhelp.pm @@ -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 @@ -63,6 +64,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 # sub servername_str { |