| [514] | 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*** | 
|---|