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