Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XWBTCPM1

XWBTCPM1.m

Go to the documentation of this file.
  1. XWBTCPM1 ;ISF/RWF - Support for XWBTCPM ;08/11/15 09:00
  1. ;;1.1;RPC BROKER;**35,64**;Mar 28, 1997;Build 12
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ZISTCP(XWBTSKT) ;Start ZISTCPS listener
  1. ;
  1. N XWBENV,XWBVOL,Y
  1. D GETENV^%ZOSV S XWBENV=Y,XWBVOL=$P(Y,"^",2)
  1. Q:'$$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK") ;quit if job is already running
  1. D UPDTREC^XWBTCPL(XWBTSKT,3) ;updt RPC BROKER SITE PARAMETER record as RUNNING
  1. D MARKER^XWBTCP(XWBTSKT,-1) ;Clear marker
  1. ;
  1. D LISTEN^%ZISTCPS(XWBTSKT,"NT^XWBTCPM","D STAT^XWBTCPM1("_XWBTSKT_")")
  1. ;
  1. S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK") ; destroy 'running flag'
  1. D UPDTREC^XWBTCPL(XWBTSKT,6) ;updt RPC BROKER SITE PARAMETER record as STOPPED
  1. Q
  1. ;
  1. OLD ;Call the old style broker
  1. ; Note: The old-style broker, which calls back to the RPC Client on a different port,
  1. ; has been deprecated in XWB*1.1*60 and will not be supported in future patches. New
  1. ; development should not use this broker, and legacy applications which use this
  1. ; interface should be moved to the new-style broker at the earliest opportunity.
  1. ;XWBRBUF setup in XWBTCPM
  1. N XWBTCNT
  1. S XWBTCNT=0
  1. D READCONN ;Get the rest of the connect msg
  1. ; -- msg should be: action^client IP^client port^token
  1. ;p64 - not sure if this works with IPv6, as I have no way to test
  1. I $P(MSG,"^")="TCPconnect" D
  1. . N DZ,%T,NATIP S DZ="",%T=0
  1. . ;Get the peer and use that IP, Allow use thru a NAT box.
  1. . S NATIP=$$GETPEER^%ZOSV S:'$L(NATIP) NATIP=$P(MSG,"^",2)
  1. . I NATIP'=$P(MSG,"^",2) S $P(MSG,"^",2)=NATIP
  1. . I '$$NEWJOB^XWBTCPM D LOG("No New Jobs"),QSND("reject") Q
  1. . ;Keep the current job & Device.
  1. . ;just call the old server code. Uses a extra socket.
  1. . D QSND("accept"),LOG("accept")
  1. . D EN^XWBTCPC($P(MSG,"^",2),$P(MSG,"^",3),$P(DZ,"^"),XWBVER,$P(MSG,"^",4))
  1. Q
  1. ;
  1. READCONN ;Read the rest of the connect message
  1. N CON,VL,LEN,MSG2
  1. S CON=$$BREAD(6,XWBTIME) I CON="" S CON="Timeout" D LOG(CON) Q
  1. I $E(CON,6)="|" D
  1. . S VL=$$BREAD(1),VL=$A(VL)
  1. . S XWBVER=$$BREAD(VL)
  1. . S LEN=$$BREAD(5)
  1. . S MSG=$$BREAD(+LEN)
  1. E S X=$E(CON,6),LEN=$E(CON,1,5)-1,MSG2=$$BREAD(LEN),MSG=X_MSG2,XWBVER=0
  1. D LOG("Connect: "_MSG)
  1. Q
  1. ;
  1. BREAD(L,TO) ;Buffer read
  1. S XWBTIME(1)=$G(TO,5)
  1. Q $$BREAD^XWBRW(L)
  1. ;
  1. QSND(H) ;Quick send
  1. D QSND^XWBRW(H)
  1. Q
  1. LOG(H) ;
  1. D:$G(XWBDEBUG) LOG^XWBDLOG(H)
  1. Q
  1. ;
  1. NODE(P) ;Get Listener node, XWBENV must be set first
  1. N X,Y,BV
  1. I '$D(XWBENV) D GETENV^%ZOSV S XWBENV=Y
  1. S BV=$P(XWBENV,"^",4)
  1. S IX1=$O(^%ZIS(14.7,"B",BV,0)) I IX1'>0 Q "Box-Vol 1"
  1. S IX1=$O(^XWB(8994.1,1,7,"B",IX1,0)) I IX1'>0 Q "Box-Vol 2"
  1. S IX2=$O(^XWB(8994.1,1,7,IX1,1,"B",P,0)) I IX2'>0 Q "Port"
  1. S X=$G(^XWB(8994.1,1,7,IX1,1,IX2,0))
  1. Q X
  1. ;
  1. STAT(P) ;Check if should stop.
  1. ;Called from ZRULE in %ZISTCPS
  1. N X
  1. S X=$$NODE(P)
  1. S ZISQUIT=($P(X,"^",2)>3) ;Status Stop
  1. Q