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