lib/NCIPServer.pm

   1 package NCIPServer;
   2
   3 use Sys::Syslog qw(syslog);
   4 use Modern::Perl;
   5 use NCIP::Configuration;
   6 use IO::Socket::INET;
   7 use Socket qw(:DEFAULT :crlf);
   8 use base qw(Net::Server::PreFork);
   9
  10 our $VERSION = '0.01';
  11
  12 # This sets up the configuration
  13
  14 my %transports = ( RAW => \&raw_transport, );
  15
  16 sub configure_hook {
  17     my ($self)        = @_;
  18     my $server        = $self->{'server'};
  19     my $config        = NCIP::Configuration->new( $server->{'config_dir'} );
  20     my $server_params = $config->('NCIP.server-params');
  21     while ( my ( $key, $val ) = each %$server_params ) {
  22         $server->{$key} = $val;
  23     }
  24     my $listeners = $config->('NCIP.listeners');
  25     foreach my $svc ( keys %$listeners ) {
  26         $server->{'port'} = $listeners->{$svc}->{'port'};
  27     }
  28     $self->{'local_config'} = $config;
  29 }
  30
  31 # Debug, remove before release
  32
  33 sub post_configure_hook {
  34     my $self = shift;
  35     use Data::Dumper;
  36     print Dumper $self;
  37 }
  38
  39 # this handles the actual requests
  40 sub process_request {
  41     my $self     = shift;
  42     my $sockname = getsockname(STDIN);
  43     my ( $port, $sockaddr ) = sockaddr_in($sockname);
  44     $sockaddr = inet_ntoa($sockaddr);
  45     my $proto = $self->{server}->{client}->NS_proto();
  46     $self->{'service'} =
  47       $self->{'local_config'}->find_service( $sockaddr, $port, $proto );
  48     if ( !defined( $self->{service} ) ) {
  49         syslog( "LOG_ERR",
  50             "process_request: Unknown recognized server connection: %s:%s/%s",
  51             $sockaddr, $port, $proto );
  52         die "process_request: Bad server connection";
  53     }
  54     my $transport = $transports{ $self->{service}->{transport} };
  55     if ( !defined($transport) ) {
  56         syslog(
  57             "LOG_WARNING",
  58             "Unknown transport '%s', dropping",
  59             $self->{'service'}->{transport}
  60         );
  61         return;
  62     }
  63     else {
  64         &$transport($self);
  65     }
  66 }
  67
  68 sub raw_transport {
  69     my $self = shift;
  70     my ($input);
  71     my $service = $self->{service};
  72
  73     # place holder code, just echo at the moment
  74     while (1) {
  75         local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
  76         $input = <STDIN>;
  77         if ($input) {
  78             print "You said $input";
  79         }
  80     }
  81
  82 }
  83
  84 1;
  85 __END__