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

BGUTCPL.m

Go to the documentation of this file. 
  1. BGUTCPL ; IHS/OIT/MJL - Background Listener for TCP connects ; 25 Jan 2006  9:01 AM [ 04/08/2008  2:01 PM ]
  1.  ;;1.5;BGU;**4**;MAY 26, 2005
  1.  ; This routine is the background process that listens for client
  1.  ; requests to connect to M. When a request is received, a new
  1.  ; process is started (via a parameterized JOB command). The jobbed
  1.  ; process will handle all the messages (procedure calls) from the
  1.  ; client application. This process will then resume listening for the
  1.  ; next client application to make a connect request.
  1.  ;
  1.  ; This job may be started in the background with:  D STRT^BGUTCP(PORT#)
  1.  ;
  1.  ; When running, this job may be stopped with:      D STOP^BGUTCP(PORT#)
  1.  ;
  1. EN(BGUTSKT) ; -- accept client connects and start the individual message handler
  1.  N $ETRAP,$ESTACK S $ETRAP="D RELEASE^BGUTCPL(1),^%ZTER J EN^BGUTCPL($G(BGUTSKT)) HALT"
  1.  I $G(BGUTSKT)="" S BGUTSKT=8000 ; default port number
  1.  ;
  1.  N BGULEN,BGUMSG S:'$D(DTIME) DTIME=300
  1.  ;
  1.  D SETNM^%ZOSV($E("RPCB_Port:"_BGUTSKT,1,15)) ;change process name
  1.  ; -- check the TCP stop parameter
  1.  Q:$G(^BGUSP("TMP","STOP"))  ; -- change to param file later ***
  1.  L +^BGUSP("TMP","RUNNING"):1 Q:'$T  ; -- quit if job is already running
  1.  ;
  1.  S BGUOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",^("OS")["OpenM":"OpenM",1:"")
  1.  ;I BGUOS="OpenM" S BGUTDEV="|TCP|"_BGUTSKT O BGUTDEV:(:BGUTSKT:"AT"):10 Q:'$T  U BGUTDEV       ; 'BGULEN means lost connection
  1.  I BGUOS="OpenM" D  I '$T Q
  1.  .S BGUTDEV="|TCP|"_BGUTSKT
  1.  .C BGUTDEV ;IHS/OIT/HMW SAC Exemption Applied For
  1.  .O BGUTDEV:(:BGUTSKT:"S"):5 I '$T Q  ;IHS/OIT/HMW SAC Exemption Applied For
  1.  .U BGUTDEV
  1.  ;
  1.  ; -- loop until TCP stop parameter is set
  1.  F  D  Q:$G(^BGUSP("TMP","STOP"))=1
  1.  . ; -- listen for connect & get the initial message from the client
  1.  .I BGUOS="DSM" O BGUTSKT:TCPCHAN:5 ;Open listener
  1.  .I BGUOS="MSM" O 56 U 56::"TCP" W /SOCKET("",BGUTSKT)
  1.  .I BGUOS="DSM" U BGUTSKT
  1.  .;I BGUOS="OpenM" U BGUTDEV R *X ;S BGUTDEV="|TCP|"_BGUTSKT O BGUTDEV:(:BGUTSKT:"AT"):10 Q:'$T  U BGUTDEV       ; 'BGULEN means lost connection
  1.  .R *BGULEN:DTIME I 'BGULEN D RELEASE(0) Q
  1.  .I BGULEN=-1 D RELEASE(0) Q
  1.  .R BGUMSG#BGULEN:DTIME
  1.  .; -- msg should be:  action^client IP^client port^XX^App ID
  1.  .; -- if the action is TCPconnect (usual case)
  1.  .I $P(BGUMSG,"^")["TCPconnect" D
  1.  ..; -- start up the handling process and respond OK to client
  1.  ..S BGUU=$P(BGUMSG,"^",5)
  1.  ..;S NATIP=$$GETPEER^%ZOSV S:'$L(NATIP) NATIP=$P(BGUMSG,"^",2)
  1.  ..;I NATIP'=$P(BGUMSG,"^",2) S $P(BGUMSG,"^",2)=NATIP
  1.  ..I BGUOS="MSM" D
  1.  ...I BGUU'="" S BGUUCI=$P(BGUU,",",1),BGUVGRP=$P(BGUU,",",2) D  Q
  1.  ....I BGUUCI'="",BGUVGRP'="" J EN^BPCTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI,BGUVGRP]::5 Q
  1.  ....J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI]::5
  1.  ...J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))::5
  1.  ...I $T W "accept",$C(4),! Q
  1.  ..I BGUOS="OpenM" D
  1.  ...;I BGUU'="" S BGUUCI=$P(BGUU,",",1) J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI]::5 S %T=$T
  1.  ...;I BGUU="" J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))::5 S %T=$T
  1.  ...I BGUU'="" S BGUUCI=$P(BGUU,",",1) J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI]:(:5:BGUTDEV:BGUTDEV):5 S %T=$T
  1.  ...I BGUU="" J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3)):(:5:BGUTDEV:BGUTDEV):5 S %T=$T
  1.  ...;J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5
  1.  ...;I %T W "accept",$C(4),! Q
  1.  ...;W "reject",$C(4),!
  1.  .;
  1.  .; -- if the action is TCPdebug (when msg handler run interactively)
  1.  .I $P(BGUMSG,"^")="TCPdebug" D
  1.  ..; -- don't job handler, just respond with 'accept'
  1.  ..W "accept",$C(4),!
  1.  .;
  1.  .; -- if the action is TCPshutdown, this listener will quit if the
  1.  .;    stop flag has been set. This request comes from an M process.
  1.  .I $P(BGUMSG,"^")="TCPshutdown" D
  1.  ..W "ack",!
  1.  ..L -^BGUSP("TMP","RUNNING"):1        ; destroy 'running flag'
  1.  .I BGUOS="OpenM"  W *-3,*-2 ;Send any data and release the socket
  1.  .D RELEASE(0)
  1.  ; -- loop end
  1.  D RELEASE(1)
  1.  Q
  1.  ;
  1. CLOSE ;CLOSE CONNECTION
  1.  I BGUOS="DSM" U BGUTSKT:DISCONNECT
  1.  I BGUOS="MSM" C 56
  1.  I BGUOS="OpenM" C BGUTDEV
  1.  Q
  1.  ;
  1. RELEASE(%) ;Now release the connection. (*p7*)
  1.  ;Parameter is zero to Release, one to Close
  1.  I BGUOS="DSM" D
  1.  . I $G(%) C BGUTSKT Q
  1.  . U BGUTSKT:DISCONNECT ; release this socket
  1.  I BGUOS="MSM" C 56
  1.  I BGUOS="OpenM" D
  1.  . I $G(%) C BGUTDEV Q
  1.  . W *-3,*-2 ;Send any data and release the socket
  1.  Q
  1.  ;