Lines 15-30
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
Link Here
|
15 |
use C4::SIP::Sip::MsgType qw( handle login_core ); |
15 |
use C4::SIP::Sip::MsgType qw( handle login_core ); |
16 |
use C4::SIP::Sip qw( read_SIP_packet ); |
16 |
use C4::SIP::Sip qw( read_SIP_packet ); |
17 |
|
17 |
|
|
|
18 |
# or use Net::Server::Fork for better use of resources |
18 |
use base qw(Net::Server::PreFork); |
19 |
use base qw(Net::Server::PreFork); |
19 |
|
20 |
|
20 |
use constant LOG_SIP => "local6"; # Local alias for the logging facility |
21 |
use constant LOG_SIP => "local6"; # Local alias for the logging facility |
21 |
|
|
|
22 |
# |
23 |
# Main # not really, since package SIPServer |
24 |
# |
25 |
# FIXME: Is this a module or a script? |
26 |
# A script with no MAIN namespace? |
27 |
# A module that takes command line args? |
28 |
|
22 |
|
29 |
my %transports = ( |
23 |
my %transports = ( |
30 |
RAW => \&raw_transport, |
24 |
RAW => \&raw_transport, |
Lines 40-46
my @parms;
Link Here
|
40 |
# |
34 |
# |
41 |
# Ports to bind |
35 |
# Ports to bind |
42 |
# |
36 |
# |
43 |
foreach my $svc (keys %{$config->{listeners}}) { |
37 |
foreach my $svc ( keys %{ $config->{listeners} } ) { |
44 |
push @parms, "port=" . $svc; |
38 |
push @parms, "port=" . $svc; |
45 |
} |
39 |
} |
46 |
|
40 |
|
Lines 53-79
foreach my $svc (keys %{$config->{listeners}}) {
Link Here
|
53 |
# |
47 |
# |
54 |
# The IDENT is determined by config file 'server-params' arguments |
48 |
# The IDENT is determined by config file 'server-params' arguments |
55 |
|
49 |
|
56 |
|
|
|
57 |
# |
50 |
# |
58 |
# Server Management: set parameters for the Net::Server::PreFork |
51 |
# Server Management: set parameters for the Net::Server |
59 |
# module. The module silently ignores parameters that it doesn't |
52 |
# module. The module silently ignores parameters that it doesn't |
60 |
# recognize, and complains about invalid values for parameters |
53 |
# recognize, and complains about invalid values for parameters |
61 |
# that it does. |
54 |
# that it does. |
62 |
# |
55 |
# |
63 |
if (defined($config->{'server-params'})) { |
56 |
if ( defined( $config->{'server-params'} ) ) { |
64 |
while (my ($key, $val) = each %{$config->{'server-params'}}) { |
57 |
while ( my ( $key, $val ) = each %{ $config->{'server-params'} } ) { |
65 |
push @parms, $key . '=' . $val; |
58 |
push @parms, $key . '=' . $val; |
66 |
} |
59 |
} |
67 |
} |
60 |
} |
68 |
|
61 |
|
69 |
|
|
|
70 |
# |
62 |
# |
71 |
# This is the main event. |
63 |
# This is the main event. |
72 |
__PACKAGE__ ->run(@parms); |
64 |
__PACKAGE__->run(@parms); |
73 |
|
|
|
74 |
# |
75 |
# Child |
76 |
# |
77 |
|
65 |
|
78 |
# process_request is the callback used by Net::Server to handle |
66 |
# process_request is the callback used by Net::Server to handle |
79 |
# an incoming connection request. |
67 |
# an incoming connection request. |
Lines 81-87
__PACKAGE__ ->run(@parms);
Link Here
|
81 |
sub process_request { |
69 |
sub process_request { |
82 |
my $self = shift; |
70 |
my $self = shift; |
83 |
my $service; |
71 |
my $service; |
84 |
my ($sockaddr, $port, $proto); |
72 |
my ( $sockaddr, $port, $proto ); |
85 |
my $transport; |
73 |
my $transport; |
86 |
|
74 |
|
87 |
$self->{config} = $config; |
75 |
$self->{config} = $config; |
Lines 90-118
sub process_request {
Link Here
|
90 |
|
78 |
|
91 |
# Check if socket connection is IPv6 before resolving address |
79 |
# Check if socket connection is IPv6 before resolving address |
92 |
my $family = Socket::sockaddr_family($sockname); |
80 |
my $family = Socket::sockaddr_family($sockname); |
93 |
if ($family == AF_INET6) { |
81 |
if ( $family == AF_INET6 ) { |
94 |
($port, $sockaddr) = sockaddr_in6($sockname); |
82 |
( $port, $sockaddr ) = sockaddr_in6($sockname); |
95 |
$sockaddr = Socket::inet_ntop(AF_INET6, $sockaddr); |
83 |
$sockaddr = Socket::inet_ntop( AF_INET6, $sockaddr ); |
96 |
} else { |
84 |
} |
97 |
($port, $sockaddr) = sockaddr_in($sockname); |
85 |
else { |
98 |
$sockaddr = inet_ntoa($sockaddr); |
86 |
( $port, $sockaddr ) = sockaddr_in($sockname); |
|
|
87 |
$sockaddr = inet_ntoa($sockaddr); |
99 |
} |
88 |
} |
100 |
$proto = $self->{server}->{client}->NS_proto(); |
89 |
$proto = $self->{server}->{client}->NS_proto(); |
101 |
|
90 |
|
102 |
$self->{service} = $config->find_service($sockaddr, $port, $proto); |
91 |
$self->{service} = $config->find_service( $sockaddr, $port, $proto ); |
103 |
|
92 |
|
104 |
if (!defined($self->{service})) { |
93 |
if ( !defined( $self->{service} ) ) { |
105 |
syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); |
94 |
syslog( "LOG_ERR", |
106 |
die "process_request: Bad server connection"; |
95 |
"process_request: Unknown recognized server connection: %s:%s/%s", |
|
|
96 |
$sockaddr, $port, $proto ); |
97 |
die "process_request: Bad server connection"; |
107 |
} |
98 |
} |
108 |
|
99 |
|
109 |
$transport = $transports{$self->{service}->{transport}}; |
100 |
$transport = $transports{ $self->{service}->{transport} }; |
110 |
|
101 |
|
111 |
if (!defined($transport)) { |
102 |
if ( !defined($transport) ) { |
112 |
syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport}); |
103 |
syslog( "LOG_WARNING", "Unknown transport '%s', dropping", |
113 |
return; |
104 |
$service->{transport} ); |
114 |
} else { |
105 |
return; |
115 |
&$transport($self); |
106 |
} |
|
|
107 |
else { |
108 |
&$transport($self); |
116 |
} |
109 |
} |
117 |
} |
110 |
} |
118 |
|
111 |
|
Lines 125-233
sub raw_transport {
Link Here
|
125 |
my ($input); |
118 |
my ($input); |
126 |
my $service = $self->{service}; |
119 |
my $service = $self->{service}; |
127 |
|
120 |
|
128 |
while (!$self->{account}) { |
121 |
while ( !$self->{account} ) { |
129 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
122 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
130 |
syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); |
123 |
syslog( "LOG_DEBUG", "raw_transport: timeout is %d", |
131 |
$input = read_SIP_packet(*STDIN); |
124 |
$service->{timeout} ); |
132 |
if (!$input) { |
125 |
$input = read_SIP_packet(*STDIN); |
133 |
# EOF on the socket |
126 |
if ( !$input ) { |
134 |
syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
127 |
|
135 |
return; |
128 |
# EOF on the socket |
136 |
} |
129 |
syslog( "LOG_INFO", |
137 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
130 |
"raw_transport: shutting down: EOF during login" ); |
138 |
last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN); |
131 |
return; |
|
|
132 |
} |
133 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
134 |
last if C4::SIP::Sip::MsgType::handle( $input, $self, LOGIN ); |
139 |
} |
135 |
} |
140 |
|
136 |
|
141 |
syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
137 |
syslog( |
142 |
$self->{account}->{id}, |
138 |
"LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
143 |
$self->{account}->{institution}); |
139 |
$self->{account}->{id}, $self->{account}->{institution} |
|
|
140 |
); |
144 |
|
141 |
|
145 |
$self->sip_protocol_loop(); |
142 |
$self->sip_protocol_loop(); |
146 |
syslog("LOG_INFO", "raw_transport: shutting down"); |
143 |
syslog( "LOG_INFO", "raw_transport: shutting down" ); |
147 |
} |
144 |
} |
148 |
|
145 |
|
149 |
sub get_clean_string { |
146 |
sub get_clean_string { |
150 |
my $string = shift; |
147 |
my $string = shift; |
151 |
if (defined $string) { |
148 |
if ( defined $string ) { |
152 |
syslog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string); |
149 |
syslog( "LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", |
153 |
chomp($string); |
150 |
length($string), $string ); |
154 |
$string =~ s/^[^A-z0-9]+//; |
151 |
chomp($string); |
155 |
$string =~ s/[^A-z0-9]+$//; |
152 |
$string =~ s/^[^A-z0-9]+//; |
156 |
syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string); |
153 |
$string =~ s/[^A-z0-9]+$//; |
157 |
} else { |
154 |
syslog( "LOG_DEBUG", "get_clean_string post-clean(length %s): %s", |
158 |
syslog("LOG_INFO", "get_clean_string called on undefined"); |
155 |
length($string), $string ); |
159 |
} |
156 |
} |
160 |
return $string; |
157 |
else { |
|
|
158 |
syslog( "LOG_INFO", "get_clean_string called on undefined" ); |
159 |
} |
160 |
return $string; |
161 |
} |
161 |
} |
162 |
|
162 |
|
163 |
sub get_clean_input { |
163 |
sub get_clean_input { |
164 |
local $/ = "\012"; |
164 |
local $/ = "\012"; |
165 |
my $in = <STDIN>; |
165 |
my $in = <STDIN>; |
166 |
$in = get_clean_string($in); |
166 |
$in = get_clean_string($in); |
167 |
while (my $extra = <STDIN>){ |
167 |
while ( my $extra = <STDIN> ) { |
168 |
syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra); |
168 |
syslog( "LOG_ERR", "get_clean_input got extra lines: %s", $extra ); |
169 |
} |
169 |
} |
170 |
return $in; |
170 |
return $in; |
171 |
} |
171 |
} |
172 |
|
172 |
|
173 |
sub telnet_transport { |
173 |
sub telnet_transport { |
174 |
my $self = shift; |
174 |
my $self = shift; |
175 |
my ($uid, $pwd); |
175 |
my ( $uid, $pwd ); |
176 |
my $strikes = 3; |
176 |
my $strikes = 3; |
177 |
my $account = undef; |
177 |
my $account = undef; |
178 |
my $input; |
178 |
my $input; |
179 |
my $config = $self->{config}; |
179 |
my $config = $self->{config}; |
180 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
180 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
181 |
syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout); |
181 |
syslog( "LOG_DEBUG", "telnet_transport: timeout is %s", $timeout ); |
182 |
|
182 |
|
183 |
eval { |
183 |
eval { |
184 |
local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; |
184 |
local $SIG{ALRM} = |
185 |
local $| = 1; # Unbuffered output |
185 |
sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; |
186 |
$/ = "\015"; # Internet Record Separator (lax version) |
186 |
local $| = 1; # Unbuffered output |
187 |
# Until the terminal has logged in, we don't trust it |
187 |
$/ = "\015"; # Internet Record Separator (lax version) |
188 |
# so use a timeout to protect ourselves from hanging. |
188 |
# Until the terminal has logged in, we don't trust it |
189 |
|
189 |
# so use a timeout to protect ourselves from hanging. |
190 |
while ($strikes--) { |
190 |
|
191 |
print "login: "; |
191 |
while ( $strikes-- ) { |
192 |
alarm $timeout; |
192 |
print "login: "; |
193 |
# $uid = &get_clean_input; |
193 |
alarm $timeout; |
194 |
$uid = <STDIN>; |
194 |
|
195 |
print "password: "; |
195 |
# $uid = &get_clean_input; |
196 |
# $pwd = &get_clean_input || ''; |
196 |
$uid = <STDIN>; |
197 |
$pwd = <STDIN>; |
197 |
print "password: "; |
198 |
alarm 0; |
198 |
|
199 |
|
199 |
# $pwd = &get_clean_input || ''; |
200 |
syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd)); |
200 |
$pwd = <STDIN>; |
201 |
$uid = get_clean_string ($uid); |
201 |
alarm 0; |
202 |
$pwd = get_clean_string ($pwd); |
202 |
|
203 |
syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd)); |
203 |
syslog( "LOG_DEBUG", |
204 |
|
204 |
"telnet_transport 1: uid length %s, pwd length %s", |
205 |
if (exists ($config->{accounts}->{$uid}) |
205 |
length($uid), length($pwd) ); |
206 |
&& ($pwd eq $config->{accounts}->{$uid}->{password})) { |
206 |
$uid = get_clean_string($uid); |
207 |
$account = $config->{accounts}->{$uid}; |
207 |
$pwd = get_clean_string($pwd); |
208 |
if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) { |
208 |
syslog( "LOG_DEBUG", |
209 |
last; |
209 |
"telnet_transport 2: uid length %s, pwd length %s", |
|
|
210 |
length($uid), length($pwd) ); |
211 |
|
212 |
if ( exists( $config->{accounts}->{$uid} ) |
213 |
&& ( $pwd eq $config->{accounts}->{$uid}->{password} ) ) |
214 |
{ |
215 |
$account = $config->{accounts}->{$uid}; |
216 |
if ( C4::SIP::Sip::MsgType::login_core( $self, $uid, $pwd ) ) { |
217 |
last; |
218 |
} |
210 |
} |
219 |
} |
211 |
} |
220 |
syslog( |
212 |
syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||'')); |
221 |
"LOG_WARNING", |
213 |
print("Invalid login$CRLF"); |
222 |
"Invalid login attempt: '%s'", |
214 |
} |
223 |
( $uid || '' ) |
215 |
}; # End of eval |
224 |
); |
|
|
225 |
print("Invalid login$CRLF"); |
226 |
} |
227 |
}; # End of eval |
216 |
|
228 |
|
217 |
if ($@) { |
229 |
if ($@) { |
218 |
syslog("LOG_ERR", "telnet_transport: Login timed out"); |
230 |
syslog( "LOG_ERR", "telnet_transport: Login timed out" ); |
219 |
die "Telnet Login Timed out"; |
231 |
die "Telnet Login Timed out"; |
220 |
} elsif (!defined($account)) { |
232 |
} |
221 |
syslog("LOG_ERR", "telnet_transport: Login Failed"); |
233 |
elsif ( !defined($account) ) { |
222 |
die "Login Failure"; |
234 |
syslog( "LOG_ERR", "telnet_transport: Login Failed" ); |
223 |
} else { |
235 |
die "Login Failure"; |
224 |
print "Login OK. Initiating SIP$CRLF"; |
236 |
} |
|
|
237 |
else { |
238 |
print "Login OK. Initiating SIP$CRLF"; |
225 |
} |
239 |
} |
226 |
|
240 |
|
227 |
$self->{account} = $account; |
241 |
$self->{account} = $account; |
228 |
syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); |
242 |
syslog( "LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", |
|
|
243 |
$account->{id}, $account->{institution} ); |
229 |
$self->sip_protocol_loop(); |
244 |
$self->sip_protocol_loop(); |
230 |
syslog("LOG_INFO", "telnet_transport: shutting down"); |
245 |
syslog( "LOG_INFO", "telnet_transport: shutting down" ); |
231 |
} |
246 |
} |
232 |
|
247 |
|
233 |
# |
248 |
# |
Lines 236-250
sub telnet_transport {
Link Here
|
236 |
# telnet transport. From that point on, both the raw and the telnet |
251 |
# telnet transport. From that point on, both the raw and the telnet |
237 |
# processes are the same: |
252 |
# processes are the same: |
238 |
sub sip_protocol_loop { |
253 |
sub sip_protocol_loop { |
239 |
my $self = shift; |
254 |
my $self = shift; |
240 |
my $service = $self->{service}; |
255 |
my $service = $self->{service}; |
241 |
my $config = $self->{config}; |
256 |
my $config = $self->{config}; |
242 |
my $timeout = $self->{service}->{client_timeout} || $config->{client_timeout}; |
257 |
my $timeout = |
243 |
my $input; |
258 |
$self->{service}->{client_timeout} || $config->{client_timeout}; |
|
|
259 |
my $input; |
244 |
|
260 |
|
245 |
# The spec says the first message will be: |
261 |
# The spec says the first message will be: |
246 |
# SIP v1: SC_STATUS |
262 |
# SIP v1: SC_STATUS |
247 |
# SIP v2: LOGIN (or SC_STATUS via telnet?) |
263 |
# SIP v2: LOGIN (or SC_STATUS via telnet?) |
248 |
# But it might be SC_REQUEST_RESEND. As long as we get |
264 |
# But it might be SC_REQUEST_RESEND. As long as we get |
249 |
# SC_REQUEST_RESEND, we keep waiting. |
265 |
# SC_REQUEST_RESEND, we keep waiting. |
250 |
|
266 |
|
Lines 252-262
sub sip_protocol_loop {
Link Here
|
252 |
# constraint, so we'll relax about it too. |
268 |
# constraint, so we'll relax about it too. |
253 |
# Using the SIP "raw" login process, rather than telnet, |
269 |
# Using the SIP "raw" login process, rather than telnet, |
254 |
# requires the LOGIN message and forces SIP 2.00. In that |
270 |
# requires the LOGIN message and forces SIP 2.00. In that |
255 |
# case, the LOGIN message has already been processed (above). |
271 |
# case, the LOGIN message has already been processed (above). |
256 |
# |
272 |
# |
257 |
# In short, we'll take any valid message here. |
273 |
# In short, we'll take any valid message here. |
258 |
#my $expect = SC_STATUS; |
274 |
#my $expect = SC_STATUS; |
259 |
local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; } if $timeout; |
275 |
local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; } |
|
|
276 |
if $timeout; |
260 |
my $expect = ''; |
277 |
my $expect = ''; |
261 |
while (1) { |
278 |
while (1) { |
262 |
if ($timeout) { |
279 |
if ($timeout) { |
Lines 264-296
sub sip_protocol_loop {
Link Here
|
264 |
} |
281 |
} |
265 |
$input = read_SIP_packet(*STDIN); |
282 |
$input = read_SIP_packet(*STDIN); |
266 |
unless ($input) { |
283 |
unless ($input) { |
267 |
return; # EOF |
284 |
return; # EOF |
268 |
} |
285 |
} |
269 |
# begin input hacks ... a cheap stand in for better Telnet layer |
286 |
|
270 |
$input =~ s/^[^A-z0-9]+//s; # Kill leading bad characters... like Telnet handshakers |
287 |
# begin input hacks ... a cheap stand in for better Telnet layer |
271 |
$input =~ s/[^A-z0-9]+$//s; # Same on the end, should get DOSsy ^M line-endings too. |
288 |
$input =~ s/^[^A-z0-9]+//s |
272 |
while (chomp($input)) {warn "Extra line ending on input";} |
289 |
; # Kill leading bad characters... like Telnet handshakers |
273 |
unless ($input) { |
290 |
$input =~ s/[^A-z0-9]+$//s |
274 |
syslog("LOG_ERR", "sip_protocol_loop: empty input skipped"); |
291 |
; # Same on the end, should get DOSsy ^M line-endings too. |
|
|
292 |
while ( chomp($input) ) { warn "Extra line ending on input"; } |
293 |
unless ($input) { |
294 |
syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" ); |
275 |
print("96$CR"); |
295 |
print("96$CR"); |
276 |
next; |
296 |
next; |
277 |
} |
297 |
} |
278 |
# end cheap input hacks |
298 |
|
279 |
my $status = handle($input, $self, $expect); |
299 |
# end cheap input hacks |
280 |
if (!$status) { |
300 |
my $status = handle( $input, $self, $expect ); |
281 |
syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2)); |
301 |
if ( !$status ) { |
282 |
} |
302 |
syslog( |
283 |
next if $status eq REQUEST_ACS_RESEND; |
303 |
"LOG_ERR", |
284 |
if ($expect && ($status ne $expect)) { |
304 |
"sip_protocol_loop: failed to handle %s", |
285 |
# We received a non-"RESEND" that wasn't what we were expecting. |
305 |
substr( $input, 0, 2 ) |
286 |
syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input); |
306 |
); |
287 |
} |
307 |
} |
288 |
# We successfully received and processed what we were expecting |
308 |
next if $status eq REQUEST_ACS_RESEND; |
289 |
$expect = ''; |
309 |
if ( $expect && ( $status ne $expect ) ) { |
290 |
if ($timeout ) { |
310 |
|
|
|
311 |
# We received a non-"RESEND" that wasn't what we were expecting. |
312 |
syslog( "LOG_ERR", |
313 |
"sip_protocol_loop: expected %s, received %s, exiting", |
314 |
$expect, $input ); |
315 |
} |
316 |
|
317 |
# We successfully received and processed what we were expecting |
318 |
$expect = ''; |
319 |
if ($timeout) { |
291 |
alarm 0; |
320 |
alarm 0; |
292 |
} |
321 |
} |
293 |
} |
322 |
} |
294 |
} |
323 |
} |
295 |
|
324 |
|
296 |
1; |
325 |
1; |
297 |
- |
|
|