ftp.nice.ch/pub/next/unix/developer/pcn.2.0.s.tar.gz#/scripts/host-control/server.pl

This is server.pl in view mode; [Download] [Up]

require 'sys/socket.ph';

package server;

$verbose = $main'verbose;

($prog = $0) =~ s,.*/,,;

sub create
{
    local(*S, $port) = @_;
    local($name, $aliases, $proto, $this);

    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
	unless $port =~ /^\d+$/;

    $sockaddr = 'S n a4 x8';
    
    $this = pack($sockaddr, &main'AF_INET, $port, "\0\0\0\0");
    
    socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
    select(S), $| = 1; select(STDOUT);
    
    bind(S, $this) || die "bind: $!";
    listen(S, 5) || die "connect: $!";
}

sub createAnon
{
    local(*S) = @_;
    local($name, $aliases, $proto, $this, $port, $family, $mySockaddr);

    $port = 0;

    $sockaddr = 'S n a4 x8';
    
    $this = pack($sockaddr, &main'AF_INET, $port, "\0\0\0\0");
    
    socket(S, &main'PF_INET, &main'SOCK_STREAM, $proto) || die "socket: $!";
    select(S), $| = 1; select(STDOUT);

    
    bind(S, $this) || die "bind: $!";
    listen(S, 5) || die "listen: $!";

    local($mySockaddr) = getsockname(S);

    ($family, $port, $myAddr) = unpack($sockaddr, $mySockaddr);

    return $port;
}

sub accept
{
    local(*NS, *S) = @_;
    local($addr, $af, $port, $inetaddr, @inetaddr);

    ($addr = accept(NS,S)) || die "accept: $!";
#    print "accept ok \n";
	
    ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
    @inetaddr = unpack('C4',$inetaddr);
#    print "$af $port @inetaddr\n";

    select(*NS); $| = 1;
    select(STDOUT);
	
    return @inetaddr;
}

sub connect
{
    local($remote, $port, *S) = @_;

    local($name, $aliases, $proto, $type, $len);
    local($remoteaddr, $localaddr, $hostname);
    local($remote_saddr, $local_saddr, $sockaddr);
    
    chop($hostname = `hostname`);
    $sockaddr = 'S n a4 x8';

    ($name,$aliases,$proto) = getprotobyname('tcp');
    ($name,$aliases,$port) = getservbyname($port, 'tcp')
	unless $port =~ /^\d+$/;

    $remoteaddr = &get_addr_for_host($remote);
    $localaddr = &get_addr_for_host($hostname);

    ($name,$aliases,$type,$len,$localaddr) = gethostbyname($hostname);

#    print "got host $remote port $port\n";
    
    $remote_saddr = pack($sockaddr, &main'AF_INET, $port, $remoteaddr);
    $local_saddr = pack($sockaddr, &main'AF_INET, 0, $localaddr);
    
    socket(S, &main'PF_INET, &main'SOCK_STREAM, $proto) || die "socket: $!";
    bind(S, $local_saddr) || die "$prog: bind: $!";
    connect(S, $remote_saddr) || die "$prog: connect: $!";
    
    select(S); $| = 1;
    select(STDOUT);
#    print "connect returns\n";
}

sub get_addr_for_host
{
    local($remote) = @_;
    local($name, $aliases, $type, $len, $remoteaddr);
    
    ($name,$aliases,$type,$len,$remoteaddr) = gethostbyname($remote);
    if (!$name)
    {
	if (@raddr = ($remote =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/))
	{
	    ($name,$aliases,$type,$len,$remoteaddr) =
		gethostbyaddr(pack('C4', split(/\./, $remote)), &main'AF_INET);
	    if ($name)
	    {
		print "Got name by gethostbyaddr: $name\n" if $verbose;;
	    }
	    else
	    {
		print "Using packed address ", join('.', @raddr), "\n"
		    if $verbose;
		$remoteaddr = pack('C4', @raddr);
	    }
	}
	else
	{
	    die "Couldn't find host $remote\n";
	}
    }
    else
    {
	print "got name $name\n" if $verbose;
    }
    print "found address ", join('.', unpack('C4', $remoteaddr)), "\n"
	if $verbose;
    $remoteaddr;
}

sub socketpair
{
    local(*MASTER, *SLAVE) = @_;

    socketpair(MASTER, SLAVE, &AF_UNIX, &SOCK_STREAM, 0) ||
	die "Cannot create socketpair: $!\n";

}

1;

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.