diff options
Diffstat (limited to 'Spline/Socketmap.pm')
-rw-r--r-- | Spline/Socketmap.pm | 103 |
1 files changed, 74 insertions, 29 deletions
diff --git a/Spline/Socketmap.pm b/Spline/Socketmap.pm index d677166..af31c31 100644 --- a/Spline/Socketmap.pm +++ b/Spline/Socketmap.pm @@ -2,34 +2,29 @@ package Spline::Socketmap; use strict; use warnings; -use base qw(Net::Server::PreFork); +use Scalar::Util qw( openhandle ); -use base 'Exporter'; +use base qw( Exporter Net::Server::PreFork ); our @EXPORT = qw( ); -our @EXPORT_OK = qw( ); - -our $timeout = 10; -our $handler = undef; - - -sub call_handler($@) { - die 'No handler configured' unless ref($handler) eq 'CODE'; - - return &$handler(@_); +our @EXPORT_OK = qw( + lookup + handle_request + netstring_read + netstring_write + process_request + socketmap_protocol +); + +sub lookup($$$) { + die 'Not implemented'; } sub handle_request($$) { my $self = shift; - my ($data) = @_; + my $data = shift; my ($map, $key) = split(/ /, $data, 2); - my $result = call_handler($map, $key); - if (defined $result) { - $self->reply($result); - } - else { - $self->reply('TEMP Protocol error'); - } + return $self->lookup($map, $key); } sub netstring_read_length($) { @@ -38,9 +33,10 @@ sub netstring_read_length($) { local $/ = ':'; $length = <$fd>; - die "Cannot read netstring length" unless defined($length); + die 'Cannot read netstring length' unless defined($length); chomp $length; + die 'Invalid length' unless $length =~ m/\A\d+\z/; return $length; } @@ -48,9 +44,12 @@ sub netstring_read($) { my $fd = shift; my ($length, $data); + die 'Filehandle required' unless openhandle($fd); + $length = netstring_read_length($fd); if (read($fd, $data, $length) == $length) { - (getc() eq ',') or die "Closing , missing"; + my $char = getc($fd); + die "Closing , missing" if not defined $char or $char ne ','; } else { die 'Received only ' . length($data) . " of $length bytes"; @@ -65,32 +64,47 @@ sub netstring_write($$) { print $fd length($data).':'.$data.','; } -sub process_request($) { +sub socketmap_protocol($$) { my $self = shift; + my $input = shift; + my $result; eval { local $SIG{'ALRM'} = sub { die "Timed Out!\n" }; - alarm($timeout); + alarm($self->{server}->{timeout} // 0); - $self->handle_request(netstring_read(*STDIN)); + if (ref($input) eq 'CODE') { + $input = &$input; + } + $result = $self->handle_request($input); alarm(0); }; my $err = $@; alarm(0); - if ($err) { if ($err =~ /timed out/i) { - $self->reply('TEMP Timeout'); + return 'TEMP Timeout'; } else { chomp $err; - $self->reply("TEMP $err"); + return "TEMP $err"; } } + else { + return $result; + } } -sub reply($$) { +sub recv($) { + my $self = shift; + + my $input = netstring_read(*STDIN); + $self->log(3, $input); + return $input; +} + +sub send($$) { my $self = shift; my ($data) = @_; @@ -98,6 +112,37 @@ sub reply($$) { netstring_write(*STDOUT, $data); } +sub process_request($) { + my $self = shift; + + my $recv = sub { return $self->recv() }; + $self->send($self->socketmap_protocol($recv) // 'TEMP Protocol error'); +} + +sub options($$) { + my $self = shift; + my $prop = $self->{'server'}; + my $template = shift; + + $self->SUPER::options($template); + + # Timeout for one request + $prop->{'timeout'} ||= undef; + $template->{'timeout'} = \$prop->{'timeout'}; +} + +sub post_configure_hook { + my $self = shift; + my $prop = $self->{'server'}; + + if (!defined($prop->{'timeout'}) || $prop->{'timeout'} !~ /^\d+$/) { + $prop->{'timeout'} = 10; + } + elsif ($prop->{'timeout'} < 0) { + $prop->{'timeout'} = 0; + } +} + 1; # vim: set et ts=4: |