#!/usr/local/bin/perl
#
# Version 1.0
# Release date: 28-Mar-95
#
# nss is a perl script that scans either individual remote hosts or entire
# subnets of hosts for various simple network security problems.  The
# majority of the tests can be performed by any non-privileged user on a
# typical Unix machine.  The only test currently being performed that
# requires root privileges is the check for a bad hosts.equiv file.  This
# test requires that a fake username (e.g., bin) be fed into rexec.
#
# Ethical (and possibly legal) concerns limit the tests that nss will run.
# nss will not create any files on remote machines nor will it run any non-
# trivial programs on remote machines.  
#
# The only non-standard external program it invokes is ypx, a program that
# attempts to download the password map from a NIS server.  ypx was posted
# in comp.sources.misc and in archived in volume 40.
#
# nss also requires the ftplib.pl package if you are running perl version
# 4.x. ftplib.pl is available from several perl archives such as
# ftp://anubis.ac.hmc.edu:/pub/perl/library/ftplib.pl.gz
#
# By default, all checks are enabled.  Execute the program with no flags
# to see a usage message.
#
# Print levels are determined by the "verbose" flag.  The print levels
# are defined as:
#   $verbose = 0  -  information messages - overly verbose
#   $verbose = 1  -  warning messages
#   $verbose = 2  -  error messages
#   $verbose = 3  -  severe error messages
# The levels are cumulative so that any messages of level greater than
# or equal to $verbose are printed.
#
# This program was developed on a DECstation 5000 running Ultrix 4.4.  It
# has had superficial portability checks made under SunOS 4.1.3 and Irix 5.2
# but extensive work has not been performed from those platforms.
#
# Copyright 1995 by Douglas O'Neal
#
# Everyone is granted permission to use and distribute this program provided
# that this copyright notice is retained in all copies distributed.
# Inclusion of this software in any commercial product without the express
# permission of the author is prohibited.
#
# This software is provided "as is" and without any express or implied
# warranties including the implied warranties of merchantibility and
# fitness for any particular purpose.
#
# In no event shall the authors or contributors be liable for any direct,
# indirect, incidental, special, exemplary, or consequential damages arising
# out of the of this software.
#
# Written by: Douglas O'Neal
#             Doug.ONeal@jhu.edu
#
# The author would welcome any suggestions or code samples for more tests.
# Any portability problem reports (other than with ypx) are also welcome.
#
# Future enhancements may include:
#
#    internal RPC library so that NFS checks do not rely on external programs
#
#    automatic generation of mail messages to be sent to the administrators
#    of machines flagged as having security problems
#
#    more exhaustive searches for NIS domain names
#
#    checks into Appletalk, Novell, or LAN Manager networks.
#
#    internal replacement for nslookup and/or better control over which
#    nameserver is queried
#
#    option for scanning numeric subnets
#

require 'sys/socket.ph';
if ($] < 4.99) {
require 'ftplib.pl';
} else {
require 'ftp.pl';
}
require 'getopts.pl';
require 'errno.ph';
$errno=0;

$TmpDir="/tmp/iss$$";
$StartDir=`/bin/pwd`;
$YPX="/users/doug/nss/ypx/ypx";
$XWININFO="/usr/bin/X11/xwininfo";
$PING='/usr/etc/ping';        #BSD
#$PING='/usr/etc/ping -c 5';    #IRIX

$verbose=2;
$nforks=4;
$do_a=1;
$do_s=1;
$do_m=1;
$do_t=1;
$do_e=1;
$do_x=1;
$do_y=1;
$do_S=1;

