Lines 4-9
use strict;
Link Here
|
4 |
use warnings; |
4 |
use warnings; |
5 |
use FindBin qw($Bin); |
5 |
use FindBin qw($Bin); |
6 |
use lib "$Bin"; |
6 |
use lib "$Bin"; |
|
|
7 |
# or use Net::Server::Fork for better use of resources |
7 |
use Net::Server::PreFork; |
8 |
use Net::Server::PreFork; |
8 |
use IO::Socket::INET; |
9 |
use IO::Socket::INET; |
9 |
use Socket qw(:DEFAULT :crlf); |
10 |
use Socket qw(:DEFAULT :crlf); |
Lines 26-39
tie *STDERR, "C4::SIP::Trapper";
Link Here
|
26 |
|
27 |
|
27 |
use base qw(Net::Server::PreFork); |
28 |
use base qw(Net::Server::PreFork); |
28 |
|
29 |
|
29 |
use constant LOG_SIP => "local6"; # Local alias for the logging facility |
30 |
use constant LOG_SIP => "local6"; # Local alias for the logging facility |
30 |
|
|
|
31 |
# |
32 |
# Main # not really, since package SIPServer |
33 |
# |
34 |
# FIXME: Is this a module or a script? |
35 |
# A script with no MAIN namespace? |
36 |
# A module that takes command line args? |
37 |
|
31 |
|
38 |
# Set interface to 'sip' |
32 |
# Set interface to 'sip' |
39 |
C4::Context->interface('sip'); |
33 |
C4::Context->interface('sip'); |
Lines 52-58
my @parms;
Link Here
|
52 |
# |
46 |
# |
53 |
# Ports to bind |
47 |
# Ports to bind |
54 |
# |
48 |
# |
55 |
foreach my $svc (keys %{$config->{listeners}}) { |
49 |
foreach my $svc ( keys %{ $config->{listeners} } ) { |
56 |
push @parms, "port=" . $svc; |
50 |
push @parms, "port=" . $svc; |
57 |
} |
51 |
} |
58 |
|
52 |
|
Lines 65-87
foreach my $svc (keys %{$config->{listeners}}) {
Link Here
|
65 |
# |
59 |
# |
66 |
# The IDENT is determined by config file 'server-params' arguments |
60 |
# The IDENT is determined by config file 'server-params' arguments |
67 |
|
61 |
|
68 |
|
|
|
69 |
# |
62 |
# |
70 |
# Server Management: set parameters for the Net::Server::PreFork |
63 |
# Server Management: set parameters for the Net::Server::* |
71 |
# module. The module silently ignores parameters that it doesn't |
64 |
# module. The module silently ignores parameters that it doesn't |
72 |
# recognize, and complains about invalid values for parameters |
65 |
# recognize, and complains about invalid values for parameters |
73 |
# that it does. |
66 |
# that it does. |
74 |
# |
67 |
# |
75 |
if (defined($config->{'server-params'})) { |
68 |
if ( defined( $config->{'server-params'} ) ) { |
76 |
while (my ($key, $val) = each %{$config->{'server-params'}}) { |
69 |
while ( my ( $key, $val ) = each %{ $config->{'server-params'} } ) { |
77 |
push @parms, $key . '=' . $val; |
70 |
push @parms, $key . '=' . $val; |
78 |
} |
71 |
} |
79 |
} |
72 |
} |
80 |
|
73 |
|
81 |
|
|
|
82 |
# |
74 |
# |
83 |
# This is the main event. |
75 |
# This is the main event. |
84 |
__PACKAGE__ ->run(@parms); |
76 |
__PACKAGE__->run(@parms); |
85 |
|
77 |
|
86 |
# |
78 |
# |
87 |
# Child |
79 |
# Child |
Lines 93-99
__PACKAGE__ ->run(@parms);
Link Here
|
93 |
sub process_request { |
85 |
sub process_request { |
94 |
my $self = shift; |
86 |
my $self = shift; |
95 |
my $service; |
87 |
my $service; |
96 |
my ($sockaddr, $port, $proto); |
88 |
my ( $sockaddr, $port, $proto ); |
97 |
my $transport; |
89 |
my $transport; |
98 |
|
90 |
|
99 |
$self->{config} = $config; |
91 |
$self->{config} = $config; |
Lines 101-135
sub process_request {
Link Here
|
101 |
# Flushing L1 to make sure the request will be processed using the correct data |
93 |
# Flushing L1 to make sure the request will be processed using the correct data |
102 |
Koha::Caches->flush_L1_caches(); |
94 |
Koha::Caches->flush_L1_caches(); |
103 |
|
95 |
|
104 |
$self->{account} = undef; # Clear out the account from the last request, it may be different |
96 |
$self->{account} = |
|
|
97 |
undef; # Clear out the account from the last request, it may be different |
105 |
$self->{logger} = set_logger( Koha::Logger->get( { interface => 'sip' } ) ); |
98 |
$self->{logger} = set_logger( Koha::Logger->get( { interface => 'sip' } ) ); |
106 |
|
99 |
|
107 |
my $sockname = getsockname(STDIN); |
100 |
my $sockname = getsockname(STDIN); |
108 |
|
101 |
|
109 |
# Check if socket connection is IPv6 before resolving address |
102 |
# Check if socket connection is IPv6 before resolving address |
110 |
my $family = Socket::sockaddr_family($sockname); |
103 |
my $family = Socket::sockaddr_family($sockname); |
111 |
if ($family == AF_INET6) { |
104 |
if ( $family == AF_INET6 ) { |
112 |
($port, $sockaddr) = sockaddr_in6($sockname); |
105 |
( $port, $sockaddr ) = sockaddr_in6($sockname); |
113 |
$sockaddr = Socket::inet_ntop(AF_INET6, $sockaddr); |
106 |
$sockaddr = Socket::inet_ntop( AF_INET6, $sockaddr ); |
114 |
} else { |
107 |
} |
115 |
($port, $sockaddr) = sockaddr_in($sockname); |
108 |
else { |
116 |
$sockaddr = inet_ntoa($sockaddr); |
109 |
( $port, $sockaddr ) = sockaddr_in($sockname); |
|
|
110 |
$sockaddr = inet_ntoa($sockaddr); |
117 |
} |
111 |
} |
118 |
$proto = $self->{server}->{client}->NS_proto(); |
112 |
$proto = $self->{server}->{client}->NS_proto(); |
119 |
|
113 |
|
120 |
$self->{service} = $config->find_service($sockaddr, $port, $proto); |
114 |
$self->{service} = $config->find_service( $sockaddr, $port, $proto ); |
121 |
|
115 |
|
122 |
if (!defined($self->{service})) { |
116 |
if ( !defined( $self->{service} ) ) { |
123 |
siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); |
117 |
siplog( "LOG_ERR", |
|
|
118 |
"process_request: Unknown recognized server connection: %s:%s/%s", |
119 |
$sockaddr, $port, $proto ); |
124 |
die "process_request: Bad server connection"; |
120 |
die "process_request: Bad server connection"; |
125 |
} |
121 |
} |
126 |
|
122 |
|
127 |
$transport = $transports{$self->{service}->{transport}}; |
123 |
$transport = $transports{ $self->{service}->{transport} }; |
128 |
|
124 |
|
129 |
if (!defined($transport)) { |
125 |
if ( !defined($transport) ) { |
130 |
siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport}); |
126 |
siplog( "LOG_WARNING", "Unknown transport '%s', dropping", |
|
|
127 |
$service->{transport} ); |
131 |
return; |
128 |
return; |
132 |
} else { |
129 |
} |
|
|
130 |
else { |
133 |
&$transport($self); |
131 |
&$transport($self); |
134 |
} |
132 |
} |
135 |
return; |
133 |
return; |
Lines 143-171
sub raw_transport {
Link Here
|
143 |
my $self = shift; |
141 |
my $self = shift; |
144 |
my $input; |
142 |
my $input; |
145 |
my $service = $self->{service}; |
143 |
my $service = $self->{service}; |
146 |
# If using Net::Server::PreFork you may already have account set from a previous session |
144 |
|
147 |
# Ensure you dont |
145 |
# If using Net::Server::PreFork you may already have account set from a previous session |
148 |
if ($self->{account}) { |
146 |
# Ensure you dont |
|
|
147 |
if ( $self->{account} ) { |
149 |
delete $self->{account}; |
148 |
delete $self->{account}; |
150 |
} |
149 |
} |
151 |
|
150 |
|
152 |
# Timeout the while loop if we get stuck in it |
151 |
# Timeout the while loop if we get stuck in it |
153 |
# In practice it should only iterate once but be prepared |
152 |
# In practice it should only iterate once but be prepared |
154 |
local $SIG{ALRM} = sub { die 'raw transport Timed Out!' }; |
153 |
local $SIG{ALRM} = sub { die 'raw transport Timed Out!' }; |
155 |
my $timeout = $self->get_timeout({ transport => 1 }); |
154 |
my $timeout = $self->get_timeout( { transport => 1 } ); |
156 |
siplog('LOG_DEBUG', "raw_transport: timeout is $timeout"); |
155 |
siplog( 'LOG_DEBUG', "raw_transport: timeout is $timeout" ); |
157 |
alarm $timeout; |
156 |
alarm $timeout; |
158 |
while (!$self->{account}) { |
157 |
while ( !$self->{account} ) { |
159 |
$input = read_request(); |
158 |
$input = read_request(); |
160 |
if (!$input) { |
159 |
if ( !$input ) { |
|
|
160 |
|
161 |
# EOF on the socket |
161 |
# EOF on the socket |
162 |
siplog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
162 |
siplog( "LOG_INFO", |
|
|
163 |
"raw_transport: shutting down: EOF during login" ); |
163 |
return; |
164 |
return; |
164 |
} |
165 |
} |
165 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
166 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
166 |
my $reg = qr/^${\(LOGIN)}/; |
167 |
my $reg = qr/^${\(LOGIN)}/; |
167 |
last if $input !~ $reg || |
168 |
last |
168 |
C4::SIP::Sip::MsgType::handle($input, $self, LOGIN); |
169 |
if $input !~ $reg |
|
|
170 |
|| C4::SIP::Sip::MsgType::handle( $input, $self, LOGIN ); |
169 |
} |
171 |
} |
170 |
alarm 0; |
172 |
alarm 0; |
171 |
|
173 |
|
Lines 173-206
sub raw_transport {
Link Here
|
173 |
Koha::Logger->get( |
175 |
Koha::Logger->get( |
174 |
{ |
176 |
{ |
175 |
interface => 'sip', |
177 |
interface => 'sip', |
176 |
category => $self->{account}->{id}, # Add id to namespace |
178 |
category => $self->{account}->{id}, # Add id to namespace |
177 |
} |
179 |
} |
178 |
) |
180 |
) |
179 |
); |
181 |
); |
180 |
|
182 |
|
181 |
siplog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
183 |
siplog( |
182 |
$self->{account}->{id}, |
184 |
"LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
183 |
$self->{account}->{institution}); |
185 |
$self->{account}->{id}, $self->{account}->{institution} |
184 |
if (! $self->{account}->{id}) { |
186 |
); |
185 |
siplog("LOG_ERR","Login failed shutting down"); |
187 |
if ( !$self->{account}->{id} ) { |
|
|
188 |
siplog( "LOG_ERR", "Login failed shutting down" ); |
186 |
return; |
189 |
return; |
187 |
} |
190 |
} |
188 |
|
191 |
|
189 |
$self->sip_protocol_loop(); |
192 |
$self->sip_protocol_loop(); |
190 |
siplog("LOG_INFO", "raw_transport: shutting down"); |
193 |
siplog( "LOG_INFO", "raw_transport: shutting down" ); |
191 |
return; |
194 |
return; |
192 |
} |
195 |
} |
193 |
|
196 |
|
194 |
sub get_clean_string { |
197 |
sub get_clean_string { |
195 |
my $string = shift; |
198 |
my $string = shift; |
196 |
if (defined $string) { |
199 |
if ( defined $string ) { |
197 |
siplog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string); |
200 |
siplog( "LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", |
|
|
201 |
length($string), $string ); |
198 |
chomp($string); |
202 |
chomp($string); |
199 |
$string =~ s/^[^A-z0-9]+//; |
203 |
$string =~ s/^[^A-z0-9]+//; |
200 |
$string =~ s/[^A-z0-9]+$//; |
204 |
$string =~ s/[^A-z0-9]+$//; |
201 |
siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string); |
205 |
siplog( "LOG_DEBUG", "get_clean_string post-clean(length %s): %s", |
202 |
} else { |
206 |
length($string), $string ); |
203 |
siplog("LOG_INFO", "get_clean_string called on undefined"); |
207 |
} |
|
|
208 |
else { |
209 |
siplog( "LOG_INFO", "get_clean_string called on undefined" ); |
204 |
} |
210 |
} |
205 |
return $string; |
211 |
return $string; |
206 |
} |
212 |
} |
Lines 209-278
sub get_clean_input {
Link Here
|
209 |
local $/ = "\012"; |
215 |
local $/ = "\012"; |
210 |
my $in = <STDIN>; |
216 |
my $in = <STDIN>; |
211 |
$in = get_clean_string($in); |
217 |
$in = get_clean_string($in); |
212 |
while (my $extra = <STDIN>){ |
218 |
while ( my $extra = <STDIN> ) { |
213 |
siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra); |
219 |
siplog( "LOG_ERR", "get_clean_input got extra lines: %s", $extra ); |
214 |
} |
220 |
} |
215 |
return $in; |
221 |
return $in; |
216 |
} |
222 |
} |
217 |
|
223 |
|
218 |
sub telnet_transport { |
224 |
sub telnet_transport { |
219 |
my $self = shift; |
225 |
my $self = shift; |
220 |
my ($uid, $pwd); |
226 |
my ( $uid, $pwd ); |
221 |
my $strikes = 3; |
227 |
my $strikes = 3; |
222 |
my $account = undef; |
228 |
my $account = undef; |
223 |
my $input; |
229 |
my $input; |
224 |
my $config = $self->{config}; |
230 |
my $config = $self->{config}; |
225 |
my $timeout = $self->get_timeout({ transport => 1 }); |
231 |
my $timeout = $self->get_timeout( { transport => 1 } ); |
226 |
siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout"); |
232 |
siplog( "LOG_DEBUG", "telnet_transport: timeout is $timeout" ); |
227 |
|
233 |
|
228 |
eval { |
234 |
eval { |
229 |
local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; |
235 |
local $SIG{ALRM} = |
230 |
local $| = 1; # Unbuffered output |
236 |
sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; |
231 |
$/ = "\015"; # Internet Record Separator (lax version) |
237 |
local $| = 1; # Unbuffered output |
232 |
# Until the terminal has logged in, we don't trust it |
238 |
$/ = "\015"; # Internet Record Separator (lax version) |
233 |
# so use a timeout to protect ourselves from hanging. |
239 |
# Until the terminal has logged in, we don't trust it |
234 |
|
240 |
# so use a timeout to protect ourselves from hanging. |
235 |
while ($strikes--) { |
241 |
|
236 |
print "login: "; |
242 |
while ( $strikes-- ) { |
237 |
alarm $timeout; |
243 |
print "login: "; |
238 |
# $uid = &get_clean_input; |
244 |
alarm $timeout; |
239 |
$uid = <STDIN>; |
245 |
|
240 |
print "password: "; |
246 |
# $uid = &get_clean_input; |
241 |
# $pwd = &get_clean_input || ''; |
247 |
$uid = <STDIN>; |
242 |
$pwd = <STDIN>; |
248 |
print "password: "; |
243 |
alarm 0; |
249 |
|
244 |
|
250 |
# $pwd = &get_clean_input || ''; |
245 |
siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd)); |
251 |
$pwd = <STDIN>; |
246 |
$uid = get_clean_string ($uid); |
252 |
alarm 0; |
247 |
$pwd = get_clean_string ($pwd); |
253 |
|
248 |
siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd)); |
254 |
siplog( "LOG_DEBUG", |
249 |
|
255 |
"telnet_transport 1: uid length %s, pwd length %s", |
250 |
if (exists ($config->{accounts}->{$uid}) |
256 |
length($uid), length($pwd) ); |
251 |
&& ($pwd eq $config->{accounts}->{$uid}->{password})) { |
257 |
$uid = get_clean_string($uid); |
252 |
$account = $config->{accounts}->{$uid}; |
258 |
$pwd = get_clean_string($pwd); |
253 |
if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) { |
259 |
siplog( "LOG_DEBUG", |
254 |
last; |
260 |
"telnet_transport 2: uid length %s, pwd length %s", |
|
|
261 |
length($uid), length($pwd) ); |
262 |
|
263 |
if ( exists( $config->{accounts}->{$uid} ) |
264 |
&& ( $pwd eq $config->{accounts}->{$uid}->{password} ) ) |
265 |
{ |
266 |
$account = $config->{accounts}->{$uid}; |
267 |
if ( C4::SIP::Sip::MsgType::login_core( $self, $uid, $pwd ) ) { |
268 |
last; |
269 |
} |
255 |
} |
270 |
} |
|
|
271 |
siplog( |
272 |
"LOG_WARNING", |
273 |
"Invalid login attempt: '%s'", |
274 |
( $uid || '' ) |
275 |
); |
276 |
print("Invalid login$CRLF"); |
256 |
} |
277 |
} |
257 |
siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||'')); |
278 |
}; # End of eval |
258 |
print("Invalid login$CRLF"); |
|
|
259 |
} |
260 |
}; # End of eval |
261 |
|
279 |
|
262 |
if ($@) { |
280 |
if ($@) { |
263 |
siplog("LOG_ERR", "telnet_transport: Login timed out"); |
281 |
siplog( "LOG_ERR", "telnet_transport: Login timed out" ); |
264 |
die "Telnet Login Timed out"; |
282 |
die "Telnet Login Timed out"; |
265 |
} elsif (!defined($account)) { |
283 |
} |
266 |
siplog("LOG_ERR", "telnet_transport: Login Failed"); |
284 |
elsif ( !defined($account) ) { |
|
|
285 |
siplog( "LOG_ERR", "telnet_transport: Login Failed" ); |
267 |
die "Login Failure"; |
286 |
die "Login Failure"; |
268 |
} else { |
287 |
} |
|
|
288 |
else { |
269 |
print "Login OK. Initiating SIP$CRLF"; |
289 |
print "Login OK. Initiating SIP$CRLF"; |
270 |
} |
290 |
} |
271 |
|
291 |
|
272 |
$self->{account} = $account; |
292 |
$self->{account} = $account; |
273 |
siplog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); |
293 |
siplog( "LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", |
|
|
294 |
$account->{id}, $account->{institution} ); |
274 |
$self->sip_protocol_loop(); |
295 |
$self->sip_protocol_loop(); |
275 |
siplog("LOG_INFO", "telnet_transport: shutting down"); |
296 |
siplog( "LOG_INFO", "telnet_transport: shutting down" ); |
276 |
return; |
297 |
return; |
277 |
} |
298 |
} |
278 |
|
299 |
|
Lines 282-291
sub telnet_transport {
Link Here
|
282 |
# telnet transport. From that point on, both the raw and the telnet |
303 |
# telnet transport. From that point on, both the raw and the telnet |
283 |
# processes are the same: |
304 |
# processes are the same: |
284 |
sub sip_protocol_loop { |
305 |
sub sip_protocol_loop { |
285 |
my $self = shift; |
306 |
my $self = shift; |
286 |
my $service = $self->{service}; |
307 |
my $service = $self->{service}; |
287 |
my $config = $self->{config}; |
308 |
my $config = $self->{config}; |
288 |
my $timeout = $self->get_timeout({ client => 1 }); |
309 |
my $timeout = $self->get_timeout( { client => 1 } ); |
289 |
|
310 |
|
290 |
# The spec says the first message will be: |
311 |
# The spec says the first message will be: |
291 |
# SIP v1: SC_STATUS |
312 |
# SIP v1: SC_STATUS |
Lines 339-376
sub sip_protocol_loop {
Link Here
|
339 |
} |
360 |
} |
340 |
|
361 |
|
341 |
sub read_request { |
362 |
sub read_request { |
342 |
my $raw_length; |
363 |
my $raw_length; |
343 |
local $/ = "\015"; |
364 |
local $/ = "\015"; |
344 |
|
365 |
|
345 |
# proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return |
366 |
# proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return |
346 |
my $buffer = <STDIN>; |
367 |
my $buffer = <STDIN>; |
347 |
if ( defined $buffer ) { |
368 |
if ( defined $buffer ) { |
348 |
STDIN->flush(); # clear an extra linefeed |
369 |
STDIN->flush(); # clear an extra linefeed |
349 |
chomp $buffer; |
370 |
chomp $buffer; |
350 |
$raw_length = length $buffer; |
371 |
$raw_length = length $buffer; |
351 |
$buffer =~ s/^\s*[^A-z0-9]+//s; |
372 |
$buffer =~ s/^\s*[^A-z0-9]+//s; |
|
|
373 |
|
352 |
# Every line must start with a "real" character. Not whitespace, control chars, etc. |
374 |
# Every line must start with a "real" character. Not whitespace, control chars, etc. |
353 |
$buffer =~ s/[^A-z0-9]+$//s; |
375 |
$buffer =~ s/[^A-z0-9]+$//s; |
354 |
|
376 |
|
355 |
# Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| |
377 |
# Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| |
356 |
$buffer =~ s/\015?\012//g; # Extra line breaks must die |
378 |
$buffer =~ s/\015?\012//g; # Extra line breaks must die |
357 |
$buffer =~ s/\015?\012//s; # Extra line breaks must die |
379 |
$buffer =~ s/\015?\012//s; # Extra line breaks must die |
358 |
$buffer =~ s/\015*\012*$//s; |
380 |
$buffer =~ s/\015*\012*$//s; |
359 |
|
381 |
|
360 |
# treat as one line to include the extra linebreaks we are trying to remove! |
382 |
# treat as one line to include the extra linebreaks we are trying to remove! |
361 |
} |
383 |
} |
362 |
else { |
384 |
else { |
363 |
siplog( 'LOG_DEBUG', 'EOF returned on read' ); |
385 |
siplog( 'LOG_DEBUG', 'EOF returned on read' ); |
364 |
return; |
386 |
return; |
365 |
} |
387 |
} |
366 |
my $len = length $buffer; |
388 |
my $len = length $buffer; |
367 |
if ( $len != $raw_length ) { |
389 |
if ( $len != $raw_length ) { |
368 |
my $trim = $raw_length - $len; |
390 |
my $trim = $raw_length - $len; |
369 |
siplog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " ); |
391 |
siplog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " ); |
370 |
} |
392 |
} |
371 |
|
393 |
|
372 |
siplog( 'LOG_INFO', "INPUT MSG: '$buffer'" ); |
394 |
siplog( 'LOG_INFO', "INPUT MSG: '$buffer'" ); |
373 |
return $buffer; |
395 |
return $buffer; |
374 |
} |
396 |
} |
375 |
|
397 |
|
376 |
# $server->get_timeout({ $type => 1, fallback => $fallback }); |
398 |
# $server->get_timeout({ $type => 1, fallback => $fallback }); |
Lines 387-416
sub get_timeout {
Link Here
|
387 |
my ( $server, $params ) = @_; |
409 |
my ( $server, $params ) = @_; |
388 |
my $fallback = $params->{fallback} || 30; |
410 |
my $fallback = $params->{fallback} || 30; |
389 |
my $service = $server->{service} // {}; |
411 |
my $service = $server->{service} // {}; |
390 |
my $config = $server->{config} // {}; |
412 |
my $config = $server->{config} // {}; |
391 |
|
413 |
|
392 |
if( $params->{transport} || |
414 |
if ( $params->{transport} |
393 |
( $params->{client} && !exists $service->{client_timeout} )) { |
415 |
|| ( $params->{client} && !exists $service->{client_timeout} ) ) |
|
|
416 |
{ |
394 |
# We do not allow zero values here. |
417 |
# We do not allow zero values here. |
395 |
# Note: config/timeout seems to be deprecated. |
418 |
# Note: config/timeout seems to be deprecated. |
396 |
return $service->{timeout} || $config->{timeout} || $fallback; |
419 |
return $service->{timeout} || $config->{timeout} || $fallback; |
397 |
|
420 |
|
398 |
} elsif( $params->{client} ) { |
421 |
} |
|
|
422 |
elsif ( $params->{client} ) { |
423 |
|
399 |
# We know that client_timeout exists now. |
424 |
# We know that client_timeout exists now. |
400 |
# We do allow zero values here to indicate no timeout. |
425 |
# We do allow zero values here to indicate no timeout. |
401 |
return 0 if $service->{client_timeout} =~ /^0+$|\D/; |
426 |
return 0 if $service->{client_timeout} =~ /^0+$|\D/; |
402 |
return $service->{client_timeout}; |
427 |
return $service->{client_timeout}; |
403 |
|
428 |
|
404 |
} elsif( $params->{policy} ) { |
429 |
} |
|
|
430 |
elsif ( $params->{policy} ) { |
405 |
my $policy = $server->{policy} // {}; |
431 |
my $policy = $server->{policy} // {}; |
406 |
my $rv = sprintf( "%03d", $policy->{timeout} // 0 ); |
432 |
my $rv = sprintf( "%03d", $policy->{timeout} // 0 ); |
407 |
if( length($rv) != 3 ) { |
433 |
if ( length($rv) != 3 ) { |
408 |
siplog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv ); |
434 |
siplog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv ); |
409 |
return '000'; |
435 |
return '000'; |
410 |
} |
436 |
} |
411 |
return $rv; |
437 |
return $rv; |
412 |
|
438 |
|
413 |
} else { |
439 |
} |
|
|
440 |
else { |
414 |
return $fallback; |
441 |
return $fallback; |
415 |
} |
442 |
} |
416 |
} |
443 |
} |
417 |
- |
|
|