DCE-Perl-RPC

 view release on metacpan or  search on metacpan

lib/DCE/Perl/RPC.pm  view on Meta::CPAN

    my $ctx_id = pack("V", rand 2**32);
    bless {'auth_type' => RPC_AUTH_NTLM,
	   'auth_level' => RPC_AUTH_LEVEL_CONNECT,
	   'auth_ctx_id' => $ctx_id}, $package;
}

############################################################################
# rpc_co_hdr composes the 16-bytes common DCE RPC header that must present #
# in all conection oriented DCE RPC messages. It takes four arguments:     #
# 1) PDU type; 2) PDU flags; 3) size of the PDU part that is specific to   #
# the PDU type; 4) size of the authentication credentials.                 #
# This function is an internal function. It is not supposed to be called   #
# from the outside world.                                                  #
############################################################################
sub rpc_co_hdr($$$$)
{
    my ($type, $flags, $size, $auth_size) = @_;
    my $msg = chr(RPC_MAJOR_VERSION) . chr(RPC_MINOR_VERSION);
    $msg .= chr($type);
    $msg .= chr($flags);
    $msg .= pack("H8", "10000000"); # assume little endian

lib/DCE/Perl/RPC.pm  view on Meta::CPAN

    $msg .= $ctx_id;
    return $msg;
}

#####################################################################
# rpc_bind composes the DCE RPC bind PDU. To make things simple, it #
# assumes the PDU context list only has one element. It takes four  #
# arguments: 1) Presentation Context Id; 2) Abstract Syntax         #
# concatenated with interface version; 3) list of transfer syntax   #
# concatenated with interface version; 4) authentication            # 
# credentials.                                                      #
#####################################################################
sub rpc_bind($$$@$)
{
    my $self = shift;
    my $ctx_id = shift;
    my $abs_syntax = shift;
    my @xfer_syntax = shift;
    my $auth_value = shift;
    my $msg = "";
    my $auth_pad = 0;

lib/DCE/Perl/RPC.pm  view on Meta::CPAN

    $bind_resp_msg .= rpc_auth_hdr($self->{'auth_type'}, $self->{'auth_level'}, $auth_pad, $self->{'auth_ctx_id'});
    $msg = rpc_co_hdr(RPC_BIND_RESP, PFC_FIRST_FRAG | PFC_LAST_FRAG,
	length($bind_resp_msg), length($auth_value)) . $bind_resp_msg . $auth_value;
    return $msg;
}

###########################################################################
# rpc_co_request composes the connection-oriented DCE RPC Request PDU. It #
# takes five arguments: 1) the stub; 2) the presentation context id;      #
# 3) operation # within the interface; 4) object UUID; 5) authetication   #
# credentials. The fourth argument can be "" if there is no UUID          #
# associate with this request PDU.                                        #
########################################################################### 
sub rpc_co_request($$$$$$)
{
    my ($self, $body, $ctx_id, $op_num, $uuid, $auth_value) = @_; 
    my $msg = "";
    my $auth_pad = 0;
    my $i;
    my $flags = PFC_FIRST_FRAG | PFC_LAST_FRAG; 
    my $req_msg = pack("V", length($body));

lib/DCE/Perl/RPC.pm  view on Meta::CPAN

    $req_msg .= rpc_auth_hdr($self->{'auth_type'}, $self->{'auth_level'}, $auth_pad, $self->{'auth_ctx_id'});
    $msg = rpc_co_hdr(RPC_REQUEST, $flags,
	length($req_msg), length($auth_value)) . $req_msg . $auth_value;
    return $msg;
}

##########################################################################
# rpc_alt_ctx composes a DCE RPC alter_context PDU. alter_context PDU is #
# used to change the presentation syntax established by the earlier bind #
# PDU. Therefore it has similar format. However, there is no need for    #
# authentication credentials. Like rpc_bind, we also assume the          #
# presentation context list only has one element.                        #
##########################################################################
sub rpc_alt_ctx($$$@)
{
    my $self = shift;
    my $ctx_id = shift;
    my $abs_syntax = shift;
    usage("Abstract Syntax plus interface version must be 20-bytes long!") unless length($abs_syntax) == 20;
    my @xfer_syntax = shift;
    my $msg = "";