source: ePrescribing/trunk/p/_zewdGTM.m@ 1445

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

web service test routines

File size: 22.8 KB
Line 
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
33version()
34 QUIT "6.0"
35 ;
36buildDate()
37 QUIT "29 January 2009"
38 ;
39config ;
40 d setApplicationRootPath^%zewdAPI("/usr/ewd/apps")
41 d setOutputRootPath^%zewdAPI("/usr/php","php")
42 ;s ^%eXtc("system","license")="2vxuxs3qzqxuyuvtynezvm8yy5Wrz4i7wwwrzmsvqwwtr"
43 QUIT
44 ;
45getMGWSIPid()
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
59startMGWSI ;
60 k ^%zewd("mgwsis")
61 d START^%ZMGWSI(0)
62 ;s ^%zewd("mgwsi","job")=$zjob
63 QUIT
64 ;
65stopMGWSI ;
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 ;
78restartMGWSI
79 d stopMGWSI
80 d startMGWSI
81 QUIT
82 ;
83closeMGWSI(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 ;
90closeMGWSIConnections
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 ;
98shutdown
99 zsystem "shutdown -h now"
100 QUIT
101 ;
102restart
103 zsystem "shutdown -r now"
104 QUIT
105 ;
106pidExists(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
119pidFileNotExists
120 c temp
121 s ok=$$deleteFile^%zewdAPI(temp)
122 u io
123 i $p($zs,",",1)=2 QUIT 0
124 QUIT 0
125 ;
126validDomain(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
142nsFileNotExists
143 u io
144 i $p($zs,",",1)=2 QUIT -1
145 QUIT -1
146 ;
147getIP(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
179ipFileNotExists
180 s $zt=""
181 u io
182 i $p($zs,",",1)=2 QUIT -1
183 QUIT ""
184 ;
185openTCP(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 ;
196tcperr ;
197 QUIT 0
198 ;
199resetSecurity
200 ;
201 k ^%zewd("config","security","validSubnet")
202 QUIT
203 ;
204resetVM
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 ;
256setClock
257 zsystem "ntpdate ntp.ubuntu.com"
258 QUIT
259 ;
260startVM
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
279startVMFail
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,!
282startVMFin
283 w "======================================================="_cr,!
284 QUIT
285 ;
286startMDBVM
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 ;
306httpGET(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 ;
361httpResponse ;
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 ;
400httpTimeout
401 QUIT "Timed out waiting for response"
402 ;
403httpPOST(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 ;
478parseURL(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 ;
488smtpSend(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 ;
609read(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
615close ;
616 c dev
617 u io
618 QUIT
619 ;
620message(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 ;
631smtpTest
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 ;
649getFileInfo(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 ;
683shellPipe ; 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 ;
691deletePipe
692 k ^%mgwPipe
693 QUIT
694 ;
695lockPipe
696 l +^%mgwPipe
697 QUIT
698 ;
699unlockPipe
700 l -^%mgwPipe
701 QUIT
702 ;
703shellCommand(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 ;
715fileInfo(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
729fileDateNotExists
730 s $zt=""
731 i $p($zs,",",1)=2 QUIT
732 QUIT
733shell(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)
742eoshell ;
743 c temp
744 u io
745 s ok=$$deleteFile^%zewdAPI(temp)
746 QUIT i-1
747 ;
748testGlobal()
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 ;
755testFile()
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 ;
762mySQL(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 ;
772encodeDate(dateString)
773 n %DN,%DS
774 s %DS=dateString
775 d INT^%DATE
776 QUIT $g(%DN)
777 ;
778relink ;
779 s ^%zewd("relink")=1 k ^%zewd("relink","process")
780 QUIT
781 ;
782install
783 n default,x
784 ;
785 w !,"Installing/Configuring "_$$version^%zewdAPI(),!!
786 w "Note: hit Esc to go back at any point",!!
787install1 ;
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 ;
795install2 ;
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 ;
803install3 ;
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 ;
812install4 ;
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 ;
830leaveAsM ;
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***
Note: See TracBrowser for help on using the repository browser.