*DECK RPCCCAL 
USETEXT TEXTIPL 
USETEXT TEXTRPC 
USETEXT TEXTXDR 
      PROC RPCCCAL (HANDLE, PROCNUM, INBUFFER, INBUFLEN, OUTBUFFER, 
        OUTBUFPOS, OUTBUFLEN, RPCSTATUS); 
*CALL COPYRITE
# TITLE RPCCCAL - CALL REMOTE PROCEDURE                         # 
  
      BEGIN                            # RPCCCAL                       #
# 
****  RPCCCAL  CALL REMOTE PROCEDURE
* 
*     THIS PROCEDURE CALLS THE RPC PROCEDURE NUMBER "PROCNUM" ASSOCIATED
*     WITH THE CLIENT "HANDLE". 
* 
*     PROC RPCCCAL
* 
*     ENTRY    HANDLE     = RPC HANDLE
*              PROCNUM    = PROCEDURE NUMBER TO CALL
*              INBUFFER   = ADDRESS OF (XDR) INPUT DATA FOR PROCNUM 
*              INBUFLEN   = LENGTH OF INBUFFER IN BYTES 
* 
*     EXIT     OUTBUFFER  = ADDRESS OF (XDR) OUTPUT DATA
*              OUTBUFPOS  = POSITION OF FIRST BYTE IN OUTBUFFER 
*              OUTBUFLEN  = LENGTH OF OUTBUFFER IN BYTES
*              RPCSTATUS  = COMPLETION STATUS 
* 
*     METHOD   THE RPC HEADER IS BUILT WITH THE XDR ROUTINES AND THE
*              MESSAGE IS SENT TO THE SERVER. WE THEN WAIT FOR A
*              RESPONSE FROM THE SERVER. IF IT ARRIVES, THE REPLY CODE
*              AND TRANSACTION ID ARE VERIFIED, THE RPC HEADER IS 
*              REMOVED AND THE RESPONSE BUFFER IS RETURNED TO THE CALLER. 
# 
  
# 
****  PROC RPCCCAL - XREF LIST
# 
      XREF
        BEGIN 
        PROC IPPRECV;    # RECEIVE DATA ON A SOCKET                    #
        PROC IPPSEND;    # SEND DATA ON A SOCKET                       #
        PROC XDRINT;     # CONVERT INTEGERS TO XDR FORMAT              #
        END 
# 
**
# 
      ITEM HANDLE              U;      # RPC HANDLE                    #
      ITEM PROCNUM             U;      # PROCEDURE NUMBER              #
      ARRAY INBUFFER [0:15] S(1);;     # INPUT BUFFER                  #
      ITEM INBUFLEN            U;      # INPUT DATA LENGTH             #
      ARRAY OUTBUFFER [0:15] S(1);;    # OUTPUT BUFFER                 #
      ITEM OUTBUFPOS           U;      # POSITION OF NXT BYTE IN BUFFER#
      ITEM OUTBUFLEN           U;      # OUTPUT DATA LENGTH            #
      ITEM RPCSTATUS   S:RPCSTAT;      # RETURN STATUS                 #
# 
**
# 
      ARRAY ADDRESS [0:0] S(ADDSIZE$);;# SOURCE ADDRESS FOR IPPRECV    #
      ARRAY RPCBUFFER [0:15] S(1);;    # BUFFER FOR RPC HEADER         #
      ITEM RPCBUFPOS            U;     # RPC BUFFER POSITION           #
      ARRAY REQHEADER [0:9]  S(1);     # RPC MESSAGE HEADER            #
        ITEM REQUESTITM U(0,0,60);
      ARRAY RESPHEADER [0:7] S(1);     # RPC MESSAGE HEADER            #
        ITEM RESPITM    U(0,0,60);
      ITEM SOCKSTATUS  S:SOCKSTAT;     # SOCKET STATUS                 #
      CONTROL EJECT;
