Querying rstatd from Perl

[Dale Worley]

This is to thank all the people who sent me information about rstatd
and about using UDP connections in Perl:
	Larry Wall
	Carl Smith
	Vipin Samar
	Guy Harris
	Michael van Elst
	(and any I've forgotten!)

My original idea was to have a program query all the hosts on our network
to determine which were idle (according to some criterion).  I want to
know:  load average, amount of virtual memory free, and keyboard idle
time.  Load average is available from rstatd, keyboard idle time is
(probably) available from rusersd, and it seems that free virtual memory
(printed by pstat -s) is probably not available from any daemon, unless I
write my own.

(While we're at it, is there any way to get the genuine keyboard idle time
when SunTools is running?  'w' shows the console as being idle for a very
long time, while input generated by a shelltool into its pty stimulated by
'^[[11t' are recorded as if it is genuine input.)

To interact with a UDP daemon in Perl, you need to open the connection
with the UDP protocol, rather than TCP.  Each print sends a UDP packet,
and each read gets a UDP packet.  You can also use send or recv without
connecting the socket.

RPC and XDR are described in Network Programming, chapters 5 and 6 (set I,
vol. XI in the 4.0.3 documentation).  Using the RPC protocol is much
simpler than it appears from the manual: XDR is just a machine independent
way to represent data structures.  The basic rule is that integers are
represented as four-byte network order integers (format N for pack and
unpack).  Also, don't forget that port 111 (a/k/a sunrpc) only handles
portmapper requests -- you either have to ask the portmapper for the port
of the service you want, or you have to ask the portmapper to forward the
request for you (the approach taken by the code below).

#!/usr/local/bin/perl

($host) = @ARGV;
die "usage: $0 hostname\n" unless $host;

$pat = 'S n C4 x8';

$stream = 1;
$datagram = 2;

$inet = 2;

$tcp = 6;
$udp = 17;

($name,$aliases,$port) = getservbyname('sunrpc','udp');

if ($host =~ /^\d+\./) {
    @bytes = split(/\./,$host);
}
else {
    ($name,$aliases,$addrtype,$length, at 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, at 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;

#while (1) {
print S pack("N13", 1956, 0, 2, 100000, 2, 5, 0, 0, 0, 0, 100001, 3, 1);

read(S, $_, 32767);

@r = unpack("N" . length($_)/4, $_);
#print join(' ', @r), "\n";
print $r[26]/256, ' ', $r[27]/256, ' ', $r[28]/256, "\n";

if ($r[0] != 1956) {
	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";
}

Dale Worley		Compass, Inc.			worley at compass.com

Oh, yeah -- the calling and returning data structures for the RPC daemons
and the various code numbers are in the files /usr/include/rpcsvc/*.x.