XWBCAGNT.m

XWBCAGNT ;ISC-SF/EG,RWF - Connect to Remote TCP Client Agent ;2/12/98  16:15<<= NOT VERIFIED > [ 04/02/2003   8:48 AM ]

 ;;1.1;RPC BROKER;**1001**;APR 1, 2003

 ;;1.1;RPC BROKER;**2**;Mar 28, 1997

 Q

 ;

CMD(XWBRET,QUES,PARAM) ;Call daemon and get responce <e.f.>

 N IPA,SOCK S XWBRET="",IPA=$G(IO("IP")),SOCK=9200 Q:IPA="" 0

 I $G(IO)="" D HOME^%ZIS

 D CALL^%ZISTCP(IPA,SOCK,3) I POP Q 0

 D SEND(QUES,$G(PARAM)),REC(.XWBRET)

 D CLOSE^%ZISTCP

 Q 1

 ;

OPEN(IP,SKT) ; - connect to remote <extrinsic function>

 D HOME^%ZIS:'$D(IO(0)),SAVDEV^%ZISUTL("XWBCAGENT HOME")

 D CALL^%ZISTCP(IP,SKT,3)

 Q

 ;

SEND(S,P) ; - send message <procedure>

 N $ETRAP S $ETRAP="S $EC="""" Q"

 S S=$$SETMSG(S,$G(P))

 U IO W S,!

 Q

 ;

REC(BODY) ; - receive message <extrinsic function>

 N LEN,Y

 U IO S BODY("HDR")="~",BODY("HDR")=$$SREAD(5) ; -- get header

 Q:BODY("HDR")'="{XWB}"  ; -- quit if no responce

 S LEN=$$SREAD(5),BODY("ID")=$$SREAD(+LEN) ; -- get PID

 S LEN=$$SREAD(5),BODY(0)=$$SREAD(+LEN) ; -- get rpc name

 S LEN=$$SREAD(5) D:+LEN BREAD(+LEN,.BODY) ; -- get rpc parameter

 S LEN=$$SREAD(1) ; -- read terminator

 Q

 ;

SETMSG(S,PAR) ; - format message <extrinsic function>

 N L,F,PID

 IF ('$D(S))!('$D(PAR)) Q ""

 S F=100000

 S PID=$J

 S L=$L(PID)

 S PID=$E(F+L,2,6)_PID

 S L=$L(S),S=$E(F+L,2,6)_S

 S L=$L(PAR),PAR=$E(F+L,2,6)_PAR

 Q "{XWB}"_PID_S_PAR_$C(23)

 ;

CLOSE ; - close device <procedure>

 D CLOSE^%ZISTCP,USE^%ZISUTL("XWBCAGENT HOME"),RMDEV^%ZISUTL("XWBCAGENT HOME")

 Q

 ;

BREAD(L,B) ;read tcp buffer, L is length <extrinsic function>

 N E,X,T,DONE,XWBTIME,Y,IX,$ETRAP S $ETRAP="S $EC="""" Q"

 S (T,E,DONE)=0,XWBTIME=10,IX=1,B=L,L=$S(L<256:L,1:128) Q:L'>0 ""

BR2 R X#L:XWBTIME

 S E=X

 IF $L(E)<L F  D  Q:DONE

 . IF $L(E)=L S DONE=1 Q

 . R X#(L-$L(E)):XWBTIME

 . S E=E_X

 S B(IX)=E,T=T+$L(E)

 I T'=B S L=$S(B-T>255:128,1:B-T),IX=IX+1 G BR2

 Q

 ;

SREAD(L) ;read short tcp buffer, L is length <extrinsic function>

 N C,E,X,DONE,XWBTIME,$ETRAP S $ETRAP="S $EC="""" Q """""

 S (C,E,DONE)=0,XWBTIME=10 Q:L'>0 ""

 R X#L:XWBTIME

 S E=X IF $L(E)<L R X#(L-$L(E)):XWBTIME S E=E_X

 Q E

 ;

XWBCAGNT  ;ISC-SF/EG,RWF - Connect to Remote TCP Client Agent ;2/12/98  16:15<<= NOT VERIFIED > [ 04/02/2003   8:48 AM ]

 +1       ;;1.1;RPC BROKER;**1001**;APR 1, 2003

 +2       ;;1.1;RPC BROKER;**2**;Mar 28, 1997

 +3        QUIT 

 +4       ;

CMD(XWBRET,QUES,PARAM) ;Call daemon and get responce <e.f.>

 +1        NEW IPA,SOCK

           SET XWBRET=""

           SET IPA=$GET(IO("IP"))

           SET SOCK=9200

           IF IPA=""

               QUIT 0

 +2        IF $GET(IO)=""

               DO HOME^%ZIS

 +3        DO CALL^%ZISTCP(IPA,SOCK,3)

           IF POP

               QUIT 0

 +4        DO SEND(QUES,$GET(PARAM))

           DO REC(.XWBRET)

 +5        DO CLOSE^%ZISTCP

 +6        QUIT 1

 +7       ;

OPEN(IP,SKT) ; - connect to remote <extrinsic function>

 +1        IF '$DATA(IO(0))

               DO HOME^%ZIS

           DO SAVDEV^%ZISUTL("XWBCAGENT HOME")

 +2        DO CALL^%ZISTCP(IP,SKT,3)

 +3        QUIT 

 +4       ;

SEND(S,P) ; - send message <procedure>

 +1        NEW $ETRAP

           SET $ETRAP="S $EC="""" Q"

 +2        SET S=$$SETMSG(S,$GET(P))

 +3        USE IO

           WRITE S,!

 +4        QUIT 

 +5       ;

REC(BODY) ; - receive message <extrinsic function>

 +1        NEW LEN,Y

 +2       ; -- get header

           USE IO

           SET BODY("HDR")="~"

           SET BODY("HDR")=$$SREAD(5)

 +3       ; -- quit if no responce

           IF BODY("HDR")'="{XWB}"

               QUIT 

 +4       ; -- get PID

           SET LEN=$$SREAD(5)

           SET BODY("ID")=$$SREAD(+LEN)

 +5       ; -- get rpc name

           SET LEN=$$SREAD(5)

           SET BODY(0)=$$SREAD(+LEN)

 +6       ; -- get rpc parameter

           SET LEN=$$SREAD(5)

           IF +LEN

               DO BREAD(+LEN,.BODY)

 +7       ; -- read terminator

           SET LEN=$$SREAD(1)

 +8        QUIT 

 +9       ;

SETMSG(S,PAR) ; - format message <extrinsic function>

 +1        NEW L,F,PID

 +2        IF ('$DATA(S))!('$DATA(PAR))

               QUIT ""

 +3        SET F=100000

 +4        SET PID=$JOB

 +5        SET L=$LENGTH(PID)

 +6        SET PID=$EXTRACT(F+L,2,6)_PID

 +7        SET L=$LENGTH(S)

           SET S=$EXTRACT(F+L,2,6)_S

 +8        SET L=$LENGTH(PAR)

           SET PAR=$EXTRACT(F+L,2,6)_PAR

 +9        QUIT "{XWB}"_PID_S_PAR_$CHAR(23)

 +10      ;

CLOSE     ; - close device <procedure>

 +1        DO CLOSE^%ZISTCP

           DO USE^%ZISUTL("XWBCAGENT HOME")

           DO RMDEV^%ZISUTL("XWBCAGENT HOME")

 +2        QUIT 

 +3       ;

BREAD(L,B) ;read tcp buffer, L is length <extrinsic function>

 +1        NEW E,X,T,DONE,XWBTIME,Y,IX,$ETRAP

           SET $ETRAP="S $EC="""" Q"

 +2        SET (T,E,DONE)=0

           SET XWBTIME=10

           SET IX=1

           SET B=L

           SET L=$SELECT(L<256:L,1:128)

           IF L'>0

               QUIT ""

BR2        READ X#L:XWBTIME

 +1        SET E=X

 +2        IF $LENGTH(E)<L

               FOR 

                   Begin DoDot:1

 +3                    IF $LENGTH(E)=L

                           SET DONE=1

                           QUIT 

 +4                    READ X#(L-$LENGTH(E)):XWBTIME

 +5                    SET E=E_X

                   End DoDot:1

                   IF DONE

                       QUIT 

 +6        SET B(IX)=E

           SET T=T+$LENGTH(E)

 +7        IF T'=B

               SET L=$SELECT(B-T>255:128,1:B-T)

               SET IX=IX+1

               GOTO BR2

 +8        QUIT 

 +9       ;

SREAD(L)  ;read short tcp buffer, L is length <extrinsic function>

 +1        NEW C,E,X,DONE,XWBTIME,$ETRAP

           SET $ETRAP="S $EC="""" Q """""

 +2        SET (C,E,DONE)=0

           SET XWBTIME=10

           IF L'>0

               QUIT ""

 +3        READ X#L:XWBTIME

 +4        SET E=X

           IF $LENGTH(E)<L

               READ X#(L-$LENGTH(E)):XWBTIME

               SET E=E_X

 +5        QUIT E

 +6       ;