1# -*- perl -*- 2# 3# 4# PlRPC - Perl RPC, package for writing simple, RPC like clients and 5# servers 6# 7# 8# Copyright (c) 1997,1998 Jochen Wiedmann 9# 10# You may distribute under the terms of either the GNU General Public 11# License or the Artistic License, as specified in the Perl README file. 12# 13# Author: Jochen Wiedmann 14# Email: jochen.wiedmann at freenet.de 15# 16 17require 5.004; 18use strict; 19 20require Storable; 21 22 23package RPC::PlServer::Comm; 24 25 26$RPC::PlServer::Comm::VERSION = '0.1003'; 27 28 29############################################################################ 30# 31# Name: new (Class method) 32# 33# Purpose: Constructor 34# 35# Inputs: $class - This class 36# $attr - Hash ref of attributes 37# 38# Result: Server object for success, error message otherwise 39# 40############################################################################ 41 42sub new ($) { 43 my($class, $attr) = @_; 44 my $self = {}; 45 bless($self, (ref($class) || $class)); 46 47 if (my $comp = $attr->{'compression'}) { 48 if ($comp eq 'off') { 49 $self->{'compression'} = undef; 50 } elsif ($comp eq 'gzip') { 51 require Compress::Zlib; 52 $self->{'compression'} = 'gzip'; 53 } else { 54 die "Unknown compression type ($comp), use 'off' or 'gzip'"; 55 } 56 } 57 if (my $cipher = $attr->{'cipher'}) { 58 $self->{'cipher'} = $cipher; 59 } 60 if (my $maxmessage = $attr->{'maxmessage'}) { 61 $self->{'maxmessage'} = $maxmessage; 62 } 63 64 $self; 65} 66 67 68############################################################################ 69# 70# Name: Write 71# 72# Purpose: Writing to a PlRPC socket; used by both the client (when 73# sending a method name and arguments) and the server (for 74# sending the result list). Communication occurrs in packets. 75# Each packet is preceeded by 4 bytes with the true packet 76# size. If encryption happens, then the packet is padded with 77# NUL bytes to a multiple of blocksize bytes. However, the 78# stored size remains unchanged. 79# 80# Inputs: $self - Instance of RPC::PlServer or RPC::PlClient 81# $socket - The socket to write to 82# $args - Reference to array of arguments being sent 83# 84# Result: Nothing; dies in case of errors. 85# 86############################################################################ 87 88sub Write ($$$) { 89 my($self, $socket, $msg) = @_; 90 91 my $encodedMsg = Storable::nfreeze($msg); 92 $encodedMsg = Compress::Zlib::compress($encodedMsg) 93 if ($self->{'compression'}); 94 95 my($encodedSize) = length($encodedMsg); 96 if (my $cipher = $self->{'cipher'}) { 97 my $size = $cipher->blocksize; 98 if (my $addSize = length($encodedMsg) % $size) { 99 $encodedMsg .= chr(0) x ($size - $addSize); 100 } 101 $msg = ''; 102 for (my $i = 0; $i < length($encodedMsg); $i += $size) { 103 $msg .= $cipher->encrypt(substr($encodedMsg, $i, $size)); 104 } 105 $encodedMsg = $msg; 106 } 107 108 local $\; 109 if (!$socket->print(pack("N", $encodedSize), $encodedMsg) || 110 !$socket->flush()) { 111 die "Error while writing socket: $!"; 112 } 113} 114 115 116############################################################################ 117# 118# Name: Read 119# 120# Purpose: Reading from a PlRPC socket; used by both the client (when 121# receiving a result list) and the server (for receiving the 122# method name and arguments). Counterpart of Write, see 123# above for specs. 124# 125# Inputs: $self - Instance of RPC::PlServer or RPC::PlClient 126# $socket - The socket to read from 127# 128# Result: Array ref to result list; dies in case of errors. 129# 130############################################################################ 131 132sub Read($$) { 133 my($self, $socket) = @_; 134 my $result; 135 136 my($encodedSize, $readSize, $blockSize); 137 $readSize = 4; 138 $encodedSize = ''; 139 while ($readSize > 0) { 140 my $result = $socket->read($encodedSize, $readSize, 141 length($encodedSize)); 142 if (!$result) { 143 return undef if defined($result); 144 die "Error while reading socket: $!"; 145 } 146 $readSize -= $result; 147 } 148 $encodedSize = unpack("N", $encodedSize); 149 my $max = $self->getMaxMessage(); 150 die "Maximum message size of $max exceeded, use option 'maxmessage' to" 151 . " increase" if $max && $encodedSize > $max; 152 $readSize = $encodedSize; 153 if ($self->{'cipher'}) { 154 $blockSize = $self->{'cipher'}->blocksize; 155 if (my $addSize = ($encodedSize % $blockSize)) { 156 $readSize += ($blockSize - $addSize); 157 } 158 } 159 my $msg = ''; 160 my $rs = $readSize; 161 while ($rs > 0) { 162 my $result = $socket->read($msg, $rs, length($msg)); 163 if (!$result) { 164 die "Unexpected EOF" if defined $result; 165 die "Error while reading socket: $!"; 166 } 167 $rs -= $result; 168 } 169 if ($self->{'cipher'}) { 170 my $cipher = $self->{'cipher'}; 171 my $encodedMsg = $msg; 172 $msg = ''; 173 for (my $i = 0; $i < $readSize; $i += $blockSize) { 174 $msg .= $cipher->decrypt(substr($encodedMsg, $i, $blockSize)); 175 } 176 $msg = substr($msg, 0, $encodedSize); 177 } 178 $msg = Compress::Zlib::uncompress($msg) if ($self->{'compression'}); 179 Storable::thaw($msg); 180} 181 182 183############################################################################ 184# 185# Name: Init 186# 187# Purpose: Initialize an object for using RPC::PlServer::Comm methods 188# 189# Input: $self - Instance 190# 191# Returns: The instance in case of success, dies in case of trouble. 192# 193############################################################################ 194 195############################################################################ 196# 197# Name: getMaxMessage 198# 199# Purpose: Returns the maximum size of a message 200# 201# Inputs: None 202# 203# Returns: Maximum message size or 65536, if none specified 204# 205############################################################################ 206 207sub getMaxMessage() { 208 my $self = shift; 209 return defined($self->{'maxmessage'}) ? 210 $self->{'maxmessage'} : 65536; 211} 212 213 2141; 215