C4/SIP/SIPServer.pm

   1 package SIPServer;
   2
   3 use strict;
   4 use warnings;
   5 # use Exporter;
   6 use Sys::Syslog qw(syslog);
   7 use Net::Server::PreFork;
   8 use IO::Socket::INET;
   9 use Socket;
  10 use Data::Dumper;               # For debugging
  11 require UNIVERSAL::require;
  12
  13 #use Sip qw(readline);
  14 use Sip::Constants qw(:all);
  15 use Sip::Configuration;
  16 use Sip::Checksum qw(checksum verify_cksum);
  17 use Sip::MsgType;
  18
  19 use constant LOG_SIP => "local6"; # Local alias for the logging facility
  20
  21 use vars qw(@ISA $VERSION);
  22
  23 BEGIN {
  24         $VERSION = 1.01;
  25         @ISA = qw(Net::Server::PreFork);
  26 }
  27
  28 #
  29 # Main  # not really, since package SIPServer
  30 #
  31 # FIXME: Is this a module or a script?
  32 # A script with no MAIN namespace?
  33 # A module that takes command line args?
  34
  35 my %transports = (
  36     RAW    => \&raw_transport,
  37     telnet => \&telnet_transport,
  38     # http   => \&http_transport,       # for http just use the OPAC
  39 );
  40
  41 #
  42 # Read configuration
  43 #
  44 my $config = new Sip::Configuration $ARGV[0];
  45 print STDERR "SIPServer config: \n" . Dumper($config) . "\nEND SIPServer config.\n";
  46 my @parms;
  47
  48 #
  49 # Ports to bind
  50 #
  51 foreach my $svc (keys %{$config->{listeners}}) {
  52     push @parms, "port=" . $svc;
  53 }
  54
  55 #
  56 # Logging
  57 #
  58 push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server",
  59   "syslog_facility=" . LOG_SIP;
  60
  61 #
  62 # Server Management: set parameters for the Net::Server::PreFork
  63 # module.  The module silently ignores parameters that it doesn't
  64 # recognize, and complains about invalid values for parameters
  65 # that it does.
  66 #
  67 if (defined($config->{'server-params'})) {
  68     while (my ($key, $val) = each %{$config->{'server-params'}}) {
  69                 push @parms, $key . '=' . $val;
  70     }
  71 }
  72
  73 print "Params for Net::Server::PreFork : \n" . Dumper(@parms);
  74
  75 #
  76 # This is the main event.
  77 __PACKAGE__ ->run(@parms);
  78
  79 #
  80 # Child
  81 #
  82
  83 # process_request is the callback used by Net::Server to handle
  84 # an incoming connection request.
  85
  86 sub process_request {
  87     my $self = shift;
  88     my $service;
  89     my ($sockaddr, $port, $proto);
  90     my $transport;
  91
  92     $self->{config} = $config;
  93
  94     my $sockname = getsockname(STDIN);
  95     ($port, $sockaddr) = sockaddr_in($sockname);
  96     $sockaddr = inet_ntoa($sockaddr);
  97     $proto = $self->{server}->{client}->NS_proto();
  98
  99     $self->{service} = $config->find_service($sockaddr, $port, $proto);
 100
 101     if (!defined($self->{service})) {
 102                 syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
 103                 die "process_request: Bad server connection";
 104     }
 105
 106     $transport = $transports{$self->{service}->{transport}};
 107
 108     if (!defined($transport)) {
 109                 syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
 110                 return;
 111     } else {
 112                 &$transport($self);
 113     }
 114 }
 115
 116 #
 117 # Transports
 118 #
 119
 120 sub raw_transport {
 121     my $self = shift;
 122     my ($input);
 123     my $service = $self->{service};
 124     my $strikes = 3;
 125
 126     eval {
 127                 local $SIG{ALRM} = sub { die "Timed Out!\n"; };
 128                 syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
 129                 while ($strikes--) {
 130                     alarm $service->{timeout};
 131                     $input = Sip::read_SIP_packet(*STDIN);
 132                     alarm 0;
 133                         if (!$input) {
 134                                 # EOF on the socket
 135                                 syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
 136                                 return;
 137                     }
 138                     $input =~ s/[\r\n]+$//sm;   # Strip off trailing line terminator
 139                     last if Sip::MsgType::handle($input, $self, LOGIN);
 140                 }
 141         };
 142
 143     if (length $@) {
 144                 syslog("LOG_ERR", "raw_transport: LOGIN ERROR: '$@'");
 145                 die "raw_transport: login error (timeout? $@), exiting";
 146     } elsif (!$self->{account}) {
 147                 syslog("LOG_ERR", "raw_transport: LOGIN FAILED");
 148                 die "raw_transport: Login failed (no account), exiting";
 149     }
 150
 151     syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
 152            $self->{account}->{id},
 153            $self->{account}->{institution});
 154
 155     $self->sip_protocol_loop();
 156     syslog("LOG_INFO", "raw_transport: shutting down");
 157 }
 158
 159 sub telnet_transport {
 160     my $self = shift;
 161     my ($uid, $pwd);
 162     my $strikes = 3;
 163     my $account = undef;
 164     my $input;
 165     my $config  = $self->{config};
 166         my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
 167         # syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout);
 168
 169     eval {
 170         local $SIG{ALRM} = sub { die "Timed Out ($timeout seconds)!\n"; };
 171         local $| = 1;                   # Unbuffered output
 172     # Until the terminal has logged in, we don't trust it
 173     # so use a timeout to protect ourselves from hanging.
 174
 175         while ($strikes--) {
 176             print "login: ";
 177                 alarm $timeout;
 178                 $uid = <STDIN>;
 179                 alarm 0;
 180
 181                 if (defined $uid) {
 182             print "password: ";
 183                 alarm $timeout;
 184             $pwd = <STDIN> || '';
 185                 alarm 0;
 186
 187                 syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
 188                 while (chomp($uid)) {1;}
 189                 while (chomp($pwd)) {1;}
 190                 syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
 191                 $uid =~ s/^\s+//;                       #
 192                 $pwd =~ s/^\s+//;                       #
 193             $uid =~ s/[\r\n]+$//gms;    #
 194             $pwd =~ s/[\r\n]+$//gms;    #
 195             $uid =~ s/[[:cntrl:]]//g;   #
 196             $pwd =~ s/[[:cntrl:]]//g;   #
 197                 syslog("LOG_DEBUG", "telnet_transport 3: uid length %s, pwd length %s", length($uid), length($pwd));
 198
 199             if (exists ($config->{accounts}->{$uid})
 200                 && ($pwd eq $config->{accounts}->{$uid}->password())) {
 201                         $account = $config->{accounts}->{$uid};
 202                         last;
 203             }
 204                 }
 205                 syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
 206                 print("Invalid login\n");
 207         }
 208     }; # End of eval
 209
 210     if ($@) {
 211                 syslog("LOG_ERR", "telnet_transport: Login timed out");
 212                 die "Telnet Login Timed out";
 213     } elsif (!defined($account)) {
 214                 syslog("LOG_ERR", "telnet_transport: Login Failed");
 215                 die "Login Failure";
 216     } else {
 217                 print "Login OK.  Initiating SIP\n";
 218     }
 219
 220     $self->{account} = $account;
 221     syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
 222     $self->sip_protocol_loop();
 223     syslog("LOG_INFO", "telnet_transport: shutting down");
 224 }
 225
 226 #
 227 # The terminal has logged in, using either the SIP login process
 228 # over a raw socket, or via the pseudo-unix login provided by the
 229 # telnet transport.  From that point on, both the raw and the telnet
 230 # processes are the same:
 231 sub sip_protocol_loop {
 232         my $self = shift;
 233         my $service = $self->{service};
 234         my $config  = $self->{config};
 235         my $input;
 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
 240
 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
 247     # not enforcing it.
 248     #
 249     #my $expect = SC_STATUS;
 250     my $expect = '';
 251     my $strikes = 3;
 252     while ($input = Sip::read_SIP_packet(*STDIN)) {
 253                 # begin cheap input hacks
 254                 $input =~ s/^\s+//;                     # Kill leading whitespace... a cheap stand in for better Telnet layer
 255                 $input =~ s/[\r\n]+$//sm;       # Strip off any trailing line ends (chomp?)
 256                 while (chomp($input)) {warn "Extra line ending on input";}
 257                 unless ($input) {
 258                         if ($strikes--) {
 259                                 syslog("LOG_ERR", "sip_protocol_loop: empty input skipped");
 260                                 next;
 261                         } else {
 262                                 syslog("LOG_ERR", "sip_protocol_loop: quitting after too many errors");
 263                                 die "sip_protocol_loop: quitting after too many errors";
 264                         }
 265                 }
 266                 # end cheap input hacks
 267                 my $status = Sip::MsgType::handle($input, $self, $expect);
 268                 if (!$status) {
 269                         syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
 270                         die "sip_protocol_loop: failed Sip::MsgType::handle('$input', $self, '$expect')";
 271                 }
 272                 next if $status eq REQUEST_ACS_RESEND;
 273                 if ($expect && ($status ne $expect)) {
 274                         # We received a non-"RESEND" that wasn't what we were expecting.
 275                     syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input);
 276                         die "sip_protocol_loop: exiting: expected '$expect', received '$status'";
 277                 }
 278                 # We successfully received and processed what we were expecting
 279                 $expect = '';
 280         }
 281 }
 282
 283 1;
 284 __END__