wiml@milton.u.washington.edu (William Lewis) (04/09/91)
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."
me@anywhere.EBay.Sun.COM (Wayne Thompson - IR Workstation Support SE) (04/09/91)
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 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ##