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: [email protected] (Bob Olson)
Subject: Re: Implementation of 'rcmd(3n)' in perl?
Message-ID: <[email protected]>
Sender: [email protected]
Nntp-Posting-Host: raptor.mcs.anl.gov
Organization: /usr/local/lib/organization
References: <[email protected]>
Date: Tue, 7 Sep 1993 12:50:42 GMT
Lines: 170

In article <[email protected]> [email protected] (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
# [email protected]
# 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;
}