package Monitor::rpc;

require 5.002;
require Exporter;

use strict;
use Socket qw( SOCK_DGRAM SOCK_STREAM PF_INET inet_aton sockaddr_in );
use FileHandle;


$rpc::xid = time;
$rpc::shadow = "";
$rpc::RPC_CALL = 0;
$rpc::AUTH_NULL = 0;
$rpc::MSG_ACCEPTED = 0;
$rpc::SUCCESS = 0;

$rpc::PMAP_PROGRAM = 100000;
$rpc::PMAP_PORT = 111;
$rpc::PMAP_VERSION = 2;
$rpc::PMAPPROC_NULL = 0;
$rpc::PMAPPROC_SET = 1;
$rpc::PMAPPROC_UNSET = 2;
$rpc::PMAPPROC_GETPORT = 3;
$rpc::PMAPPROC_DUMP = 4;
$rpc::PMAPPROC_CALLIT = 5;



sub new
{
    my ($this, $timeout) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};

    bless($self, $class);

    $self->{"timeout"} = $timeout;

    $self->{"proto_num"} = (getprotobyname('udp'))[2];
    $self->{"fh"} = FileHandle->new();

    socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
	    $self->{"proto_num"});
    eval { binmode( $self->{"fh"} ); };

    return($self);
}


sub DESTROY {
    my( $self ) = @_;

    close( $self->{"fh"} );
}



sub call {
    my( $self, $ip, $proc, $args ) = @_;
    my( $msg );
    my( $flags, $saddr, $nfound, $rbits );
    my( $port );
    my( %msg );

    $msg = pack( "NNN", ++$rpc::xid, $rpc::RPC_CALL, 2 );
    $msg .= pack( "NN", $self->{"prog"}, $self->{"version"} );
    $msg .= pack( "N", $proc );
    $msg .= pack( "N", $self->{"auth_flavor"} );
    $msg .= pack( "N", length( $self->{"auth_data"} ) );
    $msg .= $self->{"auth_data"};
    $msg .= pack( "N", $self->{"ver_auth_flavor"} );
    $msg .= pack( "N", length( $self->{"ver_auth_data"} ) );
    $msg .= $self->{"ver_auth_data"};
    $msg .= $args;
    $msg .= $rpc::shadow;

    $flags = 0;

    $ip = inet_aton( $ip );
    return() unless( $ip );
    $saddr = sockaddr_in( $self->{"port_num"}, $ip );
    while(1) {
	$rbits = "";
	vec( $rbits, fileno($self->{"fh"}), 1 ) = 1;
	$nfound = select( $rbits, undef, undef, 0 );
	last unless( $nfound );
	my $nirvana;
	$saddr = recv( $self->{"fh"}, $nirvana, 8192, $flags );
    }
    send( $self->{"fh"}, $msg, $flags, $saddr );
    $rbits = "";
    vec( $rbits, fileno($self->{"fh"}), 1 ) = 1;
    $nfound = select( $rbits, undef, undef, $self->{"timeout"} );
    return() unless( $nfound );
    $msg = "";
    $saddr = recv( $self->{"fh"}, $msg, 8192, $flags );
    return() unless( $saddr );
    ($port, $ip) = sockaddr_in($saddr);
    %msg = $self->decode( $msg );
    return() if( $msg{"xid"} != $rpc::xid );
    return %msg;
}


sub decode {
    my( $self, $msg ) = @_;
    my( %msg );

    my( $xid, $type, $stat ) = unpack( "NNN", $msg );
    $msg{"xid"} = $xid;
    $msg{"type"} = $type;
    $msg{"stat"} = ($stat == $rpc::MSG_ACCEPTED);
    if( $msg{"stat"} ) {
	$msg = substr( $msg, 16 );
	$msg{"msg"} = substr( $msg, 4 );
	($msg{"accepted_stat"}, $msg{"low"}, $msg{"high"}) =
	    unpack( "NNN", $msg );
    }

    return %msg;
}



sub portmap {
    my( $self, $ip, $prog, $version, $proto ) = @_;
    my( $rpc );
    my( $args, $msg, $i );
    my( %msg );

    $proto = (getprotobyname($proto))[2];
    $rpc = Monitor::rpc->new( 0.5 );
    $rpc->{"prog"} = $rpc::PMAP_PROGRAM;
    $rpc->{"version"} = $rpc::PMAP_VERSION;
    $rpc->{"auth"} = $rpc->{"ver_auth"} = $rpc::AUTH_NULL;
    $rpc->{"port_num"} = $rpc::PMAP_PORT;
    $args = pack( "NNNN", $prog, $version, $proto, 0 );
    for( $i=0; ($i<=3) && (! %msg); $i++ ) {
	%msg = $rpc->call( $ip, $rpc::PMAPPROC_GETPORT, $args );
#    my( $a, $b );
#    while( ($a,$b) = each( %msg ) ) {
#	print "$a\t$b\n";
#    }
    }
    return( undef ) unless( $msg{"stat"} && ($msg{"accepted_stat"}==$rpc::SUCCESS) );
    return( $msg{"high"} );
}






1;
