Improve comments in NCIP::ILS.
[working/NCIPServer.git] / lib / NCIPServer.pm
1 package NCIPServer;
2
3 # Copyright 2013 Catalyst IT <chrisc@catalyst.net.nz>
4
5 # This file is part of NCIPServer
6 #
7 # NCIPServer is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # NCIPServer is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with NCIPServer; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use Sys::Syslog qw(syslog);
21 use Modern::Perl;
22 use NCIP::Configuration;
23 use IO::Socket::INET;
24 use Socket qw(:DEFAULT :crlf);
25 use base qw(Net::Server::PreFork);
26
27 =head1 NAME
28   
29     NCIPServer
30
31 =head1 SYNOPSIS
32
33     use NCIPServer;
34     my $server = NCIPServer->new({config_dir => $config_dir});
35
36 =head1 FUNCTIONS
37
38 =head2 run()
39
40   Apart from new, this is the only method you should ever call from outside this module
41 =cut
42
43 our $VERSION = '0.01';
44
45 # This sets up the configuration
46
47 my %transports = ( RAW => \&raw_transport, );
48
49 sub configure_hook {
50     my ($self)        = @_;
51     my $server        = $self->{'server'};
52     my $config        = NCIP::Configuration->new( $server->{'config_dir'} );
53     my $server_params = $config->('NCIP.server-params');
54     while ( my ( $key, $val ) = each %$server_params ) {
55         $server->{$key} = $val;
56     }
57     my $listeners = $config->('NCIP.listeners');
58     foreach my $svc ( keys %$listeners ) {
59         $server->{'port'} = $listeners->{$svc}->{'port'};
60     }
61     $self->{'local_config'} = $config;
62 }
63
64 # Debug, remove before release
65
66 sub post_configure_hook {
67     my $self = shift;
68     use Data::Dumper;
69     print Dumper $self;
70 }
71
72 # this handles the actual requests
73 sub process_request {
74     my $self     = shift;
75     my $sockname = getsockname(STDIN);
76     my ( $port, $sockaddr ) = sockaddr_in($sockname);
77     $sockaddr = inet_ntoa($sockaddr);
78     my $proto = $self->{server}->{client}->NS_proto();
79     $self->{'service'} =
80       $self->{'local_config'}->find_service( $sockaddr, $port, $proto );
81     if ( !defined( $self->{service} ) ) {
82         syslog( "LOG_ERR",
83             "process_request: Unknown recognized server connection: %s:%s/%s",
84             $sockaddr, $port, $proto );
85         die "process_request: Bad server connection";
86     }
87     my $transport = $transports{ $self->{service}->{transport} };
88     if ( !defined($transport) ) {
89         syslog(
90             "LOG_WARNING",
91             "Unknown transport '%s', dropping",
92             $self->{'service'}->{transport}
93         );
94         return;
95     }
96     else {
97         &$transport($self);
98     }
99 }
100
101 sub raw_transport {
102     my $self = shift;
103     my ($input);
104     my $service = $self->{service};
105
106     # place holder code, just echo at the moment
107     while (1) {
108         local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
109         $input = <STDIN>;
110         if ($input) {
111             print "You said $input";
112         }
113     }
114
115 }
116
117 1;
118 __END__