← Back to branch summary

~ubuntu-branches/ubuntu/vivid/curl/vivid

« back to all changes in this revision

Viewing changes to tests/serverhelp.pm

  • Committer: Bazaar Package Importer
  • Author(s): Ramakrishnan Muthukrishnan
  • Date: 2010-03-18 08:55:19 UTC
  • mfrom: (3.4.3 squeeze)
  • mto: (3.5.1 squeeze) (1.3.1)
  • mto: This revision was merged to the branch mainline in revision 42.
  • Revision ID: james.westby@ubuntu.com-20100318085519-iq2nvq06lp26abtp
Tags: upstream-7.20.0
Import upstream version 7.20.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/serverhelp.pm
 
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
# $Id: serverhelp.pm,v 1.7 2010-02-01 12:05:08 yangtse Exp $
 
22
#***************************************************************************
 
23
 
 
24
package serverhelp;
 
25
 
 
26
use strict;
 
27
use warnings;
 
28
use Exporter;
 
29
 
 
30
 
 
31
#***************************************************************************
 
32
# Global symbols allowed without explicit package name
 
33
#
 
34
use vars qw(
 
35
    @ISA
 
36
    @EXPORT_OK
 
37
    );
 
38
 
 
39
 
 
40
#***************************************************************************
 
41
# Inherit Exporter's capabilities
 
42
#
 
43
@ISA = qw(Exporter);
 
44
 
 
45
 
 
46
#***************************************************************************
 
47
# Global symbols this module will export upon request
 
48
#
 
