| 1 | XWBTCPM1 ;ISF/RWF - Support for XWBTCPM ;05/20/2004 10:14
|
|---|
| 2 | ;;1.1;RPC BROKER;**35**;Mar 28, 1997
|
|---|
| 3 | Q
|
|---|
| 4 | ZISTCP(XWBTSKT) ;Start ZISTCPS listener
|
|---|
| 5 | ;
|
|---|
| 6 | N XWBENV,XWBVOL,Y
|
|---|
| 7 | D GETENV^%ZOSV S XWBENV=Y,XWBVOL=$P(Y,"^",2)
|
|---|
| 8 | Q:'$$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK") ;quit if job is already running
|
|---|
| 9 | D UPDTREC^XWBTCPL(XWBTSKT,3) ;updt RPC BROKER SITE PARAMETER record as RUNNING
|
|---|
| 10 | D MARKER^XWBTCP(XWBTSKT,-1) ;Clear marker
|
|---|
| 11 | ;
|
|---|
| 12 | D LISTEN^%ZISTCPS(XWBTSKT,"NT^XWBTCPM","D STAT^XWBTCPM1("_XWBTSKT_")")
|
|---|
| 13 | ;
|
|---|
| 14 | S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK") ; destroy 'running flag'
|
|---|
| 15 | D UPDTREC^XWBTCPL(XWBTSKT,6) ;updt RPC BROKER SITE PARAMETER record as STOPPED
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | OLD ;Call the old style broker
|
|---|
| 19 | ;XWBRBUF setup in XWBTCPM
|
|---|
| 20 | N XWBTCNT
|
|---|
| 21 | S XWBTCNT=0
|
|---|
| 22 | D READCONN ;Get the rest of the connect msg
|
|---|
| 23 | ; -- msg should be: action^client IP^client port^token
|
|---|
| 24 | I $P(MSG,"^")="TCPconnect" D
|
|---|
| 25 | . N DZ,%T,NATIP S DZ="",%T=0
|
|---|
| 26 | . ;Get the peer and use that IP, Allow use thru a NAT box.
|
|---|
| 27 | . S NATIP=$$GETPEER^%ZOSV S:'$L(NATIP) NATIP=$P(MSG,"^",2)
|
|---|
| 28 | . I NATIP'=$P(MSG,"^",2) S $P(MSG,"^",2)=NATIP
|
|---|
| 29 | . I '$$NEWJOB^XWBTCPM D LOG("No New Jobs"),QSND("reject") Q
|
|---|
| 30 | . ;Keep the current job & Device.
|
|---|
| 31 | . ;just call the old server code. Uses a extra socket.
|
|---|
| 32 | . D QSND("accept"),LOG("accept")
|
|---|
| 33 | . D EN^XWBTCPC($P(MSG,"^",2),$P(MSG,"^",3),$P(DZ,"^"),XWBVER,$P(MSG,"^",4))
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | READCONN ;Read the rest of the connect message
|
|---|
| 37 | N CON,VL,LEN,MSG2
|
|---|
| 38 | S CON=$$BREAD(6,XWBTIME) I CON="" S CON="Timeout" D LOG(CON) Q
|
|---|
| 39 | I $E(CON,6)="|" D
|
|---|
| 40 | . S VL=$$BREAD(1),VL=$A(VL)
|
|---|
| 41 | . S XWBVER=$$BREAD(VL)
|
|---|
| 42 | . S LEN=$$BREAD(5)
|
|---|
| 43 | . S MSG=$$BREAD(+LEN)
|
|---|
| 44 | E S X=$E(CON,6),LEN=$E(CON,1,5)-1,MSG2=$$BREAD(LEN),MSG=X_MSG2,XWBVER=0
|
|---|
| 45 | D LOG("Connect: "_MSG)
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | BREAD(L,TO) ;Buffer read
|
|---|
| 49 | S XWBTIME(1)=$G(TO,5)
|
|---|
| 50 | Q $$BREAD^XWBRW(L)
|
|---|
| 51 | ;
|
|---|
| 52 | QSND(H) ;Quick send
|
|---|
| 53 | D QSND^XWBRW(H)
|
|---|
| 54 | Q
|
|---|
| 55 | LOG(H) ;
|
|---|
| 56 | D:$G(XWBDEBUG) LOG^XWBDLOG(H)
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | NODE(P) ;Get Listener node, XWBENV must be set first
|
|---|
| 60 | N X,Y,BV
|
|---|
| 61 | I '$D(XWBENV) D GETENV^%ZOSV S XWBENV=Y
|
|---|
| 62 | S BV=$P(XWBENV,"^",4)
|
|---|
| 63 | S IX1=$O(^%ZIS(14.7,"B",BV,0)) I IX1'>0 Q "Box-Vol 1"
|
|---|
| 64 | S IX1=$O(^XWB(8994.1,1,7,"B",IX1,0)) I IX1'>0 Q "Box-Vol 2"
|
|---|
| 65 | S IX2=$O(^XWB(8994.1,1,7,IX1,1,"B",P,0)) I IX2'>0 Q "Port"
|
|---|
| 66 | S X=$G(^XWB(8994.1,1,7,IX1,1,IX2,0))
|
|---|
| 67 | Q X
|
|---|
| 68 | ;
|
|---|
| 69 | STAT(P) ;Check if should stop.
|
|---|
| 70 | ;Called from ZRULE in %ZISTCPS
|
|---|
| 71 | N X
|
|---|
| 72 | S X=$$NODE(P)
|
|---|
| 73 | S ZISQUIT=($P(X,"^",2)>3) ;Status Stop
|
|---|
| 74 | Q
|
|---|
