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