XWBCAGNT ;ISC-SF/EG,RWF - Connect to Remote TCP Client Agent ;2/12/98 16:15<<= NOT VERIFIED >
;;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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBCAGNT 2077 printed Dec 13, 2024@02:37:09 Page 2
XWBCAGNT ;ISC-SF/EG,RWF - Connect to Remote TCP Client Agent ;2/12/98 16:15<<= NOT VERIFIED >
+1 ;;1.1;RPC BROKER;**2**;Mar 28, 1997
+2 QUIT
+3 ;
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 ;
