BGUTCPL ; IHS/OIT/MJL - Background Listener for TCP connects ; 25 Jan 2006 9:01 AM [ 04/08/2008 2:01 PM ]
;;1.5;BGU;**4**;MAY 26, 2005
; This routine is the background process that listens for client
; requests to connect to M. When a request is received, a new
; process is started (via a parameterized JOB command). The jobbed
; process will handle all the messages (procedure calls) from the
; client application. This process will then resume listening for the
; next client application to make a connect request.
;
; This job may be started in the background with: D STRT^BGUTCP(PORT#)
;
; When running, this job may be stopped with: D STOP^BGUTCP(PORT#)
;
EN(BGUTSKT) ; -- accept client connects and start the individual message handler
N $ETRAP,$ESTACK S $ETRAP="D RELEASE^BGUTCPL(1),^%ZTER J EN^BGUTCPL($G(BGUTSKT)) HALT"
I $G(BGUTSKT)="" S BGUTSKT=8000 ; default port number
;
N BGULEN,BGUMSG S:'$D(DTIME) DTIME=300
;
D SETNM^%ZOSV($E("RPCB_Port:"_BGUTSKT,1,15)) ;change process name
; -- check the TCP stop parameter
Q:$G(^BGUSP("TMP","STOP")) ; -- change to param file later ***
L +^BGUSP("TMP","RUNNING"):1 Q:'$T ; -- quit if job is already running
;
S BGUOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",^("OS")["OpenM":"OpenM",1:"")
;I BGUOS="OpenM" S BGUTDEV="|TCP|"_BGUTSKT O BGUTDEV:(:BGUTSKT:"AT"):10 Q:'$T U BGUTDEV ; 'BGULEN means lost connection
I BGUOS="OpenM" D I '$T Q
.S BGUTDEV="|TCP|"_BGUTSKT
.C BGUTDEV ;IHS/OIT/HMW SAC Exemption Applied For
.O BGUTDEV:(:BGUTSKT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For
.U BGUTDEV
;
; -- loop until TCP stop parameter is set
F D Q:$G(^BGUSP("TMP","STOP"))=1
. ; -- listen for connect & get the initial message from the client
.I BGUOS="DSM" O BGUTSKT:TCPCHAN:5 ;Open listener
.I BGUOS="MSM" O 56 U 56::"TCP" W /SOCKET("",BGUTSKT)
.I BGUOS="DSM" U BGUTSKT
.;I BGUOS="OpenM" U BGUTDEV R *X ;S BGUTDEV="|TCP|"_BGUTSKT O BGUTDEV:(:BGUTSKT:"AT"):10 Q:'$T U BGUTDEV ; 'BGULEN means lost connection
.R *BGULEN:DTIME I 'BGULEN D RELEASE(0) Q
.I BGULEN=-1 D RELEASE(0) Q
.R BGUMSG#BGULEN:DTIME
.; -- msg should be: action^client IP^client port^XX^App ID
.; -- if the action is TCPconnect (usual case)
.I $P(BGUMSG,"^")["TCPconnect" D
..; -- start up the handling process and respond OK to client
..S BGUU=$P(BGUMSG,"^",5)
..;S NATIP=$$GETPEER^%ZOSV S:'$L(NATIP) NATIP=$P(BGUMSG,"^",2)
..;I NATIP'=$P(BGUMSG,"^",2) S $P(BGUMSG,"^",2)=NATIP
..I BGUOS="MSM" D
...I BGUU'="" S BGUUCI=$P(BGUU,",",1),BGUVGRP=$P(BGUU,",",2) D Q
....I BGUUCI'="",BGUVGRP'="" J EN^BPCTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI,BGUVGRP]::5 Q
....J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI]::5
...J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))::5
...I $T W "accept",$C(4),! Q
..I BGUOS="OpenM" D
...;I BGUU'="" S BGUUCI=$P(BGUU,",",1) J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI]::5 S %T=$T
...;I BGUU="" J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))::5 S %T=$T
...I BGUU'="" S BGUUCI=$P(BGUU,",",1) J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI]:(:5:BGUTDEV:BGUTDEV):5 S %T=$T
...I BGUU="" J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3)):(:5:BGUTDEV:BGUTDEV):5 S %T=$T
...;J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5
...;I %T W "accept",$C(4),! Q
...;W "reject",$C(4),!
.;
.; -- if the action is TCPdebug (when msg handler run interactively)
.I $P(BGUMSG,"^")="TCPdebug" D
..; -- don't job handler, just respond with 'accept'
..W "accept",$C(4),!
.;
.; -- if the action is TCPshutdown, this listener will quit if the
.; stop flag has been set. This request comes from an M process.
.I $P(BGUMSG,"^")="TCPshutdown" D
..W "ack",!
..L -^BGUSP("TMP","RUNNING"):1 ; destroy 'running flag'
.I BGUOS="OpenM" W *-3,*-2 ;Send any data and release the socket
.D RELEASE(0)
; -- loop end
D RELEASE(1)
Q
;
CLOSE ;CLOSE CONNECTION
I BGUOS="DSM" U BGUTSKT:DISCONNECT
I BGUOS="MSM" C 56
I BGUOS="OpenM" C BGUTDEV
Q
;
RELEASE(%) ;Now release the connection. (*p7*)
;Parameter is zero to Release, one to Close
I BGUOS="DSM" D
. I $G(%) C BGUTSKT Q
. U BGUTSKT:DISCONNECT ; release this socket
I BGUOS="MSM" C 56
I BGUOS="OpenM" D
. I $G(%) C BGUTDEV Q
. W *-3,*-2 ;Send any data and release the socket
Q
;
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
+2 ; This routine is the background process that listens for client
+3 ; requests to connect to M. When a request is received, a new
+4 ; process is started (via a parameterized JOB command). The jobbed
+5 ; process will handle all the messages (procedure calls) from the
+6 ; client application. This process will then resume listening for the
+7 ; next client application to make a connect request.
+8 ;
+9 ; This job may be started in the background with: D STRT^BGUTCP(PORT#)
+10 ;
+11 ; When running, this job may be stopped with: D STOP^BGUTCP(PORT#)
+12 ;
EN(BGUTSKT) ; -- accept client connects and start the individual message handler
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="D RELEASE^BGUTCPL(1),^%ZTER J EN^BGUTCPL($G(BGUTSKT)) HALT"
+2 ; default port number
IF $GET(BGUTSKT)=""
SET BGUTSKT=8000
+3 ;
+4 NEW BGULEN,BGUMSG
IF '$DATA(DTIME)
SET DTIME=300
+5 ;
+6 ;change process name
DO SETNM^%ZOSV($EXTRACT("RPCB_Port:"_BGUTSKT,1,15))
+7 ; -- check the TCP stop parameter
+8 ; -- change to param file later ***
IF $GET(^BGUSP("TMP","STOP"))
QUIT
+9 ; -- quit if job is already running
LOCK +^BGUSP("TMP","RUNNING"):1
IF '$TEST
QUIT
+10 ;
+11 SET BGUOS=$SELECT(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",^("OS")["OpenM":"OpenM",1:"")
+12 ;I BGUOS="OpenM" S BGUTDEV="|TCP|"_BGUTSKT O BGUTDEV:(:BGUTSKT:"AT"):10 Q:'$T U BGUTDEV ; 'BGULEN means lost connection
+13 IF BGUOS="OpenM"
Begin DoDot:1
+14 SET BGUTDEV="|TCP|"_BGUTSKT
+15 ;IHS/OIT/HMW SAC Exemption Applied For
CLOSE BGUTDEV
+16 ;IHS/OIT/HMW SAC Exemption Applied For
OPEN BGUTDEV:(:BGUTSKT:"S"):5
IF '$TEST
QUIT
+17 USE BGUTDEV
End DoDot:1
IF '$TEST
QUIT
+18 ;
+19 ; -- loop until TCP stop parameter is set
+20 FOR
Begin DoDot:1
+21 ; -- listen for connect & get the initial message from the client
+22 ;Open listener
IF BGUOS="DSM"
OPEN BGUTSKT:TCPCHAN:5
+23 IF BGUOS="MSM"
OPEN 56
USE 56::"TCP"
WRITE /SOCKET("",BGUTSKT)
+24 IF BGUOS="DSM"
USE BGUTSKT
+25 ;I BGUOS="OpenM" U BGUTDEV R *X ;S BGUTDEV="|TCP|"_BGUTSKT O BGUTDEV:(:BGUTSKT:"AT"):10 Q:'$T U BGUTDEV ; 'BGULEN means lost connection
+26 READ *BGULEN:DTIME
IF 'BGULEN
DO RELEASE(0)
QUIT
+27 IF BGULEN=-1
DO RELEASE(0)
QUIT
+28 READ BGUMSG#BGULEN:DTIME
+29 ; -- msg should be: action^client IP^client port^XX^App ID
+30 ; -- if the action is TCPconnect (usual case)
+31 IF $PIECE(BGUMSG,"^")["TCPconnect"
Begin DoDot:2
+32 ; -- start up the handling process and respond OK to client
+33 SET BGUU=$PIECE(BGUMSG,"^",5)
+34 ;S NATIP=$$GETPEER^%ZOSV S:'$L(NATIP) NATIP=$P(BGUMSG,"^",2)
+35 ;I NATIP'=$P(BGUMSG,"^",2) S $P(BGUMSG,"^",2)=NATIP
+36 IF BGUOS="MSM"
Begin DoDot:3
+37 IF BGUU'=""
SET BGUUCI=$PIECE(BGUU,",",1)
SET BGUVGRP=$PIECE(BGUU,",",2)
Begin DoDot:4
+38 IF BGUUCI'=""
IF BGUVGRP'=""
JOB EN^BPCTCPH($PIECE(BGUMSG,"^",2),$PIECE(BGUMSG,"^",3))[BGUUCI,BGUVGRP]::5
QUIT
+39 JOB EN^BGUTCPH($PIECE(BGUMSG,"^",2),$PIECE(BGUMSG,"^",3))[BGUUCI]::5
End DoDot:4
QUIT
+40 JOB EN^BGUTCPH($PIECE(BGUMSG,"^",2),$PIECE(BGUMSG,"^",3))::5
+41 IF $TEST
WRITE "accept",$CHAR(4),!
QUIT
End DoDot:3
+42 IF BGUOS="OpenM"
Begin DoDot:3
+43 ;I BGUU'="" S BGUUCI=$P(BGUU,",",1) J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))[BGUUCI]::5 S %T=$T
+44 ;I BGUU="" J EN^BGUTCPH($P(BGUMSG,"^",2),$P(BGUMSG,"^",3))::5 S %T=$T
+45 IF BGUU'=""
SET BGUUCI=$PIECE(BGUU,",",1)
JOB EN^BGUTCPH($PIECE(BGUMSG,"^",2),$PIECE(BGUMSG,"^",3))[BGUUCI]:(:5:BGUTDEV:BGUTDEV):5
SET %T=$TEST
+46 IF BGUU=""
JOB EN^BGUTCPH($PIECE(BGUMSG,"^",2),$PIECE(BGUMSG,"^",3)):(:5:BGUTDEV:BGUTDEV):5
SET %T=$TEST
+47 ;J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5
+48 ;I %T W "accept",$C(4),! Q
+49 ;W "reject",$C(4),!
End DoDot:3
End DoDot:2
+50 ;
+51 ; -- if the action is TCPdebug (when msg handler run interactively)
+52 IF $PIECE(BGUMSG,"^")="TCPdebug"
Begin DoDot:2
+53 ; -- don't job handler, just respond with 'accept'
+54 WRITE "accept",$CHAR(4),!
End DoDot:2
+55 ;
+56 ; -- if the action is TCPshutdown, this listener will quit if the
+57 ; stop flag has been set. This request comes from an M process.
+58 IF $PIECE(BGUMSG,"^")="TCPshutdown"
Begin DoDot:2
+59 WRITE "ack",!
+60 ; destroy 'running flag'
LOCK -^BGUSP("TMP","RUNNING"):1
End DoDot:2
+61 ;Send any data and release the socket
IF BGUOS="OpenM"
WRITE *-3,*-2
+62 DO RELEASE(0)
End DoDot:1
IF $GET(^BGUSP("TMP","STOP"))=1
QUIT
+63 ; -- loop end
+64 DO RELEASE(1)
+65 QUIT
+66 ;
CLOSE ;CLOSE CONNECTION
+1 IF BGUOS="DSM"
USE BGUTSKT:DISCONNECT
+2 IF BGUOS="MSM"
CLOSE 56
+3 IF BGUOS="OpenM"
CLOSE BGUTDEV
+4 QUIT
+5 ;
RELEASE(%) ;Now release the connection. (*p7*)
+1 ;Parameter is zero to Release, one to Close
+2 IF BGUOS="DSM"
Begin DoDot:1
+3 IF $GET(%)
CLOSE BGUTSKT
QUIT
+4 ; release this socket
USE BGUTSKT:DISCONNECT
End DoDot:1
+5 IF BGUOS="MSM"
CLOSE 56
+6 IF BGUOS="OpenM"
Begin DoDot:1
+7 IF $GET(%)
CLOSE BGUTDEV
QUIT
+8 ;Send any data and release the socket
WRITE *-3,*-2
End DoDot:1
+9 QUIT
+10 ;
