From 3598581ce099cfd16bcf349ad1fc3485082184ed Mon Sep 17 00:00:00 2001 From: Chris Cormack Date: Wed, 28 Aug 2013 14:46:11 +1200 Subject: [PATCH] Have added a file you can now run ./test_server.pl And if you haven't edited the test config telnet 127.0.0.1 6001 then type, it will just echo at this point --- lib/NCIP/Configuration.pm | 6 ++--- lib/NCIPServer.pm | 56 ++++++++++++++++++++++++++++++++++++++- t/NCIPServer.t | 8 +++--- t/NCIP_Configuration.t | 1 + test_server.pl | 29 ++++++++++++++++++++ 5 files changed, 91 insertions(+), 9 deletions(-) create mode 100755 test_server.pl diff --git a/lib/NCIP/Configuration.pm b/lib/NCIP/Configuration.pm index 070a2fd..4db0e5f 100644 --- a/lib/NCIP/Configuration.pm +++ b/lib/NCIP/Configuration.pm @@ -58,10 +58,8 @@ sub find_service { my $portstr; foreach my $addr ( '', '*:', "$sockaddr:" ) { $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto ); - - # Sys::Syslog::syslog( "LOG_DEBUG", - # "Configuration::find_service: Trying $portstr" ); - # print "Configuration::find_service: Trying $portstr"; + Sys::Syslog::syslog( "LOG_DEBUG", + "Configuration::find_service: Trying $portstr" ); last if ( exists( ( $self->{listeners} )->{$portstr} ) ); } return $self->{listeners}->{$portstr}; diff --git a/lib/NCIPServer.pm b/lib/NCIPServer.pm index d8928ed..de274f4 100644 --- a/lib/NCIPServer.pm +++ b/lib/NCIPServer.pm @@ -1,12 +1,18 @@ package NCIPServer; +use Sys::Syslog qw(syslog); use Modern::Perl; use NCIP::Configuration; - +use IO::Socket::INET; +use Socket qw(:DEFAULT :crlf); use base qw(Net::Server::PreFork); our $VERSION = '0.01'; +# This sets up the configuration + +my %transports = ( RAW => \&raw_transport, ); + sub configure_hook { my ($self) = @_; my $server = $self->{'server'}; @@ -19,13 +25,61 @@ sub configure_hook { foreach my $svc ( keys %$listeners ) { $server->{'port'} = $listeners->{$svc}->{'port'}; } + $self->{'local_config'} = $config; } +# Debug, remove before release + sub post_configure_hook { my $self = shift; use Data::Dumper; print Dumper $self; } +# this handles the actual requests +sub process_request { + my $self = shift; + my $sockname = getsockname(STDIN); + my ( $port, $sockaddr ) = sockaddr_in($sockname); + $sockaddr = inet_ntoa($sockaddr); + my $proto = $self->{server}->{client}->NS_proto(); + $self->{'service'} = + $self->{'local_config'}->find_service( $sockaddr, $port, $proto ); + if ( !defined( $self->{service} ) ) { + syslog( "LOG_ERR", + "process_request: Unknown recognized server connection: %s:%s/%s", + $sockaddr, $port, $proto ); + die "process_request: Bad server connection"; + } + my $transport = $transports{ $self->{service}->{transport} }; + if ( !defined($transport) ) { + syslog( + "LOG_WARNING", + "Unknown transport '%s', dropping", + $self->{'service'}->{transport} + ); + return; + } + else { + &$transport($self); + } +} + +sub raw_transport { + my $self = shift; + my ($input); + my $service = $self->{service}; + + # place holder code, just echo at the moment + while (1) { + local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; + $input = ; + if ($input) { + print "You said $input"; + } + } + +} + 1; __END__ diff --git a/t/NCIPServer.t b/t/NCIPServer.t index 22ca4e0..1928ff1 100644 --- a/t/NCIPServer.t +++ b/t/NCIPServer.t @@ -7,9 +7,9 @@ use Test::More tests => 2; BEGIN { use_ok('NCIPServer') }; ok(my $server = NCIPServer->new({config_dir => '../t/config_sample'})); -use Data::Dumper; -print Dumper $server; -$server->run(); +# use Data::Dumper; +# print Dumper $server; -print Dumper $server; +# uncomment this if you want to run the server in test mode +# $server->run(); diff --git a/t/NCIP_Configuration.t b/t/NCIP_Configuration.t index e01cf56..a9ca54f 100644 --- a/t/NCIP_Configuration.t +++ b/t/NCIP_Configuration.t @@ -17,6 +17,7 @@ use strict; use warnings; +use Sys::Syslog; use Test::More tests => 5; # last test to print diff --git a/test_server.pl b/test_server.pl new file mode 100755 index 0000000..1d30a6e --- /dev/null +++ b/test_server.pl @@ -0,0 +1,29 @@ +#!/usr/bin/perl +#=============================================================================== +# +# FILE: test_server.pl +# +# USAGE: ./test_server.pl +# +# DESCRIPTION: +# +# OPTIONS: --- +# REQUIREMENTS: --- +# BUGS: --- +# NOTES: --- +# AUTHOR: Chris Cormack (rangi), chrisc@catalyst.net.nz +# ORGANIZATION: Koha Development Team +# VERSION: 1.0 +# CREATED: 28/08/13 14:12:51 +# REVISION: --- +#=============================================================================== + +use strict; +use warnings; + +use lib "lib"; + +use NCIPServer; + +my $server = NCIPServer->new( { config_dir => 't/config_sample' } ); +$server->run(); -- 2.43.2