[alt.sources] IPC server example

tchrist@convex.com (Tom Christiansen) (02/10/90)

Here are a pair of programs (client and server) I whipped up 
yesterday.  They let remote clients execute a couple of commands
on the server host, which I think is something people have been
asking about.  You won't want to use these verbatim, as the programs
it executes on behalf of the client won't matter to you, but they
do work and should serve as an example.  The server is pretty
dumb about the requests he understands, but you can telnet to him
and talk to him a little rather than via the client program if you
want.  If this were a serious program, I'd work out a more reliable
FTP, SMTP, or NNTP kind of protocol.  

You will need syslog.pl to run this (recently posted).  Note
that I use socket.pl not socket.h; if you can't get a socket.pl,
use socket.h and convert lines like:

    socket(SERVER, $PF_INET, $SOCK_STREAM, $proto ) || die "socket: $!";

into lines like

    socket(SERVER, &PF_INET, &SOCK_STREAM, $proto ) || die "socket: $!";

--tom


#!/bin/sh
#    This is a shell archive.
#    Run the following text with /bin/sh to extract.

sed -e 's/^X//' << \EOFMARK > uuhost
X#!/usr/bin/perl
X
X($program = $0) =~ s%.*/%%;
X
Xdie "i'd rather be called uupath or uuhost"
X    unless $program eq 'uupath' || $program eq 'uuhost';
X
Xdie "usage: $program args\n" if $#ARGV < $[;
X
Xdo 'sys/socket.pl' || die "can't do sys/socket.pl: $@";
X
X$sockaddr = 'S n a4 x8';
X
Xchop ($hostname = `hostname`);
X
X
X($USER = getlogin) || ($USER = $ENV{'USER'}) || (($USER) = getpwuid($<));;
X
X(($name, $aliases, $port, $proto) = getservbyname('uupath', 'tcp'))
X    || die "no tcp service for \"uupath\"";
X#printf "port is %d\n", $port;
X
X(($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname))
X    || die "no localhost \"$hostname\"\n";
X(($name, $aliases, $type, $len, $thataddr) = gethostbyname('mailhost'))
X    || die "no server host \"mailhost\"\n";
X#printf "server is %s\n", $name;
X
X($name, $aliases, $proto) = getprotobyname('tcp'); 
X
X
X
X$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
X$that = pack($sockaddr, $AF_INET, $port, $thataddr);
X
Xsocket(SERVER, $PF_INET, $SOCK_STREAM, $proto ) || die "socket: $!";
X
Xbind(SERVER, $this) || die "bind: $!";
X
Xconnect(SERVER, $that) || die "connect: $!";
X
Xselect(SERVER); $| = 1; select(STDOUT);
X
Xprintf SERVER "helo %s\@%s\n", $USER, $hostname;
X
X$program =~ s/^uu//;
X
Xprint SERVER "$program @ARGV\n";
X
Xwhile (<SERVER>) {
X    last if /^uuhostd> \//;
X} 
X
Xwhile (<SERVER>) {
X    last if /^\.$/;
X    next unless $_ || $ok;
X    $ok++;
X    print;
X} 
X
Xprint SERVER "quit\n";
X
Xclose SERVER;
X
Xexit !$ok;
EOFMARK
sed -e 's/^X//' << \EOFMARK > uuhostd
X#!/usr/bin/perl 
X#
X# uuhostd -- sit around accepting TCP connections
X#	     backend for uuhost and uupath
X#
X
Xdo 'ctime.pl'      || die "Can't do ctime.pl: $@";
Xdo 'syslog.pl'     || die "Can't do syslog.pl: $@";
Xdo 'sys/socket.pl' || die "Can't do sys/socket.pl: $@"; 
X
X($program = $0) =~ s%.*/%%;
X$version = 0.1;
X$prompt = "$program> ";
Xchop($host = `hostname`);
X
Xdo openlog("$program $$",'user');
X
Xif ($#ARGV > $[) {
X    if ($ARGV[0] =~ /^-/ && $#ARGV != $[) {
X	print STDERR "usage: $program [portno]\n";
X	exit 1;
X    } 
X    $port = $ARGV[0];
X} else {
X    (($name, $aliases, $port, $proto) = getservbyname('uupath', 'tcp'))
X        || die "no tcp service for \"uupath\"";
X} 
X
X 
X###########################################################################
X# setup server
X
X$sockaddr = 'S n a4 x8';
X($name, $aliases, $proto) = getprotobyname('tcp');
X
X$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
Xselect(CLIENT); $| = 1; select(stdout);
X 
Xsocket(SERVER, $PF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
X
Xbind(SERVER, $this) || die "bind: $!";
X
Xlisten(SERVER, 5) || die "connect: $!";
X 
Xselect(SERVER); $| = 1; select(stdout);
X###########################################################################
X
X
X$SIG{'INT'} = 'shutdown';
X$SIG{'TERM'} = 'shutdown';
X$SIG{'HUP'} = 'shutdown';
X
X&syslog('debug','startup');
X
X###########################################################################
X# spawn kids for incoming connections
X#
XCONNECTION: for (;;) {
X
X    ($addr = accept(CLIENT,SERVER)) || die $!;
X    ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
X    @inetaddr = unpack('C4',$inetaddr);
X    ($name) = gethostbyaddr($inetaddr,$AF_INET);
X
X    if (fork) {
X	close CLIENT;
X	next CONNECTION;
X    } 
X
X###########################################################################
X# am now the child server
X
X    do syslog('info',"connect from %s (%d.%d.%d.%d)",
X	$name, $inetaddr[0], $inetaddr[1], $inetaddr[2], $inetaddr[3]); 
X
X    open(STDOUT,">&CLIENT");
X    open(STDERR,">&CLIENT");
X    select(CLIENT);
X
X
X    printf "\n%s %s v%3.1f ready at %s",$host,$program,$version,&ctime(time);
X    print "Type \"help\" for help.\n";
X    print $prompt;
X
X###########################################################################
X# service each request
X#
XREQUEST:
X    while (<CLIENT>) {
X	chop if chop eq "\r";
X	last REQUEST if !$_ || $_ eq "\004";
X
X	($cmd, @args) = split;
X
X	if      ( 'path' =~ /^$cmd/i ) {
X	    do findpath();
X	} elsif ( 'host' =~ /^$cmd/i ) {
X	    do findhost();
X	} elsif ( 'help' =~ /^$cmd/i ) {
X	    do givehelp();
X	} elsif ( 'hello' =~ /^$cmd/i || 'helo' =~ /^$cmd/i) {
X	    do sayhello();
X	} elsif ( 'quit' =~ /^$cmd/i ) {
X	    print "Goodbye.\n";
X	    last REQUEST;
X	} else {
X	    print "Unrecognized command: $cmd\n";
X	    print "Type \"help\" for help.\n";
X	} 
X
X	print $prompt;
X
X     }
X     close CLIENT;
X     exit 0;
X}
X
X###########################################################################
Xsub shutdown {
X    do syslog('debug','shutdown');
X    shutdown(CLIENT,2);  # seems prudent
X    shutdown(SERVER,2);
X    close CLIENT;
X    close SERVER;
X    exit 0;
X} 
X
X###########################################################################
Xsub sayhello {
X    printf "hello %s, pleased to meet you!\n", $args[0];
X    do syslog('debug', "HELO $args[0]");
X} 
X
X###########################################################################
Xsub findpath {
X    do syslog('info',"PATH @args");
X    do runprog('/usr/local/bin/show');
X} 
X
X###########################################################################
Xsub findhost {
X    do syslog('info',"HOST @args");
X    do runprog('/usr/local/bin/uuhosts');
X} 
X
X###########################################################################
Xsub givehelp {
X    print "Commands are: HOST HELP HELO PATH QUIT\n";
X    do syslog('debug','HELP');
X} 
X
X###########################################################################
Xsub runprog {
X    local($pathname) = @_;
X    local($msg);
X
X    print "$pathname @args\n";
X
X    if (system $pathname,@args) {
X	$msg = sprintf("\"$pathname @args\" returned %d\n", $? >> 8);
X	printf $msg;
X	do syslog('notice', $msg);
X    } 
X    print ".\n";
X}
EOFMARK

--

    Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist 
    Convex Computer Corporation                            tchrist@convex.COM
		 "EMACS belongs in <sys/errno.h>: Editor too big!"