← Back to branch summary

~jontai/openvista-gtm-integration/bug683878

« back to all changes in this revision

Viewing changes to mumps/ZISTCPS.m

  • Committer: Jeff Apple
  • Date: 2010-12-01 17:45:47 UTC
  • Revision ID: jeff.apple@medsphere.com-20101201174547-t72ddh7qia5ho041
close listener in child

Show diffs side-by-side

added added

removed removed

Lines of Context:
mumps/ZISTCPS.m
1
 
%ZISTCPS ;ISF/RWF MSC/JDA - DEVICE HANDLER TCP/IP SERVER CALLS ;22APR2009
 
1
%ZISTCPS        ;ISF/RWF MSC/JDA - DEVICE HANDLER TCP/IP SERVER CALLS ;22APR2009
2
2
 ;;8.0;KERNEL;**78,118,127,225,275,388,MSC**;Jul 10, 1995
3
3
 Q
4
4
 ;
5
 
CLOSE ;Close and reset
 
5
CLOSE   ;Close and reset
6
6
 G CLOSE^%ZISTCP
7
7
 Q
8
8
 ;
9
9
 ;In ZRULE, set ZISQUIT=1 to quit
10
 
LISTEN(SOCK,RTN,ZRULE) ;Listen on socket, start routine
 
10
LISTEN(SOCK,RTN,ZRULE)  ;Listen on socket, start routine
11
11
 N %A,ZISOS,X,NIO,EXIT
12
12
 N $ES,$ET S $ETRAP="D OPNERR^%ZISTCPS"
13
13
 S ZISOS=^%ZOSF("OS"),ZRULE=$G(ZRULE)
18
18
 Q
19
19
 ;
20
20
 ;
21
 
LONT ;Open port in Accept mode with standard terminators.
 
21
LONT    ;Open port in Accept mode with standard terminators.
22
22
 N %ZA,NEWCHAR
23
23
 S NIO="|TCP|"_SOCK,EXIT=0
24
24
 ;(adr:sock:term:ibuf:obuf:queue)
25
25
 O NIO:(:SOCK:"AT"::512:512:10):30 Q:'$T  S POP=0 U NIO
26
26
 ;Wait on read for a connect
27
 
LONT2 F  U NIO R *NEWCHAR:30 S EXIT=$$EXIT Q:$T!EXIT
 
27
LONT2   F  U NIO R *NEWCHAR:30 S EXIT=$$EXIT Q:$T!EXIT
28
28
 I EXIT C NIO Q
29
29
 ;JOB params (:Concurrent Server bit:principal input:principal output)
30
30
 J CHILDONT^%ZISTCPS(NIO,RTN):(:16::):10 S %ZA=$ZA
31
31
 I %ZA\8196#2=1 W *-2 ;Job failed to clear bit
32
32
 G LONT2
33
33
 ;
34
 
CHILDONT(IO,RTN) ;Child process for OpenM
 
34
CHILDONT(IO,RTN)        ;Child process for OpenM
35
35
 S $ETRAP="D ^%ZTER L  HALT",IO=$ZU(53)
36
36
 U IO:(::"-M") ;Work like DSM
37
37
 S NEWJOB=$$NEWOK
39
39
 I NEWJOB K NEWJOB D VAR,@RTN
40
40
 HALT
41
41
 ;
42
 
VAR ;Setup IO variables
 
42
VAR     ;Setup IO variables
43
43
 S IO(0)=IO,IO(1,IO)="",POP=0
44
44
 S IOT="TCP",IOST="P-TCP",IOST(0)=0
45
45
 S IOF=$$FLUSHCHR^%ZISTCP
46
46
 S ^XUTL("XQ",$J,0)=$$DT^XLFDT
47
47
 Q
48
 
NEWOK() ;Is it OK to start a new process
 
48
NEWOK() ;Is it OK to start a new process
49
49
 I $G(^%ZIS(14.5,"LOGON",^%ZOSF("VOL"))) Q 0
50
50
 I $$AVJ^%ZOSV()<3 Q 0
