Subject: Re: yppasswd in perl?

From: [email-masked] (Wayne Thompson)
Date: 18 Jan 92 17:39:43 GMT

In article <[email-masked]>, [email-masked] (Dale R. Worley) writes:
|> In article <[email-masked]> [email-masked] (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		[email-masked]
|> --
|> 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 <[email-masked]>, [email-masked] (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? 
| -- 
|  [email-masked]       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 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ##