      SUBROUTINE PLIP.RPC.CLIENT(CTRL,MAT PARMS,R.RES)
*PIC-LAN
*
*ALL
*PC
*N
*
*     CTRL layout:      1  Host name
*                       2  Account name
*                       3  Subroutine name
*                       4  Subroutine password
*                       5  Transmission timeout
*                       6  Max transmission size
*                       7  Receive timeout
*                       8  Max receive size
*                       9  Max retries
*                      10  Number of parameters
*                      11  Parmeter IO list
*                      12  Transaction ID
*
*
      INCLUDE SYS.TYPE.INCLUDE
*
      INCLUDE PL.DEFS
      DIM CONFIG.ARRAY(50)
      INCLUDE PL.COMMON.DEFS
      DIM PLIP$VARS(100)
      INCLUDE PLIP.VARS
*
      DIM PARMS(20)
*
      CALL PLXX.INIT(MAT CONFIG.ARRAY,MAT PLIP$VARS,531)
*
      OPEN 'PLIP.RPC,SERVERS' TO SERVER.FD ELSE
         R.RES = 'Cannot open PLIP.RPC,SERVERS file'
         RETURN
      END
*
      READ S.REC FROM SERVER.FD , CTRL<1> ELSE
         R.RES = 'Cannot read PLIP.RPC,SERVERS ' : CTRL<1> : ' item'
         RETURN
      END
*
      READV RPC.NAME FROM SERVER.FD , 'LOCAL.ID' , 20 ELSE
         READVU RPC.NAME FROM SERVER.FD , 'LOCAL.ID' , 20 THEN
            RELEASE SERVER.FD , 'LOCAL.ID'
         END ELSE
            RPC.NAME = RND(1000) 'R%3' : RND(1000) 'R%3' : RND(1000) 'R%3' : DATE() 'R%5' : TIME() 'R%5'
            WRITEV RPC.NAME ON SERVER.FD , 'LOCAL.ID' , 20
         END
      END
*
      FOR I = 5 TO 9
         IF NOT(S.REC<I> MATCHES '1N0N') THEN S.REC<I> = 0
      NEXT I
*
      IF S.REC<5> = 0 THEN S.REC<5> = 120
      IF S.REC<6> = 0 THEN S.REC<6> = 1000000
      IF S.REC<7> = 0 THEN S.REC<7> = 240
      IF S.REC<8> = 0 THEN S.REC<8> = 1000000
      IF S.REC<9> = 0 THEN
         S.REC<9> = DCOUNT(S.REC<1>,VM)
         IF S.REC<9> < 2 THEN S.REC<9> = 2
      END
*
      CRLF = CR : LF
*
      FOR I = 5 TO 9
         IF NOT(CTRL<I> MATCHES '1N0N') THEN CTRL<I> = 0
      NEXT I
      IF CTRL<5> = 0 THEN CTRL<5> = S.REC<5>
      IF CTRL<6> = 0 THEN CTRL<6> = S.REC<6>
      IF CTRL<7> = 0 THEN CTRL<7> = S.REC<7>
      IF CTRL<8> = 0 THEN CTRL<8> = S.REC<8>
      IF CTRL<9> = 0 THEN CTRL<9> = S.REC<9>
*
      PG.NAME = OCONV(S.REC<4>,'MCU')
      IF PG.NAME = '' THEN PG.NAME = '/RPC/RPC100.HTM'
*
      CTRL<12> = RPC.NAME : '*' : FIELD(OCONV('','U50BB'),' ',1)
      CTRL<13> = DATE() : '.' : TIME() : '.' : FIELD(OCONV('','U50BB'),' ',1) : '.' : RND(1000) 'R%3' : RND(1000) 'R%3' : RND(1000) 'R%3' : RND(1000) 'R%3' : RND(1000) 'R%3'
*
      S.CTRL = ''
*
      FOR I = 1 TO CTRL<10>
         IF CTRL<11>[I,1] <> 'O' THEN
            S.CTRL<1,2,I> = LEN(PARMS(I))
         END
      NEXT I
*
      FOR I = 1 TO 13
         S.CTRL<1,1,I> = CTRL<I>
      NEXT I
*
      S.BUF = S.CTRL : AM : PARMS(1) : PARMS(2) : PARMS(3) : PARMS(4) : PARMS(5) : PARMS(6) : PARMS(7) : PARMS(8) : PARMS(9) : PARMS(10) : PARMS(11) : PARMS(12) : PARMS(13) : PARMS(14) : PARMS(15) : PARMS(16) : PARMS(17) : PARMS(18) : PARMS(19) : PARMS(20)
*
      IF LEN(S.BUF) > CTRL<6> THEN
         R.RES = 'Transmitted data is above specified transmit size limit'
         RETURN
      END
*
      IF S.REC<2> <> '' THEN
         S.BUF0 = S.BUF
         CALL PLX.ENCRYPT(S.REC<2>,S.BUF0,S.BUF)
         S.BUF0 = ''
      END
*
      OBUF = 'POST ' : PG.NAME : ' HTTP/1.0' : CRLF
      OBUF = OBUF : 'User-Agent: PicLan-IP RPC version ' : VER : CRLF
      IF S.REC<3> <> '' THEN
         OBUF = OBUF : 'Server: ' : S.REC<3> : CRLF
      END
      OBUF = OBUF : 'Content-length: ' : LEN(S.BUF) : CRLF
      OBUF = OBUF : 'Connection: Keep-alive' : CRLF
      OBUF = OBUF : CRLF
      OBUF = OBUF : S.BUF : CRLF
