1 | %zewdGTM ;Enterprise Web Developer GT.M/ Virtual Appliance Functions
|
---|
2 | ;
|
---|
3 | ; Product: Enterprise Web Developer version 4.0.755
|
---|
4 | ; Build Date: Thu, 12 Feb 2009 09:53:12
|
---|
5 | ;
|
---|
6 | ; ----------------------------------------------------------------------------
|
---|
7 | ; | Enterprise Web Developer for GT.M and m_apache |
|
---|
8 | ; | Copyright (c) 2004-9 M/Gateway Developments Ltd, |
|
---|
9 | ; | Reigate, Surrey UK. |
|
---|
10 | ; | All rights reserved. |
|
---|
11 | ; | |
|
---|
12 | ; | http://www.mgateway.com |
|
---|
13 | ; | Email: rtweed@mgateway.com |
|
---|
14 | ; | |
|
---|
15 | ; | This program is free software: you can redistribute it and/or modify |
|
---|
16 | ; | it under the terms of the GNU Affero General Public License as |
|
---|
17 | ; | published by the Free Software Foundation, either version 3 of the |
|
---|
18 | ; | License, or (at your option) any later version. |
|
---|
19 | ; | |
|
---|
20 | ; | This program is distributed in the hope that it will be useful, |
|
---|
21 | ; | but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
---|
22 | ; | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
---|
23 | ; | GNU Affero General Public License for more details. |
|
---|
24 | ; | |
|
---|
25 | ; | You should have received a copy of the GNU Affero General Public License |
|
---|
26 | ; | along with this program. If not, see <http://www.gnu.org/licenses/>. |
|
---|
27 | ; ----------------------------------------------------------------------------
|
---|
28 | ;
|
---|
29 | ;
|
---|
30 | QUIT
|
---|
31 | ;
|
---|
32 | ; EWD Virtual Appliance Version/Build
|
---|
33 | version()
|
---|
34 | QUIT "6.0"
|
---|
35 | ;
|
---|
36 | buildDate()
|
---|
37 | QUIT "29 January 2009"
|
---|
38 | ;
|
---|
39 | config ;
|
---|
40 | d setApplicationRootPath^%zewdAPI("/usr/ewd/apps")
|
---|
41 | d setOutputRootPath^%zewdAPI("/usr/php","php")
|
---|
42 | ;s ^%eXtc("system","license")="2vxuxs3qzqxuyuvtynezvm8yy5Wrz4i7wwwrzmsvqwwtr"
|
---|
43 | QUIT
|
---|
44 | ;
|
---|
45 | getMGWSIPid()
|
---|
46 | ;
|
---|
47 | n io,ok,line,stop,temp
|
---|
48 | s io=$io
|
---|
49 | s temp="temp"_$p($h,",",2)_".txt"
|
---|
50 | zsystem "ps -A|grep mgwsi > "_temp
|
---|
51 | o temp:(readonly:exception="g nsFileNotExists")
|
---|
52 | u temp
|
---|
53 | r line
|
---|
54 | c temp
|
---|
55 | u io
|
---|
56 | s ok=$$deleteFile^%zewdAPI(temp)
|
---|
57 | s line=$$stripSpaces^%zewdAPI(line)
|
---|
58 | QUIT +line
|
---|
59 | startMGWSI ;
|
---|
60 | k ^%zewd("mgwsis")
|
---|
61 | d START^%ZMGWSI(0)
|
---|
62 | ;s ^%zewd("mgwsi","job")=$zjob
|
---|
63 | QUIT
|
---|
64 | ;
|
---|
65 | stopMGWSI ;
|
---|
66 | n pid
|
---|
67 | ;s pid=$g(^%zewd("mgwsi","job"))
|
---|
68 | ;s pid=$$getMGWSIPid()
|
---|
69 | ;i pid'="" d
|
---|
70 | ;. k ^%zewd("mgwsi","job")
|
---|
71 | ;. i $$pidExists(pid) zsystem "kill -TERM "_pid
|
---|
72 | s pid=""
|
---|
73 | f s pid=$o(^%zewd("mgwsis",pid)) q:pid="" d
|
---|
74 | . k ^%zewd("mgwsis",pid)
|
---|
75 | . i $$pidExists(pid) zsystem "kill -TERM "_pid
|
---|
76 | QUIT
|
---|
77 | ;
|
---|
78 | restartMGWSI
|
---|
79 | d stopMGWSI
|
---|
80 | d startMGWSI
|
---|
81 | QUIT
|
---|
82 | ;
|
---|
83 | closeMGWSI(server)
|
---|
84 | ; eg server=the MGWSI "server" to be closed, eg ewd, LOCAL, etc
|
---|
85 | n ok,html,url
|
---|
86 | s url="http://127.0.0.1:7040/cgi-bin/nph-mgwsic?mgwsidef=Default_CloseDown_Server&mgwsiSYS=2&mgwsiCDN="_server_"&mgwsiSYSbOK=Close+Connections(s)"
|
---|
87 | s ok=$$httpGET(url,.html)
|
---|
88 | QUIT
|
---|
89 | ;
|
---|
90 | closeMGWSIConnections
|
---|
91 | n pid
|
---|
92 | s pid=""
|
---|
93 | f s pid=$o(^%zewd("mgwsis",pid)) q:pid="" d
|
---|
94 | . k ^%zewd("mgwsis",pid)
|
---|
95 | . i $$pidExists(pid) zsystem "kill -TERM "_pid
|
---|
96 | QUIT
|
---|
97 | ;
|
---|
98 | shutdown
|
---|
99 | zsystem "shutdown -h now"
|
---|
100 | QUIT
|
---|
101 | ;
|
---|
102 | restart
|
---|
103 | zsystem "shutdown -r now"
|
---|
104 | QUIT
|
---|
105 | ;
|
---|
106 | pidExists(pid) ;
|
---|
107 | n io,line,ok,temp
|
---|
108 | s io=$io
|
---|
109 | s temp="temp"_$p($h,",",2)_".txt"
|
---|
110 | zsystem "ps --no-heading "_pid_" > "_temp
|
---|
111 | c temp
|
---|
112 | o temp:(readonly:exception="g pidFileNotExists")
|
---|
113 | u temp r line
|
---|
114 | c temp
|
---|
115 | u io
|
---|
116 | s ok=$$deleteFile^%zewdAPI(temp)
|
---|
117 | i line'[pid QUIT 0
|
---|
118 | QUIT 1
|
---|
119 | pidFileNotExists
|
---|
120 | c temp
|
---|
121 | s ok=$$deleteFile^%zewdAPI(temp)
|
---|
122 | u io
|
---|
123 | i $p($zs,",",1)=2 QUIT 0
|
---|
124 | QUIT 0
|
---|
125 | ;
|
---|
126 | validDomain(domain)
|
---|
127 | ;
|
---|
128 | n exists,io,ok,line,stop,temp
|
---|
129 | s io=$io
|
---|
130 | s temp="temp"_$p($h,",",2)_".txt"
|
---|
131 | zsystem "nslookup "_domain_" >"_temp
|
---|
132 | o temp:(readonly:exception="g nsFileNotExists")
|
---|
133 | u temp
|
---|
134 | s stop=0,exists=0
|
---|
135 | f r line d q:stop
|
---|
136 | . i line["authoritative answer" s stop=1,exists=1 q
|
---|
137 | . i line["server can't find" s stop=1,exists=0 q
|
---|
138 | c temp
|
---|
139 | u io
|
---|
140 | s ok=$$deleteFile^%zewdAPI(temp)
|
---|
141 | QUIT exists
|
---|
142 | nsFileNotExists
|
---|
143 | u io
|
---|
144 | i $p($zs,",",1)=2 QUIT -1
|
---|
145 | QUIT -1
|
---|
146 | ;
|
---|
147 | getIP(info)
|
---|
148 | ;
|
---|
149 | n exists,io,ip,ok,line,stop,temp,value
|
---|
150 | s io=$io
|
---|
151 | s temp="temp"_$p($h,",",2)_".txt"
|
---|
152 | zsystem "ifconfig eth0 >"_temp
|
---|
153 | o temp:(readonly:exception="g ipFileNotExists")
|
---|
154 | u temp
|
---|
155 | s stop=0,ok=0,ip=""
|
---|
156 | f r line d q:stop
|
---|
157 | . i line["HWaddr" d
|
---|
158 | . . s value=$p(line,"HWaddr ",2)
|
---|
159 | . . s info("mac")=$$stripSpaces^%zewdAPI(value)
|
---|
160 | . i line["inet addr:" d
|
---|
161 | . . s value=$p(line,"inet addr:",2)
|
---|
162 | . . s ip=$p(value," ",1)
|
---|
163 | . . s info("ip")=ip
|
---|
164 | . . i ip="127.0.0.1" s stop=1
|
---|
165 | . i line["Bcast:" d
|
---|
166 | . . s value=$p(line,"Bcast:",2)
|
---|
167 | . . s value=$p(value," ",1)
|
---|
168 | . . s info("broadcast")=value
|
---|
169 | . i line["Mask:" d
|
---|
170 | . . s value=$p(line,"Mask:",2)
|
---|
171 | . . s value=$p(value," ",1)
|
---|
172 | . . s info("mask")=value
|
---|
173 | . i line["inet6 addr" s stop=1 q
|
---|
174 | . i line["Local Lookback" s stop=1 q
|
---|
175 | c temp
|
---|
176 | u io
|
---|
177 | s ok=$$deleteFile^%zewdAPI(temp)
|
---|
178 | QUIT ip
|
---|
179 | ipFileNotExists
|
---|
180 | s $zt=""
|
---|
181 | u io
|
---|
182 | i $p($zs,",",1)=2 QUIT -1
|
---|
183 | QUIT ""
|
---|
184 | ;
|
---|
185 | openTCP(host,port,timeout)
|
---|
186 | n delim,dev
|
---|
187 | i host'?1N.N1"."1N.N1"."1N.N1"."1N.N,'$$validDomain(host) QUIT 0
|
---|
188 | i $g(host)="" QUIT 0
|
---|
189 | i $g(port)="" QUIT 0
|
---|
190 | i $g(timeout)="" s timeout=20
|
---|
191 | s delim=$c(13)
|
---|
192 | s dev="client$"_$p($h,",",2)
|
---|
193 | o dev:(connect=host_":"_port_":TCP":attach="client":exception="g tcperr"):timeout:"SOCKET"
|
---|
194 | QUIT dev
|
---|
195 | ;
|
---|
196 | tcperr ;
|
---|
197 | QUIT 0
|
---|
198 | ;
|
---|
199 | resetSecurity
|
---|
200 | ;
|
---|
201 | k ^%zewd("config","security","validSubnet")
|
---|
202 | QUIT
|
---|
203 | ;
|
---|
204 | resetVM
|
---|
205 | n files
|
---|
206 | d resetSecurity
|
---|
207 | k ^%zewdSession
|
---|
208 | s ^%zewd("nextSessid")=1
|
---|
209 | k ^%zewd("mgwsi")
|
---|
210 | k ^%zewd("mgwsis")
|
---|
211 | k ^%zewd("emailQueue")
|
---|
212 | k ^%zewd("daemon","email")
|
---|
213 | k ^%zewd("relink")
|
---|
214 | k ^%eXtc
|
---|
215 | k ^%zewdLog
|
---|
216 | k ^%zewdError
|
---|
217 | k ^CacheTempUserNode
|
---|
218 | k ^CacheTempEWD
|
---|
219 | k ^%zewdTrace
|
---|
220 | k ^zewd("trace")
|
---|
221 | k ^%MGW,^%MGWSI
|
---|
222 | k ^rob,^robdata,^robcgi
|
---|
223 | k ^CacheTempWLD
|
---|
224 | k ^ewdDemo
|
---|
225 | d removeDOMsByPrefix^%zewdAPI()
|
---|
226 | ;d getFilesInPath^%zewdHTMLParser("/usr/local/gtm/ewd",".m",.files)
|
---|
227 | ;f lineNo=1:1 s line=$t(leaveAsM+lineNo) q:line["***END***" d
|
---|
228 | ;. s leaveFiles($p(line,";;",2))=""
|
---|
229 | ; s file=""
|
---|
230 | ;f s file=$o(files(file)) q:file="" d
|
---|
231 | ;. i $d(leaveFiles(file)) q
|
---|
232 | ;. i file'["_zewd" q
|
---|
233 | ;. s path="/usr/local/gtm/ewd/"_file
|
---|
234 | ; . s ok=$$deleteFile^%zewdAPI(path)
|
---|
235 | ; s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDB.m")
|
---|
236 | ; s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBMgr.m")
|
---|
237 | ;s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBConfig.m")
|
---|
238 | s ok=$$deleteFile^%zewdAPI("/usr/MDB/MDB.conf")
|
---|
239 | k ^MDB,^MDBUAF
|
---|
240 | zsystem "rm -f ~/.bash_history"
|
---|
241 | zsystem "history -c"
|
---|
242 | ;echo " "> /var/log/apache2/access.log
|
---|
243 | ;echo " "> /var/log/apache2/error.log
|
---|
244 | ;echo " "> /var/log/apache2/access.log.1"
|
---|
245 | ;echo " "> /var/log/apache2/error.log.1"
|
---|
246 | ;zsystem "rm /usr/php/tutorial/*.*"
|
---|
247 | ; Now clear down history for root
|
---|
248 | ; Shutdown Apache and clear down Apache Log files - use above commented commands
|
---|
249 | ; Delete all ewdapps directories and files
|
---|
250 | ; Delete all PHP directories and files
|
---|
251 | ; zero-space all empty content: cat /dev/zero > zero.fill;sync;sleep 1;sync;rm -f zero.fill
|
---|
252 | ; Compress the virtual drives:
|
---|
253 | ; G:\virtual_machines\mdb_1_0_master>"C:\Program Files\VMware\VMware Server\vmware-vdiskmanager.exe" -k Ubuntu-cl1.vmdk
|
---|
254 | QUIT
|
---|
255 | ;
|
---|
256 | setClock
|
---|
257 | zsystem "ntpdate ntp.ubuntu.com"
|
---|
258 | QUIT
|
---|
259 | ;
|
---|
260 | startVM
|
---|
261 | ;
|
---|
262 | n cr,ip
|
---|
263 | s cr=$c(13)
|
---|
264 | d startMGWSI
|
---|
265 | w cr,!
|
---|
266 | d setClock
|
---|
267 | s ip=$$getIP()
|
---|
268 | w cr,!
|
---|
269 | w "======================================================="_cr,!
|
---|
270 | w " Welcome to the EWD Virtual Appliance "_cr,!
|
---|
271 | w " -- Version "_$$version()_": "_$$buildDate()_" --"_cr,!
|
---|
272 | ;
|
---|
273 | i ip=""!(ip="127.0.0.1") g startVMFail
|
---|
274 | w !
|
---|
275 | w " System clock set to "_$$inetDate^%zewdAPI($h)_cr,!!
|
---|
276 | w " The EWD Virtual Appliance is now ready for use!"_cr,!
|
---|
277 | w " To run the EWD Management Portal, point your browser at http://"_ip_cr,!!
|
---|
278 | g startVMFin
|
---|
279 | startVMFail
|
---|
280 | w "Unfortunately the Virtual Appliance was unable to acquire an IP"_cr,!
|
---|
281 | w "address. Please consult the readme file for what to do next"_cr,!
|
---|
282 | startVMFin
|
---|
283 | w "======================================================="_cr,!
|
---|
284 | QUIT
|
---|
285 | ;
|
---|
286 | startMDBVM
|
---|
287 | ;
|
---|
288 | n cr,ip
|
---|
289 | s cr=$c(13)
|
---|
290 | d startMGWSI
|
---|
291 | w cr,!
|
---|
292 | d setClock
|
---|
293 | s ip=$$getIP()
|
---|
294 | w cr,!
|
---|
295 | w "======================================================="_cr,!
|
---|
296 | w " Welcome to the M/DB Virtual Appliance "_cr,!
|
---|
297 | w " -- Version "_$$version()_": "_$$buildDate()_" --"_cr,!
|
---|
298 | ;
|
---|
299 | i ip=""!(ip="127.0.0.1") g startVMFail
|
---|
300 | w !
|
---|
301 | w " System clock set to "_$$inetDate^%zewdAPI($h)_cr,!!
|
---|
302 | w " The M/DB Virtual Appliance is now ready for use!"_cr,!
|
---|
303 | w " To run the M/DB Management Portal, point your browser at http://"_ip_cr,!!
|
---|
304 | g startVMFin
|
---|
305 | ;
|
---|
306 | httpGET(url,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
|
---|
307 | ;
|
---|
308 | n dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
|
---|
309 | ;
|
---|
310 | k rawResponse,html
|
---|
311 | s HTTPVersion="1.0"
|
---|
312 | s rawURL=url
|
---|
313 | s ssl=0
|
---|
314 | s port=80
|
---|
315 | s urllc=$$zcvt^%zewdAPI(url,"l")
|
---|
316 | i $e(urllc,1,7)="http://" d
|
---|
317 | . s url=$e(url,8,$l(url))
|
---|
318 | . s sslHost=$p(url,"/",1)
|
---|
319 | . s sslPort=80
|
---|
320 | . i sslHost[":" d
|
---|
321 | . . s sslPort=$p(sslHost,":",2)
|
---|
322 | . . s sslHost=$p(sslHost,":",1)
|
---|
323 | e i $e(urllc,1,8)="https://" d
|
---|
324 | . s url=$e(url,9,$l(url))
|
---|
325 | . s ssl=1
|
---|
326 | . s sslHost=$g(sslHost)
|
---|
327 | . i sslHost="" s sslHost="127.0.0.1"
|
---|
328 | . s sslPort=$g(sslPort)
|
---|
329 | . i sslPort="" s sslPort=89
|
---|
330 | e QUIT "Invalid URL"
|
---|
331 | s host=$p(url,"/",1)
|
---|
332 | i host[":" d
|
---|
333 | . s port=$p(host,":",2)
|
---|
334 | . s host=$p(host,":",1)
|
---|
335 | s url="/"_$p(url,"/",2,5000)
|
---|
336 | i $g(timeout)="" s timeout=20
|
---|
337 | ;
|
---|
338 | s io=$io
|
---|
339 | i $g(test)'=1 d
|
---|
340 | . s dev=$$openTCP(sslHost,sslPort,timeout)
|
---|
341 | . u dev
|
---|
342 | i ssl d
|
---|
343 | . w "GET "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
|
---|
344 | e d
|
---|
345 | . w "GET "_url_" HTTP/"_HTTPVersion_$c(13,10)
|
---|
346 | w "Host: "_host
|
---|
347 | i port'=80 w ":"_port
|
---|
348 | w $c(13,10)
|
---|
349 | w "Accept: */*"_$c(13,10)
|
---|
350 | ;
|
---|
351 | i $d(headerArray) d
|
---|
352 | . n n
|
---|
353 | . s n=""
|
---|
354 | . f s n=$o(headerArray(n)) q:n="" d
|
---|
355 | . . w headerArray(n)_$c(13,10)
|
---|
356 | ;
|
---|
357 | w $c(13,10),!
|
---|
358 | ;
|
---|
359 | ; That's the request sent !
|
---|
360 | ;
|
---|
361 | httpResponse ;
|
---|
362 | ;
|
---|
363 | i $g(test)=1 QUIT ""
|
---|
364 | n c,dlim,header,i,no,pos,rlen,stop,str
|
---|
365 | ;
|
---|
366 | k respHeaders
|
---|
367 | s stop=0,no=1
|
---|
368 | f i=1:1 d q:stop
|
---|
369 | . i i=1
|
---|
370 | . r c#1
|
---|
371 | . i c=$c(13) q
|
---|
372 | . i c'=$c(10) s respHeaders(no)=$g(respHeaders(no))_c
|
---|
373 | . i c=$c(10),$g(respHeaders(no))="" s stop=1 q
|
---|
374 | . i c=$c(10) s no=no+1
|
---|
375 | ;
|
---|
376 | s rlen=999999
|
---|
377 | f i=1:1:(no-1) d
|
---|
378 | . s header=$$zcvt^%zewdAPI(respHeaders(i),"l")
|
---|
379 | . i header["content-length" d
|
---|
380 | . . s rlen=$p(header,":",2)
|
---|
381 | . . s rlen=$$stripSpaces^%zewdAPI(rlen)
|
---|
382 | ;
|
---|
383 | i rlen<999999 d
|
---|
384 | . r str#rlen
|
---|
385 | e d
|
---|
386 | . s str=""
|
---|
387 | . f pos=1:1 r str#rlen:timeout g:'$t httpTimeout q:str="" s str(pos)=str q:($l(str)<999999)
|
---|
388 | i $g(test)'=1 c dev
|
---|
389 | s dlim=$c(10)
|
---|
390 | i str[$c(13,10) s dlim=$c(13,10)
|
---|
391 | s rlen=$l(str,dlim)
|
---|
392 | f i=1:1:rlen s html(i)=$p(str,dlim,i)
|
---|
393 | s rawResponse=""
|
---|
394 | f i=1:1:(no-1) s rawResponse=rawResponse_respHeaders(i)_dlim
|
---|
395 | s rawResponse=rawResponse_dlim_str
|
---|
396 | ;
|
---|
397 | u io
|
---|
398 | QUIT ""
|
---|
399 | ;
|
---|
400 | httpTimeout
|
---|
401 | QUIT "Timed out waiting for response"
|
---|
402 | ;
|
---|
403 | httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
|
---|
404 | ;
|
---|
405 | n contentLength,dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
|
---|
406 | ;
|
---|
407 | k rawResponse,html
|
---|
408 | s HTTPVersion="1.0"
|
---|
409 | s rawURL=url
|
---|
410 | s ssl=0
|
---|
411 | s port=80
|
---|
412 | s urllc=$$zcvt^%zewdAPI(url,"l")
|
---|
413 | i $e(urllc,1,7)="http://" d
|
---|
414 | . s url=$e(url,8,$l(url))
|
---|
415 | . s sslHost=$p(url,"/",1)
|
---|
416 | . s sslPort=80
|
---|
417 | e i $e(urllc,1,8)="https://" d
|
---|
418 | . s url=$e(url,9,$l(url))
|
---|
419 | . s ssl=1
|
---|
420 | . s sslHost=$g(sslHost)
|
---|
421 | . i sslHost="" s sslHost="127.0.0.1"
|
---|
422 | . s sslPort=$g(sslPort)
|
---|
423 | . i sslPort="" s sslPort=89
|
---|
424 | e QUIT "Invalid URL"
|
---|
425 | s host=$p(url,"/",1)
|
---|
426 | i host[":" d
|
---|
427 | . s port=$p(host,":",2)
|
---|
428 | . s host=$p(host,":",1)
|
---|
429 | s url="/"_$p(url,"/",2,5000)
|
---|
430 | i $g(timeout)="" s timeout=20
|
---|
431 | ;
|
---|
432 | s io=$io
|
---|
433 | i $g(test)'=1 d
|
---|
434 | . s dev=$$openTCP(sslHost,sslPort,timeout)
|
---|
435 | . u dev
|
---|
436 | i ssl d
|
---|
437 | . w "POST "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
|
---|
438 | e d
|
---|
439 | . w "POST "_url_" HTTP/"_HTTPVersion_$c(13,10)
|
---|
440 | w "Host: "_host
|
---|
441 | i port'=80 w ":"_port
|
---|
442 | w $c(13,10)
|
---|
443 | w "Accept: */*"_$c(13,10)
|
---|
444 | ;
|
---|
445 | i $d(headerArray) d
|
---|
446 | . n n
|
---|
447 | . s n=""
|
---|
448 | . f s n=$o(headerArray(n)) q:n="" d
|
---|
449 | . . w headerArray(n)_$c(13,10)
|
---|
450 | ;
|
---|
451 | s mimeType=$g(mimeType)
|
---|
452 | i mimeType="" s mimeType="application/x-www-form-urlencoded"
|
---|
453 | s contentLength=0
|
---|
454 | i $d(payload) d
|
---|
455 | . n no
|
---|
456 | . s no=""
|
---|
457 | . f s no=$O(payload(no)) q:no="" D
|
---|
458 | . . s contentLength=contentLength+$l(payload(no))
|
---|
459 | . s contentLength=contentLength
|
---|
460 | . w "Content-Type: ",mimeType
|
---|
461 | . i $g(charset)'="" w "; charset=""",charset,""""
|
---|
462 | . w $c(13,10)
|
---|
463 | . w "Content-Length: ",contentLength,$c(13,10)
|
---|
464 | ;
|
---|
465 | w $c(13,10)
|
---|
466 | i $D(payload) d
|
---|
467 | . n no
|
---|
468 | . s no=""
|
---|
469 | . f s no=$O(payload(no)) q:no="" d
|
---|
470 | . . w payload(no)
|
---|
471 | ;
|
---|
472 | w $c(13,10),!
|
---|
473 | ;
|
---|
474 | ; That's the request sent !
|
---|
475 | ;
|
---|
476 | g httpResponse
|
---|
477 | ;
|
---|
478 | parseURL(url,docName)
|
---|
479 | ;
|
---|
480 | n getPath,ok,server
|
---|
481 | ;
|
---|
482 | i url["http://" s url=$p(url,"http://",2)
|
---|
483 | s server=$p(url,"/",1)
|
---|
484 | s getPath=$p(url,"/",2,1000)
|
---|
485 | s ok=$$parseURL^%zewdHTMLParser(server,getPath,docName)
|
---|
486 | QUIT ok
|
---|
487 | ;
|
---|
488 | smtpSend(domain,from,displayFrom,to,displayTo,ccList,subject,message,dialog,authType,username,password,timeout,gmtOffset,port)
|
---|
489 | ;
|
---|
490 | n attach,boundary,crlf,date,dev,error,io,mess,rcpt,resp,sent,toList
|
---|
491 | ;
|
---|
492 | s timeout=$g(timeout) i timeout="" s timeout=10
|
---|
493 | s domain=$g(domain)
|
---|
494 | s port=$g(port) i port="" s port=25
|
---|
495 | s from=$g(from)
|
---|
496 | s to=$g(to)
|
---|
497 | s subject=$g(subject)
|
---|
498 | s gmtOffset=$g(gmtOffset) i gmtOffset="" s gmtOffset="GMT"
|
---|
499 | ;
|
---|
500 | s error=""
|
---|
501 | i domain="" QUIT "No SMTP Domain specified"
|
---|
502 | i from="" QUIT "No sender's email address specified"
|
---|
503 | i to="" QUIT "No recipient's email address specified"
|
---|
504 | i '$d(message) QUIT "No Email content specified"
|
---|
505 | ;
|
---|
506 | s date=$$inetDate^%zewdAPI($h)_" "_gmtOffset
|
---|
507 | s mess($increment(mess))="Date: "_date
|
---|
508 | i $g(displayFrom)'="" d
|
---|
509 | . s mess($increment(mess))="From: """_displayFrom_"""<"_from_">"
|
---|
510 | e d
|
---|
511 | . s mess($increment(mess))="From: "_from
|
---|
512 | i $g(displayTo)'="" d
|
---|
513 | . s mess($increment(mess))="To: """_displayTo_"""<"_to_">"
|
---|
514 | e d
|
---|
515 | . s mess($increment(mess))="To: "_to
|
---|
516 | s toList(to)=""
|
---|
517 | i $d(ccList) d
|
---|
518 | . n name
|
---|
519 | . s mess($increment(mess))="Cc: "
|
---|
520 | . i $g(ccList)'="" d
|
---|
521 | . . s toList(ccList)=""
|
---|
522 | . . s mess(mess)=mess(mess)_ccList
|
---|
523 | . s name=""
|
---|
524 | . f s name=$o(ccList(name)) q:name="" d
|
---|
525 | . . i mess(mess)'="Cc: " s mess(mess)=mess(mess)_", "
|
---|
526 | . . s mess(mess)=mess(mess)_name
|
---|
527 | . . s toList(name)=""
|
---|
528 | s mess($increment(mess))="Subject: "_subject
|
---|
529 | s mess($increment(mess))="X-Priority: 3 (Normal)"
|
---|
530 | s mess($increment(mess))="X-MSMail-Priority: Normal"
|
---|
531 | s mess($increment(mess))="X-Mailer: "_$$version^%zewdAPI()
|
---|
532 | s mess($increment(mess))="MIME-Version: 1.0"
|
---|
533 | s mess($increment(mess))="Content-Type: text/plain; charset=""us-ascii"""
|
---|
534 | s mess($increment(mess))="Content-Transfer-Encoding: 7bit"
|
---|
535 | s mess($increment(mess))=""
|
---|
536 | ;
|
---|
537 | s message=$g(message)
|
---|
538 | i message'="" d
|
---|
539 | . s mess($increment(mess))=message
|
---|
540 | e d
|
---|
541 | . n mlno
|
---|
542 | . s mlno=""
|
---|
543 | . f s mlno=$o(message(mlno)) q:mlno="" d
|
---|
544 | . . s mess($increment(mess))=message(mlno)
|
---|
545 | ;
|
---|
546 | k dialog
|
---|
547 | s io=$io
|
---|
548 | s crlf=$c(13,10)
|
---|
549 | s dev=$$openTCP(server,port,timeout)
|
---|
550 | i dev=0 QUIT "Unable to connect to SMTP server: "_server
|
---|
551 | u dev
|
---|
552 | r resp:timeout e d close QUIT "Unable to initiate connection with SMTP server"
|
---|
553 | s resp=$p(resp,crlf,1)
|
---|
554 | s dialog($increment(dialog))=resp
|
---|
555 | s error=""
|
---|
556 | s authType=$g(authType)
|
---|
557 | i authType="LOGIN PLAIN"!(authType="LOGIN") d i error'="" d close QUIT error
|
---|
558 | . n context,decode,passB64,str,userB64
|
---|
559 | . s context=1
|
---|
560 | . i $d(^zewd("config","MGWSI")) s context=0
|
---|
561 | . u dev w "EHLO "_domain_crlf,! s resp=$$read(.dialog)
|
---|
562 | . i resp'["250",resp'["AUTH",resp'["LOGIN" s error="Authentication type LOGIN/LOGIN PLAIN not supported on this server" q
|
---|
563 | . u dev w "AUTH LOGIN"_crlf,! s resp=$$read(.dialog)
|
---|
564 | . i resp'["334" s error="No username authentication challenge from server" q
|
---|
565 | . s str=$p(resp," ",2,1000)
|
---|
566 | . s decode=$$DB64^%ZMGWSIS(str,context)
|
---|
567 | . s resp="(decoded as : "_decode_")"
|
---|
568 | . s dialog($increment(dialog))=resp
|
---|
569 | . s userB64=$$B64^%ZMGWSIS(username,context)
|
---|
570 | . u dev w userB64_crlf,! s resp=$$read(.dialog)
|
---|
571 | . i resp'["334" s error="No password authentication challenge from server" q
|
---|
572 | . s str=$p(resp," ",2,1000)
|
---|
573 | . s decode=$$DB64^%ZMGWSIS(str,context)
|
---|
574 | . s resp="(decoded as : "_decode_")"
|
---|
575 | . s dialog($increment(dialog))=resp
|
---|
576 | . s passB64=$$B64^%ZMGWSIS(password,context)
|
---|
577 | . u dev w passB64_crlf,! s resp=$$read(.dialog)
|
---|
578 | . i resp'["235 " s error=resp q
|
---|
579 | e d i error'="" d close QUIT error
|
---|
580 | . u dev w "HELO "_domain_crlf,! s resp=$$read(.dialog)
|
---|
581 | . i resp'["250" s error=resp
|
---|
582 | ;
|
---|
583 | u dev w "MAIL FROM: "_from_crlf,! s resp=$$read(.dialog)
|
---|
584 | i resp'["250" d close QUIT resp
|
---|
585 | ;
|
---|
586 | s rcpt=""
|
---|
587 | f s rcpt=$o(toList(rcpt)) q:rcpt="" d i resp'[250 q
|
---|
588 | . u dev w "RCPT TO: <"_rcpt_">"_$c(13,10),!
|
---|
589 | . s resp=$$read(.dialog)
|
---|
590 | i resp'[250 d close QUIT resp
|
---|
591 | ;
|
---|
592 | u dev w "DATA",crlf,! s resp=$$read(.dialog)
|
---|
593 | i resp'["250",resp'["354" d close QUIT resp
|
---|
594 | ;
|
---|
595 | s message=$g(message)
|
---|
596 | i message'="" d message(message,dev)
|
---|
597 | e d
|
---|
598 | . n line,lineNo
|
---|
599 | . s lineNo=""
|
---|
600 | . f s lineNo=$o(mess(lineNo)) q:lineNo="" d
|
---|
601 | . . s line=mess(lineNo)
|
---|
602 | . . d message(line,dev)
|
---|
603 | u dev w crlf,".",crlf,! s resp=$$read(.dialog)
|
---|
604 | i resp'["250" d close QUIT resp
|
---|
605 | u dev w "QUIT",crlf,! s resp=$$read(.dialog)
|
---|
606 | d close
|
---|
607 | QUIT ""
|
---|
608 | ;
|
---|
609 | read(dialog)
|
---|
610 | n resp
|
---|
611 | r resp
|
---|
612 | s resp=$p(resp,$c(13,10),1)
|
---|
613 | s dialog($increment(dialog))=resp
|
---|
614 | QUIT resp
|
---|
615 | close ;
|
---|
616 | c dev
|
---|
617 | u io
|
---|
618 | QUIT
|
---|
619 | ;
|
---|
620 | message(line,dev)
|
---|
621 | n buf,p1
|
---|
622 | s buf=$g(line)
|
---|
623 | i buf="" u dev w $c(13,10),! QUIT
|
---|
624 | f q:buf="" d
|
---|
625 | . s p1=$e(buf,1,254),buf=$e(buf,255,$l(buf))
|
---|
626 | . i $e(p1)="." s p1="."_p1
|
---|
627 | . i $l(p1) u dev w p1,!
|
---|
628 | u dev w $c(13,10),!
|
---|
629 | QUIT
|
---|
630 | ;
|
---|
631 | smtpTest
|
---|
632 | s server="relay.xxxx.net"
|
---|
633 | s from="rtweed@xxxxx.com"
|
---|
634 | s displayFrom="Rob Tweed"
|
---|
635 | s displayTo=displayFrom
|
---|
636 | s to="rtweed@xxxx.co.uk"
|
---|
637 | s ccList("rtweed@yyyy.co.uk")=""
|
---|
638 | s ccList("rtweed@zzzz.com")=""
|
---|
639 | s message(1)="Test Message"
|
---|
640 | s message(2)="This is line 2"
|
---|
641 | s message(3)="And here is line 3"
|
---|
642 | s authType="LOGIN PLAIN"
|
---|
643 | s user="xxxxxxxxx"
|
---|
644 | s pass="yyyyyyyyy"
|
---|
645 | s subject="Test email 2"
|
---|
646 | s ok=$$smtpSend(server,from,displayFrom,to,displayTo,.ccList,subject,.message,.dialog,authType,user,pass)
|
---|
647 | QUIT
|
---|
648 | ;
|
---|
649 | getFileInfo(path,ext,info) ; Get list of files with specified extension
|
---|
650 | ;
|
---|
651 | n date,dlim,%file,%io,lineNo,ok,os,%p1,result,time,%x,%y
|
---|
652 | ;
|
---|
653 | k info
|
---|
654 | s dlim="/"
|
---|
655 | i $e(ext,1)'="." s ext="."_ext
|
---|
656 | i $e(path,$l(path))=dlim s path=$e(path,1,$l(path)-1)
|
---|
657 | ;
|
---|
658 | d shellCommand("ls -l """_path_"""",.result)
|
---|
659 | ;
|
---|
660 | ; we now have directory listing in result array
|
---|
661 | s lineNo=""
|
---|
662 | f s lineNo=$o(result(lineNo)) q:lineNo="" d
|
---|
663 | . s %file=result(lineNo)
|
---|
664 | . s %p1=$P(%file," ",1)
|
---|
665 | . i $e(%p1,1)'="d" d
|
---|
666 | . . n %e1,%e2,%rfile,%p9,%len,%name,size
|
---|
667 | . . s %rfile=$re(%file)
|
---|
668 | . . s %rfile=$$replaceAll^%zewdAPI(%rfile," "," ")
|
---|
669 | . . s %p9=$p(%rfile," ",1)
|
---|
670 | . . s time=$p(%rfile," ",2)
|
---|
671 | . . s date=$p(%rfile," ",3,4)
|
---|
672 | . . s size=$p(%rfile," ",5)
|
---|
673 | . . s %p9=$re(%p9)
|
---|
674 | . . s time=$re(time)
|
---|
675 | . . s date=$re(date)
|
---|
676 | . . ;i $$zcvt^%zewdAPI(%p9,"l")=$$zcvt^%zewdAPI(%tofile,"l") q ; ignore temp file
|
---|
677 | . . i ext=".*" s info(%p9)=date_$c(1)_time_$c(1)_size q
|
---|
678 | . . s %e1="."_$$getFileExtension^%zewdHTMLParser(%p9)
|
---|
679 | . . i %e1'=ext q
|
---|
680 | . . s info(%p9)=date_$c(1)_time_$c(1)_size
|
---|
681 | QUIT
|
---|
682 | ;
|
---|
683 | shellPipe ; Pipe output from shell commands to scratch global
|
---|
684 | ;
|
---|
685 | n i,x
|
---|
686 | ;
|
---|
687 | k ^%mgwPipe
|
---|
688 | f i=1:1:200 r x q:((i>20)&(x="")) s ^%mgwPipe(i)=x
|
---|
689 | QUIT
|
---|
690 | ;
|
---|
691 | deletePipe
|
---|
692 | k ^%mgwPipe
|
---|
693 | QUIT
|
---|
694 | ;
|
---|
695 | lockPipe
|
---|
696 | l +^%mgwPipe
|
---|
697 | QUIT
|
---|
698 | ;
|
---|
699 | unlockPipe
|
---|
700 | l -^%mgwPipe
|
---|
701 | QUIT
|
---|
702 | ;
|
---|
703 | shellCommand(command,result) ;
|
---|
704 | n lineNo
|
---|
705 | k result
|
---|
706 | d lockPipe
|
---|
707 | zsystem command_" |mumps -run shellPipe^%zewdGTM"
|
---|
708 | m result=^%mgwPipe
|
---|
709 | d deletePipe
|
---|
710 | d unlockPipe
|
---|
711 | s lineNo=""
|
---|
712 | f s lineNo=$o(result(lineNo),-1) q:lineNo="" q:result(lineNo)'="" k result(lineNo)
|
---|
713 | QUIT
|
---|
714 | ;
|
---|
715 | fileInfo(path,info)
|
---|
716 | n line,temp
|
---|
717 | k info
|
---|
718 | s temp="temp"_$p($h,",",2)_".txt"
|
---|
719 | i '$$fileExists^%zewdAPI(path) QUIT
|
---|
720 | zsystem "ls -l "_path_">"_temp
|
---|
721 | o temp:(readonly:exception="g fileDateNotExists")
|
---|
722 | u temp
|
---|
723 | r line
|
---|
724 | s info("date")=$p(line," ",6,8)
|
---|
725 | s info("size")=$p(line," ",5)
|
---|
726 | c temp
|
---|
727 | s ok=$$deleteFile^%zewdAPI(temp)
|
---|
728 | QUIT
|
---|
729 | fileDateNotExists
|
---|
730 | s $zt=""
|
---|
731 | i $p($zs,",",1)=2 QUIT
|
---|
732 | QUIT
|
---|
733 | shell(command,result)
|
---|
734 | n i,io,temp
|
---|
735 | k result
|
---|
736 | s io=$io
|
---|
737 | s temp="temp"_$p($h,",",2)_".txt"
|
---|
738 | zsystem command_">"_temp
|
---|
739 | o temp:(readonly)
|
---|
740 | u temp:exception="g eoshell"
|
---|
741 | f i=1:1 r result(i)
|
---|
742 | eoshell ;
|
---|
743 | c temp
|
---|
744 | u io
|
---|
745 | s ok=$$deleteFile^%zewdAPI(temp)
|
---|
746 | QUIT i-1
|
---|
747 | ;
|
---|
748 | testGlobal()
|
---|
749 | s start=$h
|
---|
750 | f i=1:1:1000 d fileInfo^%zewdAPI("/usr/php/ewdMgr/user.php",.info)
|
---|
751 | s end=$h
|
---|
752 | s dur=$p(end,",",2)-$p(start,",",2)
|
---|
753 | QUIT dur
|
---|
754 | ;
|
---|
755 | testFile()
|
---|
756 | s start=$h
|
---|
757 | f i=1:1:1000 d fileInfo^%zewdGTM("/usr/php/ewdMgr/user.php",.info)
|
---|
758 | s end=$h
|
---|
759 | s dur=$p(end,",",2)-$p(start,",",2)
|
---|
760 | QUIT dur
|
---|
761 | ;
|
---|
762 | mySQL(sql,resultArray,username,password,database)
|
---|
763 | n nlines,str
|
---|
764 | ;
|
---|
765 | i $g(username)="" s username="root"
|
---|
766 | i $g(password)="" s password="1234567"
|
---|
767 | i $g(database)="" s database="test"
|
---|
768 | s str="mysql --xml -u "_username_" -p"_password_" "_database_" -e """_sql_""""
|
---|
769 | s nlines=$$shell(str,.resultArray)
|
---|
770 | QUIT nlines
|
---|
771 | ;
|
---|
772 | encodeDate(dateString)
|
---|
773 | n %DN,%DS
|
---|
774 | s %DS=dateString
|
---|
775 | d INT^%DATE
|
---|
776 | QUIT $g(%DN)
|
---|
777 | ;
|
---|
778 | relink ;
|
---|
779 | s ^%zewd("relink")=1 k ^%zewd("relink","process")
|
---|
780 | QUIT
|
---|
781 | ;
|
---|
782 | install
|
---|
783 | n default,x
|
---|
784 | ;
|
---|
785 | w !,"Installing/Configuring "_$$version^%zewdAPI(),!!
|
---|
786 | w "Note: hit Esc to go back at any point",!!
|
---|
787 | install1 ;
|
---|
788 | s default=$g(^zewd("config","applicationRootPath"))
|
---|
789 | i default="" s default="/usr/ewdapps"
|
---|
790 | w !,"Application Root Path ("_default_"): " r x
|
---|
791 | i $zb=$c(27) w !," Installation aborted",!! QUIT
|
---|
792 | i x="" s x=default w x
|
---|
793 | s ^zewd("config","applicationRootPath")=x
|
---|
794 | ;
|
---|
795 | install2 ;
|
---|
796 | s default=$g(^zewd("config","routinePath","gtm"))
|
---|
797 | i default="" s default="/usr/local/gtm/ewd/"
|
---|
798 | w !,"Routine Path ("_default_"): " r x
|
---|
799 | i $zb=$c(27) w ! g install1
|
---|
800 | i x="" s x=default w x
|
---|
801 | s ^zewd("config","routinePath","gtm")=x
|
---|
802 | ;
|
---|
803 | install3 ;
|
---|
804 | s default=$g(^zewd("config","jsScriptPath","gtm","outputPath"))
|
---|
805 | i default="" s default="/var/www/resources/"
|
---|
806 | w !,"Javascript and CSS File Output Path ("_default_"): " r x
|
---|
807 | i $zb=$c(27) w ! g install2
|
---|
808 | i x="" s x=default w x
|
---|
809 | i $e(x,$l(x))'="/" s x=x_"/"
|
---|
810 | s ^zewd("config","jsScriptPath","gtm","outputPath")=x
|
---|
811 | ;
|
---|
812 | install4 ;
|
---|
813 | s default=$g(^zewd("config","jsScriptPath","gtm","path"))
|
---|
814 | i default="" s default="/resources/"
|
---|
815 | w !,"Javascript and CSS File URL Path ("_default_"): " r x
|
---|
816 | i $zb=$c(27) w ! g install3
|
---|
817 | i x="" s x=default w x
|
---|
818 | i $e(x,$l(x))'="/" s x=x_"/"
|
---|
819 | s ^zewd("config","jsScriptPath","gtm","path")=x
|
---|
820 | ;
|
---|
821 | s ^zewd("config","backEndTechnology")="m"
|
---|
822 | i '$d(^zewd("config","defaultFormat")) s ^zewd("config","defaultFormat")="pretty"
|
---|
823 | s ^zewd("config","defaultTechnology")="gtm"
|
---|
824 | s ^zewd("config","frontEndTechnology")="gtm"
|
---|
825 | i '$d(^zewd("config","jsScriptPath","gtm","mode")) s ^zewd("config","jsScriptPath","gtm","mode")="fixed"
|
---|
826 | s ^zewd("config","sessionDatabase")="gtm"
|
---|
827 | w !!,$$version^%zewdAPI()_" is configured and ready for use",!!
|
---|
828 | QUIT
|
---|
829 | ;
|
---|
830 | leaveAsM ;
|
---|
831 | ;;_zewdCompiler11.m
|
---|
832 | ;;_zewdCompiler12.m
|
---|
833 | ;;_zewdCompiler14.m
|
---|
834 | ;;_zewdCompiler15.m
|
---|
835 | ;;_zewdCompiler17.m
|
---|
836 | ;;_zewdCompiler18.m
|
---|
837 | ;;_zewdCompiler21.m
|
---|
838 | ;;_zewdCompiler2.m
|
---|
839 | ;;_zewdCompiler9.m
|
---|
840 | ;;_zewdDemo.m
|
---|
841 | ;;_zewdDocumentation1.m
|
---|
842 | ;;_zewdDocumentation2.m
|
---|
843 | ;;_zewdDocumentation3.m
|
---|
844 | ;;_zewdDocumentation4.m
|
---|
845 | ;;_zewdEJSCData.m
|
---|
846 | ;;_zewdExtJSCode.m
|
---|
847 | ;;_zewdExtJSData.m
|
---|
848 | ;;_zewdExtJSDat2.m
|
---|
849 | ;;_zewdExtJSData3.m
|
---|
850 | ;;_zewdGTM.m
|
---|
851 | ;;_zewdGTMRuntime.m
|
---|
852 | ;;_zewdHTTP.m
|
---|
853 | ;;_zewdLAMP1.m
|
---|
854 | ;;_zewdMgr.m
|
---|
855 | ;;_zewdMgr2.m
|
---|
856 | ;;_zewdMgr3.m
|
---|
857 | ;;_zewdMgrAjax.m
|
---|
858 | ;;_zewdMgrAjax2.m
|
---|
859 | ;;_zewdSlideshow.m
|
---|
860 | ;;_zewdYUI1.m
|
---|
861 | ;;_zewdYUI2.m
|
---|
862 | ;;_zewdvaMgr.m
|
---|
863 | ;;***END***
|
---|