# 
****  START MAIN PROCEDURE
* 
****  VERIFY HANDLE ENTRY 
# 
      IF NOT RP$ACTIVE [HANDLE] THEN
        BEGIN 
        RPCSTATUS = S"HANDLEINACT"; 
        RETURN; 
        END 
# 
****  GENERATE RPC HEADER.
# 
      RP$XID [HANDLE] = RP$XID [HANDLE] + 1;# INCREMENT TRANSACTION ID #
      REQUESTITM [0] = RP$XID [HANDLE];# SET MESSAGE ID                #
      REQUESTITM [1] = RPCMSG"CALL";   # MSG_TYPE = CALL               #
      REQUESTITM [2] = RPCVERSION$;    # RPC VERSION                   #
      REQUESTITM [3] = RP$PROGNUM [HANDLE];# RPC PROGRAM NUMBER        #
      REQUESTITM [4] = RP$VERSION [HANDLE];# PROTOCOL VERSION          #
      REQUESTITM [5] = PROCNUM;        # PROCEDURE NUMBER              #
      REQUESTITM [6] = 0;              # RPC CREDENTIALS (NONE)        #
      REQUESTITM [7] = 0; 
      REQUESTITM [8] = 0;              # RPC VERIFICATION (NONE)       #
      REQUESTITM [9] = 0; 
  
      RPCBUFPOS = 0;                   # INITIALIZE BUFFER POSITION    #
      XDRINT (RPCBUFFER, RPCBUFPOS, REQHEADER, 10, XDROPER"WRITE"); 
# 
****  SEND MESSAGE TO RPC SERVER. 
# 
      IPPSEND (RP$SOCKID [HANDLE], RPCBUFFER, RPCBUFPOS, INBUFFER,
        INBUFLEN, RP$ADDRESS [HANDLE], SOCKSTATUS); 
      IF SOCKSTATUS NQ S"OK"           # SEND FAILED                   #
      THEN
        BEGIN 
        RPCSTATUS = S"SOCKFAIL";
        RETURN;                        # RETURN WITH ERROR             #
        END 
# 
****  GET RPC SERVER'S RESPONSE.
# 
    GETRESP:  
      IPPRECV (RP$SOCKID [HANDLE], OUTBUFFER, OUTBUFLEN, ADDRESS, 
               SOCKSTATUS); 
      IF SOCKSTATUS NQ S"OK"           # RECEIVE FAILED                #
      THEN
        BEGIN 
        IF SOCKSTATUS EQ S"NODATA"
        THEN
          RPCSTATUS = S"RPCTIMEOUT";
        ELSE
          RPCSTATUS = S"SOCKFAIL";
        RETURN;                        # RETURN WITH ERROR             #
        END 
# 
****  REMOVE RPC HEADER FROM SERVER'S RESPONSE AND VERIFY 
# 
      OUTBUFPOS = 0;                   # INITIALIZE BUFFER POSITION    #
      XDRINT (OUTBUFFER, OUTBUFPOS, RESPHEADER, 3, XDROPER"READ");
      IF (RESPITM [1] NQ RPCMSG"REPLY") OR
         (RESPITM [0] NQ REQUESTITM [0])
      THEN
        GOTO GETRESP;                  # NOT THE RESPONSE TO THIS REQ  #
  
      IF RESPITM [2] EQ REPLYSTAT"ACCEPTED" 
      THEN
        BEGIN                          # VERIFY PROCEDURE STATUS       #
        XDRINT (OUTBUFFER, OUTBUFPOS, RESPHEADER, 3, XDROPER"READ");
        IF RESPITM [2] EQ ACCEPTSTAT"SUCCESS" 
        THEN
          RPCSTATUS = S"OK";           # SET NORMAL STATUS             #
        ELSE
          RPCSTATUS = S"CALLFAIL";     # SET FAILED STATUS             #
        END 
      ELSE
        RPCSTATUS = S"CALLREJECT";     # SET REJECTED STATUS           #
  
      RETURN;                          # RETURN TO CALLER              #
  
      END                              # RPCCCAL                       #
  
      TERM
