Event-RPC-1.04/0000755000175000017500000000000012270455742012165 5ustar joernjoernEvent-RPC-1.04/META.yml0000664000175000017500000000120112270455742013432 0ustar joernjoern--- #YAML:1.0 name: Event-RPC version: 1.04 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Event: 0 Glib: 0 IO::Socket::INET: 0 IO::Socket::SSL: 0 Net::SSLeay: 0 Storable: 0 Test::More: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Event-RPC-1.04/lib/0000755000175000017500000000000012270455742012733 5ustar joernjoernEvent-RPC-1.04/lib/Event/0000755000175000017500000000000012270455742014014 5ustar joernjoernEvent-RPC-1.04/lib/Event/RPC.pm0000644000175000017500000001313312270423532014767 0ustar joernjoernpackage Event::RPC; $VERSION = "1.04"; $PROTOCOL = "1.00"; sub crypt { my $class = shift; my ($user, $pass) = @_; return crypt($pass, $user); } __END__ =head1 NAME Event::RPC - Event based transparent Client/Server RPC framework =head1 SYNOPSIS #-- Server Code use Event::RPC::Server; use My::TestModule; my $server = Event::RPC::Server->new ( port => 5555, classes => { "My::TestModule" => { ... } }, ); $server->start; ---------------------------------------------------------- #-- Client Code use Event::RPC::Client; my $client = Event::RPC::Client->new ( server => "localhost", port => 5555, ); $client->connect; #-- Call methods of My::TestModule on the server my $obj = My::TestModule->new ( foo => "bar" ); my $foo = $obj->get_foo; =head1 ABSTRACT Event::RPC supports you in developing Event based networking client/server applications with transparent object/method access from the client to the server. Network communication is optionally encrypted using IO::Socket::SSL. Several event loop managers are supported due to an extensible API. Currently Event, Glib and AnyEvent are implemented. The latter lets you use nearly every event loop implementation available for Perl. AnyEvent was invented after Event::RPC was created and thus Event::RPC started using it's own abstraction model. =head1 DESCRIPTION Event::RPC consists of a server and a client library. The server exports a list of classes and methods, which are allowed to be called over the network. More specific it acts as a proxy for objects created on the server side (on demand of the connected clients) which handles client side methods calls with transport of method arguments and return values. The object proxy handles refcounting and destruction of objects created by clients properly. Objects as method parameters and return values are handled as well (although with some limitations, see below). For the client the whole thing is totally transparent - once connected to the server it doesn't know whether it calls methods on local or remote objects. Also the methods on the server newer know whether they are called locally or from a connected client. Your application logic is not affected by Event::RPC at all, at least if it has a rudimentary clean OO design. For details on implementing servers and clients please refer to the man pages of Event::RPC::Server and Event::RPC::Client. =head1 REQUIREMENTS Event::RPC needs either one of the following modules on the server (they're not necessary on the client): Event Glib AnyEvent They're needed for event handling resp. mainloop implementation. If you like to use SSL encryption you need to install IO::Socket::SSL As well Event::RPC makes heavy use of the Storable module, which is part of the Perl standard library. It's important that both client and server use B! Otherwise Event::RPC client/server communication will fail badly. =head1 INSTALLATION You get the latest installation tarballs and online documentation at this location: http://www.exit1.org/Event-RPC/ If your system meets the requirements mentioned above, installation is just: perl Makefile.PL make test make install To test a specific Event loop implementation, export the variable EVENT_RPC_LOOP: export EVENT_RPC_LOOP=Event::RPC::Loop::Glib make test Otherwise Event::RPC will fallback to the most appropriate module installed on your system. =head1 EXAMPLES The tarball includes an examples/ directory which contains two programs: server.pl client.pl Just execute them with --help to get the usage. They do some very simple communication but are good to test your setup, in particular in a mixed environment. =head1 LIMITATIONS Although the classes and objects on the server are accessed transparently by the client there are some limitations should be aware of. With a clean object oriented design these should be no problem in real applications: =head2 Direct object data manipulation is forbidden All objects reside on the server and they keep there! The client just has specially wrapped proxy objects, which trigger the necessary magic to access the object's B on the server. Complete objects are never transferred from the server to the client, so something like this does B work: $object->{data} = "changed data"; (assuming $object is a hash ref on the server). Only method calls are transferred to the server, so even for "simple" data manipulation a method call is necessary: $object->set_data ("changed data"); As well for reading an object attribute. Accessing a hash key will fail: my $data = $object->{data}; Instead call a method which returns the 'data' member: my $data = $object->get_data; =head2 Methods may exchange objects, but not in a too complex structure Event::RPC handles methods which return objects. The only requirement is that they are declared as a B on the server (refer to Event::RPC::Server for details), but not if the object is hidden inside a deep complex data structure. An array or hash ref of objects is Ok, but not more. This would require to much expensive runtime data inspection. Object receiving parameters are more restrictive, since even hiding them inside one array or hash ref is not allowed. They must be passed as a direkt argument of the method subroutine. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/0000755000175000017500000000000012270455742014440 5ustar joernjoernEvent-RPC-1.04/lib/Event/RPC/Client.pm0000644000175000017500000005126512270422530016212 0ustar joernjoern# $Id: Client.pm,v 1.18 2013-02-02 11:24:31 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Client; use Event::RPC; use Event::RPC::Message; use Carp; use strict; use IO::Socket::INET; sub get_client_version { $Event::RPC::VERSION } sub get_client_protocol { $Event::RPC::PROTOCOL } sub get_host { shift->{host} } sub get_port { shift->{port} } sub get_sock { shift->{sock} } sub get_timeout { shift->{timeout} } sub get_classes { shift->{classes} } sub get_class_map { shift->{class_map} } sub get_loaded_classes { shift->{loaded_classes} } sub get_error_cb { shift->{error_cb} } sub get_ssl { shift->{ssl} } sub get_ssl_ca_file { shift->{ssl_ca_file} } sub get_ssl_ca_path { shift->{ssl_ca_path} } sub get_auth_user { shift->{auth_user} } sub get_auth_pass { shift->{auth_pass} } sub get_connected { shift->{connected} } sub get_server { shift->{server} } sub get_server_version { shift->{server_version} } sub get_server_protocol { shift->{server_protocol} } sub set_host { shift->{host} = $_[1] } sub set_port { shift->{port} = $_[1] } sub set_sock { shift->{sock} = $_[1] } sub set_timeout { shift->{timeout} = $_[1] } sub set_classes { shift->{classes} = $_[1] } sub set_class_map { shift->{class_map} = $_[1] } sub set_loaded_classes { shift->{loaded_classes} = $_[1] } sub set_error_cb { shift->{error_cb} = $_[1] } sub set_ssl { shift->{ssl} = $_[1] } sub set_ssl_ca_file { shift->{ssl_ca_file} = $_[1] } sub set_ssl_ca_path { shift->{ssl_ca_path} = $_[1] } sub set_auth_user { shift->{auth_user} = $_[1] } sub set_auth_pass { shift->{auth_pass} = $_[1] } sub set_connected { shift->{connected} = $_[1] } sub set_server { shift->{server} = $_[1] } sub set_server_version { shift->{server_version} = $_[1] } sub set_server_protocol { shift->{server_protocol} = $_[1] } sub new { my $class = shift; my %par = @_; my ($server, $host, $port, $classes, $class_map, $error_cb, $timeout) = @par{'server','host','port','classes','class_map','error_cb','timeout'}; my ($ssl, $ssl_ca_file, $auth_user, $auth_pass) = @par{'ssl','ssl_ca_file','auth_user','auth_pass'}; $server ||= ''; $host ||= ''; if ( $server ne '' and $host eq '' ) { warn "Option 'server' is deprecated. Use 'host' instead."; $host = $server; } my $self = bless { host => $server, server => $host, port => $port, timeout => $timeout, classes => $classes, class_map => $class_map, ssl => $ssl, ssl_ca_file => $ssl_ca_file, auth_user => $auth_user, auth_pass => $auth_pass, error_cb => $error_cb, loaded_classes => {}, connected => 0, }, $class; return $self; } sub connect { my $self = shift; croak "Client is already connected" if $self->get_connected; my $ssl = $self->get_ssl; my $server = $self->get_server; my $port = $self->get_port; my $timeout = $self->get_timeout; if ( $ssl ) { eval { require IO::Socket::SSL }; croak "SSL requested, but IO::Socket::SSL not installed" if $@; } my $sock; if ( $ssl ) { my @verify_opts; if ( $self->get_ssl_ca_file or $self->get_ssl_ca_path ) { push @verify_opts, ( 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 => IO::Socket::SSL::SSL_VERIFY_NONE(), ); } $sock = IO::Socket::SSL->new( Proto => 'tcp', PeerPort => $port, PeerAddr => $server, Type => SOCK_STREAM, Timeout => $timeout, @verify_opts ) or croak "Can't open SSL connection to $server:$port: $IO::Socket::SSL::ERROR"; } else { $sock = IO::Socket::INET->new( Proto => 'tcp', PeerPort => $port, PeerAddr => $server, Type => SOCK_STREAM, Timeout => $timeout, ) or croak "Can't open connection to $server:$port - $!"; } $sock->autoflush(1); $self->set_sock($sock); $self->check_version; my $auth_user = $self->get_auth_user; my $auth_pass = $self->get_auth_pass; if ( $auth_user ) { my $rc = $self->send_request( { cmd => 'auth', user => $auth_user, pass => $auth_pass, } ); if ( not $rc->{ok} ) { $self->disconnect; croak $rc->{msg}; } } if ( not $self->get_classes ) { $self->load_all_classes; } else { $self->load_classes; } $self->set_connected(1); 1; } sub log_connect { my $class = shift; my %par = @_; my ( $server, $port ) = @par{ 'server', 'port' }; my $sock = IO::Socket::INET->new( Proto => 'tcp', PeerPort => $port, PeerAddr => $server, Type => SOCK_STREAM ) or croak "Can't open connection to $server:$port - $!"; return $sock; } sub disconnect { my $self = shift; close( $self->get_sock ) if $self->get_sock; $self->set_connected(0); 1; } sub DESTROY { shift->disconnect; } sub error { my $self = shift; my ($message) = @_; my $error_cb = $self->get_error_cb; if ($error_cb) { &$error_cb( $self, $message ); } else { die "Unhandled error in client/server communication: $message"; } 1; } sub check_version { my $self = shift; my $rc = $self->send_request( { cmd => 'version', } ); $self->set_server_version( $rc->{version} ); $self->set_server_protocol( $rc->{protocol} ); if ( $rc->{version} ne $self->get_client_version ) { warn "Event::RPC warning: server version $rc->{version} != " . "client version " . $self->get_client_version; } if ( $rc->{protocol} < $self->get_client_protocol ) { die "FATAL: Server protocol version $rc->{protocol} < " . "client protocol version " . $self->get_client_protocol; } 1; } sub load_all_classes { my $self = shift; my $rc = $self->send_request( { cmd => 'class_info_all', } ); my $class_info_all = $rc->{class_info_all}; foreach my $class ( keys %{$class_info_all} ) { $self->load_class( $class, $class_info_all->{$class} ); } 1; } sub load_classes { my $self = shift; my $classes = $self->get_classes; my %classes; @classes{ @{$classes} } = (1) x @{$classes}; my $rc = $self->send_request( { cmd => 'classes_list', } ); foreach my $class ( @{ $rc->{classes} } ) { next if not $classes{$class}; $classes{$class} = 0; my $rc = $self->send_request( { cmd => 'class_info', class => $class, } ); $self->load_class( $class, $rc->{methods} ); } foreach my $class ( @{$classes} ) { warn "WARNING: Class '$class' not exported by server" if $classes{$class}; } 1; } sub load_class { my $self = shift; my ( $class, $methods ) = @_; my $loaded_classes = $self->get_loaded_classes; return 1 if $loaded_classes->{$class}; $loaded_classes->{$class} = 1; my $local_method; my $class_map = $self->get_class_map; my $local_class = $class_map->{$class} || $class; # create local destructor for this class { no strict 'refs'; my $local_method = $local_class . '::' . "DESTROY"; *$local_method = sub { return if not $self->get_connected; my $oid_ref = shift; $self->send_request({ cmd => "client_destroy", oid => ${$oid_ref}, }); }; } # create local methods for this class foreach my $method ( keys %{$methods} ) { $local_method = $local_class . '::' . $method; my $method_type = $methods->{$method}; if ( $method_type eq '_constructor' ) { # this is a constructor for this class my $request_method = $class . '::' . $method; no strict 'refs'; *$local_method = sub { shift; my $rc = $self->send_request({ cmd => 'new', method => $request_method, params => \@_, }); my $oid = $rc->{oid}; return bless \$oid, $local_class; }; } elsif ( $method_type eq '1' ) { # this is a simple method my $request_method = $method; no strict 'refs'; *$local_method = sub { my $oid_ref = shift; my $rc = $self->send_request({ cmd => 'exec', oid => ${$oid_ref}, method => $request_method, params => \@_, }); return unless $rc; $rc = $rc->{rc}; return @{$rc} if wantarray; return $rc->[0]; }; } else { # this is a object returner my $request_method = $method; no strict 'refs'; *$local_method = sub { my $oid_ref = shift; my $rc = $self->send_request({ cmd => 'exec', oid => ${$oid_ref}, method => $request_method, params => \@_, }); return unless $rc; $rc = $rc->{rc}; foreach my $val ( @{$rc} ) { if ( ref $val eq 'ARRAY' ) { foreach my $list_elem ( @{$val} ) { my ($class) = split( "=", "$list_elem", 2 ); $self->load_class($class) unless $loaded_classes->{$class}; my $list_elem_copy = $list_elem; $list_elem = \$list_elem_copy; bless $list_elem, ( $class_map->{$class} || $class ); } } elsif ( ref $val eq 'HASH' ) { foreach my $hash_elem ( values %{$val} ) { my ($class) = split( "=", "$hash_elem", 2 ); $self->load_class($class) unless $loaded_classes->{$class}; my $hash_elem_copy = $hash_elem; $hash_elem = \$hash_elem_copy; bless $hash_elem, ( $class_map->{$class} || $class ); } } elsif ( defined $val ) { my ($class) = split( "=", "$val", 2 ); $self->load_class($class) unless $loaded_classes->{$class}; my $val_copy = $val; $val = \$val_copy; bless $val, ( $class_map->{$class} || $class ); } } return @{$rc} if wantarray; return $rc->[0]; }; } } return $local_class; } sub send_request { my $self = shift; my ($request) = @_; my $message = Event::RPC::Message->new( $self->get_sock ); $message->write_blocked($request); my $rc = eval { $message->read_blocked }; if ($@) { $self->error($@); return; } if ( not $rc->{ok} ) { $rc->{msg} .= "\n" if not $rc->{msg} =~ /\n$/; croak ("$rc->{msg} -- called via Event::RPC::Client"); } return $rc; } 1; __END__ =head1 NAME Event::RPC::Client - Client API to connect to Event::RPC Servers =head1 SYNOPSIS use Event::RPC::Client; my $rpc_client = Event::RPC::Client->new ( #-- Required arguments host => "localhost", port => 5555, #-- Optional arguments classes => [ "Event::RPC::Test" ], class_map => { "Event::RPC::Test" => "My::Event::RPC::Test" }, ssl => 1, ssl_ca_file => "some/ca.crt", ssl_ca_path => "some/ca/dir", timeout => 10, auth_user => "fred", auth_pass => Event::RPC->crypt("fred",$password), error_cb => sub { my ($client, $error) = @_; print "An RPC error occured: $error\n"; $client->disconnect; exit; }, ); $rpc_client->connect; #-- And now use classes and methods the server #-- allows to 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"; $obj->set_data("new foobar"); print "updated data: ".$obj->get_data."\n"; $rpc_client->disconnect; =head1 DESCRIPTION Use this module to write clients accessing objects and methods exported by a Event::RPC driven server. Just connect to the server over the network, optionally with SSL and user authentication, and then simply use the exported classes and methods like having them locally in the client. General information about the architecture of Event::RPC driven applications is collected in the Event::RPC manpage. The following documentation describes the client connection options in detail. =head1 CONFIGURATION OPTIONS You need to specify at least the server hostname and TCP port to connect a Event::RPC server instance. If the server requires a SSL connection or user authentication you need to supply the corresponding options as well, otherwise connecting will fail. All options described here may be passed to the new() constructor of Event::RPC::Client. As well you may set or modify them using set_OPTION style mutators, but not after connect() was called! All options may be read using get_OPTION style accessors. =head2 REQUIRED OPTIONS These are necessary to connect the server: =over 4 =item B This is the hostname of the server running Event::RPC::Server. Use a IP address or DNS name here. =item B This is the TCP port the server is listening to. =back =head2 NETWORK OPTIONS =over 4 =item B Specify a timeout (in seconds), which is applied when connecting the server. =back =head2 CLASS IMPORT OPTION =over 4 =item B This is reference to a list of classes which should be imported into the client. You get a warning if you request a class which is not exported by the server. By default all server classes are imported. Use this feature if your server exports a huge list of classes, but your client doesn't need all of them. This saves memory in the client and connect performance increases. =item B Optionally you can map the class names from the server to a different name on the local client using the B hash. This is necessary if you like to use the same classes locally and remotely. Imported classes from the server are by default registered under the same name on the client, so this conflicts with local classes named identically. On the client you access the remote classes under the name assigned in the class map. For example with this map class_map => { "Event::ExecFlow::Job" => "_srv::Event::ExecFlow::Job" } you need to write this on the client, if you like to create an object remotely on the server: my $server_job = _srv::Event::ExecFlow::Job->new ( ... ); and this to create an object on the client: my $client_job = Event::ExecFlow::Job->new ( ... ); The server knows nothing of the renaming on client side, so you still write this on the server to create objects there: my $job = Event::ExecFlow::Job->new ( ... ); =back =head2 SSL OPTIONS If the server accepts only SSL connections you need to enable ssl here in the client as well. By default the SSL connection will be established without any peer verification, which makes Man-in-the-Middle attacks possible. If you want to prevent that, you need to set either B or B option. =over 4 =item B Set this option to 1 to encrypt the network connection using SSL. =item B Path to the the Certificate Authority's certificate file (ca.crt), your server key was signed with. =item B Path of a directory containing several trusted certificates with a proper index. Please refer to the OpenSSL documentation for details about setting up such a directory. =back =head2 AUTHENTICATION OPTIONS If the server requires user authentication you need to set the following options: =over 4 =item B A valid username. =item B The corresponding password, encrypted using Perl's crypt() function, using the username as the salt. Event::RPC has a convenience function for generating such a crypted password, although it's currently just a wrapper around Perl's builtin crypt() function, but probably this changes someday, so better use this method: $crypted_pass = Event::RPC->crypt($user, $pass); =back If the passed credentials are invalid the Event::RPC::Client->connect() method throws a correspondent exception. =head2 ERROR HANDLING Any exceptions thrown on the server during execution of a remote method will result in a corresponding exception on the client. So you can use normal exception handling with eval {} when executing remote methods. But besides this the network connection between your client and the server may break at any time. This raises an exception as well, but you can override this behaviour with the following attribute: =over 4 =item B This subroutine is called if any error occurs in the network communication between the client and the server. The actual Event::RPC::Client object and an error string are passed as arguments. This is B generic exception handler for exceptions thrown from the executed methods on the server! If you like to catch such exceptions you need to put an eval {} around your method calls, as you would do for local method calls. If you don't specify an B an exception is thrown instead. =back =head1 METHODS =over 4 =item $rpc_client->B This establishes the configured connection to the server. An exception is thrown if something goes wrong, e.g. server not available, credentials are invalid or something like this. =item $rpc_client->B Closes the connection to the server. You may omit explicit disconnecting since it's done automatically once the Event::RPC::Client object gets destroyed. =back =head1 READY ONLY ATTRIBUTES =over 4 =item $rpc_client->B Returns the Event::RPC version number of the server after connecting. =item $rpc_client->B Returns the Event::RPC protocol number of the server after connecting. =item $rpc_client->B Returns the Event::RPC version number of the client. =item $rpc_client->B Returns the Event::RPC protocol number of the client. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Message.pm0000644000175000017500000001076712270423040016357 0ustar joernjoern# $Id: Message.pm,v 1.7 2009-04-22 10:53:51 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message; use Carp; use strict; use Storable; my $DEBUG = 0; sub get_sock { shift->{sock} } sub get_buffer { shift->{buffer} } sub get_length { shift->{length} } sub get_written { shift->{written} } sub set_buffer { shift->{buffer} = $_[1] } sub set_length { shift->{length} = $_[1] } sub set_written { shift->{written} = $_[1] } sub new { my $class = shift; my ($sock) = @_; my $self = bless { sock => $sock, buffer => undef, length => 0, written => 0, }, $class; return $self; } 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"; my $rc = sysread ($self->get_sock, $length_packed, 4); $DEBUG && print "DEBUG: header read rc=$rc\n"; 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; } my $buffer_length = length($self->{buffer}||''); $DEBUG && print "DEBUG: going to read packet... (buffer_length=$buffer_length)\n"; my $rc = sysread ( $self->get_sock, $self->{buffer}, $self->{length} - $buffer_length, $buffer_length ); $DEBUG && print "DEBUG: packet read rc=$rc\n"; return if not defined $rc; die "DISCONNECTED" if $rc == 0; $buffer_length = length($self->{buffer}); $DEBUG && print "DEBUG: more to read... ($self->{length} != $buffer_length)\n" if $self->{length} != $buffer_length; return if $self->{length} != $buffer_length; $DEBUG && print "DEBUG: read finished, length=$buffer_length\n"; my $data = Storable::thaw($self->{buffer}); $self->{buffer} = undef; $self->{length} = 0; return $data; } sub read_blocked { my $self = shift; my $rc; $rc = $self->read(1) while not defined $rc; return $rc; } sub set_data { my $self = shift; my ($data) = @_; $DEBUG && print "DEBUG: Message->set_data($data)\n"; my $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}, $self->{length}-$self->{written}, $self->{written}, ); $DEBUG && print "DEBUG: written rc=$rc\n"; return if not defined $rc; $self->{written} += $rc; if ( $self->{written} == $self->{length} ) { $DEBUG && print "DEBUG: write finished\n"; $self->{buffer} = undef; $self->{length} = 0; return 1; } $DEBUG && print "DEBUG: more to be written...\n"; return; } sub write_blocked { my $self = shift; my ($data) = @_; $self->set_data($data); my $finished = 0; $finished = $self->write(1) while not $finished; 1; } 1; __END__ =head1 NAME Event::RPC::Message - Implementation of Event::RPC network protocol =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements the network protocol of Event::RPC. Objects of this class are created internally by Event::RPC::Server and Event::RPC::Client and performs message passing over the network. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/AuthPasswdHash.pm0000644000175000017500000000076110400606651017657 0ustar joernjoernpackage Event::RPC::AuthPasswdHash; use strict; use Carp; sub get_passwd_href { shift->{passwd_href} } sub set_passwd_href { shift->{passwd_href} = $_[1] } sub new { my $class = shift; my ($passwd_href) = @_; my $self = bless { passwd_href => $passwd_href, }; return $self; } sub check_credentials { my $self = shift; my ($user, $pass) = @_; return $pass eq $self->get_passwd_href->{$user}; } 1; Event-RPC-1.04/lib/Event/RPC/LogConnection.pm0000644000175000017500000000434411173573143017541 0ustar joernjoernpackage Event::RPC::LogConnection; use Carp; use Socket; my $LOG_CONNECTION_ID; sub get_cid { shift->{cid} } sub get_sock { shift->{sock} } sub get_server { shift->{server} } sub get_watcher { shift->{watcher} } sub set_watcher { shift->{watcher} = $_[1] } sub new { my $class = shift; my ($server, $sock) = @_; my $cid = ++$LOG_CONNECTION_ID; my $self = bless { cid => $cid, sock => $sock, server => $server, watcher => undef, }, $class; $self->{watcher} = $server->get_loop->add_io_watcher( fh => $sock, poll => 'r', cb => sub { $self->input; 1 }, desc => "log reader $cid", ); $self->get_server->log (2, "Got new logger connection. Connection ID is $cid" ); return $self; } sub disconnect { my $self = shift; my $sock = $self->get_sock; $self->get_server->get_logger->remove_fh($sock) if $self->get_server->get_logger; $self->get_server->get_loop->del_io_watcher($self->get_watcher); $self->set_watcher(undef); close $sock; $self->get_server->set_log_clients_connected ( $self->get_server->get_log_clients_connected - 1 ); delete $self->get_server->get_logging_clients->{$self->get_cid}; $self->get_server->log(2, "Log client disconnected"); 1; } sub input { my $self = shift; my $buffer; $self->disconnect if not sysread($self->get_sock, $buffer, 4096); 1; } 1; __END__ =head1 NAME Event::RPC::LogConnection - Represents a logging connection =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION Objects of this class are created by Event::RPC server if a client connects to the logging port of the server. It's an internal module and has no public interface. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Connection.pm0000644000175000017500000004233012270302674017072 0ustar joernjoernpackage Event::RPC::Connection; use strict; use Carp; my $CONNECTION_ID; sub get_cid { shift->{cid} } sub get_sock { shift->{sock} } sub get_server { shift->{server} } sub get_classes { shift->{server}->{classes} } sub get_loaded_classes { shift->{server}->{loaded_classes} } 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] } sub new { my $class = shift; my ($server, $sock) = @_; my $cid = ++$CONNECTION_ID; my $self = bless { cid => $cid, sock => $sock, server => $server, is_authenticated => (!$server->get_auth_required), auth_user => "", watcher => undef, write_watcher => undef, message => undef, client_oids => {}, }, $class; if ( $sock ) { $self->log (2, "Got new RPC connection. Connection ID is $cid" ); $self->{watcher} = $self->get_server->get_loop->add_io_watcher ( fh => $sock, poll => 'r', cb => sub { $self->input; 1 }, desc => "rpc client cid=$cid", ); } my $connection_hook = $server->get_connection_hook; &$connection_hook($self, "connect") if $connection_hook; return $self; } 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; $server->set_clients_connected ( $self->get_server->get_clients_connected - 1 ); foreach my $oid ( keys %{$self->get_client_oids} ) { $server->deregister_object($oid); } $self->log(2, "Client disconnected"); my $connection_hook = $server->get_connection_hook; &$connection_hook($self, "disconnect") if $connection_hook; 1; } sub get_client_object { my $self = shift; my ($oid) = @_; croak "No object registered with oid '$oid'" unless $self->get_client_objects->{$oid}; return $self->get_client_objects->{$oid}; } sub log { my $self = shift; my ($level, $msg); if ( @_ == 2 ) { ($level, $msg) = @_; } else { ($msg) = @_; $level = 1; } $msg = "cid=".$self->get_cid.": $msg"; return $self->get_server->log ($level, $msg); } sub input { my $self = shift; my ($e) = @_; my $server = $self->get_server; my $message = $self->get_message; if ( not $message ) { $message = Event::RPC::Message->new ($self->get_sock); $self->set_message($message); } my $request = eval { $message->read } || ''; my $error = $@; return if $request eq '' && $error eq ''; $self->set_message(undef); return $self->disconnect if $request eq "DISCONNECT\n" or $error =~ /DISCONNECTED/; $server->set_active_connection($self); my ($cmd, $rc); $cmd = $request->{cmd} if not $error; $self->log(4, "RPC command: $cmd"); if ( $error ) { $self->log ("Unexpected error on incoming RPC call: $@"); $rc = { ok => 0, msg => "Unexpected error on incoming RPC call: $@", }; } elsif ( $cmd eq 'version' ) { $rc = { ok => 1, version => $Event::RPC::VERSION, protocol => $Event::RPC::PROTOCOL, }; } elsif ( $cmd eq 'auth' ) { $rc = $self->authorize_user ($request); } elsif ( $server->get_auth_required && !$self->get_is_authenticated ) { $rc = { ok => 0, msg => "Authorization required", }; } elsif ( $cmd eq 'new' ) { $rc = $self->create_new_object ($request); } elsif ( $cmd eq 'exec' ) { $rc = $self->execute_object_method ($request); } elsif ( $cmd eq 'classes_list' ) { $rc = $self->get_classes_list ($request); } elsif ( $cmd eq 'class_info' ) { $rc = $self->get_class_info ($request); } elsif ( $cmd eq 'class_info_all' ) { $rc = $self->get_class_info_all ($request); } elsif ( $cmd eq 'client_destroy' ) { $rc = $self->object_destroyed_on_client ($request); } else { $self->log ("Unknown request command '$cmd'"); $rc = { ok => 0, msg => "Unknown request command '$cmd'", }; } $server->set_active_connection(undef); $message->set_data($rc); my $watcher = $self->get_server->get_loop->add_io_watcher ( fh => $self->get_sock, poll => 'w', cb => sub { 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; } sub authorize_user { my $self = shift; my ($request) = @_; my $user = $request->{user}; my $pass = $request->{pass}; my $auth_module = $self->get_server->get_auth_module; return { ok => 1, msg => "Not authorization required", } unless $auth_module; my $ok = $auth_module->check_credentials ($user, $pass); if ( $ok ) { $self->set_auth_user($user); $self->set_is_authenticated(1); $self->log("User '$user' successfully authorized"); return { ok => 1, msg => "Credentials Ok", }; } else { $self->log("Illegal credentials for user '$user'"); return { ok => 0, msg => "Illegal credentials", }; } } sub create_new_object { my $self = shift; my ($request) = @_; # Let's create a new object my $class_method = $request->{method}; my $class = $class_method; $class =~ s/::[^:]+$//; $class_method =~ s/^.*:://; # check if access to this class/method is allowed if ( not defined $self->get_classes->{$class}->{$class_method} or $self->get_classes->{$class}->{$class_method} ne '_constructor' ) { $self->log ("Illegal constructor access to $class->$class_method"); return { ok => 0, msg => "Illegal constructor access to $class->$class_method" }; } # load the class if not done yet $self->load_class($class) if $self->get_server->get_load_modules; # resolve object params $self->resolve_object_params ($request->{params}); # ok, the class is there, let's execute the method my $object = eval { $class->$class_method (@{$request->{params}}) }; # report error if ( $@ ) { $self->log ("Error: can't create object ". "($class->$class_method): $@"); return { ok => 0, msg => $@, }; } # register object $self->get_server->register_object ($object, $class); $self->get_client_oids->{"$object"} = 1; # log and return $self->log (5, "Created new object $class->$class_method with oid '$object'", ); return { ok => 1, oid => "$object", }; } sub load_class { my $self = shift; my ($class) = @_; my $mtime; my $load_class_info = $self->get_loaded_classes->{$class}; if ( not $load_class_info or ( $self->get_server->get_auto_reload_modules && ( $mtime = (stat($load_class_info->{filename}))[9]) > $load_class_info->{mtime} ) ) { if ( not $load_class_info->{filename} ) { my $filename; my $rel_filename = $class; $rel_filename =~ s!::!/!g; $rel_filename .= ".pm"; foreach my $dir ( @INC ) { $filename = "$dir/$rel_filename", last if -f "$dir/$rel_filename"; } croak "File for class '$class' not found" if not $filename; $load_class_info->{filename} = $filename; $load_class_info->{mtime} = 0; } $mtime ||= 0; $self->log (3, "Class '$class' ($load_class_info->{filename}) changed on disk. Reloading...") if $mtime > $load_class_info->{mtime}; do $load_class_info->{filename}; if ( $@ ) { $self->log ("Can't load class '$class': $@"); $load_class_info->{mtime} = 0; return { ok => 0, msg => "Can't load class $class: $@", }; } else { $self->log (3, "Class '$class' successfully loaded"); $load_class_info->{mtime} = time; } } $self->log (5, "filename=".$load_class_info->{filename}. ", mtime=".$load_class_info->{mtime} ); $self->get_loaded_classes->{$class} ||= $load_class_info; 1; } sub execute_object_method { my $self = shift; my ($request) = @_; # Method call of an existent object my $oid = $request->{oid}; my $object_entry = $self->get_objects->{$oid}; my $method = $request->{method}; if ( not defined $object_entry ) { # object does not exists $self->log ("Illegal access to unknown object with oid=$oid"); return { ok => 0, msg => "Illegal access to unknown object with oid=$oid" }; } my $class = $object_entry->{class}; if ( not defined $self->get_classes->{$class} or not defined $self->get_classes->{$class}->{$method} ) { # illegal access to this method $self->log ("Illegal access to $class->$method"); return { ok => 0, msg => "Illegal access to $class->$method" }; } my $return_type = $self->get_classes->{$class}->{$method}; # (re)load the class if not done yet $self->load_class($class) if $self->get_server->get_load_modules; # resolve object params $self->resolve_object_params ($request->{params}); # ok, try executing the method my @rc = eval { $object_entry->{object}->$method (@{$request->{params}}) }; # report error if ( $@ ) { $self->log ("Error: can't call '$method' of object ". "with oid=$oid: $@"); return { ok => 0, msg => "$@", }; } # log $self->log (4, "Called method '$method' of object ". "with oid=$oid"); if ( $return_type eq '_object' ) { # check if objects are returned by this method # and register them in our internal object table # (if not already done yet) my $key; foreach my $rc ( @rc ) { if ( ref ($rc) and ref ($rc) !~ /ARRAY|HASH|SCALAR/ ) { # returns a single object $self->log (4, "Method returns object: $rc"); $key = "$rc"; $self->get_client_oids->{$key} = 1; $self->get_server->register_object($rc, ref $rc); $rc = $key; } elsif ( ref $rc eq 'ARRAY' ) { # possibly returns a list of objects # make a copy, otherwise the original object references # will be overwritten my @val = @{$rc}; $rc = \@val; foreach my $val ( @val ) { if ( ref ($val) and ref ($val) !~ /ARRAY|HASH|SCALAR/ ) { $self->log (4, "Method returns object lref: $val"); $key = "$val"; $self->get_client_oids->{$key} = 1; $self->get_server->register_object($val, ref $val); $val = $key; } } } elsif ( ref $rc eq 'HASH' ) { # possibly returns a hash of objects # make a copy, otherwise the original object references # will be overwritten my %val = %{$rc}; $rc = \%val; foreach my $val ( values %val ) { if ( ref ($val) and ref ($val) !~ /ARRAY|HASH|SCALAR/ ) { $self->log (4, "Method returns object href: $val"); $key = "$val"; $self->get_client_oids->{$key} = 1; $self->get_server->register_object($val, ref $val); $val = $key; } } } } } # return rc return { ok => 1, rc => \@rc, }; } sub object_destroyed_on_client { my $self = shift; my ($request) = @_; $self->log(5, "Object with oid=$request->{oid} destroyed on client"); delete $self->get_client_oids->{$request->{oid}}; $self->get_server->deregister_object($request->{oid}); return { ok => 1 }; } sub get_classes_list { my $self = shift; my ($request) = @_; my @classes = keys %{$self->get_classes}; return { ok => 1, classes => \@classes, } } sub get_class_info { my $self = shift; my ($request) = @_; my $class = $request->{class}; if ( not defined $self->get_classes->{$class} ) { $self->log ("Unknown class '$class'"); return { ok => 0, msg => "Unknown class '$class'" }; } $self->log (4, "Class info for '$class' requested"); return { ok => 1, methods => $self->get_classes->{$class}, }; } sub get_class_info_all { my $self = shift; my ($request) = @_; return { ok => 1, class_info_all => $self->get_classes, } } sub resolve_object_params { my $self = shift; my ($params) = @_; my $key; foreach my $par ( @{$params} ) { if ( defined $self->get_classes->{ref($par)} ) { $key = ${$par}; $key = "$key"; croak "unknown object with key '$key'" if not defined $self->get_objects->{$key}; $par = $self->get_objects->{$key}->{object}; } } 1; } 1; __END__ =head1 NAME Event::RPC::Connection - Represents a RPC connection =head1 SYNOPSIS Note: you never create instances of this class in your own code, it's only used internally by Event::RPC::Server. But you may request connection objects using the B of Event::RPC::Server and then having some read access on them. my $connection = Event::RPC::Server::Connection->new ( $rpc_server, $client_socket ); As well you can get the currently active connection from your Event::RPC::Server object: my $server = Event::RPC::Server->instance; my $connection = $server->get_active_connection; =head1 DESCRIPTION Objects of this class represents a connection from an Event::RPC::Client to an Event::RPC::Server instance. They live inside the server and the whole Client/Server protocol is implemented here. =head1 READ ONLY ATTRIBUTES The following attributes may be read using the corresponding get_ATTRIBUTE accessors: =over 4 =item B The connection ID of this connection. A number which is unique for this server instance. =item B The Event::RPC::Server instance this connection belongs to. =item B This boolean value reflects whether the connection is authenticated resp. whether the client passed correct credentials. =item B This is the name of the user who was authenticated successfully for this connection. =item B This is a hash reference of object id's which are in use by the client of this connection. Keys are the object ids, value is always 1. You can get the corresponding objects by using the $connection->get_client_object($oid) method. Don't change anything in this hash, in particular don't delete or add entries. Event::RPC does all the necessary garbage collection transparently, no need to mess with that. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Loop/0000755000175000017500000000000012270455742015351 5ustar joernjoernEvent-RPC-1.04/lib/Event/RPC/Loop/AnyEvent.pm0000644000175000017500000000500511535414040017425 0ustar joernjoern# $Id: AnyEvent.pm,v 1.1 2011-03-08 11:50:56 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop::AnyEvent; use base qw( Event::RPC::Loop ); use strict; use AnyEvent; my %watchers; sub get_loop_cv { shift->{loop_cv} } sub set_loop_cv { shift->{loop_cv} = $_[1] } sub add_io_watcher { my $self = shift; my %par = @_; my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'}; my $watcher = AnyEvent->io ( fh => $fh, poll => $poll, cb => $cb, ); $watchers{"$watcher"} = $watcher; return $watcher; } sub del_io_watcher { my $self = shift; my ($watcher) = @_; delete $watchers{"$watcher"}; 1; } sub add_timer { my $self = shift; my %par = @_; my ($interval, $after, $cb, $desc) = @par{'interval','after','cb','desc'}; my $timer = AnyEvent->timer ( after => $after, interval => $interval, cb => $cb, ); $watchers{"$timer"} = $timer; return $timer; } sub del_timer { my $self = shift; my ($timer) = @_; delete $watchers{"$timer"}; 1; } sub enter { my $self = shift; my $loop_cv = AnyEvent->condvar; $self->set_loop_cv($loop_cv); $loop_cv->wait; 1; } sub leave { my $self = shift; $self->get_loop_cv->send; 1; } 1; __END__ =head1 NAME Event::RPC::Loop::AnyEvent - AnyEvent mainloop for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::AnyEvent; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::AnyEvent->new(), ... ); $server->start; =head1 DESCRIPTION This modules implements a mainloop using AnyEvent for the Event::RPC::Server module. It implements the interface of Event::RPC::Loop. Please refer to the manpage of Event::RPC::Loop for details. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Loop/Glib.pm0000644000175000017500000000542111173573477016575 0ustar joernjoern# $Id: Glib.pm,v 1.4 2009-04-22 10:53:51 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop::Glib; use base qw( Event::RPC::Loop ); use strict; use Glib; sub get_glib_main_loop { shift->{glib_main_loop} } sub set_glib_main_loop { shift->{glib_main_loop} = $_[1] } sub add_io_watcher { my $self = shift; my %par = @_; my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'}; my $cond = $poll eq 'r' ? ['G_IO_IN', 'G_IO_HUP']: ['G_IO_OUT','G_IO_HUP']; return Glib::IO->add_watch ($fh->fileno, $cond, sub { &$cb(); 1 } ); } sub del_io_watcher { my $self = shift; my ($watcher) = @_; Glib::Source->remove ($watcher); 1; } sub add_timer { my $self = shift; my %par = @_; my ($interval, $after, $cb, $desc) = @par{'interval','after','cb','desc'}; die "interval and after can't be used together" if $interval && $after; if ( $interval ) { return Glib::Timeout->add ( $interval * 1000, sub { &$cb(); 1 } ); } else { return Glib::Timeout->add ( $after * 1000, sub { &$cb(); 0 } ); } 1; } sub del_timer { my $self = shift; my ($timer) = @_; Glib::Source->remove($timer); 1; } sub enter { my $self = shift; Glib->install_exception_handler(sub { print "Event::RPC::Loop::Glib caught an exception: $@\n"; 1; }); my $main_loop = Glib::MainLoop->new; $self->set_glib_main_loop($main_loop); $main_loop->run; 1; } sub leave { my $self = shift; $self->get_glib_main_loop->quit; 1; } 1; __END__ =head1 NAME Event::RPC::Loop::Glib - Glib mainloop for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::Glib; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::Glib->new(), ... ); $server->start; =head1 DESCRIPTION This modules implements a mainloop using Glib for the Event::RPC::Server module. It implements the interface of Event::RPC::Loop. Please refer to the manpage of Event::RPC::Loop for details. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Loop/Event.pm0000644000175000017500000000445611535413506016774 0ustar joernjoern# $Id: Event.pm,v 1.4 2009-04-22 10:53:51 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop::Event; use base qw( Event::RPC::Loop ); use strict; use Event; sub add_io_watcher { my $self = shift; my %par = @_; my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'}; return Event->io ( fd => $fh, poll => $poll, cb => $cb, desc => $desc, reentrant => 0, ); } sub del_io_watcher { my $self = shift; my ($watcher) = @_; $watcher->cancel; 1; } sub add_timer { my $self = shift; my %par = @_; my ($interval, $after, $cb, $desc) = @par{'interval','after','cb','desc'}; die "interval and after can't be used together" if $interval && $after; return Event->timer ( interval => $interval, after => $after, cb => $cb, desc => $desc, ); } sub del_timer { my $self = shift; my ($timer) = @_; $timer->cancel; 1; } sub enter { my $self = shift; Event::loop(); 1; } sub leave { my $self = shift; Event::unloop_all("ok"); 1; } 1; __END__ =head1 NAME Event::RPC::Loop::Event - Event mainloop for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::Event; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::Event->new(), ... ); $server->start; =head1 DESCRIPTION This modules implements a mainloop using the Event module for the Event::RPC::Server module. It implements the interface of Event::RPC::Loop. Please refer to the manpage of Event::RPC::Loop for details. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Server.pm0000644000175000017500000006346712270304442016252 0ustar joernjoern# $Id: Server.pm,v 1.14 2011-03-08 11:50:56 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Server; use Event::RPC; use Event::RPC::Message; use Event::RPC::Connection; use Event::RPC::LogConnection; use Carp; use strict; use IO::Socket::INET; use Sys::Hostname; sub get_host { shift->{host} } sub get_port { shift->{port} } sub get_name { shift->{name} } sub get_loop { shift->{loop} } sub get_classes { shift->{classes} } sub get_loaded_classes { shift->{loaded_classes} } sub get_clients_connected { shift->{clients_connected} } sub get_log_clients_connected { shift->{log_clients_connected} } sub get_logging_clients { shift->{logging_clients} } sub get_logger { shift->{logger} } sub get_start_log_listener { shift->{start_log_listener} } sub get_objects { shift->{objects} } sub get_rpc_socket { shift->{rpc_socket} } sub get_ssl { shift->{ssl} } sub get_ssl_key_file { shift->{ssl_key_file} } sub get_ssl_cert_file { shift->{ssl_cert_file} } sub get_ssl_passwd_cb { shift->{ssl_passwd_cb} } sub get_auth_required { shift->{auth_required} } sub get_auth_passwd_href { shift->{auth_passwd_href} } sub get_auth_module { shift->{auth_module} } sub get_listeners_started { shift->{listeners_started} } sub get_connection_hook { shift->{connection_hook} } sub get_load_modules { shift->{load_modules} } sub get_auto_reload_modules { shift->{auto_reload_modules} } sub get_active_connection { shift->{active_connection} } sub set_host { shift->{host} = $_[1] } sub set_port { shift->{port} = $_[1] } sub set_name { shift->{name} = $_[1] } sub set_loop { shift->{loop} = $_[1] } sub set_classes { shift->{classes} = $_[1] } sub set_loaded_classes { shift->{loaded_classes} = $_[1] } sub set_clients_connected { shift->{clients_connected} = $_[1] } sub set_log_clients_connected { shift->{log_clients_connected}= $_[1] } sub set_logging_clients { shift->{logging_clients} = $_[1] } sub set_logger { shift->{logger} = $_[1] } sub set_start_log_listener { shift->{start_log_listener} = $_[1] } sub set_objects { shift->{objects} = $_[1] } sub set_rpc_socket { shift->{rpc_socket} = $_[1] } sub set_ssl { shift->{ssl} = $_[1] } sub set_ssl_key_file { shift->{ssl_key_file} = $_[1] } sub set_ssl_cert_file { shift->{ssl_cert_file} = $_[1] } sub set_ssl_passwd_cb { shift->{ssl_passwd_cb} = $_[1] } sub set_auth_required { shift->{auth_required} = $_[1] } sub set_auth_passwd_href { shift->{auth_passwd_href} = $_[1] } sub set_auth_module { shift->{auth_module} = $_[1] } sub set_listeners_started { shift->{listeners_started} = $_[1] } sub set_connection_hook { shift->{connection_hook} = $_[1] } sub set_load_modules { shift->{load_modules} = $_[1] } sub set_auto_reload_modules { shift->{auto_reload_modules} = $_[1] } sub set_active_connection { shift->{active_connection} = $_[1] } my $INSTANCE; sub instance { $INSTANCE } sub new { my $class = shift; my %par = @_; my ($host, $port, $classes, $name, $logger, $start_log_listener) = @par{'host','port','classes','name','logger','start_log_listener'}; my ($ssl, $ssl_key_file, $ssl_cert_file, $ssl_passwd_cb) = @par{'ssl','ssl_key_file','ssl_cert_file','ssl_passwd_cb'}; my ($auth_required, $auth_passwd_href, $auth_module, $loop) = @par{'auth_required','auth_passwd_href','auth_module','loop'}; my ($connection_hook, $auto_reload_modules, $load_modules) = @par{'connection_hook','auto_reload_modules','load_modules'}; $name ||= "Event-RPC-Server"; #-- for backwards compatibility 'load_modules' defaults to 1 if ( !exists $par{load_modules} ) { $load_modules = 1; } if ( not $loop ) { foreach my $impl ( qw/AnyEvent Event Glib/ ) { $loop = "Event::RPC::Loop::$impl"; eval "use $loop"; if ( $@ ) { $loop = undef; } else { $loop = $loop->new; last; } } die "It seems no supported event loop module is installed" unless $loop; } my $self = bless { host => $host, port => $port, name => $name, classes => $classes, logger => $logger, start_log_listener => $start_log_listener, loop => $loop, ssl => $ssl, ssl_key_file => $ssl_key_file, ssl_cert_file => $ssl_cert_file, ssl_passwd_cb => $ssl_passwd_cb, auth_required => $auth_required, auth_passwd_href => $auth_passwd_href, auth_module => $auth_module, load_modules => $load_modules, auto_reload_modules => $auto_reload_modules, connection_hook => $connection_hook, rpc_socket => undef, loaded_classes => {}, objects => {}, logging_clients => {}, clients_connected => 0, listeners_started => 0, log_clients_connected => 0, active_connection => undef, }, $class; $INSTANCE = $self; $self->log ($self->get_name." started"); return $self; } sub DESTROY { my $self = shift; my $rpc_socket = $self->get_rpc_socket; close ($rpc_socket) if $rpc_socket; 1; } sub setup_listeners { my $self = shift; #-- Listener options my $host = $self->get_host; my $port = $self->get_port; my @LocalHost = $host ? ( LocalHost => $host ) : (); $host ||= "*"; #-- get event loop manager my $loop = $self->get_loop; #-- setup rpc listener my $rpc_socket; if ( $self->get_ssl ) { eval { require IO::Socket::SSL }; croak "SSL requested, but IO::Socket::SSL not installed" if $@; croak "ssl_key_file not set" unless $self->get_ssl_key_file; croak "ssl_cert_file not set" unless $self->get_ssl_cert_file; $rpc_socket = IO::Socket::SSL->new ( Listen => SOMAXCONN, @LocalHost, LocalPort => $port, Proto => 'tcp', ReuseAddr => 1, SSL_verify_mode => 0x00, SSL_key_file => $self->get_ssl_key_file, SSL_cert_file => $self->get_ssl_cert_file, SSL_passwd_cb => $self->get_ssl_passwd_cb, ) or die "can't start SSL RPC listener: $IO::Socket::SSL::ERROR"; } else { $rpc_socket = IO::Socket::INET->new ( Listen => SOMAXCONN, @LocalHost, LocalPort => $port, Proto => 'tcp', ReuseAddr => 1, ) or die "can't start RPC listener: $!"; } $self->set_rpc_socket($rpc_socket); $loop->add_io_watcher ( fh => $rpc_socket, poll => 'r', cb => sub { $self->accept_new_client($rpc_socket); 1 }, desc => "rpc listener port $port", ); if ( $self->get_ssl ) { $self->log ("Started SSL RPC listener on port $host:$port"); } else { $self->log ("Started RPC listener on $host:$port"); } # setup log listener if ( $self->get_start_log_listener ) { my $log_socket = IO::Socket::INET->new ( Listen => SOMAXCONN, LocalPort => $port + 1, @LocalHost, Proto => 'tcp', ReuseAddr => 1, ) or die "can't start log listener: $!"; $loop->add_io_watcher ( fh => $log_socket, poll => 'r', cb => sub { $self->accept_new_log_client($log_socket); 1 }, desc => "log listener port ".($port+1), ); $self->log ("Started log listener on $host:".($port+1)); } $self->set_listeners_started(1); 1; } sub setup_auth_module { my $self = shift; #-- Exit if no auth is required or setup already return if not $self->get_auth_required; return if $self->get_auth_module; #-- Default to Event::RPC::AuthPasswdHash require Event::RPC::AuthPasswdHash; #-- Setup an instance my $passwd_href = $self->get_auth_passwd_href; my $auth_module = Event::RPC::AuthPasswdHash->new ($passwd_href); $self->set_auth_module($auth_module); 1; } sub start { my $self = shift; $self->setup_listeners unless $self->get_listeners_started; $self->setup_auth_module; my $loop = $self->get_loop; $self->log ("Enter main loop using ".ref($loop)); $loop->enter; $self->log ("Server stopped"); 1; } sub stop { my $self = shift; $self->get_loop->leave; 1; } sub accept_new_client { my $self = shift; my ($rpc_socket) = @_; my $client_socket = $rpc_socket->accept or return; Event::RPC::Connection->new ($self, $client_socket); $self->set_clients_connected ( 1 + $self->get_clients_connected ); 1; } sub accept_new_log_client { my $self = shift; my ($log_socket) = @_; my $client_socket = $log_socket->accept or return; my $log_client = Event::RPC::LogConnection->new($self, $client_socket); $self->set_log_clients_connected ( 1 + $self->get_log_clients_connected ); $self->get_logging_clients->{$log_client->get_cid} = $log_client; $self->get_logger->add_fh($client_socket) if $self->get_logger; $self->log(2, "New log client connected"); 1; } sub load_class { my $self = shift; my ($class) = @_; Event::RPC::Connection->new ($self)->load_class($class); return $class; } sub log { my $self = shift; my $logger = $self->get_logger; return unless $logger; $logger->log(@_); 1; } sub remove_object { my $self = shift; my ($object) = @_; my $objects = $self->get_objects; if ( not $objects->{"$object"} ) { warn "Object $object not registered"; return; } delete $objects->{"$object"}; $self->log(5, "Object '$object' removed"); 1; } sub register_object { my $self = shift; my ($object, $class) = @_; my $objects = $self->get_objects; my $refcount; if ( $objects->{"$object"} ) { $refcount = ++$objects->{"$object"}->{refcount}; } else { $refcount = 1; $objects->{"$object"} = { object => $object, class => $class, refcount => 1, }; } $self->log(5, "Object '$object' registered. Refcount=$refcount"); 1; } sub deregister_object { my $self = shift; my ($object) = @_; my $objects = $self->get_objects; if ( not $objects->{"$object"} ) { warn "Object $object not registered"; return; } my $refcount = --$objects->{"$object"}->{refcount}; $self->log(5, "Object '$object' deregistered. Refcount=$refcount"); $self->remove_object($object) if $refcount == 0; 1; } sub print_object_register { my $self = shift; print "-"x70,"\n"; my $objects = $self->get_objects; foreach my $oid ( sort keys %{$objects} ) { print "$oid\t$objects->{$oid}->{refcount}\n"; } 1; } 1; __END__ =head1 NAME Event::RPC::Server - Simple API for event driven RPC servers =head1 SYNOPSIS use Event::RPC::Server; use My::TestModule; my $server = Event::RPC::Server->new ( #-- Required arguments port => 8888, classes => { "My::TestModule" => { new => "_constructor", get_data => 1, set_data => 1, clone => "_object", }, }, #-- Optional arguments name => "Test server", logger => Event::RPC::Logger->new(), start_log_listener => 1, ssl => 1 ssl_key_file => "server.key", ssl_cert_file => "server.crt", ssl_passwd_cb => sub { "topsecret" }, auth_required => 1, auth_passwd_href => { $user => Event::RPC->crypt($user,$pass) }, auth_module => Your::Own::Auth::Module->new(...), loop => Event::RPC::Loop::Event->new(), host => "localhost", load_modules => 1, auto_reload_modules => 1, connection_hook => sub { ... }, ); $server->start; # and later from inside your server implementation Event::RPC::Server->instance->stop; =head1 DESCRIPTION Use this module to add a simple to use RPC mechanism to your event driven server application. Just create an instance of the Event::RPC::Server class with a bunch of required settings. Then enter the main event loop through it, or take control over the main loop on your own if you like (refer to the MAINLOOP chapter for details). General information about the architecture of Event::RPC driven applications is collected in the Event::RPC manpage. =head1 CONFIGURATION OPTIONS All options described here may be passed to the new() constructor of Event::RPC::Server. As well you may set or modify them using set_OPTION style mutators, but not after start() or setup_listeners() was called! All options may be read using get_OPTION style accessors. =head2 REQUIRED OPTIONS If you just pass the required options listed beyond you have a RPC server which listens to a network port and allows everyone connecting to it to access a well defined list of classes and methods resp. using the correspondent server objects. There is no authentication or encryption active in this minimal configuration, so aware that this may be a big security risk! Adding security is easy, refer to the chapters about SSL and authentication. These are the required options: =over 4 =item B TCP port number of the RPC listener. =item B This is a hash ref with the following structure: classes => { "Class1" => { new => "_constructor", simple_method => 1, object_returner => "_object", }, "Class2" => { ... }, ... }, Each class which should be accessable 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: =over 4 =item B A constructor method creates a new object of the corresponding class and returns it. You need to assign the string "_constructor" to the method entry to mark a method as a constructor. =item B What's simple about these methods is their return value: it's a scalar, array, hash or even any complex reference structure (Ok, not simple anymore ;), but in particular it returns B objects, because this needs to handled specially (see below). Declare simple methods by assigning 1 in the method declaration. =item B Methods which return objects need to be declared by assigning "_object" to the method name here. They're not bound to return just one scalar object reference and may return an array or list reference with a bunch of objects as well. =back =back =head2 SSL OPTIONS The client/server protocol of Event::RPC is not encrypted by default, so everyone listening on your network can read or even manipulate data. To prevent this efficiently you can enable SSL encryption. Event::RPC uses the IO::Socket::SSL Perl module for this. First you need to generate a server key and certificate for your server using the openssl command which is part of the OpenSSL distribution, e.g. by issueing these commands (please refer to the manpage of openssl for details - this is a very rough example, which works in general, but probably you want to tweak some parameters): % openssl genrsa -des3 -out server.key 1024 % openssl req -new -key server.key -out server.csr % openssl x509 -req -days 3600 -in server.csr \ -signkey server.key -out server.crt After executing these commands you have the following files server.crt server.key server.csr Event::RPC needs the first two of them to operate with SSL encryption. To enable SSL encryption you need to pass the following options to the constructor: =over 4 =item B The ssl option needs to be set to 1. =item B This is the filename of the server.key you generated with the openssl command. =item B This is the filename of the server.crt file you generated with the openssl command. =item B Your server key is encrypted with a password you entered during the key creation process described above. This callback must return it. Depending on how critical your application is you probably must request the password from the user during server startup or place it into a more or less secured file. For testing purposes you can specify a simple anonymous sub here, which just returns the password, e.g. ssl_passwd_cb => sub { return "topsecret" } But note: having the password in plaintext in your program code is insecure! =back =head2 AUTHENTICATION OPTIONS SSL encryption is fine, now it's really hard for an attacker to listen or modify your network communication. But without any further configuration any user on your network is able to connect to your server. To prevent this users resp. connections to your server needs to be authenticated somehow. Since version 0.87 Event::RPC has an API to delegate authentication tasks to a module, which can be implemented outside Event::RPC. To be compatible with prior releases it ships the module Event::RPC::AuthPasswdHash which implements the old behaviour transparently. This default implementation is a simple user/password based model. For now this controls just the right to connect to your server, so knowing one valid user/password pair is enough to access all exported methods of your server. Probably a more differentiated model will be added later which allows granting access to a subset of exported methods only for each user who is allowed to connect. The following options control the authentication: =over 4 =item B Set this to 1 to enable authentication and nobody can connect your server until he passes a valid user/password pair. =item B If you like to use the builtin Event::RPC::AuthPasswdHash module simply set this attribute. If you decide to use B (explained beyound) it's not necessary. B is a hash of valid user/password pairs. The password stored here needs to be encrypted using Perl's crypt() function, using the username as the salt. Event::RPC has a convenience function for generating such a crypted password, although it's currently just a 1:1 wrapper around Perl's builtin crypt() function, but probably this changes someday, so better use this method: $crypted_pass = Event::RPC->crypt($user, $pass); This is a simple example of setting up a proper B with two users: auth_passwd_href => { fred => Event::RPC->crypt("fred", $freds_password), nick => Event::RPC->crypt("nick", $nicks_password), }, =item B If you like to implement a more complex authentication method yourself you may set the B attribute to an instance of your class. For now your implementation just needs to have this method: $auth_module->check_credentials($user, $pass) Aware that $pass is encrypted as explained above, so your original password needs to by crypted using Event::RPC->crypt as well, at least for the comparison itself. =back B you can use the authentication module without SSL but aware that an attacker listening to the network connection will be able to grab the encrypted password token and authenticate himself with it to the server (replay attack). Probably a more sophisticated challenge/response mechanism will be added to Event::RPC to prevent this. But you definitely should use SSL encryption in a critical environment anyway, which renders grabbing the password from the net impossible. =head2 LOGGING OPTIONS Event::RPC has some logging abilities, primarily for debugging purposes. It uses a B for this, which is an object implementing the Event::RPC::Logger interface. The documentation of Event::RPC::Logger describes this interface and Event::RPC's logging facilities in general. =over 4 =item B To enable logging just pass such an Event::RPC::Logger object to the constructor. =item B Additionally Event::RPC can start a log listener on the server's port number incremented by 1. All clients connected to this port (e.g. by using telnet) get the server's log output. Note: currently the logging port supports neither SSL nor authentication, so be careful enabling the log listener in critical environments. =back =head2 MAINLOOP OPTIONS Event::RPC derived it's name from the fact that it follows the event driven paradigm. There are several toolkits for Perl which allow event driven software development. Event::RPC has an abstraction layer for this and thus should be able to work with any toolkit. =over 4 =item B This option takes an object of the loop abstraction layer you want to use. Currently the following modules are implemented: Event::RPC::Loop::AnyEvent Use the AnyEvent module Event::RPC::Loop::Event Use the Event module Event::RPC::Loop::Glib Use the Glib module If B isn't set, Event::RPC::Server tries all supported modules in a row and aborts the program, if no module was found. More modules will be added in the future. If you want to implement one just take a look at the code in the modules above: it's really easy and I appreciate your patch. The interface is roughly described in the documentation of Event::RPC::Loop. =back If you use the Event::RPC->start() method as described in the SYNOPSIS Event::RPC will enter the correspondent main loop for you. If you want to have full control over the main loop, use this method to setup all necessary Event::RPC listeners: $rpc_server->setup_listeners(); and manage the main loop stuff on your own. =head2 MISCELLANEOUS OPTIONS =over 4 =item B 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 network clients from accessing your server. =item B Control whether the class module files should be loaded automatically when first accesed by a client. This options defaults to true, for backward compatibility reasons. =item B If this option is set Event::RPC::Server will check on each method call if the corresponding module changed on disk and reloads it automatically. Of course this has an effect on performance, but it's very useful during development. You probably shouldn't enable this in production environments. =item B This callback is called on each connection / disconnection with two arguments: the Event::RPC::Connection object and a string containing either "connect" or "disconnect" depending what's currently happening with this connection. =head1 METHODS The following methods are publically available: =over 4 =item Event::RPC::Server->B This returns the latest created Event::RPC::Server instance (usually you have only one instance in one program). =item $rpc_server->B Start the mainloop of your Event::RPC::Server. =item $rpc_server->B Stops the mainloop which usually means, that the server exits, as long you don't do more sophisticated mainloop stuff by your own. =item $rpc_server->B This method initializes all networking listeners needed for Event::RPC::Server to work, using the configured loop module. Use this method if you don't use the start() method but manage the mainloop on your own. =item $rpc_server->B ( [$level,] $msg ) Convenience method for logging. It simply passes the arguments to the configured logger's log() method. =item $rpc_server->B Returns the number of currently connected Event::RPC clients. =item $rpc_server->B Returns the number of currently connected logging clients. =item $rpc_server->B This returns the currently active Event::RPC::Connection object representing the connection resp. the client which currently requests method invocation. This is undef if no client call is active. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Loop.pm0000644000175000017500000000730111173573477015717 0ustar joernjoern# $Id: Loop.pm,v 1.4 2009-04-22 10:53:51 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop; sub new { my $class = shift; return bless {}, $class; } 1; __END__ =head1 NAME Event::RPC::Loop - Mainloop Abstraction layer for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::Glib; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::Glib->new(), ... ); $server->start; =head1 DESCRIPTION This modules defines the interface of Event::RPC's mainloop abstraction layer. It's a virtual class all mainloop modules should inherit from. =head1 INTERFACE The following methods need to be implemented: =over 4 =item $loop->B () Enter resp. start a mainloop. =item $loop->B () Leave the mainloop, which was started with the enter() method. =item $watcher = $loop->B ( %options ) Add an I/O watcher. Options are passed as a hash of key/value pairs. The following options are known: =over 4 =item B The filehandle to be watched. =item B This callback is called, without any parameters, if an event occured on the filehandle above. =item B A description of the watcher. Not necessarily implemented by all modules, so it may be ignored. =item B Either 'r', if your program reads from the filehandle, or 'w' if it writes to it. =back A watcher object is returned. What this exactly is depends on the implementation, so you can't do anything useful with it besides passing it back to del_io_watcher(). =item $loop->B ( $watcher ) Deletes an I/O watcher which was added with $loop->add_io_watcher(). =item $timer = $loop->B ( %options ) This sets a timer, a subroutine called after a specific timeout or on a regularly basis with a fixed time interval. Options are passed as a hash of key/value pairs. The following options are known: =over 4 =item B A time interval in seconds, may be fractional. =item B Callback is called once after this amount of seconds, may be fractional. =item B The callback. =item B A description of the timer. Not necessarily implemented by all modules, so it may be ignored. =back A timer object is returned. What this exactly is depends on the implementation, so you can't do anything useful with it besides passing it back to del_io_timer(). =item $loop->B ( $timer ) Deletes a timer which was added with $loop->add_timer(). =back =head1 DIRECT USAGE IN YOUR SERVER You may use the methods of Event::RPC::Loop by yourself if you like. This way your program keeps independent of the actual mainloop module in use, if the simplified interface of Event::RPC::Loop is sufficient for you. In your server program you access the actual mainloop object this way: my $loop = Event::RPC::Server->instance->get_loop; Naturally nothing speaks against making your program to work only with a specific mainloop implementation, if you need its features. In that case you may use the corresponding API directly (e.g. of Event or Glib), no need to access it through Event::RPC::Loop. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/lib/Event/RPC/Logger.pm0000644000175000017500000001055711173573477016234 0ustar joernjoern# $Id: Logger.pm,v 1.6 2009-04-22 10:53:51 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2006 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Logger; use strict; use FileHandle; sub get_filename { shift->{filename} } sub get_filename_fh { shift->{filename_fh} } sub get_fh_lref { shift->{fh_lref} } sub get_min_level { shift->{min_level} } sub set_fh_lref { shift->{fh_lref} = $_[1] } sub set_min_level { shift->{min_level} = $_[1] } sub new { my $class = shift; my %par = @_; my ($filename, $fh_lref, $min_level) = @par{'filename','fh_lref','min_level'}; my $filename_fh; if ( $filename ) { $filename_fh = FileHandle->new; open ($filename_fh, ">>$filename") or die "can't write log $filename"; $filename_fh->autoflush(1); } if ( $fh_lref ) { foreach my $fh ( @{$fh_lref} ) { my $old_fh = select $fh; $| = 1; select $old_fh; } } else { $fh_lref = []; } my $self = bless { filename => $filename, filename_fh => $filename_fh, fh_lref => $fh_lref, min_level => $min_level, }, $class; return $self; } sub DESTROY { my $self = shift; my $filename_fh = $self->get_filename_fh; close $filename_fh if $filename_fh; 1; } sub log { my $self = shift; my ($level, $msg); if ( @_ == 2 ) { $level = $_[0]; $msg = $_[1]; } else { $level = 1; $msg = $_[0]; } return if $level > $self->get_min_level; $msg .= "\n" if $msg !~ /\n$/; my $str = localtime(time)." [$level] $msg"; for my $fh ( @{$self->get_fh_lref} ) { print $fh $str if $fh; } my $fh = $self->get_filename_fh; print $fh $str if $fh; 1; } sub add_fh { my $self = shift; my ($fh) = @_; push @{$self->get_fh_lref}, $fh; 1; } sub remove_fh { my $self = shift; my ($fh) = @_; my $fh_lref = $self->get_fh_lref; my $i; for ( $i=0; $i<@{$fh_lref}; ++$i ) { last if $fh_lref->[$i] eq $fh; } return if $i == @{$fh_lref}; splice @{$fh_lref}, $i, 1; 1; } 1; __END__ =head1 NAME Event::RPC::Logger - Logging facility for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Logger; my $server = Event::RPC::Server->new ( ... logger => Event::RPC::Logger->new( filename => "/var/log/myserver.log", fh_lref => [ $fh, $sock ], min_level => 2, ), ... ); $server->start; =head1 DESCRIPTION This modules implements a simple logging facility for the Event::RPC framework. Log messages may be written to a specific file and/or a bunch of filehandles, which may be sockets as well. =head1 CONFIGURATION OPTIONS This is a list of options you can pass to the new() constructor: =over 4 =item B All log messages are appended to this file. =item B All log messages are printed into this list of filehandles. =item B This is the minimum log level. Output of messages with a lower level is suppressed. This option may be altered using set_min_level() even in a running server. =back =head1 METHODS =over 4 =item $logger->B ( [$level, ] $msg ) The log() method does the actual logging. Called with one argument the messages gets the default level of 1. With two argumens the first is the level for the message. =item $logger->B ( $fh ) This adds a filehandle to the internal list of filhandles all log messages are written to. =item $logger->B ( $fh ) Removes a filehandle. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.04/README0000644000175000017500000001337512270455742013056 0ustar joernjoernNAME Event::RPC - Event based transparent Client/Server RPC framework SYNOPSIS #-- Server Code use Event::RPC::Server; use My::TestModule; my $server = Event::RPC::Server->new ( port => 5555, classes => { "My::TestModule" => { ... } }, ); $server->start; ---------------------------------------------------------- #-- Client Code use Event::RPC::Client; my $client = Event::RPC::Client->new ( server => "localhost", port => 5555, ); $client->connect; #-- Call methods of My::TestModule on the server my $obj = My::TestModule->new ( foo => "bar" ); my $foo = $obj->get_foo; ABSTRACT Event::RPC supports you in developing Event based networking client/server applications with transparent object/method access from the client to the server. Network communication is optionally encrypted using IO::Socket::SSL. Several event loop managers are supported due to an extensible API. Currently Event, Glib and AnyEvent are implemented. The latter lets you use nearly every event loop implementation available for Perl. AnyEvent was invented after Event::RPC was created and thus Event::RPC started using it's own abstraction model. DESCRIPTION Event::RPC consists of a server and a client library. The server exports a list of classes and methods, which are allowed to be called over the network. More specific it acts as a proxy for objects created on the server side (on demand of the connected clients) which handles client side methods calls with transport of method arguments and return values. The object proxy handles refcounting and destruction of objects created by clients properly. Objects as method parameters and return values are handled as well (although with some limitations, see below). For the client the whole thing is totally transparent - once connected to the server it doesn't know whether it calls methods on local or remote objects. Also the methods on the server newer know whether they are called locally or from a connected client. Your application logic is not affected by Event::RPC at all, at least if it has a rudimentary clean OO design. For details on implementing servers and clients please refer to the man pages of Event::RPC::Server and Event::RPC::Client. REQUIREMENTS Event::RPC needs either one of the following modules on the server (they're not necessary on the client): Event Glib AnyEvent They're needed for event handling resp. mainloop implementation. If you like to use SSL encryption you need to install IO::Socket::SSL As well Event::RPC makes heavy use of the Storable module, which is part of the Perl standard library. It's important that both client and server use exactly the same version of the Storable module! Otherwise Event::RPC client/server communication will fail badly. INSTALLATION You get the latest installation tarballs and online documentation at this location: http://www.exit1.org/Event-RPC/ If your system meets the requirements mentioned above, installation is just: perl Makefile.PL make test make install To test a specific Event loop implementation, export the variable EVENT_RPC_LOOP: export EVENT_RPC_LOOP=Event::RPC::Loop::Glib make test Otherwise Event::RPC will fallback to the most appropriate module installed on your system. EXAMPLES The tarball includes an examples/ directory which contains two programs: server.pl client.pl Just execute them with --help to get the usage. They do some very simple communication but are good to test your setup, in particular in a mixed environment. LIMITATIONS Although the classes and objects on the server are accessed transparently by the client there are some limitations should be aware of. With a clean object oriented design these should be no problem in real applications: Direct object data manipulation is forbidden All objects reside on the server and they keep there! The client just has specially wrapped proxy objects, which trigger the necessary magic to access the object's methods on the server. Complete objects are never transferred from the server to the client, so something like this does not work: $object->{data} = "changed data"; (assuming $object is a hash ref on the server). Only method calls are transferred to the server, so even for "simple" data manipulation a method call is necessary: $object->set_data ("changed data"); As well for reading an object attribute. Accessing a hash key will fail: my $data = $object->{data}; Instead call a method which returns the 'data' member: my $data = $object->get_data; Methods may exchange objects, but not in a too complex structure Event::RPC handles methods which return objects. The only requirement is that they are declared as a Object returner on the server (refer to Event::RPC::Server for details), but not if the object is hidden inside a deep complex data structure. An array or hash ref of objects is Ok, but not more. This would require to much expensive runtime data inspection. Object receiving parameters are more restrictive, since even hiding them inside one array or hash ref is not allowed. They must be passed as a direkt argument of the method subroutine. AUTHORS Jörn Reder COPYRIGHT AND LICENSE Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Event-RPC-1.04/Changes0000644000175000017500000001521212270427003013446 0ustar joernjoern$Id: Changes,v 1.19 2013-02-02 11:20:48 joern Exp $ Revision history and release notes for Event::RPC: 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 to Event::RPC::Client, which enable SSL peer verifcation on the client. Thanks for the report about a security warning of IO::Socket::SSL to Moritz Bunkus. 1.02 Tue Mar 8, 2011, joern Features: - Added AnyEvent mainloop implementation. 1.01 Sat Oct 25, 2008, joern Bugfixes: - Even objects returned by methods not declared as an "object returner" where turned into Event::RPC object handles instead of copying the complete data structure to the client. Thanks for the report to Alex . 1.00 Sat Jun 21, 2008, joern Notes: - Time for version 1.00 ;) Features: - load_modules option added to Event::RPC::Server. - timeout option added to Event::RPC::Client. Patch by Strzelecki Lukasz . 0.90 Sun Apr 23, 2006, joern Notes: - Just a change to the license, switched from LGPL to Perl Artistic + GPL. Thanks for the hint about the bad wording in the old license text to Gregor Herrmann. 0.89 Mon Mar 27, 2006, joern Features: - New class_map attribute for Event::RPC::Client to be able to use classes locally which are imported from the server as well, by giving the server classes a different name on the client. - Turn execptions of unregistered object access into warnings, which makes client / server communication more robust and debugging easier. Bugfixes: - Fixed crashing when a method declared as an object returner returned undef, which should be absolutely legal. - Fixed client side exceptions if server connection is unexpectedly interrupted during a remote method call. - Exceptions are now stringified before send to the client, otherwise Storable may complain on exception objects which can't be freezed e.g. due to embedded code refs. 0.88 Sat Dec 24, 2005, joern Bugfixes: - Use Storable::nfreeze() to pack network messages, so Event::RPC works with mixed endian architectures as well. Patch by Rolf Grossmann . 0.87 Sun Dec 18, 2005, joern Features: - Delegation of authentication resp. user/password check to an external module via Event::RPC::Server attribute "auth_module". Old passwd hash based model is implemented in Event::RPC::AuthPasswdHash. - Fixed a typo in Event::RPC::Looger manpage. Thanks to Sean for the report. - Cleaned up examples/: server.pl and client.pl now both accept -h option for binding/connecting to a specific host, not just localhost. - Makefile.PL tuning: add detected optional modules to PREREQ_PM to get their version numbers added to CPAN Testers reports. Bugfixes: - ChangeLog entry 0.86 was wrong regarding the SSL stuff. 0.86 Sat Dec 17, 2005, joern Features: - added Event::RPC::Server->get_active_connection - documented Event::RPC::Connection->get_client_oids - added Event::RPC::Connection->get_client_object Bugfixes: - Added missing documentation for Event::RPC::Client's error_cb attribute, which was just mentioned in the SYNPOSIS. - Fixed an incompatability with IO::Socket::SSL 0.97, which doesn't return different sysread() states for error and eof anymore which confused Event::RPC. 0.85 Sun Aug 28, 2005, joern Bugfixes: - Make server more bullet proof: handle log connections even if no logger is set, but a log listener was started. - Event::RPC::Server->new didn't recognize the 'connection_hook' parameter. - Try making the testsuite more stable with Win32. 0.84 Mon Jul 25, 2005, joern Bugfixes: - Buffering for big incoming RPC requests (> 64KB) didn't work properly 0.83 Fri Apr 15, 2005, joern Features: - Made more parts of the API public by documenting them. - New server option "connection_hook" for accessing Event::RPC::Connection objects during connecting and disconnecting. - New server option "auto_reload_modules" to control the server's auto reloading facility, which was activated by default up to now. - New server option "host" to bind the listener to a specific address. Default is to bind to all addresses. - Increased connect performance by reducing the number of messages exchanged between client and server. - Client may request a subset of exported server classes. Default is still to import all classes exported by the server. - Client checks Event::RPC version and used protocol version on connect and warns different software versions but dies on incompatible protocol versions. Naturally it's recommended to use the same Event::RPC version on server and client. - Methods for getting client and server (after connecting) software and protocol version numbers. Bugfixes: - Missed ReuseAddr on listener sockets. - Made testsuite more robust - Network logging clients could block the server by sending data to it. - Renamed client option 'server' to 'host', which is more adequate. 'server' is still allowed but deprecated and using it triggers a warning. 0.82 Sun Apr 10, 2005, joern Notes: - First public release. API is fairly stable. Features: - User/password based authentication added. - Full documentation added. - Test suite added which covers all connection types and the most important features. 0.81 Sun Mar 13, 2005, joern Notes: - Still an internal release, incomplete documentation, no test suite. Features: - Support for SSL encryption added using IO::Socket::SSL. - Event loop abstraction. Event::RPC now works with Event and Glib and can be easily extended for other event loop frameworks. Thanks to Rocco Caputo for the suggestion. 0.80 Sun Mar 13, 2005, joern Notes: - A non public release. Only announced on the perl-loop mailing list for the namespace request and to get comments. Module is fully working but API isn't documented yet very well. Security stuff (SSL encryption, some password authentication) is missing also a complete test suite. Event-RPC-1.04/t/0000755000175000017500000000000012270455742012430 5ustar joernjoernEvent-RPC-1.04/t/02.cnct.t0000644000175000017500000000202512270302410013742 0ustar joernjoernuse strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } plan tests => 5; my $PORT = 27811; # 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, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # connect to server $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client (this will also stop the server, # because we started it with the -S option) ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "stop server"); Event-RPC-1.04/t/05.func.t0000644000175000017500000000453311535404467014001 0ustar joernjoernuse strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } plan tests => 16; my $PORT = 27811; # 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, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # count created objects my $object_cnt = 0; # connect to server $client->connect; ok(1, "connected"); # create instance of test class over RPC my $data = "Some test data. " x 6; my $object = Event_RPC_Test->new ( data => $data ); ++$object_cnt; ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # test data ok ($object->get_data eq $data, "data member ok"); # set data ok ($object->set_data("foo") eq "foo", "set data"); # check set data ok ($object->get_data eq "foo", "get data"); # object transfer my $clone; ++$object_cnt; ok ( $clone = $object->clone, "object transfer"); # check clone $clone->set_data("bar"); ok ( $clone->get_data eq 'bar' && $object->get_data eq 'foo', "clone"); # transfer a list of objects my ($lref, $href) = $object->multi(10); $object_cnt += 10; ok ( @$lref == 10 && $lref->[5]->get_data == 5, "multi object list"); ok ( keys(%$href) == 10 && $href->{4}->get_data == 4, "multi object hash"); # complex parameter transfer my @params = ( "scalar", { 1 => "hash" }, [ "a", "list" ], ); my @result = $object->echo(@params); ok ( @result == 3 && $result[0] eq 'scalar' && ref $result[1] eq 'HASH' && $result[1]->{1} eq 'hash' && ref $result[2] eq 'ARRAY' && $result[2]->[1] eq 'list' , "complex parameter transfer" ); # get connection cid ok ($object->get_cid == 1, "access connection object"); # get client object cnt via connection ok ($object->get_object_cnt == $object_cnt, "client object cnt via connection"); # check undef object returner ok (!defined $object->get_undef_object, "get undef from an object returner"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.04/t/ssl/0000755000175000017500000000000012270455742013231 5ustar joernjoernEvent-RPC-1.04/t/ssl/server-noca.crt0000644000175000017500000000172112103155477016165 0ustar joernjoern-----BEGIN CERTIFICATE----- MIICozCCAgwCCQC7s/EOvPkeSTANBgkqhkiG9w0BAQQFADCBlTELMAkGA1UEBhMC REUxETAPBgNVBAgTCElyZ2VuZHdvMQ4wDAYDVQQHEwVLb2VsbjESMBAGA1UEChMJ ZXhpdDEub3JnMR0wGwYDVQQLExRTb2Z0d2FyZSBEZXZlbG9wbWVudDETMBEGA1UE AxQKSvZybiBSZWRlcjEbMBkGCSqGSIb3DQEJARYMam9lcm5AenluLmRlMB4XDTA1 MDMxMzE3NDg1NloXDTE1MDEyMDE3NDg1NlowgZUxCzAJBgNVBAYTAkRFMREwDwYD VQQIEwhJcmdlbmR3bzEOMAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9y ZzEdMBsGA1UECxMUU29mdHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4g UmVkZXIxGzAZBgkqhkiG9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0B AQEFAAOBjQAwgYkCgYEApKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRh CCNfUufY8Jslmn/4hZI4wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35 uWoMw343kZA4G6eLqjWVy8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8C AwEAATANBgkqhkiG9w0BAQQFAAOBgQAaahVlE9jXt0GO+Zk9ZDUmyiLQ31lhRbvr /fFqLYB3WS0xGnKKaj3IQFREkke7an4rhUaZLGstAhF3bXcN//t9bgZKQfnRPsM2 bQHEVWAtwjebv0Rn0uR53gZBxoCHZyGwCL0Tj0Gvynpou4Y8UDGnfc1E/r+HOTCO yvVrQL359w== -----END CERTIFICATE----- Event-RPC-1.04/t/ssl/server.crt0000644000175000017500000000253712103167112015242 0ustar joernjoern-----BEGIN CERTIFICATE----- MIIDyzCCAbMCAQEwDQYJKoZIhvcNAQEFBQAwRTELMAkGA1UEBhMCQVUxEzARBgNV BAgMClNvbWUtU3RhdGUxITAfBgNVBAoMGEludGVybmV0IFdpZGdpdHMgUHR5IEx0 ZDAeFw0xMzAyMDIxMDQ1MzBaFw0yMzAxMzExMDQ1MzBaMIGVMQswCQYDVQQGEwJE RTERMA8GA1UECBMISXJnZW5kd28xDjAMBgNVBAcTBUtvZWxuMRIwEAYDVQQKEwll eGl0MS5vcmcxHTAbBgNVBAsTFFNvZnR3YXJlIERldmVsb3BtZW50MRMwEQYDVQQD FApK9nJuIFJlZGVyMRswGQYJKoZIhvcNAQkBFgxqb2VybkB6eW4uZGUwgZ8wDQYJ KoZIhvcNAQEBBQADgY0AMIGJAoGBAKSr4DKHLFi290kMNVLpMXAjkUg2IIHtXdSw BiD5UbS0YQgjX1Ln2PCbJZp/+IWSOMKXkUOTNjSzJD/JGgoJjL4spdtCPowopC6k BU0zJsFN+blqDMN+N5GQOBuni6o1lcvDRzQAU7YYIoB2lRlpXdJURaWA+A3FiM3u dAH4PHZfAgMBAAEwDQYJKoZIhvcNAQEFBQADggIBAJfqRMegqW/frG5F3JboCsAX Rp/wU66gSXK3xqxtJ9olwmVT2CokFCCWywKvK9Znx+pspf6K294LIA9IFdUQObCL q8bgYRRrQsWZQBao9reCjAxZqVVHrCrVUsi5HNvNNXlXd1G0Zl4lS2lxDnTfK/kT wNATusAGDOXu9d2pnpJo5zJs007KyZbpNgLNsGrIVCy9dgyslE+saH02mxYofK/t 6s4tBN+Qrrb6TqaX5JeAqbOlg1ewr3ygeG+t9GpId5XRTsLGMbUTmwZ27tU6J57+ HdzBd/SLz+xRu9sT6r1TbB06OOZWctRKXzg3pyKquoJC0ISBraGO2BPJ+lJAneuI xNE74zxIc+z3rFLydSPq3nbiWfeJXst1Ctxp3vJDIFY401LeJKuI/S1VZQ6ponzA Qqdjh3jSXbSTFIxaXhsyjBXwx55jOVyJLEodcKtU80nkJwc3CsqK6c0vYF9Jv078 HYYkXu3cquYysYLgBfoUfPNJQQ2eEOcX4AmaLuuFZ8sANv0Jul4AdFDDYA6g4UVo dwb43y2dHvP5BXkzwAvAigWgXQr4sRlMdp+ln5mMtilsHsQ5/K1lDgLp1JFuS7zz TAVhqNbgEZfmu3Ig7KMM1n4V1LNx38SUWNBHajLIVcXNa9MXTd36amOydLwPvJ+4 P0OzazzHKY0IpOrqroRY -----END CERTIFICATE----- Event-RPC-1.04/t/ssl/ca.crt0000644000175000017500000000357712103155363014331 0ustar joernjoern-----BEGIN CERTIFICATE----- MIIFXTCCA0WgAwIBAgIJANY18QXuuUQoMA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV BAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBX aWRnaXRzIFB0eSBMdGQwHhcNMTMwMjAyMDkyMjU5WhcNMjMwMTMxMDkyMjU5WjBF MQswCQYDVQQGEwJBVTETMBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50 ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIIC CgKCAgEA+WFF7k5VKPA0aIcLyPm9WJnAnIu5ZsdX0PhSnfLxI23t5oGCDTp8XXP6 vxJvRmtcl3Mc4SqqzdmPyAESBvLmTOjmIOfqof2wdoocU2eUJ8sbJciMOI56M8qD xlwI9nyog9mhvAwtRxgIP/C19su5qDJWBdAPUFSW2sGWCNx67HO+RGQAACYdrp08 jx/Hr2Ma8PXdCpfCg1/sBToLJn4m7McTTXpA1lfROgIa3Ut/aIyYsyX53REKM4Gu TMRJIBenJ9oCxSfDwVB90erf9ErqxffD9U5HmC77kkmwEhXzVL4Aqk7Nc3jm9ASs lXUznN3PG3lfhoUp0//I14/FghHOOteG2nlHWyNKgFAWWhEFOl/tzTMW8yE70NJG ggieVmgjZx+dcCIob1oi0IqwDcDwMT+SNC7PhIzUEeoRmUFsBHnZkMl+3E22axpO N08RZdeMlCazQV5Ygdom5SzE7hhfMEMi5XkqcAbNmy+/GfPl9dIsuaUlABmmBd/C o+dCgqy9O6i4GYZWrkxosHDGYnkQziBr/zPgASF8xnDOIPIR6Eicm90gILeBQ+pS YCtWUfzX9gZUodZ1V6vdNr8c1+VAkbyJVgDiCc5EibC//CqpcIZaIGsXOO2nELYA Q6szh16JP2Hde+E2AWk0fYDWn5zBb7lHdxkftfxdxsrVKxIwRKECAwEAAaNQME4w HQYDVR0OBBYEFBFLEuxPLf+bKqLaJSSbJBWN7WkHMB8GA1UdIwQYMBaAFBFLEuxP Lf+bKqLaJSSbJBWN7WkHMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADggIB ANRzMGVH1qhTaRVxILk1ObLuMb4Msz1IG3FVkLlB7gGTyrzUbf6Fj2LvoNTvDGUq 5VTRWlhiuRGXBT4aNrD6gOaJvVLVSHZvW9q8jN2I7ELLNBqKe91uPohVuX7ZAqyK OrdIWT+q2wH/i73LxP6MUVwISNuuJ0ij0uXDByGFuvVjgsGZLmNL69URf0XiD3PS qZ2iOgOiKuCpeR3GhFyhTkJh9ahmPYrgIZu1JMRZd5jcIuOfAw4feFJsaukgEdwr +kl8NSBC/etHWxD13LuOw8ssgXkOB7SyQ+1UbybXlXgn0PE08/lCLfS5bHSbTlf1 BYqKzQBfsSHIJnrU4okTBt19px+PPMcHkFw/eFqOPhPeord6n1p3iAR7JHNGSkQ4 eSxfS7DeeJNzCIDhJ+jrq2JC4HNY/hqCtxbp0nfvaAbUB8VAJVh5K29fwtcMgfbo O8voN0s+VxVPwuLm5gTbHNVqyEVTlVg1ToMhoCv7x9UPVqg5SbOtAGlekNUUNggi 8fTVI2DuuL2QGXRFqhbjuyMKb37Z0YhQzUQ3Y/Eq4hikUsSW9EkS02abFJXnwU+w xCRf/I6B5oUKUtgVFQGD2vAPZJ4c/q19kGyMNa/RXsPypxdTBWmVhAHx/xlRuPOQ 30cK/GbF1++X+n44GLX/0j91yQILL1i97kH7vEi/Xda5 -----END CERTIFICATE----- Event-RPC-1.04/t/ssl/ca-wrong.key0000644000175000017500000000635712103155222015454 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: DES-EDE3-CBC,21A2C2370C6F85D7 bT+xWdBBvy4uUElXccPZ6fBuI4ozeLcisnPJr2jtSWTv4lhsnzCOPQNCGPOPbKfr 1aMTmFh11vbzjsKVJOTrtVrf3MiBHDa7/bK18F2Hz0pOZUOrCiXbqd+gXx4IAJ6Z 9xSH+a36nic9CReKwODy5dBuZWBp8tBBgnpQ66SgYItHX2hNnEAhPpy/pmwXq6wH YQ0c2M6MzbJPl1H0uwe//CkgSMMTGK21NsSIsSn4vGvHEv9Sm9iuaU6489yWHfRG BWLxNcwGsJwdYbDaQNYEYTcal3EcYEeGme6CLtF28ecK4K0AW/Fje4N1HWnAGUf8 Y73sXbJ1S3T4Tbq+E/UvlTOMW64Ucdo4h1Nvsa+4mbQzXeqOzQHDyNS7m3n8mcJB S8tYl9sw2BjYWo83jrcxWYYw/fKADVaOTWfJ7OK/yJFHyefbJMiXHLplR8keqpRl EZT1b5a6goSUbIamLDShu3CEDAUWIc6PBFNFl8fUt2FXrSUfw8ditOh4V8OCjN98 nQ9T5iIcS5E65QYlAzQr/LdyyWbg7i+de/A6cqkgrSaGFn9lLWq2RE4XYEaF4iJr XX3mAfHD/kxvruaXS9Mlycrti+A1C4Iv6NlCS0N0cr6J/+GX2sPaJuj1rdXHP6QN g9bH038Hy+zb21wr7oM/Yia72BLPfXqCmEavXM/3GGD8DH8xu2KBFINi0dS1tFlx rVhPi41zDFgNXTMVeLE8Wf4/SO037cfv90gqmpSepUv9C2ML+0RHYPEko69EacY2 0wl2oQNF4gCbq5Cc/oZYEtIs0eNz0+9J23xnjUpFqOBl+Zrc/NhLoOuaSwwn9FU9 kChpx6mqaDdYybU0qgvthGlNJVHPZb4xgfc1fxXKS48TWV9AiLoZNOFl3d75RfMr 15+iplTk9kCjNg1G1vD82N6A9rjGwDIrCJPt39Sn8MGOxbIceSKQUAXhw+NT/PMK ai5p9YlAKub7tdu0sCidAzcRzTfLOa+K9R1Br6WsfClzbBtcf5IcLhbBpwhlZRpZ CUdXziLOBql8ZxvL70bglEv1epzTTJFGZXAw+IVS0Pe9a2w4XdF67IxVgaw/OSDR DxjUWhIfXWRxLxsIV0Zi1cvPELvgZGOHMfvbEQMefG8Z1hOB7Y4fF00kTxf6Y3y9 kpo5DrooOqtCmy4B+DbEkBJYBe5gJ/HRDx0uNokXGuqR1CWs4ysWnXWchP0FHE/g dvu7Tqaeq8XEgewTWXXlYV1mQ3inImWnbEp1zPfgxNNrepoYsDuDfQanUeLdJ4NC w3sO8It9pEj3QCnX9CFL3/98Yp9lJZrPQiBbRXVArHbaJZ9xheQ0osVnucHi6BjA rPHoY5HIlq3+UJn6NrSuffSpgOwojgmW2OiRxVVC3sLICgmaT2u3leQKsuj05q0x 7F7TcyzjKyKUtP5XUbo7tNNFhBSElSjxRPoVQsOI/r9TUNu7BSfpN1aLUMJ/ocBX jdKzkQSM0K/AipveNvlhjKZQGs+v2oiv0nlSPrMxcDqbIYZMHkKXSfycstH2WxEu ZdjP5jt4TBtS/VWkwP+vb4VSOjO85TZKzfYsMBfr41rSejIhLVWh03h8osmBAW1K qUA6jU21Nr7la9iTsPe81vjwLqrWmwMtGJBepxUKvFoa5sMHh5kaQxCXqG/YxiUU M2jSwSoXam8IPWLFgVYdotCswZlmQYxMVwv4Nq1PsxzHbic+n7TZ1Lkivz8zh3V2 LyazFty45dEEtlCy9UvO2Y+bIyT0GgP2tCnsyrJn8uJiVl/sm/s0Hb2CxNetyrWW BH7W4kpOoastRISw1cdBhPdWSqsD8PFTuqfQMKW10cd4RfyyLFrZKT5ImN4Eq1tQ HMNx7U2FdJJfA1VHs3YqqBYGbaCL2eBNoBdo53BxnSQEUChHfa4W2u7A73Tm0SB7 RXGTVt3aS9zlVZ6wc4UeQXNKJr+e3/j0H5qrx3z61uT7cobkf3XhxRMPHz78VB5m yOqItOj6iMITkJ74Zhdl2sFBWZnG5f84KC8b72zUD7WpwfYMbaAkRQP3HfmdywtE kYpJC656dpcok+HAihSU0H6jOnvVn526IaKAJUUmi/BbG8wc7R1YoZQHc1S9RRKA WcjEEXt/E/HI3SRyPVKMywws7FsuL/zKkFaBhMSBLcqTnb2E5D8tSeMQtst2q3OO GtoCRBwkzGHoRxjq3Sjishmabm3QbaYVOT6kcsoklLhSAinSicLJoJI3TKKHDEAt H9DX+yApFUgfkziiibotGDpjTA5RtQJv69phgpkLwJiVJqa6mNEgiz1DMr47oKtI OJeMxMLT0xtTvMa3OKNvomBZJbYk2dfsgEwE/Kvmws1FzX68zu58piWLKnVbbZv4 +ibUvdSc7sQIa3iPtfvPN/oNkeKoti2BtLibhCY1G9oZNG/CSa7Lr8jV/st0ze4y vCCCDByWQXCpmobmgS2aa8H8coSCAAqm9Exaq43eabeg79iJxuCe6pHwFKQ2RxdD jcQyTzCINxGX/+d6bc0qDlDcSdU3HQ03jxReXuhE7TdPM6u10OBpHk8chH9pTkPc K+SmBrlQjENT0Ja49VTjNz8A/WgKvjjvF1U6oEF4jWmcQGlYqLewke4FNam4XFvN yytFW/GBQ13v+1uIbX9Ecs2b4LbJKZZYQKpEMiDjqsvwlFPn4ZHTwMz+K4ni1krQ hmxUNb7Vizc6Xwt/lfN8T1hajwCYLxRbsNmwskKCvSITK+tdi9nugXXpXQXHCnOv Kz9yDqH/NXExb3KDuc/mIJOiODWvPsmOGtgqfdCQ9DQJjD62l0IflI+FJjJ72l5n ANepn7604F/50WIry4nzcGU+kKjJ2CS+e8fnIjC9rkBJgUy8lQSGxcqaJjNfztjV tLgv80U/lVpMWoGc9LFU8E5ZMmxZbGGwneVerki9IfM8gP/0FFILVSZqttDqzutv XrobEzk6hOjHkoCrCT4Vdqsj96lvhBC472J6l2x0hLCRoZljLw9umM8zHPYdqSXb KBj3tnLuURfVrnyEWEEhqNI94147LU5p4TGA88BNG0JdaGuzZqyqzo1SKdCUW3kV NJE1gXrVrQmyJRSjWOPTtUK6NenyOdqlqITeBZwRb/3w0WAv4UafbD+Ai83m1APl -----END RSA PRIVATE KEY----- Event-RPC-1.04/t/ssl/server.csr0000644000175000017500000000131010227514547015242 0ustar joernjoern-----BEGIN CERTIFICATE REQUEST----- MIIB1jCCAT8CAQAwgZUxCzAJBgNVBAYTAkRFMREwDwYDVQQIEwhJcmdlbmR3bzEO MAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9yZzEdMBsGA1UECxMUU29m dHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4gUmVkZXIxGzAZBgkqhkiG 9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA pKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRhCCNfUufY8Jslmn/4hZI4 wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35uWoMw343kZA4G6eLqjWV y8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8CAwEAAaAAMA0GCSqGSIb3 DQEBBAUAA4GBAJmfq2IqvN+m9IIRzNTHBjEaOeYIEFVKcqWIiui/hvw8M7Yi0op2 ifOjRKSfYTsgNAst1Ilwg6wgblSngg6f9GpGtWAYr1xQpoWS8PDaqjx1sLE40qi2 aNrCtrSCLxzLh9o0qeUydcrjvIK6sWe6lGRntjNoj2VCqlBm0EFQ7vNF -----END CERTIFICATE REQUEST----- Event-RPC-1.04/t/ssl/ca-wrong.crt0000644000175000017500000000357712103155257015465 0ustar joernjoern-----BEGIN CERTIFICATE----- MIIFXTCCA0WgAwIBAgIJAI9WA2Q/HOzoMA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV BAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBX aWRnaXRzIFB0eSBMdGQwHhcNMTMwMjAyMDkyMTUxWhcNMjMwMTMxMDkyMTUxWjBF MQswCQYDVQQGEwJBVTETMBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50 ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIIC CgKCAgEApbYWTWNk0rRfdvFqsw/LpBj1e8D8csoMiSTsCEPOLz/8U9dustjjgxsT eS8uSwHCzLH/TeDSuE2Iuk26HH885EXNc/OXsIu+j2HetqcOv+DOAalqeEfWfG0e llud3Y955aiJ4ME0TFhByOPPEgz5rMuj08/3NSyEXAkrvGiFGiN+fQLryZ3opH07 EuH4x/yFEbdQd+9/zP5EwNfmIHYfBhLWHWOR7T9zKo71iWogeNfJzcc+VpVRXE1L 0DAIX/+vbksd+dnewKmT7g4HcurS0lLMM97d45kiZSY6bfxwELAwXO9NY26SK6Ig H3ZFMeNVeigaQ0gwK5JNk0hEVadB6qzI3PMT8/bTVGxH+1WxDczB2sUs561Q3vhn B+Ny1GjEVf4H+fAJBwQyQbzNlGOxYLwh2ZcSmUEHEUVqwgD8VvYpMvK1ZVmU81BP XsvlDfFP1WHyCOUcdHoZMr7NY771LU0B/IRn2fnhWvffMYYo8xlZt4UJmHf1khNo O+NvFnrv8jduIPlacXVPq95OnYGIoLtAbvj8QIcehJ9dgbniYB+OJ0ShiPzRg2dL u6qe5sBQF9jyAJFWHU8L31DKAfhP42Bi37e76rr6oIDYdZTzrhMc3RUZmaJN28a3 ycpjUGuFFwHw7nFZbD+pSZlDHFVRN8k2I1S/7AOU58qpdbjMog8CAwEAAaNQME4w HQYDVR0OBBYEFIJtnPxMc/mDhofSA0rJZV3MNBfSMB8GA1UdIwQYMBaAFIJtnPxM c/mDhofSA0rJZV3MNBfSMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADggIB AAMnareCgJqE11dXTULm+TEkzCp8czWc2QK4w8Qsn1EximpNdvxUDKwqcFW3YxJu CVSJV52ma+HJ/gmCPiZgZAYpzDCdL7+2aWy81OiRZZ257RoMCZvbQ3JJcF0o4D24 skL5Ez6zSlkq4gbJpO4jBahtbAzsGji+VjSR2S1W8wTVJIPY8ifRtvp3tpIMTJQs mfPI+2+pjt9NRulS4G19jpc/cGr8C1MLoRVv/SjYWy5C65OVohkgf16UYR5aoOF3 MF04biyoVPbFE53/Q5I7stE3QYOm1rCd16lKAJh6efaEtG1YTHqvNX7DPvRp1Lrn Cm4HduwgI3dqeI1K4UxO0JyASWIuf2MWD++bn1ESWpQzQIdm3YE7j5NCfUPzHXPj PcZtIwZRmPN3mxP95Tl1VDnBegCrV8ViVh+ttlUBP6R6CxKBSBKQowDwt9IRmPnZ mQZgGhleyla+lgAp6xmJ5L9l14hEPE0lalW7l8ZVylL49oCBvMthxX2ATuVvteKV HZCTc9N3QOi0k9LVR07rb9nEKxybDLlGGAFdd4gYOIs5sVbYHpdvazzcdOO9ZcEg wTLjqDlJ5eTjsJcUxlB9pk/vEUddqYuGHJUln5RFtEtnqqYFvOdWgy6fOVDiX73A QNE4X8gvgg4RJ4zFkFyuhystX8tLx5sg1BuMfsimw6KL -----END CERTIFICATE----- Event-RPC-1.04/t/ssl/server.key0000644000175000017500000000170310227514547015251 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: DES-EDE3-CBC,CEB8A2E7F9C59066 mUDYr4fgc2lba+qobTYxcq/8ZpRS1cdoiCe1QQeSQ2Bywrsgx8H40hqkBsKOYBPa ZFC+EEQTfhGOswTD5YsgqfTyWc7w0qlXDlPCVgV28r96gKzpP6oEDoclriWsToDF ZOsANyGcdl4D4VyY+oOf9crUFqIC4C/IfUJ++pZCUlGy8k/J0qHl/kCEP1bPg92q tKrG/gcDtrqnVHYB22MruAXHSAo4JOO7A6ZmrRGH4XY5SKGZPF/T7kwLLzEXbPq2 MDrcPg3xWcCvODswrptdmK73PyF5oWkA7NXAofecu51jW1Y9G48p1lQi0mAgP3qP LDxCFQUU52G9UAxmfd8pZBSntRIsaIQV+6ffM8TemObgf1VkisCGDUCnEgvj2zDN AaieLhR4MKIQuYZSTLfCI5mKZK0vCFP5t19wK6Clt7p9bq1aUu8HkqEZ5yrNmf04 acKvUkDbVCPL1pkAsyNAEQ4Zs3f3VxkuRrtf7gqzEEFK1TQoH7JmaALqGftgkPYJ eEYX8Om/Gr8NxTftSNbnoaFUyeoBOQ1iZY2g4qqE0rZlc7lfXiXAV3ajtgPcreZa +uU4g8DF7zfQ7F8FK7w2ryLJFdlgk7SzEjv1VzCQTQ2MjBOCs0gJ3SPF6wx6lfyH 9HqYRu2OwPJlaTzVrdhwKesROuBr1+rJym18uvzObSgkbTrFQuuYcR0dNbs+AuqQ dkhOC6bzpOdZNWVnVQ7klbsj8iUSMs4QnSI0+DpSls5VOMJiAXqPCAy4YJ0GAcGv EDF12ONiToyGb0Jolo+WOXyDebHR19TxokTcC5Ri7305mtRAP7g1fQ== -----END RSA PRIVATE KEY----- Event-RPC-1.04/t/ssl/ca.key0000644000175000017500000000635712103155335014327 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: DES-EDE3-CBC,1F27D6997FA6C191 qCBFsFGQU2fdRcye4QAbGlzMoEEbs4SiVc/UhjpHzQHGVtT+iH91OprY6mTGSoUr pXdc4VohvHqtdaiWFOG7fplSj3Ie/4Wzdwf2ESENHWugFh6GOlAFFHlOtvKlfAdK M//ZdXIQRSUxTtl3aSkjInNYXFmH8u/K5NCJWpAJezxwPrA6jHjy56qAADPBD3jY VmgRJaFIrlRTgv+B1cbxarmf/difX2kDdSEAU0IJzInRiBwwP4bL0OpfCcXnjijc Uw0M9h9d2oiFoWQUsIn08/BnSKNtGJ5nUCbmQZQJrgAteje+dmw89G+DjWICmQoI CGVLuYYexUk+23CGANowO4klqcqOZDE7C4SaWbjh5OsuFFyzkhJhvzYwGMElBb+E 9sMLqJODku2esbcUhVcWF6ZjHA+9UB1V8FcLxxSfQ62fuOgVgpjvbOZHcgh2LehT 6X657OEjJI9VLxJ7t/TOdQYIyZ34YwqA2r32Ld8ZEBAiXyZOP+sKU/C61+3Uj660 rO2Om2kC4mHg112dHHMRz78Y2GHzNgzmgtg7mhHTiH0B9YmD4VEsdZHZmkJirQtc a0Vc2pBLupbr8Ley3Od0m2k2sTdN4MyD5cXkPDmhTXX/INMeslowmKxaxXucC72p CYJ/RXlZa19xGE/ZQJ5pov8Yd12yXhG9XzTr728+Z3taEbUzblhSnBvl0lC2N+tB /1cJ87SqiTEa04ybti7LVpctzP5tzqRRq3rnuNVwWme1qgV3lGlW4ddT+t8bPwlC Zwm4V325PAz+ldILzG7Ry7w+BXt8OsHRvk4OJ1muvGX/+pkRVBMzoTYmV1HHKSf5 tSQEsEop3fS1mK62OpTfyRYIMA5xqK7WYSBDvJLyruAFV6QJG0hdW6JljxPtPEiX hXZmllW5Afk61QA3zgM8yIX31WXv8OFmwnVxYWQgYSdjJlDVLOKRKPDe8A/qiCh+ 5LdIG1l5D28Mkb//cnvPER152D7RbdSgi9+VVnrI6KdLt1hQp05vmjXt+EVVHBwL FSZ/MkR2sbFP4WPOCX6c9sak3Wjwp/UcujyJ0AXA9bN5eU449AfkpY6qqE4zPcYj JRCltrHZzVKf7+nO7gt8Lp/AUjmDo/vx/qi+tPDDmzmiN1oXk0Sgi5wfcXFaKZZn 7mLca6SxcLi9v+mlwLjcwUmCcrPT5FVa0whqCdQ48+QuRvC0Xkn2RmlOj6c43aYJ exonoSMykjgcMZKSyt1+7XFQ2BzKMesXIVw8oLNCf9DFXHCXxZikNZVj6gbG1Sj3 GvYBBtb9qRRU3OhwkRHl5QpFdQN7rv9OVVqhmNowLRu/zS2XmZdVypopqzpU+YZl 7HB79N5m7GYB/GjxnhXV2qSZuKd/cW8KELIXmA3xTUqYqMHYNgVCkQHIDfuSv4tS nQrkiUCCK2PhWlpmG2RKFqI4D1METpML8qHJJyAO9ieHFemk6rHxLLRzhX2d02HS TVn4Nrx4gC3DWZoulWmM/sAVRleCG1Sh98UZAuzTa9yif4LpC2Fp7beIpeAYIxx/ pLJ8J1pNfdAM3LtQOdtN+v0df/sCgP9jI2HK2gGROLKQZshiDQoPy3gZjhQuEf+d Eg8ABKZ5680jNFIrvt1Jx5Fm6/ZMlAZgJ8zGLVQc/uP0F1nmxM3Wm5gFCrw/qR2d c5gQUZ4CfNTNGM6XN7BybGHEJOnBac8RkfYj8CP78pm886+Fpl2IbIoSuw4HVtJT 0eoNnIKSft/Cfkw0nt12GxLICDlrewQZAxi0ox06JbNNOELCJncDkXc8vvFOZdmx gqivMAWuhWgv19SyoWWBrlr0AtLs1SXN2AidUt0ufa9UVhmWUrGM63w5el4o4rf1 LDsKbKrkbtXOJnCTR3HOlAylyAbtvORB63WqlNWWhBErsle1t4R6+YylkD87js3b 5oTKauT4C7dQlmPNY8bHgKdNC1yCSbj4XH/p8q3XQeuD/8TfwH+Ue2bQR+yP9dYJ SXlMqW5h82fNFLmQu13cgVqS9WIrnrGslSpaBIjuQ2B7X6qyVlUybcVTsKZd1uU/ oa8xBxsLLa8d0MMD3DhT2zyIyqZAXBDx323LZVckTUj+6fkjOFja+JnT+fatoSMw UWgok8HuBEtp68a/jPeIaIsTo/XA7XoiN1sizKkXFfkuQuJ+nGKFXnswDSZJY11y Oi3X/TUmDVgyqliNPyCdajbXAEH5P9U/60DHEPwW+IA1RgF5BfuaGIos140suexS 2tB09R2GOjDc5d9jyqABQgyQdDomAdMH1Gm45+Vsfc9KHeJ5FmadE6kto/hTV+Jl q+fmFqARQr2PQkfaivv4/+BrcN4IQZkUkl9DfOiPJB01r8+HTzpqEWTcCo27Kcgg htZXA8tvJpjcFMg0Io/Zk6TPOkoYzYsU96Fj4SDVzg+hE6SXHGqCwVtKPeuKVIPw WFAqhkoWC/Ywrtc939Lo/G67EaG7ORIRvq1CjPI6IjrjHsvMPGILV2AuZ7xTz0fw jtONRWQwOYda9sGfVyjSxvF7R+royKf0svVMgnUi+kp0izG2SpaUIUrRv/CLFhwF NCbNQ9TxQoJ3f2Ul5uJCLyiqjR/196Xs5mE+MylsyWW6ZB3N+ftDkE/Rr+u7IL3I 6XvDKHDbYjd5Z5Doo3j6fBrhycV+rnxm/uu9UIA83HmEOA1if+tzXXxP1cS2Kf9a VFc8NYKK0oRARaT/LAWLtWpt5ESwz2m2moSa86jJjn34kDBEcTV/9DCojpHWxrpY HFkO35OIrJ2dIPJcrKqT7jXzkTSs6fVZ4o/gNgk19YuKO/RRI4/18sEQy0Flv9eS 2WD/RyU+HFtTgC34up9hsuk8XCgz7qL43NQ6Z2PjbJEaShXXcpUPS4V2pX9aLiQa R0T+ykfCqjziFM7oGv+1b/UdA38N9YEq7qhdRpmt5k9laRcyilclYFUKLfAecV61 2KboqqO+Pe0RiBug2cHGV0EmR+sTlmzNP1jH1t0TGpmOcd5dA/pYuT4ysSIozaBD qqaFDhgAMEHQJiDwy9vKaGlY2+ULU79eLAqO84vAuD/kjy+3Tnd7w7g0E2KLmGUj lmJk87PulkuBp3VJa5GMekDtXBYL+aqEyxKfhy5UJZqJn+P3rT3iuPTw9JBpQVBK -----END RSA PRIVATE KEY----- Event-RPC-1.04/t/04.cnct-auth-ssl-verifypeer.t0000644000175000017500000000274412103167264017703 0ustar joernjoernuse strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 6; my $PORT = 27811; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # 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, a => "$AUTH_USER:$AUTH_PASS", s => 1, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => "wrong pass", ssl => 1, ssl_ca_file => "t/ssl/ca.crt", ); # try to connect with wrong password eval { $client->connect }; ok($@ ne '', "connection failed with wrong pw"); # now set correct password $client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS)); # connect to server with correct password $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.04/t/04.cnct-auth-ssl.t0000644000175000017500000000267112103154066015520 0ustar joernjoernuse strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 6; my $PORT = 27811; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # 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, a => "$AUTH_USER:$AUTH_PASS", s => 1, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => "wrong pass", ssl => 1, ); # try to connect with wrong password eval { $client->connect }; ok($@ ne '', "connection failed with wrong pw"); # now set correct password $client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS)); # connect to server with correct password $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.04/t/03.cnct-auth.t0000644000175000017500000000260611535404446014726 0ustar joernjoernuse strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } plan tests => 6; my $PORT = 27811; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # 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, a => "$AUTH_USER:$AUTH_PASS", S => 2, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => "wrong", ); # try to connect with wrong password eval { $client->connect }; ok($@ ne '', "connection failed with wrong pw"); # now set correct password $client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS)); # connect to server with correct password $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client (this will also stop the server, # because we started it with the -D option) ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.04/t/04.cnct-auth-ssl-verifypeer-wrongca.t0000644000175000017500000000245612103172525021335 0ustar joernjoernuse strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 5; my $PORT = 27811; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # 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, a => "$AUTH_USER:$AUTH_PASS", s => 1, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => Event::RPC->crypt($AUTH_USER,$AUTH_PASS), ssl => 1, ssl_ca_file => "t/ssl/ca-wrong.crt", ); # connect to server: should fail due to wrong ca eval { $client->connect }; ok($@, "ssl connection failed with wrong ca"); # now correct ca to shut down server $client->set_ssl_ca_file("t/ssl/ca.crt"); ok($client->connect, "connect without ssl"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.04/t/06.object2.t0000644000175000017500000000311611535404477014374 0ustar joernjoern#!/usr/bin/perl use strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } plan tests => 10; my $PORT = 27811; # 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, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # connect to server $client->connect; ok(1, "connected"); # create instance of test class over RPC my $data = "Some test data. " x 6; my $object = Event_RPC_Test->new ( data => $data ); # check object ok($object->isa("Event_RPC_Test"), "object is Event_RPC_Test"); # get another object from this object my $object2 = $object->get_object2; ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2"); # check data of object2 ok($object2->get_data eq 'foo', "object data is 'foo'"); # create another object from this object $object2 = $object->new_object2($$); ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2"); # check data of object2 ok($object2->get_data == $$, "object data is $$"); # check if copying the complete object hash works my $ref = $object2->get_object_copy; ok($ref->{data} == $$, "object copy data is $$"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.04/t/Event_RPC_Test.pm0000644000175000017500000000632512270303447015552 0ustar joernjoern# $Id: Event_RPC_Test.pm,v 1.4 2008-06-21 12:44:13 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2005 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event_RPC_Test; use Event_RPC_Test2; use strict; sub get_data { shift->{data} } sub get_object2 { shift->{object2} } sub set_data { shift->{data} = $_[1] } sub set_object2 { shift->{object2} = $_[1] } sub new { my $class = shift; my %par = @_; my ($data) = $par{'data'}; my $self = bless { data => $data, object2 => Event_RPC_Test2->new("foo"), }, $class; return $self; } sub hello { my $self = shift; return "I hold this data: '".$self->get_data."'"; } sub quit { my $self = shift; my $rpc_server = Event::RPC::Server->instance; $rpc_server->get_loop->add_timer ( after => 1, cb => sub { $rpc_server->stop }, ); return "Server stops in one second"; } sub clone { my $self = shift; my $clone = (ref $self)->new ( data => $self->get_data ); return $clone; } sub multi { my $self = shift; my ($num) = @_; my (@list, %hash); while ($num) { push @list, $hash{$num} = (ref $self)->new ( data => $num ); --$num; } return (\@list, \%hash); } sub echo { my $self = shift; my (@params) = @_; return @params; } sub get_cid { my $self = shift; my $connection = Event::RPC::Server->instance->get_active_connection; my $cid = $connection->get_cid; return $cid; } sub get_object_cnt { my $self = shift; my $connection = Event::RPC::Server->instance->get_active_connection; my $client_oids = $connection->get_client_oids; my $cnt = keys %{$client_oids}; return $cnt; } sub get_undef_object { return undef; } sub new_object2 { my $class = shift; my ($data) = @_; 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; Event-RPC-1.04/t/04.cnct-auth-ssl-verifypeer-noca.t0000644000175000017500000000241512103172750020610 0ustar joernjoernuse strict; use Test::More; my $depend_modules = 0; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 4; my $PORT = 27811; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # load client class 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", s => 1, sf => 't/ssl/server-noca.crt', S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => Event::RPC->crypt($AUTH_USER,$AUTH_PASS), ssl => 1, ssl_ca_file => "t/ssl/ca.crt", ); # connect to server: should fail due to non signed key eval { $client->connect }; ok($@, "ssl connection failed due to unsigned server key"); # shutdown server process ok(kill(2, $server_pid), "killing server process at PID $server_pid"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.04/t/Event_RPC_Test2.pm0000644000175000017500000000046611100552574015632 0ustar joernjoernpackage Event_RPC_Test2; use strict; sub get_data { shift->{data} } sub set_data { shift->{data} = $_[1] } sub new { my $class = shift; my ($data) = @_; return bless { data => $data, }, $class; } sub get_object_copy { my $self = shift; return $self; } 1; Event-RPC-1.04/t/01.use.t0000644000175000017500000000014510227514547013627 0ustar joernjoernuse strict; use Test::More tests => 2; use_ok('Event::RPC::Server'); use_ok('Event::RPC::Client'); Event-RPC-1.04/t/Event_RPC_Test_Server.pm0000755000175000017500000000741312270303521017073 0ustar joernjoernpackage Event_RPC_Test_Server; use strict; use lib qw(t); sub start_server { my $class = shift; my %opts = @_; #-- fork my $server_pid = fork(); die "can't fork" unless defined $server_pid; #-- Client? if ( $server_pid ) { #-- client tries to make a log connection to #-- verify that the server is up and running #-- (20 times with a usleep of 0.25, so the #-- overall timeout is 5 seconds) for ( 1..20 ) { eval { Event::RPC::Client->log_connect ( server => "localhost", port => $opts{p}+1, ); }; #-- return to client code if connect succeeded return $server_pid if !$@; #-- bail out if the limit is reached if ( $_ == 20 ) { die "Couldn't start server: $@"; } #-- wait a quarter second... select(undef, undef, undef, 0.25); } #-- Client is finished here return $server_pid; } #-- We're in the server require Event::RPC::Server; require Event::RPC::Logger; require Event_RPC_Test; require Event_RPC_Test2; #-- This code is mainly copied from the server.pl #-- example and works with a command line style #-- %opts hash my %ssl_args; if ( $opts{s} ) { %ssl_args = ( ssl => 1, ssl_key_file => 't/ssl/server.key', ssl_cert_file => ($opts{sf}||'t/ssl/server.crt'), ssl_passwd_cb => sub { 'eventrpc' }, ); if ( not -f 't/ssl/server.key' ) { print "please execute from toplevel directory\n"; } } my %auth_args; if ( $opts{a} ) { my ($user, $pass) = split(":", $opts{a}); $pass = Event::RPC->crypt($user, $pass); %auth_args = ( auth_required => 1, auth_passwd_href => { $user => $pass }, ); } #-- Create a logger object my $logger = Event::RPC::Logger->new ( min_level => (defined $opts{l} ? $opts{l} : 4), fh_lref => [ \*STDOUT ], ); #-- Create a loop object my $loop; my $loop_module = $opts{L}; if ( $loop_module ) { eval "use $loop_module"; die $@ if $@; $loop = $loop_module->new(); } my $port = $opts{p} || 5555; my $disconnect_cnt = $opts{S}; #-- Create a Server instance and declare the #-- exported interface my $server; $server = Event::RPC::Server->new ( name => "test daemon", port => $port, # logger => $logger, loop => $loop, start_log_listener => 1, load_modules => 0, %auth_args, %ssl_args, classes => { 'Event_RPC_Test' => { new => '_constructor', set_data => 1, get_data => 1, hello => 1, quit => 1, clone => '_object', multi => '_object', get_object2 => '_object', new_object2 => '_object', echo => 1, 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' => { new => '_constructor', set_data => 1, get_data => 1, get_object_copy => 1, }, }, connection_hook => sub { my ($conn, $event) = @_; return if $event eq 'connect'; --$disconnect_cnt; $server->stop if $disconnect_cnt <= 0 && $server->get_clients_connected == 0; 1; }, ); #-- Start the server resp. the Event loop. $server->start; #-- Exit the program exit; } 1; Event-RPC-1.04/MANIFEST0000644000175000017500000000157512270455735013330 0ustar joernjoernChanges MANIFEST Makefile.PL META.yml README lib/Event/RPC.pm lib/Event/RPC/AuthPasswdHash.pm lib/Event/RPC/Client.pm lib/Event/RPC/Logger.pm lib/Event/RPC/Loop.pm lib/Event/RPC/Loop/AnyEvent.pm lib/Event/RPC/Loop/Event.pm lib/Event/RPC/Loop/Glib.pm lib/Event/RPC/Message.pm lib/Event/RPC/Server.pm lib/Event/RPC/Connection.pm lib/Event/RPC/LogConnection.pm t/01.use.t t/02.cnct.t t/03.cnct-auth.t t/04.cnct-auth-ssl.t t/04.cnct-auth-ssl-verifypeer-noca.t t/04.cnct-auth-ssl-verifypeer.t t/04.cnct-auth-ssl-verifypeer-wrongca.t t/05.func.t t/06.object2.t t/Event_RPC_Test.pm t/Event_RPC_Test2.pm t/Event_RPC_Test_Server.pm t/ssl/ca.crt t/ssl/ca.key t/ssl/ca-wrong.crt t/ssl/ca-wrong.key 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 examples/ssl/server.key examples/ssl/server.csr examples/ssl/server.crt Event-RPC-1.04/Makefile.PL0000644000175000017500000000341510351264167014137 0ustar joernjoern# $Id: Makefile.PL,v 1.3 2005/12/18 13:47:35 joern Exp $ use strict; use ExtUtils::MakeMaker; my $loop_modules = 0; my $has_event = 0; my $has_glib = 0; eval { require Event; $has_event = 1 } && ++$loop_modules; eval { require Glib; $has_glib = 1 } && ++$loop_modules; if ( !$loop_modules ) { print "\n"; print "*******************************************************\n"; print "WARNING: You need Event or Glib for Event::RPC to work!\n"; print "*******************************************************\n"; print "\n"; } my $has_ssl; eval { require IO::Socket::SSL; $has_ssl = 1 } || do { print "\n"; print "NOTE: Event::RPC is capable of SSL encrypted connections,\n"; print " but your Perl is missing the IO::Socket::SSL module.\n"; print " Event::RPC works perfectly without the module, but you\n"; print " can't use SSL connections until IO::Socket::SSL is\n"; print " installed.\n"; print "\n"; }; #-- Add found modules to PREREQ_PM, so CPAN Testers add #-- version numbers of these modules to the reports, which #-- are very important in case of failing tests. my @add_prereq; push @add_prereq, 'Event', 0 if $has_event; push @add_prereq, 'Glib', 0 if $has_glib; push @add_prereq, 'IO::Socket::SSL', 0 if $has_ssl; push @add_prereq, 'Net::SSLeay', 0 if $has_ssl; WriteMakefile( 'NAME' => 'Event::RPC', 'VERSION_FROM' => 'lib/Event/RPC.pm', 'PREREQ_PM' => { 'Test::More' => 0, 'Storable' => 0, 'IO::Socket::INET' => 0, @add_prereq, }, 'dist' => { COMPRESS => "gzip", SUFFIX => "gz", PREOP => q[pod2text lib/Event/RPC.pm > README], POSTOP => q[mkdir -p dist && mv Event-RPC-*tar.gz dist/], }, ); Event-RPC-1.04/examples/0000755000175000017500000000000012270455742014003 5ustar joernjoernEvent-RPC-1.04/examples/server.pl0000755000175000017500000000576510351265651015662 0ustar joernjoern#!/usr/bin/perl -w # $Id: server.pl,v 1.3 2005/12/18 14:01:13 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2005 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- use strict; use strict; use lib qw( lib ../lib examples .); use Event::RPC::Server; use Event::RPC::Logger; use Getopt::Std; my $USAGE = <<__EOU; Usage: server.pl [-l log-level] [-s] [-a user:pass] [-L loop-module] Description: Event::RPC server demonstration program. Execute this from the distribution's base or examples/ directory. Then execute examples/client.pl on another console. Options: -l log-level Logging level. Default: 4 -s Use SSL encryption -a user:pass Require authorization -h host Bind to this host interface. Default: localhost -L loop-module Event loop module to use. Default: Event::RPC::Loop::Event __EOU sub HELP_MESSAGE { my ($fh) = @_; $fh ||= \*STDOUT; print $fh $USAGE; exit; } main: { my %opts; my $opts_ok = getopts('h:L:l:a:s',\%opts); HELP_MESSAGE() unless $opts_ok; my %ssl_args; if ( $opts{s} ) { %ssl_args = ( ssl => 1, ssl_key_file => 'ssl/server.key', ssl_cert_file => 'ssl/server.crt', ssl_passwd_cb => sub { 'eventrpc' }, ); if ( not -f 'ssl/server.key' ) { chdir ("examples"); if ( not -f 'ssl/server.key' ) { print "please execute from toplevel or examples/ directory\n"; exit 1; } } } my %auth_args; if ( $opts{a} ) { my ($user, $pass) = split(":", $opts{a}); $pass = Event::RPC->crypt($user, $pass); %auth_args = ( auth_required => 1, auth_passwd_href => { $user => $pass }, ); } #-- Create a logger object my $logger = Event::RPC::Logger->new ( min_level => ($opts{l}||4), fh_lref => [ \*STDOUT ], ); #-- Create a loop object my $loop; my $loop_module = $opts{L}; if ( $loop_module ) { eval "use $loop_module"; die $@ if $@; $loop = $loop_module->new(); } #-- Host parameter my $host = $opts{h} || "localhost"; #-- Create a Server instance and declare the #-- exported interface my $server = Event::RPC::Server->new ( name => "test daemon", host => $host, port => 5555, logger => $logger, loop => $loop, start_log_listener => 1, auto_reload_modules => 1, %auth_args, %ssl_args, classes => { 'Test_class' => { new => '_constructor', set_data => 1, get_data => 1, hello => 1, quit => 1, }, }, ); #-- Start the server resp. the Event loop. $server->start; } Event-RPC-1.04/examples/ssl/0000755000175000017500000000000012270455742014604 5ustar joernjoernEvent-RPC-1.04/examples/ssl/server.crt0000644000175000017500000000172110227514547016624 0ustar joernjoern-----BEGIN CERTIFICATE----- MIICozCCAgwCCQC7s/EOvPkeSTANBgkqhkiG9w0BAQQFADCBlTELMAkGA1UEBhMC REUxETAPBgNVBAgTCElyZ2VuZHdvMQ4wDAYDVQQHEwVLb2VsbjESMBAGA1UEChMJ ZXhpdDEub3JnMR0wGwYDVQQLExRTb2Z0d2FyZSBEZXZlbG9wbWVudDETMBEGA1UE AxQKSvZybiBSZWRlcjEbMBkGCSqGSIb3DQEJARYMam9lcm5AenluLmRlMB4XDTA1 MDMxMzE3NDg1NloXDTE1MDEyMDE3NDg1NlowgZUxCzAJBgNVBAYTAkRFMREwDwYD VQQIEwhJcmdlbmR3bzEOMAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9y ZzEdMBsGA1UECxMUU29mdHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4g UmVkZXIxGzAZBgkqhkiG9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0B AQEFAAOBjQAwgYkCgYEApKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRh CCNfUufY8Jslmn/4hZI4wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35 uWoMw343kZA4G6eLqjWVy8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8C AwEAATANBgkqhkiG9w0BAQQFAAOBgQAaahVlE9jXt0GO+Zk9ZDUmyiLQ31lhRbvr /fFqLYB3WS0xGnKKaj3IQFREkke7an4rhUaZLGstAhF3bXcN//t9bgZKQfnRPsM2 bQHEVWAtwjebv0Rn0uR53gZBxoCHZyGwCL0Tj0Gvynpou4Y8UDGnfc1E/r+HOTCO yvVrQL359w== -----END CERTIFICATE----- Event-RPC-1.04/examples/ssl/server.csr0000644000175000017500000000131010227514547016615 0ustar joernjoern-----BEGIN CERTIFICATE REQUEST----- MIIB1jCCAT8CAQAwgZUxCzAJBgNVBAYTAkRFMREwDwYDVQQIEwhJcmdlbmR3bzEO MAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9yZzEdMBsGA1UECxMUU29m dHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4gUmVkZXIxGzAZBgkqhkiG 9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA pKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRhCCNfUufY8Jslmn/4hZI4 wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35uWoMw343kZA4G6eLqjWV y8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8CAwEAAaAAMA0GCSqGSIb3 DQEBBAUAA4GBAJmfq2IqvN+m9IIRzNTHBjEaOeYIEFVKcqWIiui/hvw8M7Yi0op2 ifOjRKSfYTsgNAst1Ilwg6wgblSngg6f9GpGtWAYr1xQpoWS8PDaqjx1sLE40qi2 aNrCtrSCLxzLh9o0qeUydcrjvIK6sWe6lGRntjNoj2VCqlBm0EFQ7vNF -----END CERTIFICATE REQUEST----- Event-RPC-1.04/examples/ssl/server.key0000644000175000017500000000170310227514547016624 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: DES-EDE3-CBC,CEB8A2E7F9C59066 mUDYr4fgc2lba+qobTYxcq/8ZpRS1cdoiCe1QQeSQ2Bywrsgx8H40hqkBsKOYBPa ZFC+EEQTfhGOswTD5YsgqfTyWc7w0qlXDlPCVgV28r96gKzpP6oEDoclriWsToDF ZOsANyGcdl4D4VyY+oOf9crUFqIC4C/IfUJ++pZCUlGy8k/J0qHl/kCEP1bPg92q tKrG/gcDtrqnVHYB22MruAXHSAo4JOO7A6ZmrRGH4XY5SKGZPF/T7kwLLzEXbPq2 MDrcPg3xWcCvODswrptdmK73PyF5oWkA7NXAofecu51jW1Y9G48p1lQi0mAgP3qP LDxCFQUU52G9UAxmfd8pZBSntRIsaIQV+6ffM8TemObgf1VkisCGDUCnEgvj2zDN AaieLhR4MKIQuYZSTLfCI5mKZK0vCFP5t19wK6Clt7p9bq1aUu8HkqEZ5yrNmf04 acKvUkDbVCPL1pkAsyNAEQ4Zs3f3VxkuRrtf7gqzEEFK1TQoH7JmaALqGftgkPYJ eEYX8Om/Gr8NxTftSNbnoaFUyeoBOQ1iZY2g4qqE0rZlc7lfXiXAV3ajtgPcreZa +uU4g8DF7zfQ7F8FK7w2ryLJFdlgk7SzEjv1VzCQTQ2MjBOCs0gJ3SPF6wx6lfyH 9HqYRu2OwPJlaTzVrdhwKesROuBr1+rJym18uvzObSgkbTrFQuuYcR0dNbs+AuqQ dkhOC6bzpOdZNWVnVQ7klbsj8iUSMs4QnSI0+DpSls5VOMJiAXqPCAy4YJ0GAcGv EDF12ONiToyGb0Jolo+WOXyDebHR19TxokTcC5Ri7305mtRAP7g1fQ== -----END RSA PRIVATE KEY----- Event-RPC-1.04/examples/client.pl0000755000175000017500000000545210351265651015623 0ustar joernjoern#!/usr/bin/perl -w # $Id: client.pl,v 1.4 2005/12/18 14:01:13 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2005 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- use strict; use lib 'lib'; use lib qw(../lib); use Event::RPC::Client; use Getopt::Std; my $USAGE = <<__EOU; Usage: client.pl [-s] [-a user:pass] Description: Event::RPC client demonstration program. Execute this from the distribution's base or examples/ directory after starting the correspondent examples/server.pl program. Options: -s Use SSL encryption -a user:pass Pass this authorization data to the server -h host Server hostname. Default: localhost __EOU sub HELP_MESSAGE { my ($fh) = @_; $fh ||= \*STDOUT; print $fh $USAGE; exit; } main: { my %opts; my $opts_ok = getopts('h:l:a:s',\%opts); HELP_MESSAGE() unless $opts_ok; my $ssl = $opts{s} || 0; my %auth_args; if ( $opts{a} ) { my ($user, $pass) = split(":", $opts{a}); $pass = Event::RPC->crypt($user,$pass); %auth_args = ( auth_user => $user, auth_pass => $pass, ); } #-- Host parameter my $host = $opts{h} || 'localhost'; #-- This connects to the server, requests the exported #-- interfaces and establishes correspondent proxy methods #-- in the correspondent packages. my $client; $client = Event::RPC::Client->new ( host => $host, port => 5555, ssl => $ssl, %auth_args, error_cb => sub { my ($client, $error) = @_; print "An RPC error occured: $_[0]"; print "Disconnect and exit.\n"; $client->disconnect if $client; exit }, classes => [ "Test_class" ], ); $client->connect; print "\nConnected to localhost:5555\n\n"; print "Server version: ".$client->get_server_version,"\n"; print "Server protocol: ".$client->get_server_protocol,"\n\n"; #-- So the call to Event::RPC::Test->new is handled transparently #-- by Event::RPC::Client print "** Create object on server\n"; my $object = Test_class->new ( data => "Initial data", ); print "=> Object created with data: '".$object->get_data."'\n\n"; #-- and methods calls as well... print "** Say hello to server.\n"; print "=> Server returned: >>".$object->hello,"<<\n"; print "\n** Update object data.\n"; $object->set_data ("Yes, updating works"); print "=> Retrieve data from server: '".$object->get_data."'\n"; print "\n** Disconnecting\n\n"; $client->disconnect; } Event-RPC-1.04/examples/Test_class.pm0000644000175000017500000000200610351257666016446 0ustar joernjoern# $Id: Test_class.pm,v 1.2 2005/12/18 13:10:14 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2002-2005 Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Test_class; use strict; sub get_data { shift->{data} } sub set_data { shift->{data} = $_[1] } sub new { my $class = shift; my %par = @_; my ($data) = $par{'data'}; my $self = bless { data => $data, }, $class; return $self; } sub hello { my $self = shift; return "Hello again. My data is: '".$self->get_data."'"; } sub quit { my $self = shift; my $rpc_server = Event::RPC::Server->instance; $rpc_server->get_loop->add_timer ( after => 3, cb => sub { $rpc_server->stop }, ); return "Server stops in 3 seconds"; } 1;