| [613] | 1 | %ZISTCPS ;ISF/RWF - DEVICE HANDLER TCP/IP SERVER CALLS ;06/20/2005 09:11
|
|---|
| 2 | ;;8.0;KERNEL;**78,118,127,225,275,388**;Jul 10, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | CLOSE ;Close and reset
|
|---|
| 6 | G CLOSE^%ZISTCP
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | ;In ZRULE, set ZISQUIT=1 to quit
|
|---|
| 10 | LISTEN(SOCK,RTN,ZRULE) ;Listen on socket, start routine
|
|---|
| 11 | N %A,ZISOS,X,NIO,EXIT
|
|---|
| 12 | N $ES,$ET S $ETRAP="D OPNERR^%ZISTCPS"
|
|---|
| 13 | S ZISOS=^%ZOSF("OS"),ZRULE=$G(ZRULE)
|
|---|
| 14 | S POP=1
|
|---|
| 15 | D GETENV^%ZOSV S U="^",XUENV=Y,XQVOL=$P(Y,U,2)
|
|---|
| 16 | S POP=1 D LONT:ZISOS["OpenM",LGTM:ZISOS["GT.M"
|
|---|
| 17 | I 'POP C NIO ;Close port
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | LONT ;Open port in Accept mode with standard terminators.
|
|---|
| 22 | N %ZA,NEWCHAR
|
|---|
| 23 | S NIO="|TCP|"_SOCK,EXIT=0
|
|---|
| 24 | ;(adr:sock:term:ibuf:obuf:queue)
|
|---|
| 25 | O NIO:(:SOCK:"AT"::512:512:10):30 Q:'$T S POP=0 U NIO
|
|---|
| 26 | ;Wait on read for a connect
|
|---|
| 27 | LONT2 F U NIO R *NEWCHAR:30 S EXIT=$$EXIT Q:$T!EXIT
|
|---|
| 28 | I EXIT C NIO Q
|
|---|
| 29 | ;JOB params (:Concurrent Server bit:principal input:principal output)
|
|---|
| 30 | J CHILDONT^%ZISTCPS(NIO,RTN):(:16::):10 S %ZA=$ZA
|
|---|
| 31 | I %ZA\8196#2=1 W *-2 ;Job failed to clear bit
|
|---|
| 32 | G LONT2
|
|---|
| 33 | ;
|
|---|
| 34 | CHILDONT(IO,RTN) ;Child process for OpenM
|
|---|
| 35 | S $ETRAP="D ^%ZTER L HALT",IO=$ZU(53)
|
|---|
| 36 | U IO:(::"-M") ;Work like DSM
|
|---|
| 37 | S NEWJOB=$$NEWOK
|
|---|
| 38 | I 'NEWJOB W "421 Service temporarily down.",$C(13,10),!
|
|---|
| 39 | I NEWJOB K NEWJOB D VAR,@RTN
|
|---|
| 40 | HALT
|
|---|
| 41 | ;
|
|---|
| 42 | VAR ;Setup IO variables
|
|---|
| 43 | S IO(0)=IO,IO(1,IO)="",POP=0
|
|---|
| 44 | S IOT="TCP",IOST="P-TCP",IOST(0)=0
|
|---|
| 45 | S IOF=$$FLUSHCHR^%ZISTCP
|
|---|
| 46 | S ^XUTL("XQ",$J,0)=$$DT^XLFDT
|
|---|
| 47 | Q
|
|---|
| 48 | NEWOK() ;Is it OK to start a new process
|
|---|
| 49 | I $G(^%ZIS(14.5,"LOGON",^%ZOSF("VOL"))) Q 0
|
|---|
| 50 | I $$AVJ^%ZOSV()<3 Q 0
|
|---|
| 51 | Q 1
|
|---|
| 52 | OPNERR ;
|
|---|
| 53 | S POP=1,EXIT=1,IO("ERROR")=$ECODE,$ECODE=""
|
|---|
| 54 | Q
|
|---|
| 55 | EXIT() ;See if time to exit
|
|---|
| 56 | I $$S^%ZTLOAD Q 1
|
|---|
| 57 | N ZISQUIT S ZISQUIT=0
|
|---|
| 58 | I $L(ZRULE) X ZRULE I $G(ZISQUIT) Q 1
|
|---|
| 59 | Q 0
|
|---|
| 60 | ;
|
|---|
| 61 | LGTM ;GT.M multi thread server
|
|---|
| 62 | N %A K ^TMP("ZISTCP",$J)
|
|---|
| 63 | S $ZINTERRUPT="I $$JOBEXAM^ZU($ZPOSITION)"
|
|---|
| 64 | S NIO="SCK$"_$S($J>86400:$J,1:84600+$J) ;Construct a dummy, but "unique" devicename for job
|
|---|
| 65 | D LOG("Open for Listen "_NIO)
|
|---|
| 66 | ;Open the device
|
|---|
| 67 | O NIO:(ZLISTEN=SOCK_":TCP":ATTACH="listener"):30:"SOCKET"
|
|---|
| 68 | I '$T D LOG("Can't Open Socket: "_SOCK) Q
|
|---|
| 69 | U NIO S NIO("ZISTCP",0)=$KEY D LOG("Have port.")
|
|---|
| 70 | ;Start Listening
|
|---|
| 71 | W /LISTEN(1) S NIO("ZISTCP",1)=$KEY D LOG("Start Listening. "_NIO("ZISTCP",1))
|
|---|
| 72 | ;Wait for connection
|
|---|
| 73 | LG2 S %A=0,EXIT=0 F D Q:%A!EXIT
|
|---|
| 74 | . W /WAIT(30) ;Wait for connect
|
|---|
| 75 | . I $P($KEY,"|",1)="CONNECT" S NIO("ZISTCP",2)=$KEY,%A=1
|
|---|
| 76 | . S EXIT=$$EXIT
|
|---|
| 77 | . Q
|
|---|
| 78 | I EXIT C NIO Q
|
|---|
| 79 | ;
|
|---|
| 80 | S NIO("SOCK")=$P($G(NIO("ZISTCP",2)),"|",2)
|
|---|
| 81 | D LOG("Got connection on "_NIO("SOCK"))
|
|---|
| 82 | I '$$NEWOK D G LG2
|
|---|
| 83 | . U NIO:(SOCKET=NIO("SOCK")) W "421 Service temporarily down.",$C(13,10),#
|
|---|
| 84 | . C NIO:(SOCKET=NIO("SOCK")) K NIO("ZISTCP",2)
|
|---|
| 85 | . Q
|
|---|
| 86 | ;Close the main socket
|
|---|
| 87 | C NIO:(SOCKET="listener")
|
|---|
| 88 | ;Start a new listener
|
|---|
| 89 | J LISTEN^%ZISTCPS(SOCK,RTN,ZRULE)
|
|---|
| 90 | ;Use the new socket
|
|---|
| 91 | ;U NIO:(SOCKET=NIO("SOCK"):WIDTH=512:NOWRAP:IOERROR="TRAP")
|
|---|
| 92 | U NIO:(SOCKET=NIO("SOCK"):WIDTH=512:NOWRAP)
|
|---|
| 93 | ;Run the job
|
|---|
| 94 | D GTMLNCH(NIO,RTN)
|
|---|
| 95 | S POP=0
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | GTMLNCH(IO,RTN) ;Run gt.m job for this conncetion.
|
|---|
| 99 | N NIO,SOCK,ZISOS,EXIT,XQVOL,$ETRAP
|
|---|
| 100 | S U="^",$ETRAP="D ^%ZTER L HALT"
|
|---|
| 101 | S IO(0)=IO,IO(1,IO)=""
|
|---|
| 102 | D VAR,@RTN
|
|---|
| 103 | Q $D(IO("C")) ;Use IO("C") to quit server
|
|---|
| 104 | ;
|
|---|
| 105 | LOG(MSG) ;LOG STATUS
|
|---|
| 106 | N CNT
|
|---|
| 107 | S CNT=$G(^TMP("ZISTCP",$J))+1,^TMP("ZISTCP",$J)=CNT,^($J,CNT)=MSG
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
