1#*************************************************************************** 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al. 9# 10# This software is licensed as described in the file COPYING, which 11# you should have received as part of this distribution. The terms 12# are also available at https://curl.haxx.se/docs/copyright.html. 13# 14# You may opt to use, copy, modify, merge, publish, distribute and/or sell 15# copies of the Software, and permit persons to whom the Software is 16# furnished to do so, under the terms of the COPYING file. 17# 18# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY 19# KIND, either express or implied. 20# 21#*************************************************************************** 22 23package serverhelp; 24 25use strict; 26use warnings; 27use Exporter; 28 29 30#*************************************************************************** 31# Global symbols allowed without explicit package name 32# 33use vars qw( 34 @ISA 35 @EXPORT_OK 36 ); 37 38 39#*************************************************************************** 40# Inherit Exporter's capabilities 41# 42@ISA = qw(Exporter); 43 44 45#*************************************************************************** 46# Global symbols this module will export upon request 47# 48@EXPORT_OK = qw( 49 serverfactors 50 servername_id 51 servername_str 52 servername_canon 53 server_pidfilename 54 server_portfilename 55 server_logfilename 56 server_cmdfilename 57 server_inputfilename 58 server_outputfilename 59 mainsockf_pidfilename 60 mainsockf_logfilename 61 datasockf_pidfilename 62 datasockf_logfilename 63 ); 64 65 66#*************************************************************************** 67# Just for convenience, test harness uses 'https' and 'httptls' literals as 68# values for 'proto' variable in order to differentiate different servers. 69# 'https' literal is used for stunnel based https test servers, and 'httptls' 70# is used for non-stunnel https test servers. 71 72 73#*************************************************************************** 74# Return server characterization factors given a server id string. 75# 76sub serverfactors { 77 my $server = $_[0]; 78 my $proto; 79 my $ipvnum; 80 my $idnum; 81 82 if($server =~ 83 /^((ftp|http|imap|pop3|smtp|http-pipe)s?)(\d*)(-ipv6|)$/) { 84 $proto = $1; 85 $idnum = ($3 && ($3 > 1)) ? $3 : 1; 86 $ipvnum = ($4 && ($4 =~ /6$/)) ? 6 : 4; 87 } 88 elsif($server =~ 89 /^(tftp|sftp|socks|ssh|rtsp|gopher|httptls)(\d*)(-ipv6|)$/) { 90 $proto = $1; 91 $idnum = ($2 && ($2 > 1)) ? $2 : 1; 92 $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4; 93 } 94 else { 95 die "invalid server id: '$server'" 96 } 97 return($proto, $ipvnum, $idnum); 98} 99 100 101#*************************************************************************** 102# Return server name string formatted for presentation purposes 103# 104sub servername_str { 105 my ($proto, $ipver, $idnum) = @_; 106 107 $proto = uc($proto) if($proto); 108 die "unsupported protocol: '$proto'" unless($proto && 109 ($proto =~ /^(((FTP|HTTP|HTTP\/2|IMAP|POP3|SMTP|HTTP-PIPE)S?)|(TFTP|SFTP|SOCKS|SSH|RTSP|GOPHER|HTTPTLS|DICT|SMB|SMBS|TELNET|MQTT))$/)); 110 111 $ipver = (not $ipver) ? 'ipv4' : lc($ipver); 112 die "unsupported IP version: '$ipver'" unless($ipver && 113 ($ipver =~ /^(4|6|ipv4|ipv6|-ipv4|-ipv6|unix)$/)); 114 $ipver = ($ipver =~ /6$/) ? '-IPv6' : (($ipver =~ /unix$/) ? '-unix' : ''); 115 116 $idnum = 1 if(not $idnum); 117 die "unsupported ID number: '$idnum'" unless($idnum && 118 ($idnum =~ /^(\d+)$/)); 119 $idnum = '' unless($idnum > 1); 120 121 return "${proto}${idnum}${ipver}"; 122} 123 124 125#*************************************************************************** 126# Return server name string formatted for identification purposes 127# 128sub servername_id { 129 my ($proto, $ipver, $idnum) = @_; 130 return lc(servername_str($proto, $ipver, $idnum)); 131} 132 133 134#*************************************************************************** 135# Return server name string formatted for file name purposes 136# 137sub servername_canon { 138 my ($proto, $ipver, $idnum) = @_; 139 my $string = lc(servername_str($proto, $ipver, $idnum)); 140 $string =~ tr/-/_/; 141 $string =~ s/\//_v/; 142 return $string; 143} 144 145 146#*************************************************************************** 147# Return file name for server pid file. 148# 149sub server_pidfilename { 150 my ($proto, $ipver, $idnum) = @_; 151 my $trailer = '_server.pid'; 152 return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; 153} 154 155#*************************************************************************** 156# Return file name for server port file. 157# 158sub server_portfilename { 159 my ($proto, $ipver, $idnum) = @_; 160 my $trailer = '_server.port'; 161 return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; 162} 163 164 165#*************************************************************************** 166# Return file name for server log file. 167# 168sub server_logfilename { 169 my ($logdir, $proto, $ipver, $idnum) = @_; 170 my $trailer = '_server.log'; 171 $trailer = '_stunnel.log' if(lc($proto) =~ /^(ftp|http|imap|pop3|smtp)s$/); 172 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 173} 174 175 176#*************************************************************************** 177# Return file name for server commands file. 178# 179sub server_cmdfilename { 180 my ($logdir, $proto, $ipver, $idnum) = @_; 181 my $trailer = '_server.cmd'; 182 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 183} 184 185 186#*************************************************************************** 187# Return file name for server input file. 188# 189sub server_inputfilename { 190 my ($logdir, $proto, $ipver, $idnum) = @_; 191 my $trailer = '_server.input'; 192 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 193} 194 195 196#*************************************************************************** 197# Return file name for server output file. 198# 199sub server_outputfilename { 200 my ($logdir, $proto, $ipver, $idnum) = @_; 201 my $trailer = '_server.output'; 202 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 203} 204 205 206#*************************************************************************** 207# Return file name for main or primary sockfilter pid file. 208# 209sub mainsockf_pidfilename { 210 my ($proto, $ipver, $idnum) = @_; 211 die "unsupported protocol: '$proto'" unless($proto && 212 (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/)); 213 my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.pid':'_sockfilt.pid'; 214 return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; 215} 216 217 218#*************************************************************************** 219# Return file name for main or primary sockfilter log file. 220# 221sub mainsockf_logfilename { 222 my ($logdir, $proto, $ipver, $idnum) = @_; 223 die "unsupported protocol: '$proto'" unless($proto && 224 (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/)); 225 my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.log':'_sockfilt.log'; 226 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 227} 228 229 230#*************************************************************************** 231# Return file name for data or secondary sockfilter pid file. 232# 233sub datasockf_pidfilename { 234 my ($proto, $ipver, $idnum) = @_; 235 die "unsupported protocol: '$proto'" unless($proto && 236 (lc($proto) =~ /^ftps?$/)); 237 my $trailer = '_sockdata.pid'; 238 return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; 239} 240 241 242#*************************************************************************** 243# Return file name for data or secondary sockfilter log file. 244# 245sub datasockf_logfilename { 246 my ($logdir, $proto, $ipver, $idnum) = @_; 247 die "unsupported protocol: '$proto'" unless($proto && 248 (lc($proto) =~ /^ftps?$/)); 249 my $trailer = '_sockdata.log'; 250 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 251} 252 253 254#*************************************************************************** 255# End of library 2561; 257