|
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 |
- |
|
|