49
@EXPORT_OK = qw(
 
50
    serverfactors
 
51
    servername_id
 
52
    servername_str
 
53
    servername_canon
 
54
    server_pidfilename
 
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
# Return server characterization factors given a server id string.
 
68
#
 
69
sub serverfactors {
 
70
    my $server = $_[0];
 
71
    my $proto;
 
72
    my $ipvnum;
 
73
    my $idnum;
 
74
 
 
75
    if($server =~ /^((ftp|http|imap|pop3|smtp)s?)(\d*)(-ipv6|)$/) {
 
76
        $proto  = $1;
 
77
        $idnum  = ($3 && ($3 > 1)) ? $3 : 1;
 
78
        $ipvnum = ($4 && ($4 =~ /6$/)) ? 6 : 4;
 
79
    }
 
80
    elsif($server =~ /^(tftp|sftp|socks|ssh|rtsp)(\d*)(-ipv6|)$/) {
 
81
        $proto  = $1;
 
82
        $idnum  = ($2 && ($2 > 1)) ? $2 : 1;
 
83
        $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
 
84
    }
 
85
    else {
 
86
        die "invalid server id: $server"
 
87
    }
 
88
    return($proto, $ipvnum, $idnum);
 
89
}
 
90
 
 
91
 
 
92
#***************************************************************************
 
93
# Return server name string formatted for presentation purposes
 
94
#
 
95
sub servername_str {
 
96
    my ($proto, $ipver, $idnum) = @_;
 
97
 
 
98
    $proto = uc($proto) if($proto);
 
99
    die "unsupported protocol: $proto" unless($proto &&
 
100
        ($proto =~ /^(((FTP|HTTP|IMAP|POP3|SMTP)S?)|(TFTP|SFTP|SOCKS|SSH|RTSP))$/));
 
101
 
 
102
    $ipver = (not $ipver) ? 'ipv4' : lc($ipver);
 
103
    die "unsupported IP version: $ipver" unless($ipver &&
 
104
        ($ipver =~ /^(4|6|ipv4|ipv6|-ipv4|-ipv6)$/));
 
105
    $ipver = ($ipver =~ /6$/) ? '-IPv6' : '';
 
106
 
 
107
    $idnum = 1 if(not $idnum);
 
108
    die "unsupported ID number: $idnum" unless($idnum &&
 
109
        ($idnum =~ /^(\d+)$/));
 
110
    $idnum = '' unless($idnum > 1);
 
111
 
 
112
    return "${proto}${idnum}${ipver}";
 
113
}
 
114
 
 
115
 
 
116
#***************************************************************************
 
117
# Return server name string formatted for identification purposes
 
118
#
 
119
sub servername_id {
 
120
    my ($proto, $ipver, $idnum) = @_;
 
121
    return lc(servername_str($proto, $ipver, $idnum));
 
122
}
 
123
 
 
124
 
 
125
#***************************************************************************
 
126
# Return server name string formatted for file name purposes
 
127
#
 
128
sub servername_canon {
 
129
    my ($proto, $ipver, $idnum) = @_;
 
130
    my $string = lc(servername_str($proto, $ipver, $idnum));
 
131
    $string =~ tr/-/_/;
 
132
    return $string;
 
133
}
 
134
 
 
135
 
 
136
#***************************************************************************
 
137
# Return file name for server pid file.
 
138
#
 
139
sub server_pidfilename {
 
140
    my ($proto, $ipver, $idnum) = @_;
 
141
    my $trailer = '_server.pid';
 
142
    return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer";
 
143
}
 
144
 
 
145
 
 
146
#***************************************************************************
 
147
# Return file name for server log file.
 
148
#
 
149
sub server_logfilename {
 
150
    my ($logdir, $proto, $ipver, $idnum) = @_;
 
151
    my $trailer = '_server.log';
 
152
    $trailer = '_stunnel.log' if(lc($proto) =~ /^(ftp|http|imap|pop3|smtp)s$/);
 
153
    return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";
 
154
}
 
155
 
 
156
 
 
157
#***************************************************************************
 
158
# Return file name for server commands file.
 
159
#
 
160
sub server_cmdfilename {
 
161
    my ($logdir, $proto, $ipver, $idnum) = @_;
 
162
    my $trailer = '_server.cmd';
 
163
    return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";
 
164
}
 
165
 
 
166
 
 
167
#***************************************************************************
 
168
# Return file name for server input file.
 
169
#
 
170
sub server_inputfilename {
 
171
    my ($logdir, $proto, $ipver, $idnum) = @_;
 
172
    my $trailer = '_server.input';
 
173
    return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";
 
174
}
 
175
 
 
176
 
 
177
#***************************************************************************
 
178
# Return file name for server output file.
 
179
#
 
180
sub server_outputfilename {
 
181
    my ($logdir, $proto, $ipver, $idnum) = @_;
 
182
    my $trailer = '_server.output';
 
183
    return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";
 
184
}
 
185
 
 
186
 
 
187
#***************************************************************************
 
188
# Return file name for main or primary sockfilter pid file.
 
189
#
 
190
sub mainsockf_pidfilename {
 
191
    my ($proto, $ipver, $idnum) = @_;
 
192
    die "unsupported protocol: $proto" unless($proto &&
 
193
        (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/));
 
194
    my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.pid':'_sockfilt.pid';
 
195
    return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer";
 
196
}
 
197
 
 
198
 
 
199
#***************************************************************************
 
200
# Return file name for main or primary sockfilter log file.
 
201
#
 
202
sub mainsockf_logfilename {
 
203
    my ($logdir, $proto, $ipver, $idnum) = @_;
 
204
    die "unsupported protocol: $proto" unless($proto &&
 
205
        (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/));
 
206
    my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.log':'_sockfilt.log';
 
207
    return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";
 
208
}
 
209
 
 
210
 
 
211
#***************************************************************************
 
212
# Return file name for data or secondary sockfilter pid file.
 
213
#
 
214
sub datasockf_pidfilename {
 
215
    my ($proto, $ipver, $idnum) = @_;
 
216
    die "unsupported protocol: $proto" unless($proto &&
 
217
        (lc($proto) =~ /^ftps?$/));
 
218
    my $trailer = '_sockdata.pid';
 
219
    return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer";
 
220
}
 
221
 
 
222
 
 
223
#***************************************************************************
 
224
# Return file name for data or secondary sockfilter log file.
 
225
#
 
226
sub datasockf_logfilename {
 
227
    my ($logdir, $proto, $ipver, $idnum) = @_;
 
228
    die "unsupported protocol: $proto" unless($proto &&
 
229
        (lc($proto) =~ /^ftps?$/));
 
230
    my $trailer = '_sockdata.log';
 
231
    return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";
 
232
}
 
233
 
 
234
 
 
235
#***************************************************************************
 
236
# End of library
 
237
1;
 
238