51
51
 Q 1
52
 
OPNERR ;
 
52
OPNERR  ;
53
53
 S POP=1,EXIT=1,IO("ERROR")=$ECODE,$ECODE=""
54
54
 Q
55
 
EXIT() ;See if time to exit
 
55
EXIT()  ;See if time to exit
56
56
 I $$S^%ZTLOAD Q 1
57
57
 N ZISQUIT S ZISQUIT=0
58
58
 I $L(ZRULE) X ZRULE I $G(ZISQUIT) Q 1
59
59
 Q 0
60
60
 ;
61
 
LGTM ;GT.M multi thread server
 
61
LGTM    ;GT.M multi thread server
62
62
 N %A K ^TMP("ZISTCP",$J)
63
63
 S $ZINTERRUPT="I $$JOBEXAM^ZU($ZPOSITION)"
64
64
 S NIO="SCK$"_$S($J>86400:$J,1:84600+$J) ;Construct a dummy, but "unique" devicename for job
69
69
 U NIO S NIO("ZISTCP",0)=$KEY D LOG("Have port.")
70
70
 ;Start Listening
71
71
 W /LISTEN(1) S NIO("ZISTCP",1)=$KEY D LOG("Start Listening. "_NIO("ZISTCP",1))
72
 
 N ZC,ZR,IDX,DESC
 
72
 N ZC,ZR,IDX,DESC,LDESC
73
73
 S ZC="ZSHOW ""D"":ZR"
 
74
 X ZC
 
75
 S LDESC="" F IDX=1:1:$O(ZR("D",""),-1) S:(ZR("D",IDX)["listener")&(ZR("D",IDX)["PORT="_SOCK) LDESC=$P($P(ZR("D",IDX),"DESC=",2)," ",1) Q:LDESC'=""
74
76
 ;Wait for connection
75
 
LG2 S %A=0,EXIT=0 F  D  Q:%A!EXIT
 
77
LG2     S %A=0,EXIT=0 F  D  Q:%A!EXIT
76
78
 . U NIO:(SOCKET="listener")
77
79
 . W /WAIT(30) ;Wait for connect
78
80
 . I $P($KEY,"|",1)="CONNECT" S NIO("ZISTCP",2)=$KEY,%A=1
91
93
 S DESC="" F IDX=1:1:$O(ZR("D",""),-1) S:ZR("D",IDX)[NIO("SOCK") DESC=$P($P(ZR("D",IDX),"DESC=",2)," ",1) Q:DESC'=""
92
94
 I DESC="" D LOG("Can not find file descriptor!") G LG2
93
95
 ;spawn child process
94
 
 S SPAWNID=$&openvista.gtmserver(DESC,"GTMLNCH^%ZISTCPS")
 
96
 S SPAWNID=$&openvista.gtmserver(DESC,LDESC,"GTMLNCH^%ZISTCPS")
95
97
 L +^TMP("ZISTCPS",SPAWNID)
96
98
 S ^TMP("ZISTCPS",SPAWNID)=RTN
97
99
 L -^TMP("ZISTCPS",SPAWNID)
101
103
 G LG2
102
104
 Q
103
105
 ;
104
 
GTMLNCH ;Run gt.m job for this connection.
 
106
GTMLNCH ;Run gt.m job for this connection.
 
107
 N JDAZ
 
108
 ZSHOW "D":JDAZ
 
109
 M ^JDA("Z2",$I(^JDA))=JDAZ
105
110
 N RTN S RTN=""
106
111
 S IO("GTM-IP")=$P($K,"|",3)
107
112
 F  D  Q:RTN'=""  ; Loop until we get entry point
117
122
 D VAR,@RTN
118
123
 Q
119
124
 ;
120
 
LOG(MSG) ;LOG STATUS
 
125
LOG(MSG)        ;LOG STATUS
121
126
 N CNT
122
127
 S CNT=$G(^TMP("ZISTCP",$J))+1,^TMP("ZISTCP",$J)=CNT,^($J,CNT)=MSG
123
128
 Q