#!/home/rebelsky/perl/bin/perl


# ============================================================================
# SimpleRPC.pm - A simple RPC (Remote Procedure Call) client/server package.
#                This is a small module designed to provide services for a
#                invoking procedures running on another server.  This package
#                can be used in either of the server or the client mode.  To
#                use it in server mode, merely use this package and then call
#                RPCServerLoop with the port to listen on and it will do its
#                thing.  To use it in client mode, call RPCCreateStubs with
#                the address and port of the server to use followed by a list
#                of procedures that will be invoked through this mechanism.
#                After that, you may call the procedures normally as though
#                they were locally hosted.
#
#                This package is simple for a good reason.  It has a number of
#                important limitations.  For one, the parameters to the 
#                procedures invoked this way must be simple scalars.  No
#                references.  No typeglobs.  Nothing weird; just good old
#                fashioned strings and numbers.  Also, the procedure can
#                only return such a scalar.  Things would get a lot ickier to
#                support returning arrays and other things.
#
#                Another limitation of this is that it currently has no
#                security and is wide open.  Anybody can send commands to the
#                server and the server will execute any command.  Even ones
#                that are potentially destructive.  This issue should be 
#                addressed before this package is used for production code.
#
#                Caveat Emptor.
#
# Author:        Andrew Kensler
#
# Date:          July 12, 1999

# ============================================================================
# Packages Used
 
use Sys::Hostname;		# To find our hostname for the server code
use IO::Socket;			# General socket stuff
use URI::Escape;		# For encoding and decoding the scalars

# ============================================================================
# RPCServerLoop - This sets up the simple RPC server.  It tries to set itself
#                 up on the port given to it and listen for connections from
#                 clients.  It handles clients in a single threaded manner
#                 and does not fork to process them or select to multiplex
#                 them.  It merely lets treats them in a FIFO queue fashion.
#                 It stays in this loop indefinitely.
# Input: port - The port to serve from
# Output: None.
sub RPCServerLoop
  {
    #print out a message that says that the server is starting
    print "Server starting...\n";

    # Local Variables
    my $server_daemon;		# Server daemon object (IO::Socket::INET)
    my $client;			# Client connection (IO::Socket::INET)
    my $command;		# The name of the procedure to invoke (String)
    my @argument_list;		# The list of arguments to pass (Array)
    my $result;			# The result of calling the procedure (String)

    # Create a daemon object to list for incoming client request.  We'll set
    # it to listen on the port passed to us.
    $server_daemon=new IO::Socket::INET
      LocalAddr=>hostname,
      LocalPort=>shift,
      Proto=>'tcp',
      Listen=>5;
    die "Couldn't start server" unless $server_daemon;

    #print out a message that says that the server is ready
    print "Server ready.\n\n";

    # Here is the main loop.  We block on accept and wait for client
    # connections.  For each one, we call ProcessRequest to handle it.
    while($client=$server_daemon->accept)
      {
        autoflush $client 1;

	# Get the command name
	chomp($command=<$client>);

        #print out a message saying it got the command
        print "Request for $command.\n";

	# Loop until we get a blank line.  For each that is not a blank
	# line, we call the URI::Escape module to decode it and then
	# push that string onto the list that we will eventually pass
	# to the actual subroutine
	while(<$client>)
	  {

	    chomp;
	    last if ($_ eq "");
	    push(@argument_list,uri_unescape($_));
	  }


	
	# Now we do an eval to call the real subroutine
	$result=eval "$command(\@argument_list)";
        @argument_list = ();



	# Pass that back encoded
	print $client uri_escape($result)."\n";
	
	# We're finished so close the socket
	close $socket;
        
        #print out a message that says the request is complete
        print "Request complete.\n\n";
          
      }

  }

# ============================================================================
# RPCClientCall - This does the basic job of contacting the RPC server and
#                 passing along the call and its encoded parameters.  It
#                 retrieves and decodes the result returned from the call and
#                 returns it.  Naturally, this blocks until the remote
#                 procedure has execute and its results have been returned.
# Input: address - The host name of the RPC server
#        port - The port that the RPC server is on
#        command - The name of the command to invoke
#        parameters - Any additional parameters
# Output: The result of the RPC
sub RPCClientCall
  {

    # Local Variables
    my $socket;			# Connection to the server (IO::Socket::INET)


    
    # Create a connection to the server.  The address and port come from the
    # first two parameters.
    $socket=new IO::Socket::INET
      PeerAddr=>shift,
      PeerPort=>shift,
      Proto=>'tcp';

    autoflush $socket 1;


    # For each remaining parameter, use URL style encoding to asci encode it
    # and then send it on its own line.
    foreach (@_)
      {       
	print $socket uri_escape($_)."\n";
      }

    # A blank line signals that we are done sending parameters.
    print $socket "\n";
   
    # Now get the result of the call back and decode it.
    chomp($result=<$socket>);
    $result=uri_unescape $result;

    # Okay.  We're done, so close the socket.
    close $socket;

    # Return the result.
    return $result;
  }

# ============================================================================
# RPCCreateStubs - This procedure builds the stubs that call ClientCall to
#                  to their work through the RPC.  The result is to make the
#                  remote invocation transparent to the user after this has
#                  been called.
# Input: address - The host address of the RPC server
#        port - The port to talk to it on
#        procedures - A list of procedures to construct the stubs for
sub RPCCreateStubs
  {

    # Parameters
    my $server_addr=shift;
    my $server_port=shift;

    # Local variables
    my $stub;

    # Each remaining parameter is the name of a procedure to
    # build a stub for.  So we loop through the rest of the
    # parameter list to construct the stub and use eval to
    # set it up in Perl.
    foreach (@_)
      {
        $stub=      "sub $_\n";
        $stub=$stub."{\n";
        $stub=$stub."    return RPCClientCall(\"$server_addr\",$server_port,\"$_\",\@_)\n";
        $stub=$stub."}\n";	
	eval $stub;
      }
  }

# Return true to placate perl
return 1;