PlRPC/ 40777 0 0 0 10635305262 10152 5ustar usergroupPlRPC/lib/ 40777 0 0 0 10635305364 10723 5ustar usergroupPlRPC/lib/RPC/ 40777 0 0 0 10635304154 11343 5ustar usergroupPlRPC/lib/RPC/PlClient/ 40777 0 0 0 10635304154 13055 5ustar usergroupPlRPC/lib/RPC/PlClient/Comm.pm100666 0 0 1146 10624653406 14412 0ustar usergroup# -*- perl -*- # # # PlRPC - Perl RPC, package for writing simple, RPC like clients and # servers # # # Copyright (c) 1997,1998 Jochen Wiedmann # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # Author: Jochen Wiedmann # Email: jochen.wiedmann at freenet.de # require 5.004; use strict; require RPC::PlServer::Comm; package RPC::PlClient::Comm; $RPC::PlClient::Comm::VERSION = '0.1002'; @RPC::PlClient::Comm::ISA = qw(RPC::PlServer::Comm); sub getMaxMessage() { return 0; } 1; PlRPC/lib/RPC/PlServer/ 40777 0 0 0 10635304154 13105 5ustar usergroupPlRPC/lib/RPC/PlServer/Comm.pm100666 0 0 13371 10624653406 14465 0ustar usergroup# -*- perl -*- # # # PlRPC - Perl RPC, package for writing simple, RPC like clients and # servers # # # Copyright (c) 1997,1998 Jochen Wiedmann # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # Author: Jochen Wiedmann # Email: jochen.wiedmann at freenet.de # require 5.004; use strict; require Storable; package RPC::PlServer::Comm; $RPC::PlServer::Comm::VERSION = '0.1003'; ############################################################################ # # Name: new (Class method) # # Purpose: Constructor # # Inputs: $class - This class # $attr - Hash ref of attributes # # Result: Server object for success, error message otherwise # ############################################################################ sub new ($) { my($class, $attr) = @_; my $self = {}; bless($self, (ref($class) || $class)); if (my $comp = $attr->{'compression'}) { if ($comp eq 'off') { $self->{'compression'} = undef; } elsif ($comp eq 'gzip') { require Compress::Zlib; $self->{'compression'} = 'gzip'; } else { die "Unknown compression type ($comp), use 'off' or 'gzip'"; } } if (my $cipher = $attr->{'cipher'}) { $self->{'cipher'} = $cipher; } if (my $maxmessage = $attr->{'maxmessage'}) { $self->{'maxmessage'} = $maxmessage; } $self; } ############################################################################ # # Name: Write # # Purpose: Writing to a PlRPC socket; used by both the client (when # sending a method name and arguments) and the server (for # sending the result list). Communication occurrs in packets. # Each packet is preceeded by 4 bytes with the true packet # size. If encryption happens, then the packet is padded with # NUL bytes to a multiple of blocksize bytes. However, the # stored size remains unchanged. # # Inputs: $self - Instance of RPC::PlServer or RPC::PlClient # $socket - The socket to write to # $args - Reference to array of arguments being sent # # Result: Nothing; dies in case of errors. # ############################################################################ sub Write ($$$) { my($self, $socket, $msg) = @_; my $encodedMsg = Storable::nfreeze($msg); $encodedMsg = Compress::Zlib::compress($encodedMsg) if ($self->{'compression'}); my($encodedSize) = length($encodedMsg); if (my $cipher = $self->{'cipher'}) { my $size = $cipher->blocksize; if (my $addSize = length($encodedMsg) % $size) { $encodedMsg .= chr(0) x ($size - $addSize); } $msg = ''; for (my $i = 0; $i < length($encodedMsg); $i += $size) { $msg .= $cipher->encrypt(substr($encodedMsg, $i, $size)); } $encodedMsg = $msg; } local $\; if (!$socket->print(pack("N", $encodedSize), $encodedMsg) || !$socket->flush()) { die "Error while writing socket: $!"; } } ############################################################################ # # Name: Read # # Purpose: Reading from a PlRPC socket; used by both the client (when # receiving a result list) and the server (for receiving the # method name and arguments). Counterpart of Write, see # above for specs. # # Inputs: $self - Instance of RPC::PlServer or RPC::PlClient # $socket - The socket to read from # # Result: Array ref to result list; dies in case of errors. # ############################################################################ sub Read($$) { my($self, $socket) = @_; my $result; my($encodedSize, $readSize, $blockSize); $readSize = 4; $encodedSize = ''; while ($readSize > 0) { my $result = $socket->read($encodedSize, $readSize, length($encodedSize)); if (!$result) { return undef if defined($result); die "Error while reading socket: $!"; } $readSize -= $result; } $encodedSize = unpack("N", $encodedSize); my $max = $self->getMaxMessage(); die "Maximum message size of $max exceeded, use option 'maxmessage' to" . " increase" if $max && $encodedSize > $max; $readSize = $encodedSize; if ($self->{'cipher'}) { $blockSize = $self->{'cipher'}->blocksize; if (my $addSize = ($encodedSize % $blockSize)) { $readSize += ($blockSize - $addSize); } } my $msg = ''; my $rs = $readSize; while ($rs > 0) { my $result = $socket->read($msg, $rs, length($msg)); if (!$result) { die "Unexpected EOF" if defined $result; die "Error while reading socket: $!"; } $rs -= $result; } if ($self->{'cipher'}) { my $cipher = $self->{'cipher'}; my $encodedMsg = $msg; $msg = ''; for (my $i = 0; $i < $readSize; $i += $blockSize) { $msg .= $cipher->decrypt(substr($encodedMsg, $i, $blockSize)); } $msg = substr($msg, 0, $encodedSize); } $msg = Compress::Zlib::uncompress($msg) if ($self->{'compression'}); Storable::thaw($msg); } ############################################################################ # # Name: Init # # Purpose: Initialize an object for using RPC::PlServer::Comm methods # # Input: $self - Instance # # Returns: The instance in case of success, dies in case of trouble. # ############################################################################ ############################################################################ # # Name: getMaxMessage # # Purpose: Returns the maximum size of a message # # Inputs: None # # Returns: Maximum message size or 65536, if none specified # ############################################################################ sub getMaxMessage() { my $self = shift; return defined($self->{'maxmessage'}) ? $self->{'maxmessage'} : 65536; } 1; PlRPC/lib/RPC/PlServer/Test.pm100666 0 0 404 10624653406 14442 0ustar usergroup# -*- perl -*- use strict; require 5.004; require RPC::PlServer; require Net::Daemon::Test; package RPC::PlServer::Test; $RPC::PlServer::Test::VERSION = '0.01'; @RPC::PlServer::Test::ISA = qw(RPC::PlServer); @RPC::PlServer::ISA = qw(Net::Daemon::Test); PlRPC/lib/RPC/PlClient.pm100666 0 0 31060 10635304564 13535 0ustar usergroup# -*- perl -*- # # # PlRPC - Perl RPC, package for writing simple, RPC like clients and # servers # # RPC::PlClient.pm is the module for writing the PlRPC client. # # # Copyright (c) 1997, 1998 Jochen Wiedmann # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # Author: Jochen Wiedmann # Email: jochen.wiedmann at freenet.de # use strict; use RPC::PlClient::Comm (); use Net::Daemon::Log (); use IO::Socket (); package RPC::PlClient; $RPC::PlClient::VERSION = '0.2020'; @RPC::PlClient::ISA = qw(Net::Daemon::Log); ############################################################################ # # Name: new # # Purpose: Constructor of the PlRPC::Client module # # Inputs: $self - Class name # @attr - Attribute list # # Returns: Client object; dies in case of errors. # ############################################################################ sub new ($@) { my $proto = shift; my $self = {@_}; bless($self, (ref($proto) || $proto)); my $comm = $self->{'comm'} = RPC::PlClient::Comm->new($self); my $app = $self->{'application'} or $self->Fatal("Missing application name"); my $version = $self->{'version'} or $self->Fatal("Missing version number"); my $user = $self->{'user'} || ''; my $password = $self->{'password'} || ''; my $socket; if (!($socket = $self->{'socket'})) { $self->Fatal("Missing peer address") unless $self->{'peeraddr'}; $self->Fatal("Missing peer port") unless ($self->{'peerport'} || index($self->{'peeraddr'}, ':') != -1); $socket = $self->{'socket'} = IO::Socket::INET->new ('PeerAddr' => $self->{'peeraddr'}, 'PeerPort' => $self->{'peerport'}, 'Proto' => $self->{'socket_proto'}, 'Type' => $self->{'socket_type'}, 'Timeout' => $self->{'timeout'}); $self->Fatal("Cannot connect: $!") unless $socket; } $self->Debug("Connected to %s, port %s", $socket->peerhost(), $socket->peerport()); $self->Debug("Sending login message: %s, %s, %s, %s", $app, $version, $user, "x" x length($password)); $comm->Write($socket, [$app, $version, $user, $password]); $self->Debug("Waiting for server's response ..."); my $reply = $comm->Read($socket); die "Unexpected EOF from server" unless defined($reply); die "Expected server to return an array ref" unless ref($reply) eq 'ARRAY'; my $msg = defined($reply->[1]) ? $reply->[1] : ''; die "Refused by server: $msg" unless $reply->[0]; $self->Debug("Logged in, server replies: $msg"); return ($self, $msg) if wantarray; $self; } ############################################################################ # # Name: Call # # Purpose: Coerce method located on the server # # Inputs: $self - client instance # $method - method name # @args - method attributes # # Returns: method results; dies in case of errors. # ############################################################################ sub Call ($@) { my $self = shift; my $socket = $self->{'socket'}; my $comm = $self->{'comm'}; $comm->Write($socket, [@_]); my $msg = $comm->Read($socket); die "Unexpected EOF while waiting for server reply" unless defined($msg); die "Server returned error: $$msg" if ref($msg) eq 'SCALAR'; die "Expected server to return an array ref" unless ref($msg) eq 'ARRAY'; @$msg; } sub ClientObject { my $client = shift; my $class = shift; my $method = shift; my($object) = $client->Call('NewHandle', $class, $method, @_); die "Constructor didn't return a TRUE value" unless $object; die "Constructor didn't return an object" unless $object =~ /^((?:\w+|\:\:)+)=(\w+)/; RPC::PlClient::Object->new($1, $client, $object); } sub Disconnect { my $self = shift; $self->{'socket'} = undef; 1; } package RPC::PlClient::Object; use vars qw($AUTOLOAD); sub AUTOLOAD { my $method = $AUTOLOAD; my $index; die "Cannot parse method: $method" unless ($index = rindex($method, '::')) != -1; my $class = substr($method, 0, $index); $method = substr($method, $index+2); eval <<"EOM"; package $class; sub $method { my \$self = shift; my \$client = \$self->{'client'}; my \$object = \$self->{'object'}; my \@result = \$client->Call('CallMethod', \$object, '$method', \@_); return \@result if wantarray; return \$result[0]; } EOM goto &$AUTOLOAD; } sub new { my($class, $cl, $client, $object) = @_; $class = ref($class) if ref($class); no strict 'refs'; my $ocl = "${class}::$cl"; @{"${ocl}::ISA"} = $class unless @{"${ocl}::ISA"}; my $self = { 'client' => $client, 'object' => $object }; bless($self, $ocl); $self; } sub DESTROY { my $saved_error = $@; # Save $@ my $self = shift; if (my $client = delete $self->{'client'}) { eval { $client->Call('DestroyHandle', $self->{'object'}) }; } $@ = $saved_error; # Restore $@ } 1; __END__ =pod =head1 NAME RPC::PlClient - Perl extension for writing PlRPC clients =head1 SYNOPSIS require RPC::PlClient; # Create a client object and connect it to the server my $client = RPC::PlClient->new('peeraddr' => 'joes.host.de', 'peerport' => 2570, 'application' => 'My App', 'version' => '1.0', 'user' => 'joe', 'password' => 'hello!'); # Create an instance of $class on the server by calling $class->new() # and an associated instance on the client. my $object = $client->Call('NewHandle', $class, 'new', @args); # Call a method on $object, effectively calling the same method # on the associated server instance. my $result = $object->do_method(@args); =head1 DESCRIPTION PlRPC (Perl RPC) is a package that simplifies the writing of Perl based client/server applications. RPC::PlServer is the package used on the server side, and you guess what RPC::PlClient is for. See L for this part. PlRPC works by defining a set of methods that may be executed by the client. For example, the server might offer a method "multiply" to the client. Now a function call @result = $client->Call('multiply', $a, $b); on the client will be mapped to a corresponding call $server->multiply($a, $b); on the server. The function calls result will be transferred to the client and returned as result of the clients method. Simple, eh? :-) =head2 Client methods =over 4 =item $client = new(%attr); (Class method) The client constructor. Returns a client object, connected to the server. A Perl exception is thrown in case of errors, thus you typically use it like this: $client = eval { RPC::PlClient->new ( ... ) }; if ($@) { print STDERR "Cannot create client object: $@\n"; exit 0; } The method accepts a list of key/value pairs as arguments. Known arguments are: =over 8 =item peeraddr =item peerport =item socket_proto =item socket_type =item timeout These correspond to the attributes I, I, I, I and I of IO::Socket::INET. The server connection will be established by passing them to IO::Socket::INET->new(). =item socket After a connection was established, the IO::Socket instance will be stored in this attribute. If you prefer establishing the connection on your own, you may as well create an own instance of IO::Socket and pass it as attribute I to the new method. The above attributes will be ignored in that case. =item application =item version =item user =item password it is part of the PlRPC authorization process, that the client must obeye a login procedure where he will pass an application name, a protocol version and optionally a user name and password. These arguments are handled by the servers I, I and I methods. =item compression Set this to off (default, no compression) or gzip (requires the Compress::Zlib module). =item cipher This attribute can be used to add encryption quite easily. PlRPC is not bound to a certain encryption method, but to a block encryption API. The attribute is an object supporting the methods I, I and I. For example, the modules Crypt::DES and Crypt::IDEA support such an interface. Note that you can set or remove encryption on the fly (putting C as attribute value will stop encryption), but you have to be sure, that both sides change the encryption mode. Example: use Crypt::DES; $cipher = Crypt::DES->new(pack("H*", "0123456789abcdef")); $client = RPC::PlClient->new('cipher' => $cipher, ...); =item maxmessage The size of messages exchanged between client and server is restricted, in order to omit denial of service attacks. By default the limit is 65536 bytes. =item debug Enhances logging level by emitting debugging messages. =item logfile By default the client is logging to syslog (Unix) or the event log (Windows). If neither is available or you pass a TRUE value as I, then logging will happen to the given file handle, an instance of IO::Handle. If the value is scalar, then logging will occur to stderr. Examples: # Logging to stderr: my $client = RPC::PlClient->new('logfile' => 1, ...); # Logging to 'my.log': my $file = IO::File->new('my.log', 'a') || die "Cannot create log file 'my.log': $!"; my $client = RPC::PlClient->new('logfile' => $file, ...); =back =item @result = $client->Call($method, @args); (Instance method) Calls a method on the server; the arguments are a method name of the server class and the method call arguments. It returns the method results, if successfull, otherwise a Perl exception is thrown. Example: @results = eval { $client->Call($method, @args }; if ($@) { print STDERR "An error occurred while executing $method: $@\n"; exit 0; } =item $cobj = $client->ClientObject($class, $method, @args) (Instance method) A set of predefined methods is available that make dealing with client side objects incredibly easy: In short the client creates a representation of the server object for you. Say we have an object $sobj on the server and an associated object $cobj on the client: Then a call @results = $cobj->my_method(@args); will be immediately mapped to a call @results = $sobj->my_method(@args); on the server and the results returned to you without any additional programming. Here's how you create $cobj, an instance of I: my $cobj = $client->ClientObject($class, 'new', @args); This will trigger a call my $sobj = $class->new(@args); on the server for you. Note that the server has the ability to restrict access to both certain classes and methods by setting $server->{'methods'} appropriately. =back =head1 EXAMPLE We'll create a simple example application, an MD5 client. The server will have installed the MD5 module and create digests for us. We present the client part only, the server example is part of the RPC::PlServer man page. See L. #!/usr/local/bin/perl use strict; # Always a good choice. require RPC::PlClient; # Constants my $MY_APPLICATION = "MD5_Server"; my $MY_VERSION = 1.0; my $MY_USER = ""; # The server doesn't require user my $MY_PASSWORD = ""; # authentication. my $hexdigest = eval { my $client = RPC::PlClient->new ('peeraddr' => '127.0.0.1', 'peerport' => 2000, 'application' => $MY_APPLICATION, 'version' => $MY_VERSION, 'user' => $MY_USER, 'password' => $MY_PASSWORD); # Create an MD5 object on the server and an associated # client object. Executes a # $context = MD5->new() # on the server. my $context = $client->ClientObject('MD5', 'new'); # Let the server calculate a digest for us. Executes a # $context->add("This is a silly string!"); # $context->hexdigest(); # on the server. $context->add("This is a silly string!"); $context->hexdigest(); }; if ($@) { die "An error occurred: $@"; } print "Got digest $hexdigest\n"; =head1 AUTHOR AND COPYRIGHT The PlRPC-modules are Copyright (C) 1998, Jochen Wiedmann Email: jochen.wiedmann at freenet.de All rights reserved. You may distribute this package under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. =head1 SEE ALSO L, L, L, L, L An example application is the DBI Proxy client: L. =cut PlRPC/lib/RPC/PlServer.pm100666 0 0 45743 10635304576 13605 0ustar usergroup# -*- perl -*- # # # PlRPC - Perl RPC, package for writing simple, RPC like clients and # servers # # # Copyright (c) 1997,1998 Jochen Wiedmann # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # Author: Jochen Wiedmann # Email: jochen.wiedmann at freenet.de # # use strict; require Net::Daemon; require RPC::PlServer::Comm; package RPC::PlServer; @RPC::PlServer::ISA = qw(Net::Daemon); $RPC::PlServer::VERSION = '0.2020'; ############################################################################ # # Name: Version (Class method) # # Purpose: Returns version string # # Inputs: $class - This class # # Result: Version string; suitable for printed by "--version" # ############################################################################ sub Version ($) { "RPC::PlServer application, Copyright (C) 1997, 1998, Jochen Wiedmann"; } ############################################################################ # # Name: Options (Class method) # # Purpose: Returns a hash ref of command line options # # Inputs: $class - This class # # Result: Options array; any option is represented by a hash ref; # used keys are 'template', a string suitable for describing # the option to Getopt::Long::GetOptions and 'description', # a string for the Usage message # ############################################################################ sub Options ($) { my $options = shift->SUPER::Options(); $options->{'maxmessage'} = { 'template' => 'maxmessage=i', 'description' => '--maxmessage ' . 'Set max message size to (Default 65535).' }; $options->{'compression'} = { 'template' => 'compression=s', 'description' => '--compression ' . 'Set compression type to off (default) or gzip.' }; $options; } ############################################################################ # # Name: AcceptApplication, AcceptVersion, AcceptUser # (Instance methods) # # Purpose: Called for authentication purposes; these three in common # are replacing Net::Daemon's Accept(). # # Inputs: $self - Server instance # $app - Application name # $version - Version number # $user, $password - User name and password # # Result: TRUE, if the client has successfully authorized, FALSE # otherwise. The AcceptUser method (being called as the # last) may additionally return an array ref as a TRUE # value: This is treated as welcome message. # ############################################################################ sub AcceptApplication ($$) { my $self = shift; my $app = shift; $self->Debug("Client requests application $app"); UNIVERSAL::isa($self, $app); } sub AcceptVersion ($$) { my $self = shift; my $version = shift; $self->Debug("Client requests version $version"); no strict 'refs'; my $myversion = ${ref($self) . "::VERSION"}; ($version <= $myversion) ? 1 : 0; } sub AcceptUser ($$$) { my $self = shift; my $user = shift; my $password = shift; my $client = $self->{'client'}; return 1 unless $client->{'users'}; my $users = $client->{'users'}; foreach my $u (@$users) { my $au; if (ref($u)) { $au = $u; $u = defined($u->{'name'}) ? $u->{'name'} : ''; } if ($u eq $user) { $self->{'authorized_user'} = $au; return 1; } } 0; } sub Accept ($) { my $self = shift; my $socket = $self->{'socket'}; my $comm = $self->{'comm'}; return 0 if (!$self->SUPER::Accept()); my $client; if ($client = $self->{'client'}) { if (my $cipher = $client->{'cipher'}) { $self->Debug("Host encryption: %s", $cipher); $self->{'cipher'} = $cipher; } } my $msg = $comm->Read($socket); die "Unexpected EOF from client" unless defined $msg; die "Login message: Expected array, got $msg" unless ref($msg) eq 'ARRAY'; my $app = $self->{'application'} = $msg->[0] || ''; my $version = $self->{'version'} = $msg->[1] || 0; my $user = $self->{'user'} = $msg->[2] || ''; my $password = $self->{'password'} = $msg->[3] || ''; $self->Debug("Client logs in: Application %s, version %s, user %s", $app, $version, $user); if (!$self->AcceptApplication($app)) { $comm->Write($socket, [0, "This is a " . ref($self) . " server, go away!"]); return 0; } if (!$self->AcceptVersion($version)) { $comm->Write($socket, [0, "Sorry, but I am not running version $version."]); return 0; } my $result; if (!($result = $self->AcceptUser($user, $password))) { $comm->Write($socket, [0, "User $user is not permitted to connect."]); return 0; } $comm->Write($socket, (ref($result) ? $result : [1, "Welcome!"])); if (my $au = $self->{'authorized_user'}) { if (ref($au) && (my $cipher = $au->{'cipher'})) { $self->Debug("User encryption: %s", $cipher); $self->{'cipher'} = $cipher; } } if (my $client = $self->{'client'}) { if (my $methods = $client->{'methods'}) { $self->{'methods'} = $methods; } } if (my $au = $self->{'authorized_user'}) { if (my $methods = $au->{'methods'}) { $self->{'methods'} = $methods; } } 1; } ############################################################################ # # Name: new (Class method) # # Purpose: Constructor # # Inputs: $class - This class # $attr - Hash ref of attributes # $args - Array ref of command line arguments # # Result: Server object for success, error message otherwise # ############################################################################ sub new ($$;$) { my $self = shift->SUPER::new(@_); $self->{'comm'} = RPC::PlServer::Comm->new($self); $self; } ############################################################################ # # Name: Run # # Purpose: Process client requests # # Inputs: $self - Server instance # # Returns: Nothing, dies in case of errors. # ############################################################################ sub Run ($) { my $self = shift; my $comm = $self->{'comm'}; my $socket = $self->{'socket'}; while (!$self->Done()) { my $msg = $comm->Read($socket); last unless defined($msg); die "Expected array" unless ref($msg) eq 'ARRAY'; my($error, $command); if (!($command = shift @$msg)) { $error = "Expected method name"; } else { if ($self->{'methods'}) { my $class = $self->{'methods'}->{ref($self)}; if (!$class || !$class->{$command}) { $error = "Not permitted for method $command of class " . ref($self); } } if (!$error) { $self->Debug("Client executes method $command"); my @result = eval { $self->$command(@$msg) }; if ($@) { $error = "Failed to execute method $command: $@"; } else { $comm->Write($socket, \@result); } } } if ($error) { $comm->Write($socket, \$error); } } } ############################################################################ # # Name: StoreHandle, NewHandle, UseHandle, DestroyHandle, # CallMethod # # Purpose: Support functions for working with objects # # Inputs: $self - server instance # $object - Server side object # $handle - Client side handle # ############################################################################ sub StoreHandle ($$) { my $self = shift; my $object = shift; my $handle = "$object"; $self->{'handles'}->{$handle} = $object; $handle; } sub NewHandle ($$$@) { my($self, $handle, $method, @args) = @_; my $object = $self->CallMethod($handle, $method, @args); die "Constructor $method didn't return a true value" unless $object; $self->StoreHandle($object) } sub UseHandle ($$) { my $self = shift; my $handle = shift; $self->{'handles'}->{$handle} || die "No such object: $handle"; } sub DestroyHandle ($$) { my $self = shift; my $handle = shift; (delete $self->{'handles'}->{$handle}) || die "No such object: $handle"; (); } sub CallMethod ($$$@) { my($self, $handle, $method, @args) = @_; my($ref, $object); my $call_by_instance; { my $lock = lock($Net::Daemon::RegExpLock) if $Net::Daemon::RegExpLock && $self->{'mode'} eq 'threads'; $call_by_instance = ($handle =~ /=\w+\(0x/); } if ($call_by_instance) { # Looks like a call by instance $object = $self->UseHandle($handle); $ref = ref($object); } else { # Call by class $ref = $object = $handle; } if ($self->{'methods'}) { my $class = $self->{'methods'}->{$ref}; if (!$class || !$class->{$method}) { die "Not permitted for method $method of class $ref"; } } $object->$method(@args); } 1; __END__ =head1 NAME RPC::PlServer - Perl extension for writing PlRPC servers =head1 SYNOPSIS # Create a subclass of RPC::PlServer use RPC::PlServer; package MyServer; $MyServer::VERSION = '0.01'; @MyServer::ISA = qw(RPC::PlServer); # Overwrite the Run() method to handle a single connection sub Run { my $self = shift; my $socket = $self->{'socket'}; } # Create an instance of the MyServer class package main; my $server = MyServer->new({'localport' => '1234'}, \@ARGV); # Bind the server to its port to make it actually running $server->Bind(); =head1 DESCRIPTION PlRPC (Perl RPC) is a package for implementing servers and clients that are written in Perl entirely. The name is borrowed from Sun's RPC (Remote Procedure Call), but it could as well be RMI like Java's "Remote Method Interface), because PlRPC gives you the complete power of Perl's OO framework in a very simple manner. RPC::PlServer is the package used on the server side, and you guess what RPC::PlClient is for. Both share the package RPC::PlServer::Comm for communication purposes. See L and L for these parts. PlRPC works by defining a set of methods that may be executed by the client. For example, the server might offer a method "multiply" to the client. Now the clients method call @result = $client->multiply($a, $b); will be immediately mapped to a method call @result = $server->multiply($a, $b); on the server. The arguments and results will be transferred to or from the server automagically. (This magic has a name in Perl: It's the Storable module, my thanks to Raphael Manfredi for this excellent package.) Simple, eh? :-) The RPC::PlServer and RPC::PlClient are abstract servers and clients: You have to derive your own classes from it. =head2 Additional options The RPC::PlServer inherits all of Net::Daemon's options and attributes and adds the following: =over 8 =item I The attribute value is an instance of Crypt::DES, Crypt::IDEA or any other class with the same API for block encryption. If you supply such an attribute, the traffic between client and server will be encrypted using this option. =item I (B<--maxmessage=size>) The size of messages exchanged between client and server is restricted, in order to omit denial of service attacks. By default the limit is 65536 bytes. =item users This is an attribute of the client object used for Permit/Deny rules in the config file. It's value is an array ref of user names that are allowed to connect from the given client. See the example config file below. L. =back =head2 Error Handling Error handling is simple with the RPC package, because it is based on Perl exceptions completely. Thus your typical code looks like this: eval { # Do something here. Don't care for errors. ... }; if ($@) { # An error occurred. ... } =head2 Server Constructors my $server = RPC::PlServer(\%options, \@args); (Class method) This constructor is immediately inherited from the Net::Daemon package. See L for details. =head2 Access Control $ok = $self->AcceptApplication($app); $ok = $self->AcceptVersion($version); $ok = $self->AcceptUser($user, $password); The RPC::PlServer package has a very detailed access control scheme: First of all it inherits Net::Daemon's host based access control. It adds version control and user authorization. To achieve that, the method I from Net::Daemon is split into three methods, I, I and I, each of them returning TRUE or FALSE. The client receives the arguments as the attributes I, I, I and I. A client is accepted only if all of the above methods are returning TRUE. The default implementations are as follows: The AcceptApplication method returns TRUE, if B<$self> is a subclass of B<$app>. The AcceptVersion method returns TRUE, if the requested version is less or equal to B<${$class}::VERSION>, $self being an instance of B<$class>. Whether a user is permitted to connect depends on the client configuration. See L below for examples. =head2 Method based access control Giving a client the ability to invoke arbitrary methods can be a terrible security hole. Thus the server has a I attribute. This is a hash ref of class names as keys, the values being hash refs again with method names as the keys. That is, if your hash looks as follows: $self->{'methods'} = { 'CalcServer' => { 'NewHandle' => 1, 'CallMethod' => 1 }, 'Calculator' => { 'new' => 1, 'multiply' => 1, 'add' => 1, 'divide' => 1, 'subtract' => 1 } }; then the client may use the CalcServer's I method to create objects, but only via the permitted constructor Calculator->new. Once a Calculator object is created, the server may invoke the methods multiply, add, divide and subtract. =head1 CONFIGURATION FILE The server config file is inherited from Net::Daemon. It adds the I and I attribute to the client list. Thus a typical config file might look as follows: # Load external modules; this is not required unless you use # the chroot() option. #require DBD::mysql; #require DBD::CSV; # Create keys my $myhost_key = Crypt::IDEA->new('83fbd23390ade239'); my $bob_key = Crypt::IDEA->new('be39893df23f98a2'); { # 'chroot' => '/var/dbiproxy', 'facility' => 'daemon', 'pidfile' => '/var/dbiproxy/dbiproxy.pid', 'user' => 'nobody', 'group' => 'nobody', 'localport' => '1003', 'mode' => 'fork', # Access control 'clients' => [ # Accept the local LAN (192.168.1.*) { 'mask' => '^192\.168\.1\.\d+$', 'accept' => 1, 'users' => [ 'bob', 'jim' ], 'cipher' => $myhost_key }, # Accept myhost.company.com { 'mask' => '^myhost\.company\.com$', 'accept' => 1, 'users' => [ { 'name' => 'bob', 'cipher' => $bob_key } ] }, # Deny everything else { 'mask' => '.*', 'accept' => 0 } ] } Things you should note: The user list of 192.168.1.* contains scalar values, but the user list of myhost.company.com contains hash refs: This is required, because the user configuration is more specific for user based encryption. =head1 EXAMPLE Enough wasted time, spread the example, not the word. :-) Let's write a simple server, say a server for MD5 digests. The server uses the external package MD5, but the client doesn't need to install the package. L. We present the server source here, the client is part of the RPC::PlClient man page. See L. #!/usr/bin/perl -wT # Note the -T switch! This is always recommended for Perl servers. use strict; # Always a good choice. require RPC::PlServer; require MD5; package MD5_Server; # Clients need to request application # "MD5_Server" $MD5_Server::VERSION = '1.0'; # Clients will be refused, if they # request version 1.1 @MD5_Server::ISA = qw(RPC::PlServer); eval { # Server options below can be overwritten in the config file or # on the command line. my $server = MD5_Server->new({ 'pidfile' => '/var/run/md5serv.pid', 'configfile' => '/etc/md5serv.conf', 'facility' => 'daemon', # Default 'user' => 'nobody', 'group' => 'nobody', 'localport' => 2000, 'logfile' => 0, # Use syslog 'mode' => 'fork', # Recommended for Unix 'methods' => { 'MD5_Server' => { 'ClientObject' => 1, 'CallMethod' => 1, 'NewHandle' => 1 }, 'MD5' => { 'new' => 1, 'add' => 1, 'hexdigest' => 1 }, } }); $server->Bind(); }; =head1 SECURITY It has to be said: PlRPC based servers are a potential security problem! I did my best to avoid security problems, but it is more than likely, that I missed something. Security was a design goal, but not *the* design goal. (A well known problem ...) I highly recommend the following design principles: =head2 Protection against "trusted" users =over 4 =item perlsec Read the perl security FAQ (C) and use the C<-T> switch. =item taintperl B the C<-T> switch. I mean it! =item Verify data Never untaint strings withouth verification, better verify twice. For example the I function first checks, whether an object handle is valid before coercing a method on it. =item Be restrictive Think twice, before you give a client access to a method. =item perlsec And just in case I forgot it: Read the C man page. :-) =back =head2 Protection against untrusted users =over 4 =item Host based authorization PlRPC has a builtin host based authorization scheme; use it! See L. =item User based authorization PlRPC has a builtin user based authorization scheme; use it! See L. =item Encryption Using encryption with PlRPC is extremely easy. There is absolutely no reason for communicating unencrypted with the clients. Even more: I recommend two phase encryption: The first phase is the login phase, where to use a host based key. As soon as the user has authorized, you should switch to a user based key. See the DBI::ProxyServer for an example. =back =head1 AUTHOR AND COPYRIGHT The PlRPC-modules are Copyright (C) 1998, Jochen Wiedmann Email: jochen.wiedmann at freenet.de All rights reserved. You may distribute this package under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. =head1 SEE ALSO L, L, L, L, L, L, L See L for an example application. =cut PlRPC/lib/Bundle/ 40777 0 0 0 10635305364 12134 5ustar usergroupPlRPC/lib/Bundle/PlRPC.pm100666 0 0 542 10624653406 13471 0ustar usergrouppackage Bundle::PlRPC; $VERSION = '0.03'; 1; __END__ =head1 NAME Bundle::PlRPC - A bundle to install PlRPC-Server, Client and prerequisites. =head1 SYNOPSIS C =head1 CONTENTS Storable Net::Daemon RPC::PlServer =head1 DESCRIPTION This bundle includes all that's needed to run PlRPC-Server and Client. PlRPC/ChangeLog100666 0 0 10563 10635305042 12042 0ustar usergroup2007-06-17 Malcolm Nooning (0.2020) * Got rid of the .svn directories that I errently allowed into the last gz upload. 2007-05-16 Malcolm Nooning (0.2019) * Fixed an @opts name that was causing crypt.t to fail. Namely, changed 'cipher' to 'usercipher', but only in @opts, because the tests invoked by crypt.t were looking to match 'usercipher' to get the user key. 2004-07-19 Jochen Wiedmann (0.2018) * The RPC::PlServer::Comm module is now being used as an encapsulated object $self->{'comm'}. It has definitely been a design flaw to use like it has been. * The client is no longer bound to a maximum message size of 65536 bytes. Emile, 2003-05-31 Jochen Wiedmann (0.2017) * lib/RPC/PlClient.pm: Added Disconnect method for proper cleanup of resources. Steven N. Hirsch, hirschs at btv.ibm.com * lib/RPC/PlClient.pm: Initialization of Comm module is now at the beginning of new(). Steven N. Hirsch, hirschs at btv.ibm.com 2001-10-01 Jochen Wiedmann (0.2016) * lib/RPC/PlServer/Comm.pm (Write): Added handling of $\. Brian McCauley 2001-03-26 Jochen Wiedmann (0.2014) * lib/RPC/PlClient.pm: Documentation fixes Joel Meulenberg 2001-01-23 Jochen Wiedmann (0.2014) * lib/RPC/PlServer.pm: Changed DES->new to Crypt::DES->new. (Thanks heaven, DES is now a standard module!) Paul Schinder 2001-01-22 Jochen Wiedmann (0.2013) * lib/RPC/PlClient.pm (DESTROY): $@ was possibly destroyed. Tushar 1999-06-26 Jochen Wiedmann (0.2012) * lib/RPC/PlServer.pm (CallMethod): RegExpLock was used too long. Thanks to Brady Montz (bradym@cs.arizona.edu). 1999-06-26 Jochen Wiedmann (0.2011) * lib/RPC/PlServer/Comm.pm (Read): The result of read() was used incorrect, resulting in never ending loops. Thanks to Gerald Richter (richter@ecos.de). 1999-04-09 Jochen Wiedmann (0.2010) * lib/RPC/PlServer/Comm.pm (Read): Added 'maxmessage' option to omit "Out of memory" bugs (Liraz Siri ). * Lots of minor bug fixes in the docs of RPC::PlServer and RPC::PlClient. Alf Wachsmann * lib/RPC/PlServer/Comm.pm: Added 'compression' option. 1999-01-13 Jochen Wiedmann (0.2003) * lib/RPC/PlServer.pm (CallMethod): Fixed bug in lock handling, thanks to schinder@pobox.com. 1999-01-12 Jochen Wiedmann (0.2002) * Added use of Net::Daemon::RegExpLock. * Fixed prerequisite checks in Makefile.PL, my thanks to Andreas Koenig . 1998-10-30 Jochen Wiedmann (0.2001) * t/methods.t: $handle->Terminate() wasn't called without END. 1998-10-28 Jochen Wiedmann (0.2000) * Complete rewrite, based on Net::Daemon. Renamed to PlRPC, due to compatibility problems. 1998-09-08 Jochen Wiedmann (0.1006) * lib/RPC/pClient.pm: Added Log(), Debug(), Error() and Fatal() methods to support Windows. $self->{'stderr'} can now be an IO handle or any other object supporting a print method. My thanks to Toni L. Harbaugh for his patches. 1998-08-13 Jochen Wiedmann (0.1005) * Makefile.PL: Added check for Sys::Syslog.h to detect problems with missing sys/syslog.ph. 1998-07-19 Jochen Wiedmann (0.1004) * lib/RPC/pServer.pm: Embedded all occurrences of setlogsock('unix') into an eval. Required, because it otherwise fails on Solaris. 1998-07-18 Jochen Wiedmann (0.1003) * Minor fixes to prevent warnings with DBI::ProxyServer. 0.1002 Checking for existence of Sys::Syslog::setlogsock in test scripts. (Ulrich Pfeifer, upf@de.uu.net) Fixed Socket::inet_ntoa() instead of inet_ntoa() in pServer.pm. (Ulrich Pfeifer, upf@de.uu.net) Added 'Reuse' => 1 to server configuration. 0.1001 Tue Aug 19 17:53:44 1997 - original version; created by h2xs 1.18 PlRPC/Makefile.PL100666 0 0 4427 10624653406 12234 0ustar usergroup# -*- perl -*- use strict; use ExtUtils::MakeMaker; use Config; $| = 1; # Check, if fork() is available. If so, we assume that syslog should # be available too. Thankfull for any better recommendations ... if ($Config::Config{'d_fork'} eq 'define') { print "Checking for Sys::Syslog ... "; eval { require Sys::Syslog }; if ($@) { my $errmsg = $@; $errmsg =~ s/^/ /mg; if ($@ =~ /h2ph/) { print STDERR <<"MSG"; While loading the Sys::Syslog module, I received the following error message: $errmsg Most probably this means that you did not run the h2ph script after installing Perl. You can do this now by executing the commands cd /usr/include h2ph *.h */*.h */*/*.h MSG exit 10; } my $reply = prompt(qq{ Your system looks like Unix, as you seem to have fork() available. However I cannot load the Sys::Syslog module which should be working on any Unix machine. Please check out the following error message: $@ In either case, please contact the package author, jochen.wiedmann\@freenet.de and let him know your machine configuration (try "perl -V") and the above error message. Do you want to continue? }, "y"); if ($reply !~ /y/i) { exit 1; } } else { print "ok\n"; } } # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. my %opts = ( 'NAME' => 'RPC::PlServer', 'DISTNAME' => 'PlRPC', 'dist' => { SUFFIX => '.gz', DIST_DEFAULT => 'all tardist', COMPRESS => 'gzip -9vf' }, 'VERSION_FROM' => 'lib/RPC/PlServer.pm', # finds $VERSION 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' 'clean' => { 'FILES' => 'ndtest.prt t/*.cfg' } ); if ($ExtUtils::MakeMaker::VERSION >= 5.43) { $opts{'AUTHOR'} = 'Jochen Wiedmann (jochen.wiedmann@freenet.de)'; $opts{'PREREQ_PM'} = { 'Storable'=> 0, 'Net::Daemon' => 0.13 }, $opts{'ABSTRACT'} = 'Perl Remote Method Invocation'; } WriteMakefile(%opts); package MY; sub libscan { my($self, $path) = @_; ($path =~ /\~$/) ? undef : $path } sub postamble { <<"END_OF_POSTAMBLE"; pm_to_blib: README README: lib/RPC/PlServer.pm \tperldoc -t lib/RPC/PlServer.pm >README END_OF_POSTAMBLE } PlRPC/MANIFEST100666 0 0 505 10624653406 11364 0ustar usergroupChangeLog MANIFEST Makefile.PL README lib/Bundle/PlRPC.pm lib/RPC/PlClient.pm lib/RPC/PlClient/Comm.pm lib/RPC/PlServer.pm lib/RPC/PlServer/Comm.pm lib/RPC/PlServer/Test.pm t/base.t t/client.t t/compress.t t/crypt.t t/methods.t t/lib.pl t/server META.yml Module meta-data (added by MakeMaker) PlRPC/META.yml100666 0 0 574 10624653406 11512 0ustar usergroup# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: PlRPC version: 0.2018 version_from: lib/RPC/PlServer.pm installdirs: site requires: Net::Daemon: 0.13 Storable: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 PlRPC/README100666 0 0 26165 10624653406 11165 0ustar usergroupNAME RPC::PlServer - Perl extension for writing PlRPC servers SYNOPSIS # Create a subclass of RPC::PlServer use RPC::PlServer; package MyServer; $MyServer::VERSION = '0.01'; @MyServer::ISA = qw(RPC::PlServer); # Overwrite the Run() method to handle a single connection sub Run { my $self = shift; my $socket = $self->{'socket'}; } # Create an instance of the MyServer class package main; my $server = MyServer->new({'localport' => '1234'}, \@ARGV); # Bind the server to its port to make it actually running $server->Bind(); DESCRIPTION PlRPC (Perl RPC) is a package for implementing servers and clients that are written in Perl entirely. The name is borrowed from Sun's RPC (Remote Procedure Call), but it could as well be RMI like Java's "Remote Method Interface), because PlRPC gives you the complete power of Perl's OO framework in a very simple manner. RPC::PlServer is the package used on the server side, and you guess what RPC::PlClient is for. Both share the package RPC::PlServer::Comm for communication purposes. See PlRPC::Client(3) and RPC::PlServer::Comm for these parts. PlRPC works by defining a set of methods that may be executed by the client. For example, the server might offer a method "multiply" to the client. Now the clients method call @result = $client->multiply($a, $b); will be immediately mapped to a method call @result = $server->multiply($a, $b); on the server. The arguments and results will be transferred to or from the server automagically. (This magic has a name in Perl: It's the Storable module, my thanks to Raphael Manfredi for this excellent package.) Simple, eh? :-) The RPC::PlServer and RPC::PlClient are abstract servers and clients: You have to derive your own classes from it. Additional options The RPC::PlServer inherits all of Net::Daemon's options and attributes and adds the following: *cipher* The attribute value is an instance of Crypt::DES, Crypt::IDEA or any other class with the same API for block encryption. If you supply such an attribute, the traffic between client and server will be encrypted using this option. *maxmessage* (--maxmessage=size) The size of messages exchanged between client and server is restricted, in order to omit denial of service attacks. By default the limit is 65536 bytes. users This is an attribute of the client object used for Permit/Deny rules in the config file. It's value is an array ref of user names that are allowed to connect from the given client. See the example config file below. "CONFIGURATION FILE". Error Handling Error handling is simple with the RPC package, because it is based on Perl exceptions completely. Thus your typical code looks like this: eval { # Do something here. Don't care for errors. ... }; if ($@) { # An error occurred. ... } Server Constructors my $server = RPC::PlServer(\%options, \@args); (Class method) This constructor is immediately inherited from the Net::Daemon package. See Net::Daemon(3) for details. Access Control $ok = $self->AcceptApplication($app); $ok = $self->AcceptVersion($version); $ok = $self->AcceptUser($user, $password); The RPC::PlServer package has a very detailed access control scheme: First of all it inherits Net::Daemon's host based access control. It adds version control and user authorization. To achieve that, the method *Accept* from Net::Daemon is split into three methods, *AcceptApplication*, *AcceptVersion* and *AcceptUser*, each of them returning TRUE or FALSE. The client receives the arguments as the attributes *application*, *version*, *user* and *password*. A client is accepted only if all of the above methods are returning TRUE. The default implementations are as follows: The AcceptApplication method returns TRUE, if $self is a subclass of $app. The AcceptVersion method returns TRUE, if the requested version is less or equal to ${$class}::VERSION, $self being an instance of $class. Whether a user is permitted to connect depends on the client configuration. See "CONFIGURATION FILE" below for examples. Method based access control Giving a client the ability to invoke arbitrary methods can be a terrible security hole. Thus the server has a *methods* attribute. This is a hash ref of class names as keys, the values being hash refs again with method names as the keys. That is, if your hash looks as follows: $self->{'methods'} = { 'CalcServer' => { 'NewHandle' => 1, 'CallMethod' => 1 }, 'Calculator' => { 'new' => 1, 'multiply' => 1, 'add' => 1, 'divide' => 1, 'subtract' => 1 } }; then the client may use the CalcServer's *NewHandle* method to create objects, but only via the permitted constructor Calculator->new. Once a Calculator object is created, the server may invoke the methods multiply, add, divide and subtract. CONFIGURATION FILE The server config file is inherited from Net::Daemon. It adds the *users* and *cipher* attribute to the client list. Thus a typical config file might look as follows: # Load external modules; this is not required unless you use # the chroot() option. #require DBD::mysql; #require DBD::CSV; # Create keys my $myhost_key = Crypt::IDEA->new('83fbd23390ade239'); my $bob_key = Crypt::IDEA->new('be39893df23f98a2'); { # 'chroot' => '/var/dbiproxy', 'facility' => 'daemon', 'pidfile' => '/var/dbiproxy/dbiproxy.pid', 'user' => 'nobody', 'group' => 'nobody', 'localport' => '1003', 'mode' => 'fork', # Access control 'clients' => [ # Accept the local LAN (192.168.1.*) { 'mask' => '^192\.168\.1\.\d+$', 'accept' => 1, 'users' => [ 'bob', 'jim' ], 'cipher' => $myhost_key }, # Accept myhost.company.com { 'mask' => '^myhost\.company\.com$', 'accept' => 1, 'users' => [ { 'name' => 'bob', 'cipher' => $bob_key } ] }, # Deny everything else { 'mask' => '.*', 'accept' => 0 } ] } Things you should note: The user list of 192.168.1.* contains scalar values, but the user list of myhost.company.com contains hash refs: This is required, because the user configuration is more specific for user based encryption. EXAMPLE Enough wasted time, spread the example, not the word. :-) Let's write a simple server, say a server for MD5 digests. The server uses the external package MD5, but the client doesn't need to install the package. MD5(3). We present the server source here, the client is part of the RPC::PlClient man page. See RPC::PlClient(3). #!/usr/bin/perl -wT # Note the -T switch! This is always recommended for Perl servers. use strict; # Always a good choice. require RPC::PlServer; require MD5; package MD5_Server; # Clients need to request application # "MD5_Server" $MD5_Server::VERSION = '1.0'; # Clients will be refused, if they # request version 1.1 @MD5_Server::ISA = qw(RPC::PlServer); eval { # Server options below can be overwritten in the config file or # on the command line. my $server = MD5_Server->new({ 'pidfile' => '/var/run/md5serv.pid', 'configfile' => '/etc/md5serv.conf', 'facility' => 'daemon', # Default 'user' => 'nobody', 'group' => 'nobody', 'localport' => 2000, 'logfile' => 0, # Use syslog 'mode' => 'fork', # Recommended for Unix 'methods' => { 'MD5_Server' => { 'ClientObject' => 1, 'CallMethod' => 1, 'NewHandle' => 1 }, 'MD5' => { 'new' => 1, 'add' => 1, 'hexdigest' => 1 }, } }); $server->Bind(); }; SECURITY It has to be said: PlRPC based servers are a potential security problem! I did my best to avoid security problems, but it is more than likely, that I missed something. Security was a design goal, but not *the* design goal. (A well known problem ...) I highly recommend the following design principles: Protection against "trusted" users perlsec Read the perl security FAQ ("perldoc perlsec") and use the "-T" switch. taintperl Use the "-T" switch. I mean it! Verify data Never untaint strings withouth verification, better verify twice. For example the *CallMethod* function first checks, whether an object handle is valid before coercing a method on it. Be restrictive Think twice, before you give a client access to a method. perlsec And just in case I forgot it: Read the "perlsec" man page. :-) Protection against untrusted users Host based authorization PlRPC has a builtin host based authorization scheme; use it! See "CONFIGURATION FILE". User based authorization PlRPC has a builtin user based authorization scheme; use it! See "CONFIGURATION FILE". Encryption Using encryption with PlRPC is extremely easy. There is absolutely no reason for communicating unencrypted with the clients. Even more: I recommend two phase encryption: The first phase is the login phase, where to use a host based key. As soon as the user has authorized, you should switch to a user based key. See the DBI::ProxyServer for an example. AUTHOR AND COPYRIGHT The PlRPC-modules are Copyright (C) 1998, Jochen Wiedmann Email: jochen.wiedmann at freenet.de All rights reserved. You may distribute this package under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. SEE ALSO RPC::PlClient(3), RPC::PlServer::Comm(3), Net::Daemon(3), Net::Daemon::Log(3), Storable(3), Sys::Syslog(3), Win32::EventLog(3) See DBI::ProxyServer(3) for an example application. PlRPC/t/ 40777 0 0 0 10635304154 10414 5ustar usergroupPlRPC/t/base.t100666 0 0 371 10624653406 11576 0ustar usergroup use strict; print "1..3\n"; my $ok = require RPC::PlServer::Comm; printf("%sok 1\n", ($ok ? "" : "not ")); $ok = require RPC::PlServer; printf("%sok 2\n", ($ok ? "" : "not ")); $ok = require RPC::PlClient; printf("%sok 3\n", ($ok ? "" : "not ")); PlRPC/t/client.t100666 0 0 1325 10624653406 12162 0ustar usergroup# -*- perl -*- # require 5.004; use strict; require "t/lib.pl"; my $numTests = 10; my $numTest = 0; my($handle, $port); if (@ARGV) { $port = $ARGV[0]; } else { ($handle, $port) = Net::Daemon::Test->Child($numTests, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', '--mode=single', '--debug', '--timeout', 60); } my @opts = ('peeraddr' => '127.0.0.1', 'peerport' => $port, 'debug' => 1, 'application' => 'CalcServer', 'version' => 0.01, 'timeout' => 20); my $client; # Making a first connection and closing it immediately Test(eval { RPC::PlClient->new(@opts) }) or print "Failed to make first connection: $@\n"; RunTests(@opts); eval { $handle->Terminate() } if $handle; PlRPC/t/compress.t100666 0 0 2204 10624653406 12534 0ustar usergroup# -*- perl -*- # require 5.004; use strict; eval { require Compress::Zlib }; if ($@) { print "1..0\n"; exit 0; } require "t/lib.pl"; my $numTests = 18; my $numTest = 0; # Create a configfile with compression my $cfg = <<"EOF"; require Compress::Zlib; { clients => [ { 'mask' => '^127\.0\.0\.1\$', 'accept' => 1, 'users' => [ { 'name' => 'bob' }, { 'name' => 'jim', } ] } ] } EOF if (!open(FILE, ">t/compress.cfg") || !(print FILE ($cfg)) || !close(FILE)) { die "Error while creating config file t/compress.cfg: $!"; } my($handle, $port); if (@ARGV) { $port = $ARGV[0]; } else { ($handle, $port) = Net::Daemon::Test->Child ($numTests, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', '--mode=single', '--debug', '--timeout', 60, '--configfile', 't/compress.cfg', '--compression=gzip'); } my @opts = ('peeraddr' => '127.0.0.1', 'peerport' => $port, 'debug' => 1, 'application' => 'CalcServer', 'version' => 0.01, 'timeout' => 20, 'compression' => 'gzip'); RunTests('user' => 'bob', @opts); RunTests('user' => 'jim', @opts); $handle->Terminate() if $handle; PlRPC/t/crypt.t100666 0 0 2714 10624653406 12050 0ustar usergroup# -*- perl -*- # require 5.004; use strict; eval { require Crypt::DES }; if ($@ || $Crypt::DES::VERSION < 2.03) { print "1..0\n"; exit 0; } require "t/lib.pl"; my $numTests = 18; my $numTest = 0; my $hostkey = 'b3a6d83ef3187ac4'; my $userkey = '9823adc3287efa98'; # Create a configfile with host encryption. my $cfg = <<"EOF"; require Crypt::DES; { clients => [ { 'mask' => '^127\.0\.0\.1\$', 'accept' => 1, 'cipher' => Crypt::DES->new(pack("H*", "$hostkey")), 'users' => [ { 'name' => 'bob' }, { 'name' => 'jim', 'cipher' => Crypt::DES->new(pack("H*", "$userkey")) } ] } ] } EOF if (!open(FILE, ">t/crypt.cfg") || !(print FILE ($cfg)) || !close(FILE)) { die "Error while creating config file t/crypt.cfg: $!"; } my($handle, $port); ($handle, $port) = Net::Daemon::Test->Child($numTests, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', '--mode=single', '--debug', '--timeout', 60, '--configfile', 't/crypt.cfg'); require Crypt::DES; my $hostcipher = Crypt::DES->new(pack("H*", $hostkey)); my $usercipher = Crypt::DES->new(pack("H*", $userkey)); my @opts = ('peeraddr' => '127.0.0.1', 'peerport' => $port, 'debug' => 1, 'application' => 'CalcServer', 'version' => 0.01, 'timeout' => 20, 'usercipher' => $hostcipher); RunTests('user' => 'bob', @opts); RunTests('usercipher' => $usercipher, 'user' => 'jim', @opts); $handle->Terminate() if $handle; PlRPC/t/lib.pl100666 0 0 3114 10624653406 11620 0ustar usergrouprequire IO::Socket; require Config; require Net::Daemon::Test; require RPC::PlClient; sub Test($) { my $result = shift; printf("%sok %d\n", ($result ? "" : "not "), ++$numTest); $result; } sub RunTests (@) { my $client; my $key; if ($_[0] && $_[0] eq 'usercipher') { shift; $key = shift; } # Making a new connection Test($client = eval { RPC::PlClient->new(@_) }) or print "Failed to make second connection: $@\n"; if ($key) { $client->{'cipher'} = $key } # Creating a calculator object my $calculator = eval { $client->ClientObject('Calculator', 'new') }; Test($calculator) or print "Failed to create calculator: $@\n"; print "Calculator is $calculator.\n"; print "Handle is $calculator->{'object'}.\n"; print "Client is $calculator->{'client'}.\n"; # Let him do calculations ... my $result = eval { $calculator->add(4, 6, 7) }; Test($result and $result eq 17) or printf("Expected 17, got %s, errstr $@\n", (defined($result) ? $result : "undef")); $result = eval { $calculator->multiply(2, 3, 4) }; Test($result and $result eq 24); $result = eval { $calculator->subtract(27, 12) }; Test($result and $result eq 15); $result = eval { $calculator->subtract(27, 12, 7) }; Test($@ and $@ =~ /Usage/); $result = eval { $calculator->divide(15, 3) }; Test($result and $result eq 5); $result = eval { $calculator->divide(27, 12, 7) }; Test($@ and $@ =~ /Usage/); $result = eval { $calculator->divide(27, 0) }; Test($@ and $@ =~ /zero/); ($client, $calculator); } 1; PlRPC/t/methods.t100666 0 0 2133 10624653406 12345 0ustar usergroup# -*- perl -*- # require 5.004; use strict; require "t/lib.pl"; my $numTests = 11; my $numTest = 0; my $cfg = <<"EOF"; { clients => [ { 'mask' => '^127\.0\.0\.1\$', 'accept' => 1, 'methods' => { 'CalcServer' => { 'NewHandle' => 1, 'CallMethod' => 1 }, 'Calculator' => { 'new' => 1, 'add' => 1, 'multiply' => 1, 'divide' => 1, 'subtract' => 1 } } } ] } EOF if (!open(FILE, ">t/methods.cfg") || !(print FILE ($cfg)) || !close(FILE)) { die "Error while creating config file t/methods.cfg: $!"; } my($handle, $port); ($handle, $port) = Net::Daemon::Test->Child($numTests, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', '--mode=single', '--debug', '--timeout', 60, '--configfile', 't/methods.cfg'); my @opts = ('peeraddr' => '127.0.0.1', 'peerport' => $port, 'debug' => 1, 'application' => 'CalcServer', 'version' => 0.01, 'timeout' => 20); my($client, $calculator) = RunTests(@opts); Test(!eval { $calculator->not_permitted() }); Test($@ =~ /permitted/); END { $handle->Terminate() if $handle }; PlRPC/t/server100666 0 0 2576 10624653406 11761 0ustar usergroup# -*- perl -*- # # This example implements a very simple server, let's call it # CalcServer. Calculating is done by the 'Calculator' class, # Calculator instances accept method calls like # # my $result = $calculator->multiply(3, 4, 5); # require 5.004; use strict; use lib qw(blib/arch blib/lib); $| = 1; require Net::Daemon::Test; require RPC::PlServer::Test; require IO::Socket; package Calculator; sub new { my $proto = shift; my $self = { @_ }; bless($self, (ref($proto) || $proto)); $self; } sub add { my $self = shift; my $result = 0; foreach my $arg (@_) { $result += $arg } $result; } sub multiply { my $self = shift; my $result = 1; foreach my $arg (@_) { $result *= $arg } $result; } sub subtract { my $self = shift; die 'Usage: subtract($a, $b)' if @_ != 2; my $result = shift; $result - shift; } sub divide { my $self = shift; die 'Usage: subtract($a, $b)' if @_ != 2; my $result = shift; my $divisor = shift; if (!$divisor) { die "Division by zero error" } $result / $divisor; } package CalcServer; use vars qw($VERSION @ISA); $VERSION = '0.01'; @ISA = qw(RPC::PlServer::Test); sub Version ($) { return "CalcServer - A simple network calculator; 1998, Jochen Wiedmann"; } package main; my $server = CalcServer->new({'pidfile' => 'none'}, \@ARGV); $server->Bind();