[613] | 1 | XWBTCPC ;ISC-SF/EG/VYD - TCP/IP PROCESS HANDLER ;08/25/2004 14:18
|
---|
| 2 | ;;1.1;RPC BROKER;**2,5,4,6,9,16,26,35**;Mar 28, 1997
|
---|
| 3 | ;Based on: XQORTCPH ;SLC/KCM - Service TCP Messages
|
---|
| 4 | ;Modified by ISC-SF/EG
|
---|
| 5 | ; 0. No longer supports old style OERR messages
|
---|
| 6 | ; 1. Makes call to RPC broker
|
---|
| 7 | ; 2. Result of an rpc call can be a closed form of global
|
---|
| 8 | ; 3. Can receive a large local array, within limits of job
|
---|
| 9 | ; partition size.
|
---|
| 10 | ; 4. Sets default device to NULL device prior to call, restores
|
---|
| 11 | ; at termination. Prevents garbage from 'talking' calls.
|
---|
| 12 | ; 5. All reads have a timeout.
|
---|
| 13 | ; 6. Intro message is sent when first connected.
|
---|
| 14 | ; 7. Uses callback model to connect to client
|
---|
| 15 | ;
|
---|
| 16 | ;
|
---|
| 17 | EN(XWBTIP,XWBTSKT,DUZ,XWBVER,XWBCLMAN) ; -- Main entry point
|
---|
| 18 | N TYPE,XWBTBUF,XWBTBUF1,XWBTDEV,XWBTLEN,XWBTOS,XWBTRTN,XWBWRAP
|
---|
| 19 | N X,XWBL,XWB1,XWB2,Y,XWBTIME,XWBPTYPE,XWBPLEN,XWBNULL,XWBODEV,XWBRBUF
|
---|
| 20 | N XWBERROR,XWBSEC ;new error variable available to rpc calls
|
---|
| 21 | N IO,IOP,L,XWBAPVER,VL,XWBTHDR,XWBT
|
---|
| 22 | ;
|
---|
| 23 | ;Set up the error trap
|
---|
| 24 | S U="^",$ETRAP="D ^%ZTER,XUTL^XUSCLEAN H" ;XWB-30
|
---|
| 25 | S XWBOS=$$OS
|
---|
| 26 | S XWBT("BF")=$S(XWBOS="GT.M":"#",1:"!")
|
---|
| 27 | ;start RUM for Broker Handler XWB*1.1*5
|
---|
| 28 | D LOGRSRC^%ZOSV("$BROKER HANDLER$",2,1)
|
---|
| 29 | ;
|
---|
| 30 | S XWBCLMAN=$G(XWBCLMAN)
|
---|
| 31 | I '$D(XWBDEBUG) D ;(*p35)
|
---|
| 32 | . S XWBDEBUG=$$GET^XPAR("SYS","XWBDEBUG")
|
---|
| 33 | . D LOGSTART^XWBDLOG("XWBTCPC")
|
---|
| 34 | . Q
|
---|
| 35 | I XWBDEBUG D LOG("Callback: "_XWBTIP_" :"_XWBTSKT) ;(*p35)
|
---|
| 36 | D SETTIME(1) ;Setup for sign-on time-out
|
---|
| 37 | ;Use Kernel to open the connection back to the client on new port
|
---|
| 38 | D CALL^%ZISTCP(XWBTIP,XWBTSKT) Q:POP S XWBTDEV=IO,IO(0)=IO
|
---|
| 39 | ;Attempt to share the license, Must have TCP port open first.
|
---|
| 40 | U XWBTDEV I $T(SHARELIC^%ZOSV)'="" D SHARELIC^%ZOSV(1)
|
---|
| 41 | ;setup null device "NULL"
|
---|
| 42 | S %ZIS="0H",IOP="NULL" D ^%ZIS S XWBNULL=IO I POP S XWBERROR="No NULL device" D ^%ZTER Q
|
---|
| 43 | D SAVDEV^%ZISUTL("XWBNULL")
|
---|
| 44 | I XWBOS="GTM" S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
|
---|
| 45 | ;change process name
|
---|
| 46 | S X="ip"_$P(XWBTIP,".",3,4)_":"_XWBTSKT
|
---|
| 47 | D SETNM^%ZOSV($E(X,1,15)),LOG("ProcName: "_X)
|
---|
| 48 | RESTART ;(*p35)
|
---|
| 49 | N $ESTACK S $ETRAP="D ETRAP^XWBTCPC"
|
---|
| 50 | S U="^",DUZ=0,DUZ(0)="",DTIME=300
|
---|
| 51 | U XWBTDEV D MAIN
|
---|
| 52 | ;Turn off the error trap for the exit
|
---|
| 53 | S $ETRAP=""
|
---|
| 54 | I $G(DUZ) D LOGOUT^XUSRB
|
---|
| 55 | K XWBR,XWBARY
|
---|
| 56 | ;stop RUM for handler XWB*1.1*5
|
---|
| 57 | D LOGRSRC^%ZOSV("$BROKER HANDLER$",2,2)
|
---|
| 58 | D LOG("DUZ="_$G(DUZ)_" LOGGED OFF")
|
---|
| 59 | D USE^%ZISUTL("XWBNULL"),CLOSE^%ZISUTL("XWBNULL")
|
---|
| 60 | C XWBTDEV ;Close can get an error
|
---|
| 61 | Q
|
---|
| 62 | ;
|
---|
| 63 | MAIN ; -- main message processing loop
|
---|
| 64 | N XCNT,XR
|
---|
| 65 | F D Q:XWBTBUF="#BYE#"
|
---|
| 66 | . S XWBAPVER=0,(XWBSEC,XWBERROR,XWBRBUF)=""
|
---|
| 67 | . U XWBTDEV ;Make sure we are reading from the right device
|
---|
| 68 | . ; -- read client request
|
---|
| 69 | . ;F XCNT=0:0 R XR#1:XWBTIME Q:(XR="{")!(XR="#") I '$T S XCNT=XCNT+1 Q:XCNT>5
|
---|
| 70 | . S XR=$$BREAD^XWBRW(1,XWBTIME,1)
|
---|
| 71 | . I '$L(XR) D LOG("Timeout"),TIMEOUT S XWBTBUF="#BYE#" Q
|
---|
| 72 | . S XWBTHDR=XR_$$BREAD^XWBRW(4) ;(*p35)
|
---|
| 73 | . I XWBTHDR["#BYE#" S XWBTBUF="#BYE#" Q ;Clear $C(4)
|
---|
| 74 | . S XWBTHDR=XWBTHDR_$$BREAD^XWBRW(6)
|
---|
| 75 | . I $G(XWBDEBUG)>1 D LOG("HDR Read:"_XWBTHDR_":")
|
---|
| 76 | . S TYPE=($E(XWBTHDR,1,5)="{XWB}") ;check HDR
|
---|
| 77 | . I 'TYPE D Q
|
---|
| 78 | . . D LOG("Bad Header: "_XWBTHDR) ;(*p35)
|
---|
| 79 | . . S XWBTBUF="#BYE#" D QSND^XWBRW(XWBTBUF) ;(*p35)
|
---|
| 80 | . . Q
|
---|
| 81 | . S XWBTLEN=$E(XWBTHDR,6,10),L=$E(XWBTHDR,11)
|
---|
| 82 | . I L="|" D ;(*p35) Save $T
|
---|
| 83 | . . S VL=$$BREAD^XWBRW(1),VL=$A(VL)
|
---|
| 84 | . . S XWBAPVER=$$BREAD^XWBRW(VL),XWBPLEN=$$BREAD^XWBRW(5) ;(*p35)
|
---|
| 85 | . E S XWBTBUF=$$BREAD^XWBRW(4),XWBPLEN=L_XWBTBUF ;(*p35)
|
---|
| 86 | . S XWBTBUF=$$BREAD^XWBRW(XWBPLEN) ;(*p35)
|
---|
| 87 | . I $P(XWBTBUF,U)="TCPconnect" D Q
|
---|
| 88 | . . D QSND^XWBRW("accept") ;Ack (*p35)
|
---|
| 89 | . IF TYPE D
|
---|
| 90 | . . K XWBR,XWBARY
|
---|
| 91 | . . IF XWBTBUF="#BYE#" D QSND^XWBRW("#BYE#") Q ; -- clean disconnect
|
---|
| 92 | . . S XWBTLEN=XWBTLEN-15
|
---|
| 93 | . . D CALLP^XWBBRK(.XWBR,XWBTBUF)
|
---|
| 94 | . . S XWBPTYPE=$S('$D(XWBPTYPE):1,XWBPTYPE<1:1,XWBPTYPE>6:1,1:XWBPTYPE)
|
---|
| 95 | . IF XWBTBUF="#BYE#" D LOG("APP set #BYE#") Q ;(*p35)
|
---|
| 96 | . U XWBTDEV
|
---|
| 97 | . D SND^XWBRW ;Does SNDERR,SND,WRITE($C(4))
|
---|
| 98 | . I $G(XWBSHARE) D KILL1^XUSCLEAN ; CLEAN OUT PARTITION FOR SHARED BROKER
|
---|
| 99 | Q ;End Of Main
|
---|
| 100 | ;
|
---|
| 101 | ETRAP ; -- on trapped error, send error info to client
|
---|
| 102 | N XWBERC,XWBERR
|
---|
| 103 | ;Change trapping during trap.
|
---|
| 104 | S $ETRAP="D ^%ZTER,BYE^XUSCLEAN,XUTL^XUSCLEAN HALT" ;XWB-30
|
---|
| 105 | S XWBERC=$E($$EC^%ZOSV,1,200),XWBERR="M ERROR="_XWBERC_$C(13,10)_"LAST REF="_$$LGR^%ZOSV
|
---|
| 106 | S XWBOS=$$OS
|
---|
| 107 | ;Check for short read, Tell Client to resend.
|
---|
| 108 | I $EC["U411" S XWBERROR="U411",XWBSEC="",XWBERR="Data Transfer Error to Server"
|
---|
| 109 | D ^%ZTER ;%ZTER clears $ZE and $ECODE
|
---|
| 110 | I $G(XWBDEBUG) D LOG("In ETRAP: "_XWBERC) ;(*p35)
|
---|
| 111 | I ($G(XWBERC)["READ")!($G(XWBERC)["WRITE")!($G(XWBERC)["SYSTEM-F")!('$D(XWBERC)) D:$G(DUZ) LOGOUT^XUSRB HALT ; XWB-30
|
---|
| 112 | U XWBTDEV
|
---|
| 113 | L ;Clear locks (*p35)
|
---|
| 114 | ETX ;Exit for trap
|
---|
| 115 | D ESND^XWBRW($C(24)_XWBERR_$C(4)) ;(p*35)
|
---|
| 116 | S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G RESTART^XWBTCPC",$ECODE=",U99,"
|
---|
| 117 | Q
|
---|
| 118 | ;
|
---|
| 119 | STYPE(X,WRAP) ;For backward compatability only
|
---|
| 120 | I $D(WRAP) Q $$RTRNFMT^XWBLIB($G(X),WRAP)
|
---|
| 121 | Q $$RTRNFMT^XWBLIB(X)
|
---|
| 122 | ;
|
---|
| 123 | SETTIME(%) ;Set the Read timeout 0=RPC, 1=sign-on
|
---|
| 124 | ; Increased timeout period (%=1) during signon from 90 to 180 for accessibility reasons
|
---|
| 125 | S XWBTIME=$S($G(%):180,$G(XWBVER)>1.105:$$BAT^XUPARAM,1:36000),XWBTIME(1)=5 ; (*p35)
|
---|
| 126 | I $G(%) S XWBTIME=$S($G(XWBVER)>1.1:90,1:36000)
|
---|
| 127 | Q
|
---|
| 128 | TIMEOUT ;Do this on MAIN loop timeout
|
---|
| 129 | I $G(DUZ)>0 D QSND^XWBRW("#BYE#"_$C(4)) Q
|
---|
| 130 | ;Sign-on timeout
|
---|
| 131 | S XWBR(0)=0,XWBR(1)=1,XWBR(2)="",XWBR(3)="TIME-OUT",XWBPTYPE=2
|
---|
| 132 | D SND^XWBRW
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|
| 135 | MSM ;entry point for MSERVER service - used by MSM
|
---|
| 136 | N XWBVER,LEN,MSG,X
|
---|
| 137 | S XWBVER=0
|
---|
| 138 | R LEN#11:3600 IF $E(LEN,1,5)'="{XWB}" D Q ;bad client, abort
|
---|
| 139 | . W "RPC broker disconnect!",!
|
---|
| 140 | . C 56
|
---|
| 141 | . Q
|
---|
| 142 | IF $E(LEN,11,11)="|" D
|
---|
| 143 | . R X#1:60
|
---|
| 144 | . R XWBVER#$A(X):60
|
---|
| 145 | . R LEN#5:60
|
---|
| 146 | . R MSG#LEN:60
|
---|
| 147 | . Q
|
---|
| 148 | ELSE S X=$E(LEN,11,11),LEN=$E(LEN,6,10)-1 R MSG#LEN:60 S MSG=X_MSG
|
---|
| 149 | IF $P(MSG,"^")="TCPconnect" D
|
---|
| 150 | . D QSND^XWBRW("accept")
|
---|
| 151 | . C 56
|
---|
| 152 | . D EN($P(MSG,"^",2),$P(MSG,"^",3),$P(X,"^"),XWBVER,$P(MSG,"^",4))
|
---|
| 153 | IF $P(MSG,"^")="TCPdebug" D
|
---|
| 154 | . D QSND^XWBRW("accept")
|
---|
| 155 | C 56
|
---|
| 156 | Q
|
---|
| 157 | OS() ;Return the OS
|
---|
| 158 | N % S %=^%ZOSF("OS") ;(*p35)
|
---|
| 159 | Q $S(%["DSM":"DSM",%["OpenM":"OpenM",%["GT.M":"GTM",1:"MSM") ;(*p35)
|
---|
| 160 | ;
|
---|
| 161 | LOG(TX) ;DeBug Logging (*p35)
|
---|
| 162 | D:$G(XWBDEBUG) LOG^XWBDLOG(TX)
|
---|
| 163 | Q
|
---|