if ($#ARGV == -1) {&Usage};
if (!&Getopts ('aemstxyf:v:h:d:r:o:S')) {&Usage};
if (defined $opt_h && defined $opt_d) {&Usage};
if (defined $opt_r && !defined $opt_d) {&Usage};

if (defined $opt_v) { $verbose=$opt_v }   # verbosity level
if (defined $opt_s) { $do_s = 0}          # sendmail
if (defined $opt_a) { $do_a = 0}          # anonymous ftp
if (defined $opt_m) { $do_m = 0}          # NFS exports
if (defined $opt_t) { $do_t = 0}          # tftp
if (defined $opt_e) { $do_e = 0}          # check hosts.equiv +
if (defined $opt_x) { $do_x = 0}          # check xhost +
if (defined $opt_y) { $do_y = 0}          # check ypx maps
if (defined $opt_f) { $nforks=$opt_f }    # number of forks to run
if (defined $opt_S) { $do_S = 0}          # don't sort hostnames

$SIG{'INT'} = 'SignalCatcher';
$SIG{'QUIT'} = 'SignalCatcher';
$SIG{'CLD'} = 'SigChildCatcher';

if (defined $opt_o) {
    open(STDOUT, ">$opt_o") || die "Cannot open output file.\n";
    open(STDERR, ">$opt_o");
    select STDOUT; $|=1;
    select STDERR; $|=1;
    close(STDIN);
    # now fork and detach
    if (fork) { # parent
        wait;
        exit 0;
    } else { # child
        if (fork) { # child
            exit 0;
        } else { # grandchild
            sleep 1 until getppid == 1;
        }
    }
        
}

mkdir($TmpDir,0700) || die "Cannot create tmp directory $TmpDir\n";
chdir $TmpDir;

if ($do_e) {
    if (($< != 0) && ($> != 0)) {
        $do_e=0;
        print "Need root access to check hosts.equiv\n";
    }
}

if (defined $opt_h) {
    $hostname[0] = $opt_h;
    if (!(($name,$aliases,$addrtype,$length,@addrs) =
        gethostbyname($hostname[0]))) {
        die "Unknown host $hostname[0]\n";
    }
} elsif (defined $opt_d) {
    if (defined $opt_r) {
        @hostname = &GetDomainListing($opt_d, $opt_r);
    } else {
        @hostname = &GetDomainListing($opt_d);
    }
} else {
    die "Neither hostname nor domain is defined, use -h or -d option.\n";
}

$HANDLES="FORK00000";
$rin='';
$timeout=5.0;
$counter=0;

for ($fork=0; $fork<$nforks; $fork++) {
    if ($counter <= $#hostname) {
        *IN=$HANDLES;
        $HANDLES++;
        *OUT=$HANDLES;
        $HANDLES++;
        pipe(IN,OUT);
        if ($pid=fork()) {
            close(OUT);
            vec($rin, fileno(IN), 1) = 1;
            $INPUT[$fork]=*IN;
            $PID[$fork]=$pid;
            $counter++;
        } else {
            close(IN);
            open(STDOUT, ">&OUT");
            select(STDOUT); $|=1;
            last;
        }
    }
}

if ($pid) {
    while (unpack("b*",$rin) =~ m/1/) {
        $nfound=select($rout=$rin,undef,undef,$timeout);
        for ($i=0; $i<$nforks; $i++) {
            *IN=$INPUT[$i];
            if (vec($rout,fileno(IN),1)==1) {
                while ($_=<IN>) { print $_ }
            }
            if (eof(IN)) {
                vec($rin,fileno(IN),1)=0;
                close(IN);
                if ($counter <= $#hostname) {
                    *IN=$HANDLES;
                    $HANDLES++;
                    *OUT=$HANDLES;
                    $HANDLES++;
                    pipe(IN,OUT);
                    if ($pid=fork()) {
                        close(OUT);
                        vec($rin, fileno(IN), 1) = 1;
                        $INPUT[$i]=*IN;
                        $PID[$i]=$pid;
                        $counter++;
                    } else {
                        close(IN);
                        open(STDOUT, ">&OUT");
                        &doit($hostname[$counter]);
                        exit(0);
                    }
                }
            }
        }
    }
} else {
    &doit($hostname[$counter]);
    exit(0);
}

if (defined $opt_o) {
    close(OutFile);
}

chdir $StartDir;
rmdir $TmpDir;

exit (0);

############################################################################

sub doit {
    local($host)=$_[0];

    @messages=();
    &Print(0,"$host:\tscan starting.");

# check to see if the host answers a ping first...
#    if (! &pingecho($host)) {
#        &Print(0,"$host is not reachable.");
#        next;
#    }
    open(FD,"$PING $host 2>&1 |");
    $rin='';
    vec($rin,fileno(FD),1)=1;
    $timeout=30.0;
    while ($nfound=select($rout=$rin,undef,undef,$timeout)) {
        $_=<FD>;
        if (/no answer/ || / 0 packets received/ ) { $is_up = 0}
        if (/is alive/ || /bytes from/ )  { $is_up = 1 }
        if (eof(FD)) { last };
    }
    close (FD);
    if ($is_up==0) {
        &Print(0,"$host:\tnot reachable.");
    } else { 
        if ($do_s) { &CheckSendmail($host) }
        if ($do_a) { &CheckAnonymousFtp($host) }
        if ($do_m) { &CheckNFSExports($host) }
        if ($do_t) { &CheckTftpAccess($host) }
        if ($do_e) { &CheckEquivAccess($host) }
        if ($do_x) { &CheckX11Access($host) }
        if ($do_y) { &CheckNISMaps($host) }
    }

    &Print(0,"$host:\tscan completed.");
    for ($i=0; $i<$#messages; $i++) { print $messages[$i] }
    wait;
}

sub Usage {
    print "Usage: $0 [-amst] [-v level] [-o file] [-h host] [-d domain [-r restrict]]\n";
    print "    -a           turn off anonymous ftp checks\n";
    print "    -m           turn off NFS exports checks\n";
    print "    -s           turn off sendmail checks\n";
    print "    -t           turn off tftp checks\n";
    print "    -e           turn off host.equiv checks\n";
    print "    -x           turn off xhost access checks\n";
    print "    -y           turn off NIS maps checks\n";
    print "    -v level     set verbosity level (0-3, 0 being most verbose)\n";
    print "    -f number    number of hosts to run in parallel\n";
    print "    -o file      set output file\n";
    print "    -h host      check a single host\n";
    print "    -d domain    check an entire domain\n";
    print "    -r restrict  check only this subdomain\n";
    print "    -S           turn off sorting hostnames\n";
    exit(0);
}

sub SigAlarmCatcher {
    return 0;
}

sub SigChildCatcher {
    waitpid(-1,WNOHANG);
    return 0;
}

sub SignalCatcher {
    local($sig)=$_[0];
    &Print(4,"$host:\tCaught signal SIG$sig - bye!");
    close(STDOUT);
    close(STDERR);
    if (defined $opt_o) { close(OutFile) }
    chdir $StartDir;
    rmdir $TmpDir;
    exit 0;
}

sub GetDomainListing {
    local($name);
    local($aliases);
    local($addrtype);
    local($length);
    local(@addr);
    local($ip);
    local(@hostnames);
    local($i);

    pipe(FD, FD1);
    if (fork()) {     #Parent
        $i=0;
        close(FD1);
        while(<FD>) {
            if (m/(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
                if ((($1!=127) && ($2!=0) && ($3!=0) && ($4!=1)) &&
                    (($1!=255) && ($2!=255) && ($3!=255) && ($4!=255))) {
                    ($name, $aliases, $addrtype, $length, @addr) = 
                        gethostbyaddr(pack('C4',$1,$2,$3,$4),&AF_INET);
                    if ($name && (($#_==0) || ($name =~ m/\.$_[1]/))) {
                        $hostnames[$i] = $name;
                        $i++;
                    }
                }
            }
        }
        wait;
    } else {          #Child
        close(FD);
        open(STDOUT, ">&FD1");  #Make STDOUT go to FD;
        open(OUT, "|/usr/ucb/nslookup 2>&1");
        print(OUT "ls $_[0]\n");
        print(OUT "\004");
        close(OUT);
        wait;
        exit 0;
    }
    if ($do_S) { @hostnames=sort(SortName @hostnames) }
    return (@hostnames);
}

sub SortName {
    local(@aa) = split(/\./,$a);
    local(@bb) = split(/\./,$b);
    if ($aa[1] eq $bb[1]) {
        return ($aa[0] cmp $bb[0])
    } else {
        return ($aa[1] cmp $bb[1])
    }
}

sub CheckSendmail {
#    local(@ids)=('decode','uudecode','lp','lpr');
    local(@ids)=('decode','uudecode');

    if (! &chat'open_port($_[0], 25)) {
        &Print(0,"$_[0]:\tDoes not support SMTP.");
        return;
    }

    $_ = &telnet_listenr(20, '^220 ') ;
    if (@sver = m/Sendmail (.*) ready/) {
        &Print(0,"$_[0]:\tSendmail version @sver");
    } elsif (@sver = m/TGV MultiNet (.*) SMTP/) {
        &Print(0,"$_[0];\tTGV Multinet @sver");
    } else {
        &Print(0,"$_[0]:\tSendmail version not available.");
    }

#    &chat'print("wiz\r\n");
#    $_ = &telnet_read(20);
#    if (m/^5\d\d /) {
#        &Print(0,"$_[0]:\twiz command disabled");
#    } else {
#        &Print(2,"$_[0]:\twiz command enabled");
#    }

#    &chat'print("debug\r\n");
#    $_ = &telnet_read(20);
#    if (m/^5\d\d /) {
#        &Print(0,"$_[0]:\tdebug command disabled");
#    } else {
#        &Print(2,"$_[0]:\tdebug command enabled");
#    }

    foreach $id (@ids) {
        &chat'print("vrfy $id\r\n");
        $_ = &telnet_read(20);
# this should be the proper method but many SMTP servers do not return
# a 5xx error code for a non-existant user.
#        if (m/^5\d\d/) {
#            &Print(0,"$_[0]:\tno mail alias found for pseudouser $id");
#        } else {
#            &Print(1,"$_[0]:\tmail alias found for pseudouser $id");
#        }
        if (m/^250 <*$id>*/) {
            &Print(1,"$_[0]:\tmail alias found for pseudouser $id");
        } else {
            &Print(0,"$_[0]:\tno mail alias found for pseudouser $id");
        }
    }

    &chat'print("quit\r\n");
    while ($_= &telnet_read(20)) { ; }
    &chat'close;
}

sub CheckAnonymousFtp {
    if (&ftp'open($_[0])) {
        &Print(1,"$_[0]:\tSupport anonymous ftp.");
    } else {
        &Print(0,"$_[0]:\tDoes not support anonymous ftp.");
        return;
    }

    &ftp'cwd("/etc");
    @list = &ftp'dir();
    for ($i=0; $i<=$#list; $i++) {
        if ($list[$i] =~ m/passwd/) {
            &ftp'get("/etc/passwd", $TmpDir . "/" . $_[0]);
        }
        open(FD,$TmpDir . "/" . $_[0]);
        while (<FD>) {
            @fields = split(/:/);
            if (!($fields[0]=~/root/) && !($fields[0]=~/ftp/)) {
                &Print(1,"$_[0]:\tpasswd file has extraneous users in it.");
            }
            if ($fields[1] ne '*') {
                &Print(1,
                    "$_[0]:\tpasswd file has non-locked account $fields[0].");
            }
        }
        close(FD);
        unlink $TmpDir . "/" . $_[0];
    }
    &ftp'close();
}

sub CheckNFSExports {
    local($check)=0;
    open (FD, "/usr/etc/showmount -e $_[0] 2>&1 |");
    while (<FD>) {
        if (m/Port mapper failure/) {
            &Print(0,"$_[0]:\tNFS exports not enabled");
            $check++;
        }
        if (m/Program not registered/) {
            &Print(0,"$_[0]:\tNo filesystems exported");
            $check++;
        }
        if (m%\(everyone\)%) {
            @fs = split;
            &Print(2,"$_[0]:\tFile system $fs[0] exported to the world.");
            $check++;
        }
        if (m%^/ %) {
            &Print(1,"$_[0]:\tRoot file system exported.");
            $check++;
        }
    }
    close (FD);
    if ($check==0) {&Print(0,"$_[0]:\tNFS exports enabled.")}
}

sub CheckTftpAccess {
    local(@check) = &tftp($_[0], '/etc/passwd');
    local($i);

    if ($check[0] == -1) {
        &Print(0,"$_[0]:\ttftp not enabled.");
        return;
    } else {
        &Print(1,"$_[0]:\ttftp enabled.");
    }

    if (($check[0] != 0) ||
      (@check[1] != m/No such file or directory./)) {
        &Print(0,"$_[0]:\tpasswd file not available via tftp.");
    } else {
        &Print(2,"$_[0]:\tpasswd file available via tftp.");
        local(@lines) = split('\n', @check[1]);
        for ($i=0; $i<=$#lines; $i++) {
            local(@fields) = split(/:/,$lines[$i]);
            if ($fields[1] ne '*') {
                &Print(1,
                    "$_[0]:\tpasswd file has non-locked account $fields[0].");
            }
        }
    }
}

sub CheckEquivAccess {
    local($lines)=0;
    local($id);
    local(@ids)=('root','bin','sys','daemon','uucp','lp','lpr','sync',
                 'news','ingres','audit','fax','nobody');
    local($name,$aliases,$rport)=getservbyname('shell','tcp');
    local($s)=S;
    local($fd2p)=1;
    local($rin)='';
    local($timeout)=0.50;
    local($cmd)='/bin/echo Success';
    local($retval);
    local($reterr)=0;

    foreach $id (@ids) {
        $lines=0;
        $retval=&rcmd($s,$_[0],$rport,$id,$id,$cmd,$fd2p);
        if ($retval <= -1) {
            $reterr++;
            next;
        }

        $rin='';
        vec($rin, fileno($s), 1) = 1;
        vec($rin, fileno($fd2p), 1) = 1;

        for (;;) {
            $nfound=select($rout=$rin, undef, undef, $timeout);
            if ($nfound==0 || (eof($s)&&eof($fd2p))) {last};
            if (vec($rout,fileno($s),1)==1) {
	        $_=<$s>;
            } elsif (vec($rout,fileno($fd2p),1)==1) {
	        $_=<$fd2p>;
            }
            $lines++;
            if (m/[Pp]ermission denied/ ||
                m/[Cc]onnection refused/ ||
                m/[Cc]ennection timed out/ ||
                m/[Ll]ogin incorrect/) {
                &Print(0,"$_[0]:\tCannot access user $id through hosts.equiv");
            } elsif (m/Success/) {
                &Print(2,"$_[0]:\tCan access user $id through hosts.equiv");
            } else {
                if ($lines >= 25) { last };
                &Print(0,"$_[0]:\trshd got line $_") unless ($_ eq '');
            }                
        }
        if ($lines==0) {
            &Print(0,"$_[0]:\trshd received no response to user $id?");
        }
    }
    if ($reterr==($#ids+1)) {
        &Print(0,"$_[0]:\tCannot access rsh server");
    }
    shutdown($s,0);
    shutdown($fd2p,0);
}

sub CheckX11Access {
    local($check)=0;
    open (FD, "$XWININFO -root -display $_[0]:0 2>&1 |");
    $rin='';
    vec($rin,fileno(FD),1)=1;
    $timeout=30.0;
    while ($nfound=select($rout=$rin,undef,undef,$timeout)) {
        if (vec($rout,fileno(FD),1) || eof(FD)) { last }
        $_=<FD>;
        if ((m/Client is not authorized/) || (m/unable to open display/)) {
            $check++;
        }
    }
    close(FD);
    if ($check) {
	&Print(0,"$_[0]:\txserver access denied");
    } else {
        &Print(1,"$_[0]:\txserver access allowed");
    }
}

sub CheckNISMaps {
    system("/bin/rm -f $_[0].out");
    open (FD, "$YPX -sg -o $_[0].out $_[0] 2>&1 |");
    while (<FD>) {
        if ($verbose==0) { print $_ }
    }
    close(FD);
    if (-s "$_[0].out") {
        if ($verbose==0) { system("/bin/cat $_[0].out") }
        &Print(4,"$_[0]:\tNIS password file available");
    } else {
        &Print(0,"$_[0]:\tNIS password file safe");
    }
    system("/bin/rm -f $_[0].out");
}

sub Print {
    if ($_[0] >= $verbose) {
        $messages[$#messages+1] = $_[1] . "\n";
    }
}

sub telnet_talk {
    local($text) = $_[0];
    &chat'print($text);
}

sub telnet_listen {
    local($secs) = $_[0];
    local($return,$tmp) = "";
    while (length($tmp = &telnet_read($secs))) {
        $return .= $tmp;
    }
    $return;
}

sub telnet_listenr {
    local($secs,$regex) = $_[0];
    local($return,$tmp) = "";
    while (length($tmp = &telnet_read($secs))) {
        $return .= $tmp;
        last if $return =~ /$regex/i;
    }
    $return;
}

sub telnet_read {
    local($secs) = $_[0];
    &chat'expect($secs,
        '^\377[\375\376](.|\n)',
        q#&chat'print ("\377\374".$1); redo LOOP#,
            # WON'T do these do/don't requests
        '^\377[\373\374](.|\n)', 'redo LOOP',
            # ignore these will/won't changes
        '^\377\377', '"\377"',
            # escaping the IAC
        '^\377(.|\n)', 'redo LOOP',
            # ignoring these
        '^[^\377]+', '$&'
            # return these
        );
}

sub tftp {
    local($hostname) = $_[0];
    local($filename) = $_[1];

    local($AF_INET)=&AF_INET;
    local($SOCK_DGRAM)=&SOCK_DGRAM;
    local($sockaddr)='S n C4 x8';

    local($OP_RRQ)=1;
    local($OP_WRQ)=2;
    local($OP_DATA)=3;
    local($OP_ACK)=4;
    local($OP_ERROR)=5;

    local($PACK_RRQ_WRQ) = 'n a* a*';
    local($PACK_DATA) = 'n n a*';
    local($PACK_ACK) = 'n n';
    local($PACK_ERROR) = 'n n a*';

    local($timeout) = 20;

    local($name, $aliases, $proto, $port, $addrtype, $length, @addrs);
    local($this, $that, $rin, $rout, $packet, $nfound);
    local(@return) = (0, '');

    ($name, $aliases, $proto) = getprotobyname('udp');
    ($name, $aliases, $port) = getservbyname('tftp','udp');
    ($hostname, $aliases, $addrtype, $length, @addrs) =
        gethostbyname($hostname);
    $that = pack($sockaddr, $AF_INET, $port, unpack('C4',$addrs[0]));
    $this = pack($sockaddr, $AF_INET, 0, 0, 0, 0, 0);

    socket(S, $AF_INET, $SOCK_DGRAM, $proto);

    bind(S,$this);

    select(S); $|=1; select(STDOUT);
    $rin = ''; vec($rin, fileno(S), 1) = 1;

    $packet = pack($PACK_RRQ_WRQ, $OP_RRQ, $filename . "\000netascii\000");

    send(S, $packet, 0, $that);

    while (1) {
        $nfound = select($rout=$rin, undef, undef, $timeout);
        if ($nfound == 0) {
            shutdown(S,0);
            @return = (-1, 'Transfer timed out.');
            return @return;
        }

        $that = recv(S, $_, 32767, 0);
        @buffer = unpack('n C*', $_);

        if ($buffer[0] == 3) {
            @buffer = unpack($PACK_DATA, $_);
            $return[1] = $return[1] . $buffer[2];
            $packet = pack($PACK_ACK, $OP_ACK, $buffer[1]);
            send(S, $packet, 0, $that);
            if (length($_) < 516) {
                shutdown(S,0);
                return @return;
            }
        }
        if ($buffer[0] == 4) {
            @buffer = unpack($PACK_ACK, $_);
            $block = $buffer[1];
        }
        if ($buffer[0] == 5) {
            @buffer = unpack($PACK_ERROR, $_);
            shutdown(S,0);
            @return = ($buffer[1], $buffer[2]);
            return @return;
        }
    }
}


sub rcmd {
    $S=$_[0];
    local($ahost) = $_[1];
    local($rport) = $_[2];
    local($locuser) = $_[3];
    local($remuser) = $_[4];
    local($cmd) = $_[5];
    $fd2p = $_[6];

    local($sockaddr)='S n C4 x8';
    local($AF_INET)=&AF_INET;
    local($EADDRINUSE)=&EADDRINUSE;

    local($lport) = 1023;

    local($S2) = $S+1;
    local($S3) = $S+2;

    ($ahost, $aliases, $addrtype, $length, @addrs) = gethostbyname($ahost);
    $that = pack($sockaddr, $AF_INET, $rport, unpack('C4',$addrs[0]));

    for (;;) {
        $retval=&rresvport($lport, $S);
        if ($retval <= -1) {
#            if ($errno == &EAGAIN) { print "socket: all ports in use\n"; }
            return -1;
        }

        $SIG{'ALRM'} = 'SigAlarmCatcher';
        alarm(30);
        last if connect($S, $that);
        $SIG{'ALRM'} = 'IGNORE';
        close($S);
        if ($errno==&EADDRINUSE) {
            $lport--;
            next;
        }
#        print "$!\n";
        return -1;
    }
    select($S); $|=1; select(stdout);
    $lport--;
    if ($fd2p==0) {
        print $S 0;
        $lport=0;
    } else {
        &rresvport($lport,$S2);
        listen($S2, 1);
        select($S2); $|=1; select(stdout);
        $clport = sprintf("%d\000",$lport);
        if (syswrite($S,$clport,length($clport)) != length($clport)) {
            return -1;
        }

        $addr = accept($S3, $S2);
        close($S2);
        $fd2p = $S3;
    }
    print $S "$locuser\0";
    print $S "$remuser\0";
    print $S "$cmd\0";
    $retval=read($S, $c, 1);
    if ($retval == 0) {
#        print "Protocol error, $ahost closed connection\n";
        return -1;
    }
    return 0;
}

sub rresvport {
    $lport = $_[0];
    $socket = $_[1];
    local($sockaddr)='S n C4 x8';
    local($AF_INET)=&AF_INET;
    local($SOCK_STREAM)=&SOCK_STREAM;
    local($fd);
    ($name, $aliases, $proto) = getprotobyname('tcp');

    socket($socket, $AF_INET, $SOCK_STREAM, $proto) || return -1;

    for (;;) {
        $this=pack($sockaddr, $AF_INET, $lport, 0, 0, 0, 0);
        if (bind($socket,$this)) {
            return 0;
        }
        if ($! != &EADDRINUSE) {
            close($socket);
            return -1;
        }
        $lport--;
        if ($lport <= 512) {
            close($socket);
            $errno = &EAGAIN;
            return -1;
        }
    }
}
