| 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***
 | 
|---|