3 # Copyright 2013 Catalyst IT <chrisc@catalyst.net.nz>
5 # This file is part of NCIPServer
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
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.
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.
20 use Sys::Syslog qw(syslog);
22 use NCIP::Configuration;
24 use Socket qw(:DEFAULT :crlf);
25 use base qw(Net::Server::PreFork);
34 my $server = NCIPServer->new({config_dir => $config_dir});
40 Apart from new, this is the only method you should ever call from outside this module
43 our $VERSION = '0.01';
45 # This sets up the configuration
47 my %transports = ( RAW => \&raw_transport, );
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;
57 my $listeners = $config->('NCIP.listeners');
58 foreach my $svc ( keys %$listeners ) {
59 $server->{'port'} = $listeners->{$svc}->{'port'};
61 $self->{'local_config'} = $config;
64 # Debug, remove before release
66 sub post_configure_hook {
72 # this handles the actual requests
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();
80 $self->{'local_config'}->find_service( $sockaddr, $port, $proto );
81 if ( !defined( $self->{service} ) ) {
83 "process_request: Unknown recognized server connection: %s:%s/%s",
84 $sockaddr, $port, $proto );
85 die "process_request: Bad server connection";
87 my $transport = $transports{ $self->{service}->{transport} };
88 if ( !defined($transport) ) {
91 "Unknown transport '%s', dropping",
92 $self->{'service'}->{transport}
104 my $service = $self->{service};
106 # place holder code, just echo at the moment
108 local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
111 print "You said $input";