Article 5673 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:5673
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!spool.mu.edu!uwm.edu!caen!msuinfo!uchinews!milo.mcs.anl.gov!raptor.mcs.anl.gov!olson
From: olson@raptor.mcs.anl.gov (Bob Olson)
Subject: Re: Implementation of 'rcmd(3n)' in perl?
Message-ID: <7474062422455@raptor.mcs.anl.gov>
Sender: usenet@mcs.anl.gov
Nntp-Posting-Host: raptor.mcs.anl.gov
Organization: /usr/local/lib/organization
References: <rantapaa.747364160@s6.math.umn.edu>
Date: Tue, 7 Sep 1993 12:50:42 GMT
Lines: 170

In article <rantapaa.747364160@s6.math.umn.edu> rantapaa@s6.math.umn.edu (Erik E. Rantapaa) writes:
>I was just curious if anyone had written the equivalent of 'rcmd()'
>in perl.

Matter of fact I have. At least it looks like it; I wrote this
two years ago and haven't looked at it since. Buyer beware :-).

#!/usr/local/bin/perl

#
# rcmd implementation
#
# Robert Olson
# olson@mcs.anl.gov
# Argonne National Laboratory
# October, 1991
#

package rcmd;

require 'sys/socket.ph';
require 'netinet/in.ph';
require 'errno.ph';

$TIMEOUT = "Alarm Timeout\n";

$porthandle = "LPORT0001";
$connect_timeout = 5;

sub main'rcmd
{
    local($host, $rport, $locuser, $remuser, $cmd) = @_;

    local($name,$aliases,$type,$len,$haddr);
    local($port, $handle, $hostname, $remote_addr);
    local($sockaddr);
    local($lport, $h);
    local($timeout) = 1;

    ($h) = $host =~ /(.*)/;

    $lport = &IPPORT_RESERVED - 1;

    $sockaddr = 'S n C4 x8';
    $sockaddr2 = 'S n C4 x8';

    ($hostname,$aliases,$type,$len,@addrs) = gethostbyname($h);

    if ($hostname eq '')
    {
	$error = "Host not found";
	return undef;
    }

#    ($name,$aliases,$rport) = getservbyname($rport, 'tcp')
#	unless $rport =~ /^\d+$/;

    @addrs = unpack('C4', $addrs[0]);
    print "Got rport='$rport' host='$hostname' haddr='",
                  join(":", @addrs), "\n" if $verbose;

    $SIG{"ALRM"} = timeout;

    while (1)
    {
	$handle = $porthandle++;
	$port = &rresvport($lport, $handle);
	if (!$port)
	{
	    if (errno == &EAGAIN)
	    {
		$error =  "all ports in use\n";
	    }
	    else
	    {
		$error = "rresvport failed: $!\n";
	    }

	    
	    return undef;
	}
	
	$remote_addr = pack($sockaddr, &AF_INET, 514, @addrs);

	print "Remote addr: '",
	           join(":", unpack($sockaddr2, $remote_addr)), "\n"
		       if $verbose;

	alarm($connect_timeout);
	if (connect($handle, $remote_addr))
	{
	    print "Connected\n" if $verbose;
	    alarm(0);
	    last;
	}
	alarm(0);

	if ($! == &EADDRINUSE)
	{
	    $lport--;
	    next;
	}
	elsif ($! == &EINTR)
	{
	    $! = &ETIMEDOUT;
	    $error = $!;
	    return undef;
	}
	else
	{
	    $error = $!;
	    return undef;
	}
    }

    print $handle "\0";
    print $handle $locuser, "\0";
    print $handle $remuser, "\0";
    print $handle $cmd, "\0";
    return "rcmd'$handle";
}

sub timeout
{
    print "Got timeout\n";
    die $TIMEOUT;
}

sub rresvport
{
    local($portnum, $handle) = @_;
    local($name, $aliases, $proto, $type, $len);
    local($remoteaddr, $localaddr, $hostname);
    local($remote_saddr, $local_saddr, $sockaddr);
    
    $sockaddr = 'S n C4 x8';

    if (!socket($handle, &AF_INET, &SOCK_STREAM, 0))
    {
	warn "Socket failed: $!\n";
	return undef;
    }

    select($handle); $| = 1;
    select(STDOUT);

    ($name, $aliases, $proto) = getprotobyname("tcp");
    print "got '$name' '$aliases' '$proto'\n" if $verbose;

    while ($portnum > &IPPORT_RESERVED / 2)
    {
	$addr = pack($sockaddr, &AF_INET, $portnum, &INADDR_ANY);
	print join(":", unpack($sockaddr, $addr)), "\n" if $verbose;
	if (bind($handle, $addr))
	{
	    print "Bind succeeded\n" if $verbose;
	    return $portnum;
	}
	elsif ($! != &EADDRINUSE)
	{
	    warn "Bind failed: $!\n";
	    close($handle);
	    return undef;
	}
	$portnum--;
    }
    $! = &EAGAIN;
    return undef;
}




.