2 # Copyright (C) 2006-2008 Georgia Public Library Service
4 # Author: David J. Fiander
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of version 2 of the GNU General Public
8 # License as published by the Free Software Foundation.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public
16 # License along with this program; if not, write to the Free
17 # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
25 use Sys::Syslog qw(syslog);
26 use Net::Server::PreFork;
27 use Net::Server::Proto;
30 use Data::Dumper; # For debugging
31 require UNIVERSAL::require;
33 #use Sip qw(readline);
34 use Sip::Constants qw(:all);
35 use Sip::Configuration;
36 use Sip::Checksum qw(checksum verify_cksum);
39 use constant LOG_SIP => "local6"; # Local alias for the logging facility
41 our @ISA = qw(Net::Server::PreFork);
47 RAW => \&raw_transport,
48 telnet => \&telnet_transport,
49 http => \&http_transport,
54 my $config = new Sip::Configuration $ARGV[0];
61 foreach my $svc (keys %{$config->{listeners}}) {
62 push @parms, "port=" . $svc;
68 push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server",
69 "syslog_facility=" . LOG_SIP;
72 # Server Management: set parameters for the Net::Server::PreFork
73 # module. The module silently ignores parameters that it doesn't
74 # recognize, and complains about invalid values for parameters
77 if (defined($config->{'server-params'})) {
78 while (my ($key, $val) = each %{$config->{'server-params'}}) {
79 push @parms, $key . '=' . $val;
86 # This is the main event.
87 SIPServer->run(@parms);
93 # process_request is the callback used by Net::Server to handle
94 # an incoming connection request.
100 my ($sockaddr, $port, $proto);
103 $self->{config} = $config;
105 $sockaddr = $self->{server}->{sockaddr};
106 $port = $self->{server}->{sockport};
107 $proto = $self->{server}->{client}->NS_proto();
108 syslog('LOG_INFO', "Inbound connection from $sockaddr on port $port and proto $proto");
109 $self->{service} = $config->find_service($sockaddr, $port, $proto);
111 if (!defined($self->{service})) {
112 syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
113 die "process_request: Bad server connection";
116 $transport = $transports{$self->{service}->{transport}};
118 if (!defined($transport)) {
119 syslog("LOG_WARN", "Unknown transport '%s', dropping", $service->{transport});
134 my $service = $self->{service};
140 local $SIG{ALRM} = sub { die "alarm\n"; };
141 syslog("LOG_DEBUG", "raw_transport: timeout is %d",
142 $service->{timeout});
144 alarm $service->{timeout};
145 $input = Sip::read_SIP_packet(*STDIN);
150 syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
154 $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator
156 last if Sip::MsgType::handle($input, $self, LOGIN);
161 syslog("LOG_ERR", "raw_transport: LOGIN ERROR: '$@'");
162 die "raw_transport: login error, exiting";
163 } elsif (!$self->{account}) {
164 syslog("LOG_ERR", "raw_transport: LOGIN FAILED");
165 die "raw_transport: Login failed, exiting";
168 syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
169 $self->{account}->{id},
170 $self->{account}->{institution});
172 $self->sip_protocol_loop();
174 syslog("LOG_INFO", "raw_transport: shutting down");
177 sub telnet_transport {
183 my $config = $self->{config};
185 # Until the terminal has logged in, we don't trust it
186 # so use a timeout to protect ourselves from hanging.
188 local $SIG{ALRM} = sub { die "alarm\n"; };
192 $| = 1; # Unbuffered output
193 $timeout = $config->{timeout} if (exists($config->{timeout}));
206 $uid =~ s/[\r\n]+$//;
207 $pwd =~ s/[\r\n]+$//;
209 if (exists($config->{accounts}->{$uid})
210 && ($pwd eq $config->{accounts}->{$uid}->password())) {
211 $account = $config->{accounts}->{$uid};
214 syslog("LOG_WARNING", "Invalid login attempt: '%s'", $uid);
215 print("Invalid login\n");
221 syslog("LOG_ERR", "telnet_transport: Login timed out");
222 die "Telnet Login Timed out";
223 } elsif (!defined($account)) {
224 syslog("LOG_ERR", "telnet_transport: Login Failed");
227 print "Login OK. Initiating SIP\n";
230 $self->{account} = $account;
232 $self->sip_protocol_loop();
233 syslog("LOG_INFO", "telnet_transport: shutting down");
241 # The terminal has logged in, using either the SIP login process
242 # over a raw socket, or via the pseudo-unix login provided by the
243 # telnet transport. From that point on, both the raw and the telnet
244 # processes are the same:
245 sub sip_protocol_loop {
248 my $service = $self->{service};
249 my $config = $self->{config};
252 # Now that the terminal has logged in, the first message
253 # we recieve must be an SC_STATUS message. But it might be
254 # an SC_REQUEST_RESEND. So, as long as we keep receiving
255 # SC_REQUEST_RESEND, we keep waiting for an SC_STATUS
257 # Comprise reports that no other ILS actually enforces this
258 # constraint, so we'll relax about it too. As long as everybody
259 # uses the SIP "raw" login process, rather than telnet, this
260 # will be fine, becaues the LOGIN protocol exchange will force
261 # us into SIP 2.00 anyway. Machines that want to log in using
262 # telnet MUST send an SC Status message first, even though we're
265 #$expect = SC_STATUS;
268 while ($input = Sip::read_SIP_packet(*STDIN)) {
271 $input =~ s/[\r\n]+$//sm; # Strip off any trailing line ends
273 $status = Sip::MsgType::handle($input, $self, $expect);
274 next if $status eq REQUEST_ACS_RESEND;
277 syslog("LOG_ERR", "raw_transport: failed to handle %s",
278 substr($input, 0, 2));
279 die "raw_transport: dying";
280 } elsif ($expect && ($status ne $expect)) {
281 # We received a non-"RESEND" that wasn't what we were
284 "raw_transport: expected %s, received %s, exiting",
286 die "raw_transport: exiting: expected '$expect', received '$status'";
288 # We successfully received and processed what we were expecting