1#*************************************************************************** 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) 1998 - 2010, 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 http://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_logfilename 55 server_cmdfilename 56 server_inputfilename 57 server_outputfilename 58 mainsockf_pidfilename 59 mainsockf_logfilename 60 datasockf_pidfilename 61 datasockf_logfilename 62 ); 63 64 65#*************************************************************************** 66# Return server characterization factors given a server id string. 67# 68sub serverfactors { 69 my $server = $_[0]; 70 my $proto; 71 my $ipvnum; 72 my $idnum; 73 74 if($server =~ /^((ftp|http|imap|pop3|smtp)s?)(\d*)(-ipv6|)$/) { 75 $proto = $1; 76 $idnum = ($3 && ($3 > 1)) ? $3 : 1; 77 $ipvnum = ($4 && ($4 =~ /6$/)) ? 6 : 4; 78 } 79 elsif($server =~ /^(tftp|sftp|socks|ssh|rtsp)(\d*)(-ipv6|)$/) { 80 $proto = $1; 81 $idnum = ($2 && ($2 > 1)) ? $2 : 1; 82 $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4; 83 } 84 else { 85 die "invalid server id: $server" 86 } 87 return($proto, $ipvnum, $idnum); 88} 89 90 91#*************************************************************************** 92# Return server name string formatted for presentation purposes 93# 94sub servername_str { 95 my ($proto, $ipver, $idnum) = @_; 96 97 $proto = uc($proto) if($proto); 98 die "unsupported protocol: $proto" unless($proto && 99 ($proto =~ /^(((FTP|HTTP|IMAP|POP3|SMTP)S?)|(TFTP|SFTP|SOCKS|SSH|RTSP|GOPHER|HTTP\+TLS-SRP))$/)); 100 101 $ipver = (not $ipver) ? 'ipv4' : lc($ipver); 102 die "unsupported IP version: $ipver" unless($ipver && 103 ($ipver =~ /^(4|6|ipv4|ipv6|-ipv4|-ipv6)$/)); 104 $ipver = ($ipver =~ /6$/) ? '-IPv6' : ''; 105 106 $idnum = 1 if(not $idnum); 107 die "unsupported ID number: $idnum" unless($idnum && 108 ($idnum =~ /^(\d+)$/)); 109 $idnum = '' unless($idnum > 1); 110 111 return "${proto}${idnum}${ipver}"; 112} 113 114 115#*************************************************************************** 116# Return server name string formatted for identification purposes 117# 118sub servername_id { 119 my ($proto, $ipver, $idnum) = @_; 120 return lc(servername_str($proto, $ipver, $idnum)); 121} 122 123 124#*************************************************************************** 125# Return server name string formatted for file name purposes 126# 127sub servername_canon { 128 my ($proto, $ipver, $idnum) = @_; 129 my $string = lc(servername_str($proto, $ipver, $idnum)); 130 $string =~ tr/-/_/; 131 return $string; 132} 133 134 135#*************************************************************************** 136# Return file name for server pid file. 137# 138sub server_pidfilename { 139 my ($proto, $ipver, $idnum) = @_; 140 my $trailer = '_server.pid'; 141 return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; 142} 143 144 145#*************************************************************************** 146# Return file name for server log file. 147# 148sub server_logfilename { 149 my ($logdir, $proto, $ipver, $idnum) = @_; 150 my $trailer = '_server.log'; 151 $trailer = '_stunnel.log' if(lc($proto) =~ /^(ftp|http|imap|pop3|smtp)s$/); 152 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 153} 154 155 156#*************************************************************************** 157# Return file name for server commands file. 158# 159sub server_cmdfilename { 160 my ($logdir, $proto, $ipver, $idnum) = @_; 161 my $trailer = '_server.cmd'; 162 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 163} 164 165 166#*************************************************************************** 167# Return file name for server input file. 168# 169sub server_inputfilename { 170 my ($logdir, $proto, $ipver, $idnum) = @_; 171 my $trailer = '_server.input'; 172 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 173} 174 175 176#*************************************************************************** 177# Return file name for server output file. 178# 179sub server_outputfilename { 180 my ($logdir, $proto, $ipver, $idnum) = @_; 181 my $trailer = '_server.output'; 182 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 183} 184 185 186#*************************************************************************** 187# Return file name for main or primary sockfilter pid file. 188# 189sub mainsockf_pidfilename { 190 my ($proto, $ipver, $idnum) = @_; 191 die "unsupported protocol: $proto" unless($proto && 192 (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/)); 193 my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.pid':'_sockfilt.pid'; 194 return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; 195} 196 197 198#*************************************************************************** 199# Return file name for main or primary sockfilter log file. 200# 201sub mainsockf_logfilename { 202 my ($logdir, $proto, $ipver, $idnum) = @_; 203 die "unsupported protocol: $proto" unless($proto && 204 (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/)); 205 my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.log':'_sockfilt.log'; 206 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 207} 208 209 210#*************************************************************************** 211# Return file name for data or secondary sockfilter pid file. 212# 213sub datasockf_pidfilename { 214 my ($proto, $ipver, $idnum) = @_; 215 die "unsupported protocol: $proto" unless($proto && 216 (lc($proto) =~ /^ftps?$/)); 217 my $trailer = '_sockdata.pid'; 218 return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; 219} 220 221 222#*************************************************************************** 223# Return file name for data or secondary sockfilter log file. 224# 225sub datasockf_logfilename { 226 my ($logdir, $proto, $ipver, $idnum) = @_; 227 die "unsupported protocol: $proto" unless($proto && 228 (lc($proto) =~ /^ftps?$/)); 229 my $trailer = '_sockdata.log'; 230 return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; 231} 232 233 234#*************************************************************************** 235# End of library 2361; 237 238