*
      N.SERVERS = DCOUNT(S.REC<1>,VM)
      N.RETRIES = CTRL<9>
      R.RES = ''
      IBUF = ''
      FOR I = 1 TO N.RETRIES WHILE R.RES = ''
         SERVER.N = MOD(I+1,N.SERVERS) + 1
         SERVER.ADDR = S.REC<1,SERVER.N>
         GOSUB 100
      NEXT I
*
      IF R.RES = '200' THEN
         IF S.REC<2> <> '' THEN
            IBUF0 = IBUF
            CALL PLX.DECRYPT(S.REC<2>,IBUF0,IBUF)
            IBUF0 = ''
         END
         S.CTRL = IBUF<1>
         IF S.CTRL<1,1,1> = '' THEN
            IBUF = IBUF[LEN(S.CTRL)+2,999999999]
            N = 1
            FOR I = 1 TO CTRL<10>
               S.LEN = S.CTRL<1,2,I>
               IF CTRL<11>[I,1] <> 'I' THEN
                  PARMS(I) = IBUF[N,S.LEN]
               END
               N = N + S.LEN
            NEXT I
            R.RES = ''
         END ELSE
            R.RES = S.CTRL<1,1,1>
         END
      END ELSE
         IF R.RES = '' THEN
            R.RES = R.ERR
         END
      END
*
      RETURN
*
100   REM Try an HTTP hit
*
      CALL PLXX.TCP.OPEN(MAT CONFIG.ARRAY,MAT PLIP$VARS,FIELD(SERVER.ADDR,':',1),FIELD(SERVER.ADDR,':',2),TCP.HANDLE,R.ERR,531)
      IF R.ERR <> '' THEN
         RETURN
      END
*
      CALL PLXX.TCP.WRITE(MAT CONFIG.ARRAY,MAT PLIP$VARS,TCP.HANDLE,'',CTRL<5>,OBUF:'',R.ERR)
      IF R.ERR <> '' THEN
         RETURN
      END
*
      IBUF = ''
      R.RES = ''
      IHDR = ''
      POST.LEN = 0
      T0.0 = PL_NOW()
      T0.1 = T0.0
      R.CNT = 0
      LOOP
         CALL PLXX.TCP.READ(MAT CONFIG.ARRAY,MAT PLIP$VARS,TCP.HANDLE,'',50000,0,IIBUF,R.STATUS,R.ERR)
         R.CNT = R.CNT + 1
         IF R.STATUS = 'CLOSING' AND IIBUF <> '' THEN
            R.STATUS = ''
         END
         IF R.STATUS = '' AND R.ERR = '' THEN
            IF IIBUF <> '' THEN
               T0.1 = PL_NOW()
               IBUF = IBUF : IIBUF
               IF IHDR = '' THEN
                  T = INDEX(IBUF,CRLF:CRLF,1)
                  IF T THEN
                     IHDR = PL_CRLFTOAM(IBUF[1,T-1])
                     IBUF = IBUF[T+4,999999999]
                  END ELSE
                     T = INDEX(IBUF,CR:CR,1)
                     IF T THEN
                        IBUF = IBUF[1,T-1]
                        IHDR = PL_REPL(IBUF,CR,AM)
                        IBUF = IBUF[T+2,999999999]
                     END
                  END
                  IF IHDR <> '' THEN
                       IF FIELD(IHDR<1>,' ',2) = '200' THEN
                        I1 = DCOUNT(IHDR,AM)
                        FOR I = 1 TO I1 WHILE NOT(POST.LEN)
                           W = OCONV(FIELD(IHDR<I>,':',1),'MCU')
                           IF W = 'CONTENT-LENGTH' THEN
                              POST.LEN = TRIM(FIELD(IHDR<I>,':',2))
                              IF NOT(NUM(POST.LEN)) THEN
                                 R.ERR = 'Invalid post length'
                              END
                           END
                        NEXT I
                     END ELSE
                        R.RES = FIELD(IHDR<1>,' ',2)
                        IF R.RES = '' THEN
                           R.ERR = 'Invalid HTTP status (NULL)'
                        END
                     END
                  END
               END
               IF POST.LEN > 0 THEN
                  IF LEN(IBUF) >= POST.LEN THEN
                     R.RES = 200
                  END
               END
            END ELSE
               IF ( PL_NOW() - T0.1 ) > 60 THEN
                  R.ERR = 'Short timeout'
               END
            END
         END
         IF (PL_NOW() - T0.0 ) > 180 THEN
            R.ERR = 'Long timeout'
         END
      UNTIL R.RES <> '' OR R.STATUS <> '' OR R.ERR <> '' DO
         IF IIBUF <> '' THEN
            IF R.CNT < 10 THEN
               PL_RQM
            END ELSE
               SLEEP 1
            END
         END ELSE
         END
      REPEAT
*
      CALL PLXX.TCP.RESET(MAT CONFIG.ARRAY,MAT PLIP$VARS,TCP.HANDLE)
*
      RETURN
   END
