Lines 5-11
use strict;
Link Here
|
5 |
use warnings; |
5 |
use warnings; |
6 |
use FindBin qw($Bin); |
6 |
use FindBin qw($Bin); |
7 |
use lib "$Bin"; |
7 |
use lib "$Bin"; |
8 |
use Sys::Syslog qw(syslog); |
|
|
9 |
use Net::Server::PreFork; |
8 |
use Net::Server::PreFork; |
10 |
use IO::Socket::INET; |
9 |
use IO::Socket::INET; |
11 |
use Socket qw(:DEFAULT :crlf); |
10 |
use Socket qw(:DEFAULT :crlf); |
Lines 15-20
use Sip::Constants qw(:all);
Link Here
|
15 |
use Sip::Configuration; |
14 |
use Sip::Configuration; |
16 |
use Sip::Checksum qw(checksum verify_cksum); |
15 |
use Sip::Checksum qw(checksum verify_cksum); |
17 |
use Sip::MsgType; |
16 |
use Sip::MsgType; |
|
|
17 |
use Koha::Log qw(:log set_default_logger); |
18 |
|
18 |
|
19 |
use base qw(Net::Server::PreFork); |
19 |
use base qw(Net::Server::PreFork); |
20 |
|
20 |
|
Lines 27-32
use constant LOG_SIP => "local6"; # Local alias for the logging facility
Link Here
|
27 |
# A script with no MAIN namespace? |
27 |
# A script with no MAIN namespace? |
28 |
# A module that takes command line args? |
28 |
# A module that takes command line args? |
29 |
|
29 |
|
|
|
30 |
set_default_logger( |
31 |
Syslog => {min_level => 'warn', facility => LOG_SIP}, |
32 |
Stdout => {min_level => 'fatal'}, |
33 |
); |
34 |
|
30 |
my %transports = ( |
35 |
my %transports = ( |
31 |
RAW => \&raw_transport, |
36 |
RAW => \&raw_transport, |
32 |
telnet => \&telnet_transport, |
37 |
telnet => \&telnet_transport, |
Lines 95-108
sub process_request {
Link Here
|
95 |
$self->{service} = $config->find_service($sockaddr, $port, $proto); |
100 |
$self->{service} = $config->find_service($sockaddr, $port, $proto); |
96 |
|
101 |
|
97 |
if (!defined($self->{service})) { |
102 |
if (!defined($self->{service})) { |
98 |
syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); |
103 |
log_fatal { "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto }; |
99 |
die "process_request: Bad server connection"; |
|
|
100 |
} |
104 |
} |
101 |
|
105 |
|
102 |
$transport = $transports{$self->{service}->{transport}}; |
106 |
$transport = $transports{$self->{service}->{transport}}; |
103 |
|
107 |
|
104 |
if (!defined($transport)) { |
108 |
if (!defined($transport)) { |
105 |
syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport}); |
109 |
log_warn { "Unknown transport '%s', dropping", $service->{transport} }; |
106 |
return; |
110 |
return; |
107 |
} else { |
111 |
} else { |
108 |
&$transport($self); |
112 |
&$transport($self); |
Lines 120-154
sub raw_transport {
Link Here
|
120 |
|
124 |
|
121 |
while (!$self->{account}) { |
125 |
while (!$self->{account}) { |
122 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
126 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
123 |
syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); |
127 |
log_debug { "raw_transport: timeout is %d", $service->{timeout} }; |
124 |
$input = Sip::read_SIP_packet(*STDIN); |
128 |
$input = Sip::read_SIP_packet(*STDIN); |
125 |
if (!$input) { |
129 |
if (!$input) { |
126 |
# EOF on the socket |
130 |
# EOF on the socket |
127 |
syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
131 |
log_info { "raw_transport: shutting down: EOF during login" }; |
128 |
return; |
132 |
return; |
129 |
} |
133 |
} |
130 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
134 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
131 |
last if Sip::MsgType::handle($input, $self, LOGIN); |
135 |
last if Sip::MsgType::handle($input, $self, LOGIN); |
132 |
} |
136 |
} |
133 |
|
137 |
|
134 |
syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
138 |
log_debug { "raw_transport: uname/inst: '%s/%s'", |
135 |
$self->{account}->{id}, |
139 |
$self->{account}->{id}, |
136 |
$self->{account}->{institution}); |
140 |
$self->{account}->{institution} }; |
137 |
|
141 |
|
138 |
$self->sip_protocol_loop(); |
142 |
$self->sip_protocol_loop(); |
139 |
syslog("LOG_INFO", "raw_transport: shutting down"); |
143 |
log_info { "raw_transport: shutting down" }; |
140 |
} |
144 |
} |
141 |
|
145 |
|
142 |
sub get_clean_string { |
146 |
sub get_clean_string { |
143 |
my $string = shift; |
147 |
my $string = shift; |
144 |
if (defined $string) { |
148 |
if (defined $string) { |
145 |
syslog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string); |
149 |
log_debug { "get_clean_string pre-clean(length %s): %s", length($string), $string }; |
146 |
chomp($string); |
150 |
chomp($string); |
147 |
$string =~ s/^[^A-z0-9]+//; |
151 |
$string =~ s/^[^A-z0-9]+//; |
148 |
$string =~ s/[^A-z0-9]+$//; |
152 |
$string =~ s/[^A-z0-9]+$//; |
149 |
syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string); |
153 |
log_debug { "get_clean_string post-clean(length %s): %s", length($string), $string }; |
150 |
} else { |
154 |
} else { |
151 |
syslog("LOG_INFO", "get_clean_string called on undefined"); |
155 |
log_info { "get_clean_string called on undefined" }; |
152 |
} |
156 |
} |
153 |
return $string; |
157 |
return $string; |
154 |
} |
158 |
} |
Lines 158-164
sub get_clean_input {
Link Here
|
158 |
my $in = <STDIN>; |
162 |
my $in = <STDIN>; |
159 |
$in = get_clean_string($in); |
163 |
$in = get_clean_string($in); |
160 |
while (my $extra = <STDIN>){ |
164 |
while (my $extra = <STDIN>){ |
161 |
syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra); |
165 |
log_error { "get_clean_input got extra lines: %s", $extra }; |
162 |
} |
166 |
} |
163 |
return $in; |
167 |
return $in; |
164 |
} |
168 |
} |
Lines 171-177
sub telnet_transport {
Link Here
|
171 |
my $input; |
175 |
my $input; |
172 |
my $config = $self->{config}; |
176 |
my $config = $self->{config}; |
173 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
177 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
174 |
syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout); |
178 |
log_debug { "telnet_transport: timeout is %s", $timeout }; |
175 |
|
179 |
|
176 |
eval { |
180 |
eval { |
177 |
local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; |
181 |
local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; |
Lines 190-224
sub telnet_transport {
Link Here
|
190 |
$pwd = <STDIN>; |
194 |
$pwd = <STDIN>; |
191 |
alarm 0; |
195 |
alarm 0; |
192 |
|
196 |
|
193 |
syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd)); |
197 |
log_debug { "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd) }; |
194 |
$uid = get_clean_string ($uid); |
198 |
$uid = get_clean_string ($uid); |
195 |
$pwd = get_clean_string ($pwd); |
199 |
$pwd = get_clean_string ($pwd); |
196 |
syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd)); |
200 |
log_debug { "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd) }; |
197 |
|
201 |
|
198 |
if (exists ($config->{accounts}->{$uid}) |
202 |
if (exists ($config->{accounts}->{$uid}) |
199 |
&& ($pwd eq $config->{accounts}->{$uid}->password())) { |
203 |
&& ($pwd eq $config->{accounts}->{$uid}->password())) { |
200 |
$account = $config->{accounts}->{$uid}; |
204 |
$account = $config->{accounts}->{$uid}; |
201 |
Sip::MsgType::login_core($self,$uid,$pwd) and last; |
205 |
Sip::MsgType::login_core($self,$uid,$pwd) and last; |
202 |
} |
206 |
} |
203 |
syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||'')); |
207 |
log_warn { "Invalid login attempt: '%s'", ($uid||'') }; |
204 |
print("Invalid login$CRLF"); |
208 |
print("Invalid login$CRLF"); |
205 |
} |
209 |
} |
206 |
}; # End of eval |
210 |
}; # End of eval |
207 |
|
211 |
|
208 |
if ($@) { |
212 |
if ($@) { |
209 |
syslog("LOG_ERR", "telnet_transport: Login timed out"); |
213 |
log_fatal { "telnet_transport: Login timed out" }; |
210 |
die "Telnet Login Timed out"; |
|
|
211 |
} elsif (!defined($account)) { |
214 |
} elsif (!defined($account)) { |
212 |
syslog("LOG_ERR", "telnet_transport: Login Failed"); |
215 |
log_fatal { "telnet_transport: Login Failed" }; |
213 |
die "Login Failure"; |
|
|
214 |
} else { |
216 |
} else { |
215 |
print "Login OK. Initiating SIP$CRLF"; |
217 |
print "Login OK. Initiating SIP$CRLF"; |
216 |
} |
218 |
} |
217 |
|
219 |
|
218 |
$self->{account} = $account; |
220 |
$self->{account} = $account; |
219 |
syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); |
221 |
log_debug { "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution} }; |
220 |
$self->sip_protocol_loop(); |
222 |
$self->sip_protocol_loop(); |
221 |
syslog("LOG_INFO", "telnet_transport: shutting down"); |
223 |
log_info { "telnet_transport: shutting down" }; |
222 |
} |
224 |
} |
223 |
|
225 |
|
224 |
# |
226 |
# |
Lines 257-275
sub sip_protocol_loop {
Link Here
|
257 |
$input =~ s/[^A-z0-9]+$//s; # Same on the end, should get DOSsy ^M line-endings too. |
259 |
$input =~ s/[^A-z0-9]+$//s; # Same on the end, should get DOSsy ^M line-endings too. |
258 |
while (chomp($input)) {warn "Extra line ending on input";} |
260 |
while (chomp($input)) {warn "Extra line ending on input";} |
259 |
unless ($input) { |
261 |
unless ($input) { |
260 |
syslog("LOG_ERR", "sip_protocol_loop: empty input skipped"); |
262 |
log_error { "sip_protocol_loop: empty input skipped" }; |
261 |
print("96$CR"); |
263 |
print("96$CR"); |
262 |
next; |
264 |
next; |
263 |
} |
265 |
} |
264 |
# end cheap input hacks |
266 |
# end cheap input hacks |
265 |
my $status = Sip::MsgType::handle($input, $self, $expect); |
267 |
my $status = Sip::MsgType::handle($input, $self, $expect); |
266 |
if (!$status) { |
268 |
if (!$status) { |
267 |
syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2)); |
269 |
log_error { "sip_protocol_loop: failed to handle %s",substr($input,0,2) }; |
268 |
} |
270 |
} |
269 |
next if $status eq REQUEST_ACS_RESEND; |
271 |
next if $status eq REQUEST_ACS_RESEND; |
270 |
if ($expect && ($status ne $expect)) { |
272 |
if ($expect && ($status ne $expect)) { |
271 |
# We received a non-"RESEND" that wasn't what we were expecting. |
273 |
# We received a non-"RESEND" that wasn't what we were expecting. |
272 |
syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input); |
274 |
log_error { "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input }; |
273 |
} |
275 |
} |
274 |
# We successfully received and processed what we were expecting |
276 |
# We successfully received and processed what we were expecting |
275 |
$expect = ''; |
277 |
$expect = ''; |
276 |
- |
|
|