| 1 | XWBCAGNT ;ISC-SF/EG,RWF - Connect to Remote TCP Client Agent ;2/12/98 16:15<<= NOT VERIFIED >
|
|---|
| 2 | ;;1.1;RPC BROKER;**2**;Mar 28, 1997
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | CMD(XWBRET,QUES,PARAM) ;Call daemon and get responce <e.f.>
|
|---|
| 6 | N IPA,SOCK S XWBRET="",IPA=$G(IO("IP")),SOCK=9200 Q:IPA="" 0
|
|---|
| 7 | I $G(IO)="" D HOME^%ZIS
|
|---|
| 8 | D CALL^%ZISTCP(IPA,SOCK,3) I POP Q 0
|
|---|
| 9 | D SEND(QUES,$G(PARAM)),REC(.XWBRET)
|
|---|
| 10 | D CLOSE^%ZISTCP
|
|---|
| 11 | Q 1
|
|---|
| 12 | ;
|
|---|
| 13 | OPEN(IP,SKT) ; - connect to remote <extrinsic function>
|
|---|
| 14 | D HOME^%ZIS:'$D(IO(0)),SAVDEV^%ZISUTL("XWBCAGENT HOME")
|
|---|
| 15 | D CALL^%ZISTCP(IP,SKT,3)
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | SEND(S,P) ; - send message <procedure>
|
|---|
| 19 | N $ETRAP S $ETRAP="S $EC="""" Q"
|
|---|
| 20 | S S=$$SETMSG(S,$G(P))
|
|---|
| 21 | U IO W S,!
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | REC(BODY) ; - receive message <extrinsic function>
|
|---|
| 25 | N LEN,Y
|
|---|
| 26 | U IO S BODY("HDR")="~",BODY("HDR")=$$SREAD(5) ; -- get header
|
|---|
| 27 | Q:BODY("HDR")'="{XWB}" ; -- quit if no responce
|
|---|
| 28 | S LEN=$$SREAD(5),BODY("ID")=$$SREAD(+LEN) ; -- get PID
|
|---|
| 29 | S LEN=$$SREAD(5),BODY(0)=$$SREAD(+LEN) ; -- get rpc name
|
|---|
| 30 | S LEN=$$SREAD(5) D:+LEN BREAD(+LEN,.BODY) ; -- get rpc parameter
|
|---|
| 31 | S LEN=$$SREAD(1) ; -- read terminator
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | SETMSG(S,PAR) ; - format message <extrinsic function>
|
|---|
| 35 | N L,F,PID
|
|---|
| 36 | IF ('$D(S))!('$D(PAR)) Q ""
|
|---|
| 37 | S F=100000
|
|---|
| 38 | S PID=$J
|
|---|
| 39 | S L=$L(PID)
|
|---|
| 40 | S PID=$E(F+L,2,6)_PID
|
|---|
| 41 | S L=$L(S),S=$E(F+L,2,6)_S
|
|---|
| 42 | S L=$L(PAR),PAR=$E(F+L,2,6)_PAR
|
|---|
| 43 | Q "{XWB}"_PID_S_PAR_$C(23)
|
|---|
| 44 | ;
|
|---|
| 45 | CLOSE ; - close device <procedure>
|
|---|
| 46 | D CLOSE^%ZISTCP,USE^%ZISUTL("XWBCAGENT HOME"),RMDEV^%ZISUTL("XWBCAGENT HOME")
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | BREAD(L,B) ;read tcp buffer, L is length <extrinsic function>
|
|---|
| 50 | N E,X,T,DONE,XWBTIME,Y,IX,$ETRAP S $ETRAP="S $EC="""" Q"
|
|---|
| 51 | S (T,E,DONE)=0,XWBTIME=10,IX=1,B=L,L=$S(L<256:L,1:128) Q:L'>0 ""
|
|---|
| 52 | BR2 R X#L:XWBTIME
|
|---|
| 53 | S E=X
|
|---|
| 54 | IF $L(E)<L F D Q:DONE
|
|---|
| 55 | . IF $L(E)=L S DONE=1 Q
|
|---|
| 56 | . R X#(L-$L(E)):XWBTIME
|
|---|
| 57 | . S E=E_X
|
|---|
| 58 | S B(IX)=E,T=T+$L(E)
|
|---|
| 59 | I T'=B S L=$S(B-T>255:128,1:B-T),IX=IX+1 G BR2
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | SREAD(L) ;read short tcp buffer, L is length <extrinsic function>
|
|---|
| 63 | N C,E,X,DONE,XWBTIME,$ETRAP S $ETRAP="S $EC="""" Q """""
|
|---|
| 64 | S (C,E,DONE)=0,XWBTIME=10 Q:L'>0 ""
|
|---|
| 65 | R X#L:XWBTIME
|
|---|
| 66 | S E=X IF $L(E)<L R X#(L-$L(E)):XWBTIME S E=E_X
|
|---|
| 67 | Q E
|
|---|
| 68 | ;
|
|---|
