From worley@compass.com Fri Jan 17 18:43:06 1992
SUB: Re: yppasswd in perl?
SUM: Tom Christiansen <tchrist@convex.COM>, tchrist@convex.COM (Tom Christiansen)->Perl-Users@fuggles.acc.Virginia.EDU
>From the keyboard of jbryans@beach.csulb.edu (Jack Bryans):
:Minor edits to the Camel Book's passwd.pl to remove typos & one
:off-the-Wall-ism made it a working program. Now we'd like to make a
:yppasswd out of it, but we're unsure what tack to take.
:
:Can RPC calls be made directly from perl? Or will we need to write a C
:sub-routine to be called from perl to get the yppasswd(oldpass,newpw)
:functionality?
Sure they can. It's just not fun. Here's an old article that should
point the way. These days I would rely on c2ph for the structure
definitions though.
--tom
Date: 21 Aug 90 20:37:22 GMT
From: worley@compass.com (Dale Worley)
Subject: Querying rstatd from Perl
Reply-to: worley@compass.com
Organization: The Internet
Newsgroups: comp.lang.perl
Message-ID: <1990Aug21.203722.26933@uvaarpa.Virginia.EDU>
Forwarded: Mon, 04 Mar 91 13:46:08 CST
connolly
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).
--
"GUIs normally make it simple to accomplish simple actions and impossible
to accomplish complex actions." --Doug Gwyn (22/Jun/91 in comp.unix.wizards)
Tom Christiansen tchrist@convex.com convex!tchrist
From me@anywhere.EBay.Sun.COM Sun Jan 19 16:45:47 1992
To: Perl-Users@fuggles.acc.Virginia.EDU
From: me@anywhere.EBay.Sun.COM (Wayne Thompson)
Subject: Re: yppasswd in perl?
Date: 18 Jan 92 17:39:43 GMT
SUB: Re: yppasswd in perl?
SUM: me@anywhere.EBay.Sun.COM (Wayne Thompson)->Perl-Users@fuggles.acc.Virginia.EDU
In article <DRW.92Jan17161416@kutta.mit.edu>, drw@kutta.mit.edu (Dale R. Worley) writes:
|> In article <JBRYANS.92Jan16164859@beach.csulb.edu> jbryans@beach.csulb.edu (Jack Bryans) writes:
|> Can RPC calls be made directly from perl? Or will we need to write a C
|> sub-routine to be called from perl to get the yppasswd(oldpass,newpw)
|> functionality?
|>
|> Well, you *can* do RPC calls from Perl, they're just packets sent to
|> IP addresses. The trouble is that you have to figure out how to do
|> all the XDR stuff manually, and perhaps even call the portmapper to
|> find out what port to talk to. But, if you're going to do it, why not
|> bundle it into a nice library for the rest of us? :-)
|>
|> Dale Worley Dept. of Math., MIT drw@math.mit.edu
|> --
|> Mind you, not as bad as the night Archie Pettigrew ate some
|> sheep's testicles for a bet... God, that bloody sheep kicked him...
|> -- Ripping Yarns
This is what I did when I had to RPC.
In article <1991Apr9.051205.21448@milton.u.washington.edu>, wiml@milton.u.washington.edu (William Lewis) writes:
|
| Is it possible to do RPC from perl? I know little about rpc and
| its implementation, but it seems that perl should be able to do
| the necessary mechanics. Has anyone written a package to do perl
| rpcs?
| --
| wiml@milton.acs.washington.edu Seattle, Washington
| (William Lewis) | 47 41' 15" N 122 42' 58" W
| "Just remember, wherever you go ... you're stuck there."
Yes, it's possible but not altogther easy.
I had to go through documentation for RPC, TCP/IP, quite a few header
files and even dumps of packet exchanges to come up with the
following. Even after all that, I still couldn't come up with how to
tag one field (@idontknow).
It makes an rpc call to rstatd and determines if the client has a disk
that's in use. The disk IOs are ORed together and if there are more
than 16 you've got a disk and you're using it. It turns out that a
diskless client that has a disk that's not in use will have 16 IOs
(probably happens during device probing).
I wish I had the time to document this (not even sure I could remember
it all). I can answer specific questions.
Any comments are welcomed.
Wayne
$MYNAME is the basename(1) of $0. i.e. ($MYNAME = $0) =~ s|.*/||;
call using:
&UsingDisk ($hostname);
&UsingDisk ($ipaddr); # in a string i.e. "127.1.0.0"
returns:
0: not using disk
1: using disk
-1: timed out
Such as it is...
## >> BEGIN subroutine: UsingDisk >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ##
require ('signal.ph');
require ('sys/types.ph');
require ('netinet/in.ph');
require ('sys/socket.ph');
#require ('rpc/rpc.ph');
require ('rpcsvc/rstat.ph');
sub UsingDisk {
package UsingDisk;
$sub = 'UsingDisk';
eval ('$MYNAME = "${' . ($caller = (caller)[0]) . '\'MYNAME}"');
$MYNAME .= "'$sub" unless $caller eq $sub;
($host) = @_;
socket (S
, &'PF_INET
, &'SOCK_DGRAM
, &'IPPROTO_UDP
) || die "\n$MYNAME: error: socket: $!\n";
bind (S
, pack ('S n C4 x8'
, &'AF_INET
, 0
, 0
, 0
, 0
, 0
)
) || die "\n$MYNAME: error: bind: $!\n";
connect (S
, pack ('S n C4 x8'
, &'AF_INET
, (getservbyname ('sunrpc', 'udp'))[2]
, $host =~ /^\d+\./
? @bytes = split(/\./, $host)
: (@bytes = unpack ('C4', (gethostbyname ($host))[4]))
)
) || die "\n$MYNAME: error: connect: $!\n";
die "\n$MYNAME: error: $host: unknown host.\n" unless @bytes;
select((select(S), $| = 1)[0]);
print S pack ("N13"
, @call = ($rm_xid = int (2**23*rand)
, $msg_type = $CALL = 0
, $cb_rpcvers = 2
, $cb_prog = $PMAPPROG = 100000
, $cb_vers = $PMAPVERS = 2
, $cb_proc = $PMAPPROC_CALLIT = 5
, @cb_cred = ($flavor = 0
, $body = 0
)
, @cb_verf = @cb_cred
, @call_args = ($prog = &'RSTATPROG
, $vers = &'RSTATVERS
, $proc = &'RSTATPROC_STATS
)
)
);
vec ($rmask = "", fileno (S), 1) = 1;
($nfound, $rmask) = select ($rmask, undef, undef, 10);
$nread = sysread (S, $_, 1024) if $nread = $nfound;
close (S);
return -1 unless $nread;
($r_xid, $r_msgtype, $r_reply_stat, @r)
= unpack ("N" . length ($_) / 4, $_);
$r_xid == $rm_xid || die "\n$MYNAME: error: rpc: xid error\n";
$r_msgtype == ($reply = 1) || die "\n$MYNAME: error: rpc: not a reply\n";
$r_reply_stat == ($rejected_reply = 1)
&& die "\n$MYNAME: error: rpc: call rejected\n";
$r_reply_stat != ($accepted_reply = 0)
&& die "\n$MYNAME: error: rpc: $r_reply_stat: unknown reply status\n";
(@verf[0..1], @r) = @r;
$r_accept_stat = shift (@r);
(@idontknow[0..1], @r) = @r;
(@cp_time[0..3]
, @dk_xfer[0..3]
, $v_pgpgin
, $v_pgpgout
, $v_pswpin
, $v_pswpout
, $v_intr
, $if_ipackets
, $if_ierrors
, $if_oerrors
, $if_collisions
, $v_swtch
, @avenrun[0..2]
, @boottime[0..1]
, @curtime[0..1]
, $if_opackets
) = @r;
eval (join ('|', @dk_xfer)) > 16 ? 1 : 0;
}
## << END subroutine: UsingDisk <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ##