1# -*- perl -*- 2# 3# 4# PlRPC - Perl RPC, package for writing simple, RPC like clients and 5# servers 6# 7# RPC::PlClient.pm is the module for writing the PlRPC client. 8# 9# 10# Copyright (c) 1997, 1998 Jochen Wiedmann 11# 12# You may distribute under the terms of either the GNU General Public 13# License or the Artistic License, as specified in the Perl README file. 14# 15# Author: Jochen Wiedmann 16# Email: jochen.wiedmann at freenet.de 17# 18 19use strict; 20 21use RPC::PlClient::Comm (); 22use Net::Daemon::Log (); 23use IO::Socket (); 24 25 26package RPC::PlClient; 27 28$RPC::PlClient::VERSION = '0.2020'; 29@RPC::PlClient::ISA = qw(Net::Daemon::Log); 30 31 32############################################################################ 33# 34# Name: new 35# 36# Purpose: Constructor of the PlRPC::Client module 37# 38# Inputs: $self - Class name 39# @attr - Attribute list 40# 41# Returns: Client object; dies in case of errors. 42# 43############################################################################ 44 45sub new ($@) { 46 my $proto = shift; 47 my $self = {@_}; 48 bless($self, (ref($proto) || $proto)); 49 50 my $comm = $self->{'comm'} = RPC::PlClient::Comm->new($self); 51 my $app = $self->{'application'} or 52 $self->Fatal("Missing application name"); 53 my $version = $self->{'version'} or 54 $self->Fatal("Missing version number"); 55 my $user = $self->{'user'} || ''; 56 my $password = $self->{'password'} || ''; 57 58 my $socket; 59 if (!($socket = $self->{'socket'})) { 60 $self->Fatal("Missing peer address") unless $self->{'peeraddr'}; 61 $self->Fatal("Missing peer port") 62 unless ($self->{'peerport'} || 63 index($self->{'peeraddr'}, ':') != -1); 64 $socket = $self->{'socket'} = IO::Socket::INET->new 65 ('PeerAddr' => $self->{'peeraddr'}, 66 'PeerPort' => $self->{'peerport'}, 67 'Proto' => $self->{'socket_proto'}, 68 'Type' => $self->{'socket_type'}, 69 'Timeout' => $self->{'timeout'}); 70 $self->Fatal("Cannot connect: $!") unless $socket; 71 } 72 $self->Debug("Connected to %s, port %s", 73 $socket->peerhost(), $socket->peerport()); 74 $self->Debug("Sending login message: %s, %s, %s, %s", 75 $app, $version, $user, "x" x length($password)); 76 $comm->Write($socket, [$app, $version, $user, $password]); 77 $self->Debug("Waiting for server's response ..."); 78 my $reply = $comm->Read($socket); 79 die "Unexpected EOF from server" unless defined($reply); 80 die "Expected server to return an array ref" unless ref($reply) eq 'ARRAY'; 81 my $msg = defined($reply->[1]) ? $reply->[1] : ''; 82 die "Refused by server: $msg" unless $reply->[0]; 83 $self->Debug("Logged in, server replies: $msg"); 84 85 return ($self, $msg) if wantarray; 86 $self; 87} 88 89 90############################################################################ 91# 92# Name: Call 93# 94# Purpose: Coerce method located on the server 95# 96# Inputs: $self - client instance 97# $method - method name 98# @args - method attributes 99# 100# Returns: method results; dies in case of errors. 101# 102############################################################################ 103 104sub Call ($@) { 105 my $self = shift; 106 my $socket = $self->{'socket'}; 107 my $comm = $self->{'comm'}; 108 $comm->Write($socket, [@_]); 109 my $msg = $comm->Read($socket); 110 die "Unexpected EOF while waiting for server reply" unless defined($msg); 111 die "Server returned error: $$msg" if ref($msg) eq 'SCALAR'; 112 die "Expected server to return an array ref" unless ref($msg) eq 'ARRAY'; 113 @$msg; 114} 115 116sub ClientObject { 117 my $client = shift; my $class = shift; my $method = shift; 118 my($object) = $client->Call('NewHandle', $class, $method, @_); 119 die "Constructor didn't return a TRUE value" unless $object; 120 die "Constructor didn't return an object" 121 unless $object =~ /^((?:\w+|\:\:)+)=(\w+)/; 122 RPC::PlClient::Object->new($1, $client, $object); 123} 124 125sub Disconnect { 126 my $self = shift; 127 $self->{'socket'} = undef; 128 1; 129} 130 131 132package RPC::PlClient::Object; 133 134use vars qw($AUTOLOAD); 135 136sub AUTOLOAD { 137 my $method = $AUTOLOAD; 138 my $index; 139 die "Cannot parse method: $method" 140 unless ($index = rindex($method, '::')) != -1; 141 my $class = substr($method, 0, $index); 142 $method = substr($method, $index+2); 143 eval <<"EOM"; 144 package $class; 145 sub $method { 146 my \$self = shift; 147 my \$client = \$self->{'client'}; my \$object = \$self->{'object'}; 148 my \@result = \$client->Call('CallMethod', \$object, '$method', 149 \@_); 150 return \@result if wantarray; 151 return \$result[0]; 152 } 153EOM 154 goto &$AUTOLOAD; 155} 156 157sub new { 158 my($class, $cl, $client, $object) = @_; 159 $class = ref($class) if ref($class); 160 no strict 'refs'; 161 my $ocl = "${class}::$cl"; 162 @{"${ocl}::ISA"} = $class unless @{"${ocl}::ISA"}; 163 my $self = { 'client' => $client, 'object' => $object }; 164 165 bless($self, $ocl); 166 $self; 167} 168 169 170sub DESTROY { 171 my $saved_error = $@; # Save $@ 172 my $self = shift; 173 if (my $client = delete $self->{'client'}) { 174 eval { $client->Call('DestroyHandle', $self->{'object'}) }; 175 } 176 $@ = $saved_error; # Restore $@ 177} 178 1791; 180 181 182__END__ 183 184 185=pod 186 187=head1 NAME 188 189RPC::PlClient - Perl extension for writing PlRPC clients 190 191 192=head1 SYNOPSIS 193 194 require RPC::PlClient; 195 196 # Create a client object and connect it to the server 197 my $client = RPC::PlClient->new('peeraddr' => 'joes.host.de', 198 'peerport' => 2570, 199 'application' => 'My App', 200 'version' => '1.0', 201 'user' => 'joe', 202 'password' => 'hello!'); 203 204 # Create an instance of $class on the server by calling $class->new() 205 # and an associated instance on the client. 206 my $object = $client->Call('NewHandle', $class, 'new', @args); 207 208 209 # Call a method on $object, effectively calling the same method 210 # on the associated server instance. 211 my $result = $object->do_method(@args); 212 213 214=head1 DESCRIPTION 215 216PlRPC (Perl RPC) is a package that simplifies the writing of 217Perl based client/server applications. RPC::PlServer is the 218package used on the server side, and you guess what RPC::PlClient 219is for. See L<RPC::PlServer(3)> for this part. 220 221PlRPC works by defining a set of methods that may be executed by the client. 222For example, the server might offer a method "multiply" to the client. Now 223a function call 224 225 @result = $client->Call('multiply', $a, $b); 226 227on the client will be mapped to a corresponding call 228 229 $server->multiply($a, $b); 230 231on the server. The function calls result will be transferred to the 232client and returned as result of the clients method. Simple, eh? :-) 233 234 235=head2 Client methods 236 237=over 4 238 239=item $client = new(%attr); 240 241(Class method) The client constructor. Returns a client object, connected 242to the server. A Perl exception is thrown in case of errors, thus you 243typically use it like this: 244 245 $client = eval { RPC::PlClient->new ( ... ) }; 246 if ($@) { 247 print STDERR "Cannot create client object: $@\n"; 248 exit 0; 249 } 250 251The method accepts a list of key/value pairs as arguments. Known arguments 252are: 253 254=over 8 255 256=item peeraddr 257 258=item peerport 259 260=item socket_proto 261 262=item socket_type 263 264=item timeout 265 266These correspond to the attributes I<PeerAddr>, I<PeerPort>, I<Proto>, 267I<Type> and I<Timeout> of IO::Socket::INET. The server connection will be 268established by passing them to IO::Socket::INET->new(). 269 270=item socket 271 272After a connection was established, the IO::Socket instance will be stored 273in this attribute. If you prefer establishing the connection on your own, 274you may as well create an own instance of IO::Socket and pass it as attribute 275I<socket> to the new method. The above attributes will be ignored in that 276case. 277 278=item application 279 280=item version 281 282=item user 283 284=item password 285 286it is part of the PlRPC authorization process, that the client 287must obeye a login procedure where he will pass an application 288name, a protocol version and optionally a user name and password. 289These arguments are handled by the servers I<Application>, I<Version> 290and I<User> methods. 291 292=item compression 293 294Set this to off (default, no compression) or gzip (requires the 295Compress::Zlib module). 296 297=item cipher 298 299This attribute can be used to add encryption quite easily. PlRPC is not 300bound to a certain encryption method, but to a block encryption API. The 301attribute is an object supporting the methods I<blocksize>, I<encrypt> 302and I<decrypt>. For example, the modules Crypt::DES and Crypt::IDEA 303support such an interface. 304 305Note that you can set or remove encryption on the fly (putting C<undef> 306as attribute value will stop encryption), but you have to be sure, 307that both sides change the encryption mode. 308 309Example: 310 311 use Crypt::DES; 312 $cipher = Crypt::DES->new(pack("H*", "0123456789abcdef")); 313 $client = RPC::PlClient->new('cipher' => $cipher, 314 ...); 315 316=item maxmessage 317 318The size of messages exchanged between client and server is restricted, 319in order to omit denial of service attacks. By default the limit is 32065536 bytes. 321 322=item debug 323 324Enhances logging level by emitting debugging messages. 325 326=item logfile 327 328By default the client is logging to syslog (Unix) or the event log (Windows). 329If neither is available or you pass a TRUE value as I<logfile>, then logging 330will happen to the given file handle, an instance of IO::Handle. If the 331value is scalar, then logging will occur to stderr. 332 333Examples: 334 335 # Logging to stderr: 336 my $client = RPC::PlClient->new('logfile' => 1, ...); 337 338 # Logging to 'my.log': 339 my $file = IO::File->new('my.log', 'a') 340 || die "Cannot create log file 'my.log': $!"; 341 my $client = RPC::PlClient->new('logfile' => $file, ...); 342 343=back 344 345=item @result = $client->Call($method, @args); 346 347(Instance method) Calls a method on the server; the arguments are a method 348name of the server class and the method call arguments. It returns the 349method results, if successfull, otherwise a Perl exception is thrown. 350 351Example: 352 353 @results = eval { $client->Call($method, @args }; 354 if ($@) { 355 print STDERR "An error occurred while executing $method: $@\n"; 356 exit 0; 357 } 358 359=item $cobj = $client->ClientObject($class, $method, @args) 360 361(Instance method) A set of predefined methods is available that make 362dealing with client side objects incredibly easy: In short the client 363creates a representation of the server object for you. Say we have an 364object $sobj on the server and an associated object $cobj on the client: 365Then a call 366 367 @results = $cobj->my_method(@args); 368 369will be immediately mapped to a call 370 371 @results = $sobj->my_method(@args); 372 373on the server and the results returned to you without any additional 374programming. Here's how you create $cobj, an instance of 375I<RPC::PlClient::Object>: 376 377 my $cobj = $client->ClientObject($class, 'new', @args); 378 379This will trigger a call 380 381 my $sobj = $class->new(@args); 382 383on the server for you. Note that the server has the ability to restrict 384access to both certain classes and methods by setting $server->{'methods'} 385appropriately. 386 387=back 388 389 390=head1 EXAMPLE 391 392We'll create a simple example application, an MD5 client. The server 393will have installed the MD5 module and create digests for us. We 394present the client part only, the server example is part of the 395RPC::PlServer man page. See L<RPC::PlServer(3)>. 396 397 #!/usr/local/bin/perl 398 399 use strict; # Always a good choice. 400 401 require RPC::PlClient; 402 403 # Constants 404 my $MY_APPLICATION = "MD5_Server"; 405 my $MY_VERSION = 1.0; 406 my $MY_USER = ""; # The server doesn't require user 407 my $MY_PASSWORD = ""; # authentication. 408 409 my $hexdigest = eval { 410 my $client = RPC::PlClient->new 411 ('peeraddr' => '127.0.0.1', 412 'peerport' => 2000, 413 'application' => $MY_APPLICATION, 414 'version' => $MY_VERSION, 415 'user' => $MY_USER, 416 'password' => $MY_PASSWORD); 417 418 # Create an MD5 object on the server and an associated 419 # client object. Executes a 420 # $context = MD5->new() 421 # on the server. 422 my $context = $client->ClientObject('MD5', 'new'); 423 424 # Let the server calculate a digest for us. Executes a 425 # $context->add("This is a silly string!"); 426 # $context->hexdigest(); 427 # on the server. 428 $context->add("This is a silly string!"); 429 $context->hexdigest(); 430 }; 431 if ($@) { 432 die "An error occurred: $@"; 433 } 434 435 print "Got digest $hexdigest\n"; 436 437 438=head1 AUTHOR AND COPYRIGHT 439 440The PlRPC-modules are 441 442 Copyright (C) 1998, Jochen Wiedmann 443 Email: jochen.wiedmann at freenet.de 444 445 All rights reserved. 446 447You may distribute this package under the terms of either the GNU 448General Public License or the Artistic License, as specified in the 449Perl README file. 450 451 452=head1 SEE ALSO 453 454L<PlRPC::Server(3)>, L<Net::Daemon(3)>, L<Storable(3)>, L<Sys::Syslog(3)>, 455L<Win32::EventLog> 456 457An example application is the DBI Proxy client: 458 459L<DBD::Proxy(3)>. 460 461=cut 462 463