#!/usr/local/bin/perl
#
# rpcinfo in perl.
#  This program is a piece of filthy crap, but it does work.
#

die "usage: $0 hostname\n" unless @ARGV;
$pat = 'S n C4 x8';
$stream = 1;
$datagram = 2;
$inet = 2;
$tcp = 6;
$udp = 17;

srand($$^time);

%rpc_serv=qw(100000 portmapper
	     100001 rstatd
	     100002 rusersd
	     100004 ypserv
	     100007 ypbind
	     100003 nfs
	     100005 mountd
	     100008 walld
	     100009 yppasswdd
	     100011 rquotad
	     100012 sprayd
	     100017 rexd
	     100020 llockmgr
	     100021 nlockmgr
	     100024 status
	     100029 keyserv
	     100068 rpc.cmsd
	     100078 kerbd
	     100083 rpc.ttdbserverd
	     100087 admind
	     100099 autofs
	     150001 pcnfsd
	     390103 nsrd
	     390109 nsrstat
	     390113 nsrexec
	     390107 nsrmmdbd
	     390104 nsrmmd
	     390105 nsrindexd
	     );

($name,$aliases,$port) = getservbyname('sunrpc','udp');
$host=$ARGV[0];
	if ($host =~ /^\d+\./) {
		@bytes = split(/\./,$host);
	} else {
		($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
		die "Can't lookup $host\n" unless $name;
		@bytes = unpack("C4",$addrs[0]);
	}
	$this = pack($pat,$inet,0,0,0,0,0);
	$that = pack($pat,$inet,$port,@bytes);
	socket(S,2,$datagram,$udp) || die "socket: $!\n";
	bind(S,$this) || die "bind: $!\n";
	connect(S,$that) || die "connect: $!\n";
	select(S); $| = 1; select(STDOUT); $| = 1;

	$trx=int(rand(10000));

	print S pack("N13",
		     $trx,	# transaction
     		     0,		# call
		     2,		# RPC Version
		     100000,	# portmap program number
		     2,		# version number
		     4,		# procedure number
		     );

	sysread(S, $_, 32767);
	$"=" ";
	@r = unpack("N" . length($_)/4, $_);
	if ($r[0] != $trx) {
		die "xid error\n";
	} elsif ($r[1] != 1) {
		die "Not a reply!\n";
	} elsif ($r[2] == 1) {
		if ($r[3] == 0) {
			die "Rejected - RPC_MISMATCH\n";
		} elsif ($r[3] == 1) {
			die "Rejected - AUTH_ERROR\n";
		} else {
			die "Rejected - unknown code\n";
		}
	} else {
#		print '', (("SUCCESS", "PROG_UNAVAIL", "PROG_MISMATCH", "PROC_UNAVAIL",
#			"GARBAGE_ARGS")[$r[5]]), "\n";
	}
	close S;

shift(@r);shift(@r);shift(@r);shift(@r);shift(@r);shift(@r);shift(@r);
print "   program vers proto   port  program       owner\n";
while (@r) {
    $r[$_+2] = "tcp" if ($r[$_+2] == 6);
    $r[$_+2] = "udp" if ($r[$_+2] == 17);
    $r[$_+4] = (getpwuid($r[$_+4]))[0];
    write;
    shift(@r);shift(@r);shift(@r);shift(@r);shift(@r);
}
exit;

format STDOUT=
@>>>>>>>>> @>>> @>>>> @>>>>>  @<<<<<<<<<<<< @<<<<<<<<
$r[$_],$r[$_+1],$r[$_+2],$r[$_+3],$rpc_serv{$r[$_]},$r[$_+4]
.
