75 lines
2.2 KiB
Mathematica
75 lines
2.2 KiB
Mathematica
XWBTCPM1 ;ISF/RWF - Support for XWBTCPM ;05/20/2004 10:14
|
|
;;1.1;RPC BROKER;**35**;Mar 28, 1997
|
|
Q
|
|
ZISTCP(XWBTSKT) ;Start ZISTCPS listener
|
|
;
|
|
N XWBENV,XWBVOL,Y
|
|
D GETENV^%ZOSV S XWBENV=Y,XWBVOL=$P(Y,"^",2)
|
|
Q:'$$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK") ;quit if job is already running
|
|
D UPDTREC^XWBTCPL(XWBTSKT,3) ;updt RPC BROKER SITE PARAMETER record as RUNNING
|
|
D MARKER^XWBTCP(XWBTSKT,-1) ;Clear marker
|
|
;
|
|
D LISTEN^%ZISTCPS(XWBTSKT,"NT^XWBTCPM","D STAT^XWBTCPM1("_XWBTSKT_")")
|
|
;
|
|
S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK") ; destroy 'running flag'
|
|
D UPDTREC^XWBTCPL(XWBTSKT,6) ;updt RPC BROKER SITE PARAMETER record as STOPPED
|
|
Q
|
|
;
|
|
OLD ;Call the old style broker
|
|
;XWBRBUF setup in XWBTCPM
|
|
N XWBTCNT
|
|
S XWBTCNT=0
|
|
D READCONN ;Get the rest of the connect msg
|
|
; -- msg should be: action^client IP^client port^token
|
|
I $P(MSG,"^")="TCPconnect" D
|
|
. N DZ,%T,NATIP S DZ="",%T=0
|
|
. ;Get the peer and use that IP, Allow use thru a NAT box.
|
|
. S NATIP=$$GETPEER^%ZOSV S:'$L(NATIP) NATIP=$P(MSG,"^",2)
|
|
. I NATIP'=$P(MSG,"^",2) S $P(MSG,"^",2)=NATIP
|
|
. I '$$NEWJOB^XWBTCPM D LOG("No New Jobs"),QSND("reject") Q
|
|
. ;Keep the current job & Device.
|
|
. ;just call the old server code. Uses a extra socket.
|
|
. D QSND("accept"),LOG("accept")
|
|
. D EN^XWBTCPC($P(MSG,"^",2),$P(MSG,"^",3),$P(DZ,"^"),XWBVER,$P(MSG,"^",4))
|
|
Q
|
|
;
|
|
READCONN ;Read the rest of the connect message
|
|
N CON,VL,LEN,MSG2
|
|
S CON=$$BREAD(6,XWBTIME) I CON="" S CON="Timeout" D LOG(CON) Q
|
|
I $E(CON,6)="|" D
|
|
. S VL=$$BREAD(1),VL=$A(VL)
|
|
. S XWBVER=$$BREAD(VL)
|
|
. S LEN=$$BREAD(5)
|
|
. S MSG=$$BREAD(+LEN)
|
|
E S X=$E(CON,6),LEN=$E(CON,1,5)-1,MSG2=$$BREAD(LEN),MSG=X_MSG2,XWBVER=0
|
|
D LOG("Connect: "_MSG)
|
|
Q
|
|
;
|
|
BREAD(L,TO) ;Buffer read
|
|
S XWBTIME(1)=$G(TO,5)
|
|
Q $$BREAD^XWBRW(L)
|
|
;
|
|
QSND(H) ;Quick send
|
|
D QSND^XWBRW(H)
|
|
Q
|
|
LOG(H) ;
|
|
D:$G(XWBDEBUG) LOG^XWBDLOG(H)
|
|
Q
|
|
;
|
|
NODE(P) ;Get Listener node, XWBENV must be set first
|
|
N X,Y,BV
|
|
I '$D(XWBENV) D GETENV^%ZOSV S XWBENV=Y
|
|
S BV=$P(XWBENV,"^",4)
|
|
S IX1=$O(^%ZIS(14.7,"B",BV,0)) I IX1'>0 Q "Box-Vol 1"
|
|
S IX1=$O(^XWB(8994.1,1,7,"B",IX1,0)) I IX1'>0 Q "Box-Vol 2"
|
|
S IX2=$O(^XWB(8994.1,1,7,IX1,1,"B",P,0)) I IX2'>0 Q "Port"
|
|
S X=$G(^XWB(8994.1,1,7,IX1,1,IX2,0))
|
|
Q X
|
|
;
|
|
STAT(P) ;Check if should stop.
|
|
;Called from ZRULE in %ZISTCPS
|
|
N X
|
|
S X=$$NODE(P)
|
|
S ZISQUIT=($P(X,"^",2)>3) ;Status Stop
|
|
Q
|