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