6 use Sys::Syslog qw(syslog);
7 use Net::Server::PreFork;
10 use Data::Dumper; # For debugging
11 require UNIVERSAL::require;
13 #use Sip qw(readline);
14 use Sip::Constants qw(:all);
15 use Sip::Configuration;
16 use Sip::Checksum qw(checksum verify_cksum);
19 use constant LOG_SIP => "local6"; # Local alias for the logging facility
21 use vars qw(@ISA $VERSION);
25 @ISA = qw(Net::Server::PreFork);
33 RAW => \&raw_transport,
34 telnet => \&telnet_transport,
35 http => \&http_transport,
40 my $config = new Sip::Configuration $ARGV[0];
47 foreach my $svc (keys %{$config->{listeners}}) {
48 push @parms, "port=" . $svc;
54 push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server",
55 "syslog_facility=" . LOG_SIP;
58 # Server Management: set parameters for the Net::Server::PreFork
59 # module. The module silently ignores parameters that it doesn't
60 # recognize, and complains about invalid values for parameters
63 if (defined($config->{'server-params'})) {
64 while (my ($key, $val) = each %{$config->{'server-params'}}) {
65 push @parms, $key . '=' . $val;
72 # This is the main event.
73 SIPServer->run(@parms);
79 # process_request is the callback used by Net::Server to handle
80 # an incoming connection request.
86 my ($sockaddr, $port, $proto);
89 $self->{config} = $config;
91 $sockname = getsockname(STDIN);
92 ($port, $sockaddr) = sockaddr_in($sockname);
93 $sockaddr = inet_ntoa($sockaddr);
94 $proto = $self->{server}->{client}->NS_proto();
96 $self->{service} = $config->find_service($sockaddr, $port, $proto);
98 if (!defined($self->{service})) {
99 syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
100 die "process_request: Bad server connection";
103 $transport = $transports{$self->{service}->{transport}};
105 if (!defined($transport)) {
106 syslog("LOG_WARN", "Unknown transport '%s', dropping", $service->{transport});
121 my $service = $self->{service};
127 local $SIG{ALRM} = sub { die "alarm\n"; };
128 syslog("LOG_DEBUG", "raw_transport: timeout is %d",
129 $service->{timeout});
131 alarm $service->{timeout};
132 $input = Sip::read_SIP_packet(*STDIN);
136 syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
140 $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator
142 last if Sip::MsgType::handle($input, $self, LOGIN);
147 syslog("LOG_ERR", "raw_transport: LOGIN ERROR: '$@'");
148 die "raw_transport: login error, exiting";
149 } elsif (!$self->{account}) {
150 syslog("LOG_ERR", "raw_transport: LOGIN FAILED");
151 die "raw_transport: Login failed, exiting";
154 syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
155 $self->{account}->{id},
156 $self->{account}->{institution});
158 $self->sip_protocol_loop();
160 syslog("LOG_INFO", "raw_transport: shutting down");
163 sub telnet_transport {
169 my $config = $self->{config};
171 # Until the terminal has logged in, we don't trust it
172 # so use a timeout to protect ourselves from hanging.
174 local $SIG{ALRM} = sub { die "alarm\n"; };
177 $| = 1; # Unbuffered output
178 $timeout = $config->{timeout} if (exists($config->{timeout}));
191 $uid =~ s/[\r\n]+$//;
192 $pwd =~ s/[\r\n]+$//;
194 if (exists($config->{accounts}->{$uid})
195 && ($pwd eq $config->{accounts}->{$uid}->password())) {
196 $account = $config->{accounts}->{$uid};
199 syslog("LOG_WARNING", "Invalid login attempt: '%s'", $uid);
200 print("Invalid login\n");
206 syslog("LOG_ERR", "telnet_transport: Login timed out");
207 die "Telnet Login Timed out";
208 } elsif (!defined($account)) {
209 syslog("LOG_ERR", "telnet_transport: Login Failed");
212 print "Login OK. Initiating SIP\n";
215 $self->{account} = $account;
217 $self->sip_protocol_loop();
218 syslog("LOG_INFO", "telnet_transport: shutting down");
226 # The terminal has logged in, using either the SIP login process
227 # over a raw socket, or via the pseudo-unix login provided by the
228 # telnet transport. From that point on, both the raw and the telnet
229 # processes are the same:
230 sub sip_protocol_loop {
233 my $service = $self->{service};
234 my $config = $self->{config};
236 # Now that the terminal has logged in, the first message
237 # we recieve must be an SC_STATUS message. But it might be
238 # an SC_REQUEST_RESEND. So, as long as we keep receiving
239 # SC_REQUEST_RESEND, we keep waiting for an SC_STATUS
241 # Comprise reports that no other ILS actually enforces this
242 # constraint, so we'll relax about it too. As long as everybody
243 # uses the SIP "raw" login process, rather than telnet, this
244 # will be fine, becaues the LOGIN protocol exchange will force
245 # us into SIP 2.00 anyway. Machines that want to log in using
246 # telnet MUST send an SC Status message first, even though we're
249 #$expect = SC_STATUS;
252 while ($input = Sip::read_SIP_packet(*STDIN)) {
255 $input =~ s/[\r\n]+$//sm; # Strip off any trailing line ends
257 $status = Sip::MsgType::handle($input, $self, $expect);
258 next if $status eq REQUEST_ACS_RESEND;
259 #### stopped here rch
261 syslog("LOG_ERR", "raw_transport: failed to handle %s",
262 substr($input, 0, 2));
263 die "raw_transport: dying";
264 } elsif ($expect && ($status ne $expect)) {
265 # We received a non-"RESEND" that wasn't what we were
268 "raw_transport: expected %s, received %s, exiting",
270 die "raw_transport: exiting: expected '$expect', received '$status'";
272 # We successfully received and processed what we were expecting