C4/SIP/SIPServer.pm

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