[comp.lang.perl] Querying rstatd from Perl

worley@compass.com (Dale Worley) (08/22/90)

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,@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;

#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@compass.com
--
Hall's Laws of Politics:
	(1) The voters want fewer taxes and more spending.
	(2) Citizens want honest politicians until they want something fixed.
	(3) Constituency drives out consistency (i.e., liberals defend 
	    military spending, and conservatives social spending, in their 
	    own districts).

worley@compass.com (Dale Worley) (08/22/90)

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.

Dale Worley		Compass, Inc.			worley@compass.com
--
Who are you to tell me to question authority?