Annotation of embedaddon/curl/tests/serverhelp.pm, revision 1.1
1.1 ! misho 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:
! 23: package serverhelp;
! 24:
! 25: use strict;
! 26: use warnings;
! 27: use Exporter;
! 28:
! 29:
! 30: #***************************************************************************
! 31: # Global symbols allowed without explicit package name
! 32: #
! 33: use 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: #
! 76: sub 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: #
! 104: sub 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: #
! 128: sub 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: #
! 137: sub 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: #
! 149: sub 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: #
! 158: sub 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: #
! 168: sub 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: #
! 179: sub 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: #
! 189: sub 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: #
! 199: sub 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: #
! 209: sub 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: #
! 221: sub 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: #
! 233: sub 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: #
! 245: sub 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
! 256: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to serverhelp.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests