C4/SIP/SIPServer.pm

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