Have added a file you can now run
[working/NCIPServer.git] / 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__