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__