@@ -1,7 +1,32 @@
-$Id: Changes,v 1.19 2013-02-02 11:20:48 joern Exp $
+$Id: Changes,v 1.21 2014-01-28 15:40:22 joern Exp $
Revision history and release notes for Event::RPC:
+1.05 Tue Feb 28, 2014, joern
+ Features:
+ - New Method set_max_packet_size (Client and Server)
+ to change the default value of 2 GB up to 4 GB
+ (or less).
+
+ Bugfixes
+ - Increased default maximum packet size from 4 MB
+ to 2 GB.
+ - Fixed test suite for parallel execution by using
+ different port numbers for the test server.
+ Thanks for the report to Andreas König.
+ - Applied a patch from Salvatore Bonaccorso which
+ fixes missing encoding declarations in POD. Thanks!
+ - Fixed some POD typos. Thanks for the report to
+ Xavier Guimard.
+
+1.04 Fri Feb 24, 2014, joern
+ Bugfixes
+ - Under certain infrequently conditions it could
+ happen that the server process blocked when
+ sending a response packet to a client.
+ - Event::RPC::Client failed loading when no
+ IO::Socket::SSL is installed.
+
1.03 Sat Feb 2, 2013, joern
Features:
- Added options 'ssl_ca_file and 'ssl_ca_path' options
@@ -35,7 +35,6 @@ t/ssl/server.crt
t/ssl/server.csr
t/ssl/server.key
t/ssl/server-noca.crt
-
examples/server.pl
examples/client.pl
examples/Test_class.pm
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Event-RPC
-version: 1.03
+version: 1.05
abstract: ~
author: []
license: unknown
@@ -1,4 +1,4 @@
-# $Id: Client.pm,v 1.18 2013-02-02 11:24:31 joern Exp $
+# $Id: Client.pm,v 1.20 2014-01-28 15:40:10 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -56,6 +56,16 @@ sub set_server { shift->{server} = $_[1] }
sub set_server_version { shift->{server_version} = $_[1] }
sub set_server_protocol { shift->{server_protocol} = $_[1] }
+sub get_max_packet_size {
+ return Event::RPC::Message->get_max_packet_size;
+}
+
+sub set_max_packet_size {
+ my $class = shift;
+ my ($value) = @_;
+ Event::RPC::Message->set_max_packet_size($value);
+}
+
sub new {
my $class = shift;
my %par = @_;
@@ -101,24 +111,24 @@ sub connect {
my $port = $self->get_port;
my $timeout = $self->get_timeout;
- if ($ssl) {
- eval { use IO::Socket::SSL };
+ if ( $ssl ) {
+ eval { require IO::Socket::SSL };
croak "SSL requested, but IO::Socket::SSL not installed" if $@;
}
my $sock;
- if ($ssl) {
+ if ( $ssl ) {
my @verify_opts;
if ( $self->get_ssl_ca_file or $self->get_ssl_ca_path ) {
push @verify_opts, (
- SSL_verify_mode => SSL_VERIFY_PEER,
+ SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
SSL_ca_file => $self->get_ssl_ca_file,
SSL_ca_path => $self->get_ssl_ca_path,
);
}
else {
push @verify_opts, (
- SSL_verify_mode => SSL_VERIFY_NONE,
+ SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
);
}
@@ -152,7 +162,7 @@ sub connect {
my $auth_user = $self->get_auth_user;
my $auth_pass = $self->get_auth_pass;
- if ($auth_user) {
+ if ( $auth_user ) {
my $rc = $self->send_request(
{ cmd => 'auth',
user => $auth_user,
@@ -437,6 +447,8 @@ sub send_request {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Client - Client API to connect to Event::RPC Servers
@@ -471,10 +483,11 @@ Event::RPC::Client - Client API to connect to Event::RPC Servers
},
);
+ $rpc_client->set_max_packet_size(2*1024*1024*1024);
$rpc_client->connect;
- #-- And now use classes and methods the server
- #-- allows to access via RPC, here My::TestModule
+ #-- And now use classes and methods to which the
+ #-- server allows access via RPC, here My::TestModule
#-- from the Event::RPC::Server manpage SYNPOSIS.
my $obj = My::TestModule->new( data => "foobar" );
print "obj says hello: ".$obj->hello."\n";
@@ -685,6 +698,22 @@ Closes the connection to the server. You may omit explicit disconnecting
since it's done automatically once the Event::RPC::Client object gets
destroyed.
+=item $rpc_client->B<set_max_packet_size> ( $bytes )
+
+By default Event::RPC does not handle network packages which
+exceed 2 GB in size (was 4 MB with version 1.04 and earlier).
+
+You can change this value using this method at any time,
+but 4 GB is the maximum. An attempt of the server to send a
+bigger packet will be aborted and reported as an exception
+on the client and logged as an error message on the server.
+
+Note: you have to set the same value on client and server side!
+
+=item $rpc_client->B<get_max_packet_size>
+
+Returns the currently active max packet size.
+
=back
=head1 READY ONLY ATTRIBUTES
@@ -15,11 +15,13 @@ sub get_objects { shift->{server}->{objects} }
sub get_client_oids { shift->{client_oids} }
sub get_watcher { shift->{watcher} }
+sub get_write_watcher { shift->{write_watcher} }
sub get_message { shift->{message} }
sub get_is_authenticated { shift->{is_authenticated} }
sub get_auth_user { shift->{auth_user} }
sub set_watcher { shift->{watcher} = $_[1] }
+sub set_write_watcher { shift->{write_watcher} = $_[1] }
sub set_message { shift->{message} = $_[1] }
sub set_is_authenticated { shift->{is_authenticated} = $_[1] }
sub set_auth_user { shift->{auth_user} = $_[1] }
@@ -37,6 +39,7 @@ sub new {
is_authenticated => (!$server->get_auth_required),
auth_user => "",
watcher => undef,
+ write_watcher => undef,
message => undef,
client_oids => {},
}, $class;
@@ -63,7 +66,10 @@ sub disconnect {
my $self = shift;
$self->get_server->get_loop->del_io_watcher($self->get_watcher);
+ $self->get_server->get_loop->del_io_watcher($self->get_write_watcher)
+ if $self->get_write_watcher;
$self->set_watcher(undef);
+ $self->set_write_watcher(undef);
close $self->get_sock;
my $server = $self->get_server;
@@ -189,19 +195,23 @@ sub input {
$server->set_active_connection(undef);
- $message->write($rc) and return;
+ $message->set_data($rc);
- my $watcher;
- $watcher = $self->get_server->get_loop->add_io_watcher (
+ my $watcher = $self->get_server->get_loop->add_io_watcher (
fh => $self->get_sock,
poll => 'w',
cb => sub {
- $self->get_server->get_loop->del_io_watcher($watcher)
- if $message->write;
+ if ( $message->write ) {
+ $self->get_server->get_loop->del_io_watcher($self->get_write_watcher)
+ if $self->get_write_watcher;
+ $self->set_write_watcher();
+ }
1;
},
);
+ $self->set_write_watcher($watcher);
+
1;
}
@@ -550,6 +560,8 @@ sub resolve_object_params {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Connection - Represents a RPC connection
@@ -70,6 +70,8 @@ sub input {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::LogConnection - Represents a logging connection
@@ -1,4 +1,4 @@
-# $Id: Logger.pm,v 1.6 2009-04-22 10:53:51 joern Exp $
+# $Id: Logger.pm,v 1.7 2014-01-28 15:37:33 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -125,6 +125,8 @@ sub remove_fh {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Logger - Logging facility for Event::RPC
@@ -1,4 +1,4 @@
-# $Id: AnyEvent.pm,v 1.1 2011-03-08 11:50:56 joern Exp $
+# $Id: AnyEvent.pm,v 1.2 2014-01-28 15:37:33 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -96,6 +96,8 @@ sub leave {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Loop::AnyEvent - AnyEvent mainloop for Event::RPC
@@ -1,4 +1,4 @@
-# $Id: Event.pm,v 1.4 2009-04-22 10:53:51 joern Exp $
+# $Id: Event.pm,v 1.5 2014-01-28 15:37:33 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -84,6 +84,8 @@ sub leave {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Loop::Event - Event mainloop for Event::RPC
@@ -1,4 +1,4 @@
-# $Id: Glib.pm,v 1.4 2009-04-22 10:53:51 joern Exp $
+# $Id: Glib.pm,v 1.5 2014-01-28 15:37:33 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -101,6 +101,8 @@ sub leave {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Loop::Glib - Glib mainloop for Event::RPC
@@ -1,4 +1,4 @@
-# $Id: Loop.pm,v 1.4 2009-04-22 10:53:51 joern Exp $
+# $Id: Loop.pm,v 1.5 2014-01-28 15:37:33 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -19,6 +19,8 @@ sub new {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Loop - Mainloop Abstraction layer for Event::RPC
@@ -1,4 +1,4 @@
-# $Id: Message.pm,v 1.7 2009-04-22 10:53:51 joern Exp $
+# $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -15,6 +15,7 @@ use strict;
use Storable;
my $DEBUG = 0;
+my $MAX_PACKET_SIZE = 2*1024*1024*1024;
sub get_sock { shift->{sock} }
@@ -26,12 +27,20 @@ sub set_buffer { shift->{buffer} = $_[1] }
sub set_length { shift->{length} = $_[1] }
sub set_written { shift->{written} = $_[1] }
+sub get_max_packet_size {
+ return $MAX_PACKET_SIZE;
+}
+
+sub set_max_packet_size {
+ my $class = shift;
+ my ($value) = @_;
+ $MAX_PACKET_SIZE = $value;
+}
+
sub new {
my $class = shift;
my ($sock) = @_;
- $sock->blocking(1);
-
my $self = bless {
sock => $sock,
buffer => undef,
@@ -44,7 +53,10 @@ sub new {
sub read {
my $self = shift;
+ my ($blocking) = @_;
+ $self->get_sock->blocking($blocking?1:0);
+
if ( not defined $self->{buffer} ) {
my $length_packed;
$DEBUG && print "DEBUG: going to read header...\n";
@@ -53,8 +65,8 @@ sub read {
die "DISCONNECTED" if !(defined $rc) || $rc == 0;
$self->{length} = unpack("N", $length_packed);
$DEBUG && print "DEBUG: packet size=$self->{length}\n";
- die "Incoming message too big"
- if $self->{length} > 4194304;
+ die "Incoming message size exceeds limit of $MAX_PACKET_SIZE bytes"
+ if $self->{length} > $MAX_PACKET_SIZE;
}
my $buffer_length = length($self->{buffer}||'');
@@ -94,24 +106,38 @@ sub read_blocked {
my $self = shift;
my $rc;
- $rc = $self->read while not defined $rc;
+ $rc = $self->read(1) while not defined $rc;
return $rc;
}
-sub write {
+sub set_data {
my $self = shift;
my ($data) = @_;
- $DEBUG && print "DEBUG: going to write...\n";
+ $DEBUG && print "DEBUG: Message->set_data($data)\n";
- if ( not defined $self->{buffer} ) {
- my $packed = Storable::nfreeze ($data);
- $self->{buffer} = pack("N", length($packed)).$packed;
- $self->{length} = length($self->{buffer});
- $self->{written} = 0;
+ my $packed = Storable::nfreeze ($data);
+
+ if ( length($packed) > $MAX_PACKET_SIZE ) {
+ Event::RPC::Server->instance->log("ERROR: response packet exceeds limit of $MAX_PACKET_SIZE bytes");
+ $data = { rc => 0, msg => "Response packed exceeds limit of $MAX_PACKET_SIZE bytes" };
+ $packed = Storable::nfreeze ($data);
}
+ $self->{buffer} = pack("N", length($packed)).$packed;
+ $self->{length} = length($self->{buffer});
+ $self->{written} = 0;
+
+ 1;
+}
+
+sub write {
+ my $self = shift;
+ my ($blocking) = @_;
+
+ $self->get_sock->blocking($blocking?1:0);
+
my $rc = syswrite (
$self->get_sock,
$self->{buffer},
@@ -141,10 +167,10 @@ sub write_blocked {
my $self = shift;
my ($data) = @_;
- $self->write($data) and return;
+ $self->set_data($data);
my $finished = 0;
- $finished = $self->write while not $finished;
+ $finished = $self->write(1) while not $finished;
1;
}
@@ -153,6 +179,8 @@ sub write_blocked {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Message - Implementation of Event::RPC network protocol
@@ -1,4 +1,4 @@
-# $Id: Server.pm,v 1.14 2011-03-08 11:50:56 joern Exp $
+# $Id: Server.pm,v 1.15 2014-01-28 15:40:10 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -75,6 +75,16 @@ sub set_active_connection { shift->{active_connection} = $_[1] }
my $INSTANCE;
sub instance { $INSTANCE }
+sub get_max_packet_size {
+ return Event::RPC::Message->get_max_packet_size;
+}
+
+sub set_max_packet_size {
+ my $class = shift;
+ my ($value) = @_;
+ Event::RPC::Message->set_max_packet_size($value);
+}
+
sub new {
my $class = shift;
my %par = @_;
@@ -412,6 +422,8 @@ sub print_object_register {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC::Server - Simple API for event driven RPC servers
@@ -455,6 +467,7 @@ Event::RPC::Server - Simple API for event driven RPC servers
connection_hook => sub { ... },
);
+ $server->set_max_packet_size(2*1024*1024*1024);
$server->start;
# and later from inside your server implementation
@@ -514,7 +527,7 @@ This is a hash ref with the following structure:
...
},
-Each class which should be accessable for clients needs to
+Each class which should be accessible for clients needs to
be listed here at the first level, assigned a hash of methods
allowed to be called. Event::RPC disuinguishes three types
of methods by classifying their return value:
@@ -756,7 +769,7 @@ and manage the main loop stuff on your own.
By default the network listeners are bound to all interfaces
in the system. Use the host option to bind to a specific
-interface, e.g. "localhost" if you efficently want to prevent
+interface, e.g. "localhost" if you efficiently want to prevent
network clients from accessing your server.
=item B<load_modules>
@@ -780,6 +793,8 @@ with two arguments: the Event::RPC::Connection object and
a string containing either "connect" or "disconnect" depending
what's currently happening with this connection.
+=back
+
=head1 METHODS
The following methods are publically available:
@@ -827,6 +842,22 @@ representing the connection resp. the client which currently
requests method invocation. This is undef if no client call
is active.
+=item $rpc_client->B<set_max_packet_size> ( $bytes )
+
+By default Event::RPC does not handle network packages which
+exceed 2 GB in size (was 4 MB with version 1.04 and earlier).
+
+You can change this value using this method at any time,
+but 4 GB is the maximum. An attempt of the server to send a
+bigger packet will be aborted and reported as an exception
+on the client and logged as an error message on the server.
+
+Note: you have to set the same value on client and server side!
+
+=item $rpc_client->B<get_max_packet_size>
+
+Returns the currently active max packet size.
+
=back
=head1 AUTHORS
@@ -1,6 +1,6 @@
package Event::RPC;
-$VERSION = "1.03";
+$VERSION = "1.05";
$PROTOCOL = "1.00";
sub crypt {
@@ -11,6 +11,8 @@ sub crypt {
__END__
+=encoding latin1
+
=head1 NAME
Event::RPC - Event based transparent Client/Server RPC framework
@@ -11,13 +11,13 @@ if ( not $depend_modules ) {
plan tests => 5;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
# load client class
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
Event_RPC_Test_Server->start_server (
p => $PORT,
S => 1,
@@ -12,7 +12,9 @@ if ( not $depend_modules ) {
plan tests => 6;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
+
my $AUTH_USER = "foo";
my $AUTH_PASS = "bar";
@@ -20,7 +22,6 @@ my $AUTH_PASS = "bar";
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
Event_RPC_Test_Server->start_server (
p => $PORT,
a => "$AUTH_USER:$AUTH_PASS",
@@ -17,7 +17,9 @@ if ( $@ ) {
plan tests => 4;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
+
my $AUTH_USER = "foo";
my $AUTH_PASS = "bar";
@@ -25,8 +27,6 @@ my $AUTH_PASS = "bar";
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
-
my $server_pid = Event_RPC_Test_Server->start_server (
p => $PORT,
a => "$AUTH_USER:$AUTH_PASS",
@@ -17,7 +17,9 @@ if ( $@ ) {
plan tests => 5;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
+
my $AUTH_USER = "foo";
my $AUTH_PASS = "bar";
@@ -25,7 +27,6 @@ my $AUTH_PASS = "bar";
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
Event_RPC_Test_Server->start_server (
p => $PORT,
a => "$AUTH_USER:$AUTH_PASS",
@@ -17,7 +17,9 @@ if ( $@ ) {
plan tests => 6;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
+
my $AUTH_USER = "foo";
my $AUTH_PASS = "bar";
@@ -25,7 +27,6 @@ my $AUTH_PASS = "bar";
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
Event_RPC_Test_Server->start_server (
p => $PORT,
a => "$AUTH_USER:$AUTH_PASS",
@@ -17,7 +17,9 @@ if ( $@ ) {
plan tests => 6;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
+
my $AUTH_USER = "foo";
my $AUTH_PASS = "bar";
@@ -25,7 +27,6 @@ my $AUTH_PASS = "bar";
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
Event_RPC_Test_Server->start_server (
p => $PORT,
a => "$AUTH_USER:$AUTH_PASS",
@@ -11,13 +11,13 @@ if ( not $depend_modules ) {
plan tests => 16;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
# load client class
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
Event_RPC_Test_Server->start_server (
p => $PORT,
S => 1,
@@ -13,13 +13,13 @@ if ( not $depend_modules ) {
plan tests => 10;
-my $PORT = 27811;
+require "t/Event_RPC_Test_Server.pm";
+my $PORT = Event_RPC_Test_Server->port;
# load client class
use_ok('Event::RPC::Client');
# start server in background, without logging
-require "t/Event_RPC_Test_Server.pm";
Event_RPC_Test_Server->start_server (
p => $PORT,
S => 1,
@@ -1,4 +1,4 @@
-# $Id: Event_RPC_Test.pm,v 1.4 2008/06/21 12:44:13 joern Exp $
+# $Id: Event_RPC_Test.pm,v 1.5 2014-01-27 13:38:51 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2005 Jörn Reder <joern AT zyn.de>.
@@ -106,5 +106,34 @@ sub new_object2 {
return Event_RPC_Test2->new($data);
}
+sub get_big_data_struct {
+ my @records;
+
+ for (0..100) {
+ push @records, {
+ a => 123,
+ b => 456789,
+ c => "ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n",
+ d => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20),
+ e => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20),
+ f => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50),
+ g => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50),
+ x => $_,
+ h => {
+ a => 123,
+ b => 456789,
+ c => "ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n",
+ d => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20),
+ e => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20),
+ f => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50),
+ g => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50),
+ x => $_,
+ },
+ };
+ }
+
+ return \@records;
+}
+
1;
@@ -3,6 +3,7 @@ package Event_RPC_Test_Server;
use strict;
use lib qw(t);
+use Fcntl qw( :flock );
sub start_server {
my $class = shift;
@@ -116,6 +117,7 @@ sub start_server {
get_cid => 1,
get_object_cnt => 1,
get_undef_object => '_object',
+ get_big_data_struct => 1,
async_call_1 => 'object:async:reeintrant'
},
'Event_RPC_Test2' => {
@@ -136,6 +138,8 @@ sub start_server {
},
);
+ $server->set_max_packet_size($opts{M}) if $opts{M};
+
#-- Start the server resp. the Event loop.
$server->start;
@@ -143,5 +147,28 @@ sub start_server {
exit;
}
+sub port {
+ my $file = "port.txt";
+
+ open (my $fh, "+>>", $file) or die "Can't open '$file': $!";
+ flock($fh, LOCK_EX) or die "Cannot lock $file: $!";
+
+ seek $fh, 0, 0;
+
+ my $port = <$fh> || 27808;
+ chomp $port;
+
+ truncate $fh, 0;
+
+ $port += 2;
+
+ $port = 27810 if $port > 65000;
+
+ print $fh "$port\n";
+ close $fh;
+
+ return $port;
+}
+
1;