source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/_ZMGWSI.m@ 1087

Last change on this file since 1087 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
[613]1%ZMGWSI ; Service Integration - Core Server
2 ;
3 ; ----------------------------------------------------------------------------
4 ; | m_apache |
5 ; | Copyright (c) 2004-2009 M/Gateway Developments Ltd, |
6 ; | Surrey UK. |
7 ; | All rights reserved. |
8 ; | |
9 ; | http://www.mgateway.com |
10 ; | |
11 ; | This program is free software: you can redistribute it and/or modify |
12 ; | it under the terms of the GNU Affero General Public License as |
13 ; | published by the Free Software Foundation, either version 3 of the |
14 ; | License, or (at your option) any later version. |
15 ; | |
16 ; | This program is distributed in the hope that it will be useful, |
17 ; | but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 ; | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
19 ; | GNU Affero General Public License for more details. |
20 ; | |
21 ; | You should have received a copy of the GNU Affero General Public License |
22 ; | along with this program. If not, see <http://www.gnu.org/licenses/>. |
23 ; ----------------------------------------------------------------------------
24 ;
25A0 D VERS^%ZMGWSIS
26 q
27 ;
28START(port) ; Start daemon
29 new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":STARTE"
30 k ^%MGWSI("STOP")
31 j M($g(port))
32 q
33STARTE ; Error
34 q
35 ;
36EeeStart ; Start
37 d START(0)
38 Q
39 ;
40STOP ; Stop
41 ;s ^%MGWSI("STOP")=1
42 w !,"Stopping MGWSI ... "
43 d STOP1(0,1)
44 ;f q:'$d(^%MGWSI("STOP")) h 3 w "."
45 w !!,"MGWSI stopped",!
46 Q
47 ;
48STOP1(port,context) ; Stop daemon
49 ; context==0: stop child processes
50 ; context==1: stop master and child processes
51 s pport=+$g(port)
52 i pport D STOP2(pport,context) q
53 s pport="" f s pport=$o(^%MGWSI("TCP_PORT",pport)) q:pport="" D STOP2(pport,context)
54 q
55 ;
56STOP2(pport,context) ; Stop series
57 s cport="" f s cport=$o(^%MGWSI("TCP_PORT",pport,cport)) q:cport="" D
58 . s pid=$g(^%MGWSI("TCP_PORT",pport,cport))
59 . D STOP3(cport,pid)
60 . k ^%MGWSI("TCP_PORT",pport,cport)
61 . q
62 i context=1 s pid=$g(^%MGWSI("TCP_PORT",pport)) D STOP3(pport,pid) k ^%MGWSI("TCP_PORT",pport)
63 q
64 ;
65STOP3(port,pid) ; Stop this listener
66 i '$l(pid) q
67 w !,"stop: "_pid
68 zsy "kill -TERM "_pid
69 q
70 ;
71M(port) ; Non-Concurrent TCP service (Old MUMPS systems)
72 new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":MH"
73 s $ZS="",dev=""
74 s port=+$g(port)
75 i 'port s port=7041
76 ; Initialize list of 'used' TCP server ports
77 k ^%MGWSI("TCP_PORT",port)
78 s ^%MGWSI("TCP_PORT",port)=$j
79 ;
80MA ; Set TCP server device
81 Set dev="server$"_$j,timeout=30
82 ;
83 ; Open TCP server device
84 Open dev:(ZLISTEN=port_":TCP":attach="server"):timeout:"SOCKET"
85 ;
86 ; Use TCP server device
87 Use dev
88 Write /listen(1)
89 ;
90M0 set %ZNSock="",%ZNFrom=""
91 S OK=1 F D Q:OK I $D(^%MGWSI("STOP")) S OK=0 k ^%MGWSI("STOP") Q
92 . Write /wait(timeout)
93 . I $KEY'="" S OK=1 Q
94 . S OK=0
95 . Q
96 I 'OK G MX
97 set %ZNSock=$piece($KEY,"|",2),%ZNFrom=$piece($KEY,"|",3)
98 d EVENT^%ZMGWSIS("Incoming connection from "_%ZNFrom_", starting child server process ("_%ZNSock_")")
99 ;
100 ; d CHILD^%ZMGWSIS(port,port,1,"")
101 ;
102 s errors=0
103 D VARS^%ZMGWSIS
104M1 ; Read the next command from the MGWSI gateway
105 new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":ME"
106 s $ZS=""
107 s req="" f i=1:1 r *x q:x=10!(x=0) i i<300 s req=req_$c(x)
108 ;D EVENT^%ZMGWSIS("command::"_(req[$c(10))_":"_req)
109 i x=0 C dev G MA
110 s errors=0
111 s cmnd=$p(req,"^",2)
112 ;
113 ; Only interested in the request to start a new service job
114 ; and the close-down command - discard everything else
115 k res
116 i cmnd="S" D DINT ; start a new service job
117 i cmnd="X" G MX ; close-down this service
118 ;
119 ; Flush output buffer
120 d END^%ZMGWSIS
121 C dev G MA
122 ;
123ME ; Error - probably client disconnect (which is normal)
124 new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":MX"
125 s errors=errors+1 i errors<37 C dev G MA
126 ; Too many errors
127 d EVENT^%ZMGWSIS("Accept Loop - Too many errors - Closing Down ("_$ZS_")")
128MX ; Exit
129 new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":MH"
130 d EVENT^%ZMGWSIS("Closing Server")
131 ;
132 ; Close TCP server device
133 c dev
134 h
135 ;
136MH ; Start-up error - Halt
137 new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":MH1"
138 d EVENT^%ZMGWSIS("Service start-up error: "_$ZS) Q
139 ;
140 ; Close TCP server device
141 i $l($g(dev)) c dev
142 h
143MH1 ; Halt
144 h
145 ;
146DINT ; Start-up and initialise a new service job
147 N %uci,%touci,systype,cport,dev,i,txt,timeout,x
148 S %touci=$p($p(req,"uci=",2),"&",1) ; UCI for service job
149 s %uci=$$getuci^%ZMGWSIS() ; This UCI (should be manager)
150 s systype=$$getsys^%ZMGWSIS() ; System type
151 ;
152 ; Get the next available TCP port for server child process
153 f cport=port+1:1 i '$d(^%MGWSI("TCP_PORT",port,cport)),'$d(^%MGWSI("TCP_PORT_EXCLUDED",cport)) q
154 ; Mark the port as in-use
155 s ^%MGWSI("TCP_PORT",port,cport)=""
156 ;
157 ; Start server child process
158 new $ZTRAP set $ZTRAP="ZGOTO "_$ZLEVEL_":DINTE"
159 s ok=1,timeout=10
160 j CHILD^%ZMGWSIS(port,cport,0,%touci)
161 s ^%zewd("mgwsis",$zjob)=""
162 i 'ok g DINTE
163 ; Send confirmation of a successful child start-up to the MGWSI gateway
164 s txt="pid="_$J_"&uci="_%UCI_"&server_type="_systype_"&version="_$p($$V^%ZMGWSIS(),".",1,3)_"&child_port="_cport
165 k res s res="" s res(1)="00000cv"_$C(10),maxlen=$$getslen^%ZMGWSIS() d send^%ZMGWSIS(txt)
166 q
167DINTE ; Probably a NameSpace/UCI error
168 s x="" f s x=$o(^%MGWSI("TCP_PORT",x)) q:x="" k ^%MGWSI("TCP_PORT",x,cport)
169 d EVENT^%ZMGWSIS("Unable to start a child process: "_$ZS)
170 s txt="Error# "_$ZS
171 k res s res="" s res(1)="00000ce"_$C(10),maxlen=$$getslen^%ZMGWSIS() d send^%ZMGWSIS(txt)
172 q
173 ;
Note: See TracBrowser for help on using the repository browser.