Borrowing example code from IO::*, this script wraps a simple TCP text protocol around a hashtable. Get and set values remotely 'til the camels come home.
So I'd wanted to program Spacewars, Adventure, Traveller-on-line, and other multiplayer games, but never got the courage to write the communication protocol. And then when I decided to bite the bullet, I'd get bogged down on whether to do UDP, TCP, RMI, Serialized Objects, XML... basically I'd waffle and my dreams would fizzle. What I needed was some proof of concept.
Enter B.U.R.P. - the Barely Usable Remote Protocol. With a raw TCP connection and some text-pushing, I can fetch, create, and update generic data from a thin server in perl. This proof-of-concept assumes trusted, heavy clients. Therefore, it's unsuitable for many things. As the protocol states, it's Barely Usable. But it was fun to write, and made writing network code a snap.
One side-effect is that any number of separate games may all access the same server, peacefully coexisting. The only requirement is that keys must be thoughtfully orthogonal.
rje
#!/usr/bin/perl -w
use strict;
use IO::Socket;
use IO::Select;
$|++; # always flush
=head1 Title
BURP - Barely Usable Remote Protocol
v1.0
BURP is a remotely-accessible hashtable. Or, put another way,
it's a TCP text protocol wrapped around a hashtable.
Why use a hashtable? Why not just send actual perl code to the
server and return the result? Well, I don't want the system to
be *that* open, so maybe this is the next best thing.
To use the BURP protocol, simply point your TCP client at BURP's
port and send one of the following messages:
Commands:
quit! Close connection
Gets:
The first two getters return data in an URL-style string, like
this: key1=val1&key2=val2&key3=val3. The last getter simply
returns the value (or the empty string, if there is no value).
* Get everything
/pattern/ Get everything matching a pattern
key Get $state{key}
Sets:
k=v Set one key/value pair
k=v&k=v&k=v... Set multiple key/value pairs
=cut
my $port = 8080;
my $lsn = new IO::Socket::INET(Listen => 1, LocalPort => $port);
my $sel = new IO::Select( $lsn );
my %state = ();
print "BURP/1.0 listening on port $port.\n";
#####################################################################
#
# Main Loop
#
#####################################################################
while( my @ready = $sel->can_read )
{
foreach my $fh (@ready)
{
if ($fh == $lsn) # Add a new connection
{
$sel->add($lsn->accept);
}
else # Process existing connection
{
my $in = '';
$fh->recv( $in, 4096 );
$in =~ s/[\r\n]//g;
$_ = $in;
m|\*| && ( $fh->write( &allQuery() ) && next ); # al
+l
m|/(.*)/| && ( $fh->write( &grepQuery($1) ) && next ); # pa
+ttern
m|=| && ( $fh->write( &set( $_ ) ) && next ); # se
+t
m|^quit!$| && ( &done( $fh ) && next ); # qu
+it
m|[^/]| && ( $fh->write( &oneQuery( $_ ) ) && next ); #
+ get 1
}
}
}
#####################################################################
#
# Kill a connection
#
#####################################################################
sub done
{
my $fh = shift;
$sel->remove( $fh );
$fh->close;
}
#####################################################################
#
# Put values into the hashtable
#
#####################################################################
sub set
{
my ($text) = @_;
my @pairs = split( '&', $text );
#
# Update state
#
foreach (@pairs)
{
my ($k,$v) = split( '=' );
$state{ $k } = $v if $k && $v; # update value
delete $state{ $k } if $k && !$v; # remove key
}
return "status=ok\n";
}
#####################################################################
#
# Get values from the hashtable
#
#####################################################################
sub allQuery
{
return query( keys %state );
}
sub grepQuery
{
my $pattern = shift;
return query( grep( /$pattern/, keys %state ) );
}
sub query
{
my @out = ();
foreach my $key (@_)
{
my $val = $state{$key} || '';
push @out, "$key=$val";
}
return join( '&', @out ) . "\n";
}
sub oneQuery
{
my $key = shift;
return $state{ $key } . "\n";
}