web service test routines
This commit is contained in:
george
parent
6cb2dc662b
commit
0ccf973dda
|
|
@ -0,0 +1,90 @@
|
||||||
|
C0PEWD1 ; CCDCCR/GPL - ePrescription utilities; 12/6/08
|
||||||
|
;;0.1;CCDCCR;nopatch;noreleasedate
|
||||||
|
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||||||
|
;General Public License See attached copy of the License.
|
||||||
|
;
|
||||||
|
;This program is free software; you can redistribute it and/or modify
|
||||||
|
;it under the terms of the GNU General Public License as published by
|
||||||
|
;the Free Software Foundation; either version 2 of the License, or
|
||||||
|
;(at your option) any later version.
|
||||||
|
;
|
||||||
|
;This program is distributed in the hope that it will be useful,
|
||||||
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;GNU General Public License for more details.
|
||||||
|
;
|
||||||
|
;You should have received a copy of the GNU General Public License along
|
||||||
|
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||||||
|
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN
|
||||||
|
i $g(^%ZISH)["" d ; if the VistA Kernal routine %ZISH exists
|
||||||
|
. n zfile,zpath,ztmp s (zfile,zpath,ztmp)=""
|
||||||
|
. s zfile=$re($p($re(filepath),"/",1)) ;file name
|
||||||
|
. s zpath=$p(filepath,zfile,1) ; file path
|
||||||
|
. s ztmp=$na(^CacheTempEWD($j,0))
|
||||||
|
. s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2
|
||||||
|
q
|
||||||
|
;
|
||||||
|
TEST2 ;
|
||||||
|
s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml"
|
||||||
|
;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath)
|
||||||
|
s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global
|
||||||
|
s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0)
|
||||||
|
;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM")
|
||||||
|
w ok,!
|
||||||
|
q
|
||||||
|
;
|
||||||
|
GPLTEST ;
|
||||||
|
;s ok=$$httpGET^%zewdGTM("http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml",.gpl)
|
||||||
|
s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
|
||||||
|
s ok=$$httpGET^%zewdGTM(URL,.gpl)
|
||||||
|
S ZG=""
|
||||||
|
F S ZG=$O(gpl(ZG)) Q:ZG="" D ;
|
||||||
|
. s gpl(ZG)=$$CLEAN^C0PEWDU(gpl(ZG)) ;
|
||||||
|
. ;w gpl(ZG)
|
||||||
|
m ^CacheTempEWD($j)=gpl
|
||||||
|
b
|
||||||
|
s ok=$$parseDocument^%zewdHTMLParser("gpl2",0)
|
||||||
|
s ok=$$outputDOM^%zewdDOM("gpl2",1,1)
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
GPLTEST2 ;
|
||||||
|
s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
|
||||||
|
;s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output"
|
||||||
|
s ok=$$httpGET^%zewdGTM(URL,.gpl)
|
||||||
|
D INDEX^C0CXPATH("gpl","gpl2")
|
||||||
|
S G=""
|
||||||
|
F S G=$O(gpl2(G)) Q:G="" D ;
|
||||||
|
. W !,G," = ",gpl2(G)
|
||||||
|
W !
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
CLEAN(INX) ;DELETE NON-PRINTING CHARACTER IN INX, PASSED BY VALUE
|
||||||
|
;DON'T USE THIS -- IT DOESN'T WORK -- USE $$CLEAN^C0PEWDU
|
||||||
|
;N ZT,ZI
|
||||||
|
S ZT=""
|
||||||
|
F ZI=32:1:126 S ZT=ZT_$CHAR(ZI)
|
||||||
|
S ZZ=$TR(INX,ZT)
|
||||||
|
Q ZZ
|
||||||
|
;
|
||||||
|
LOAD(filepath) ; load an xml file into the EWD global for DOM processing
|
||||||
|
; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML)
|
||||||
|
; after to process it to the DOM - isHTML=0 for XML files
|
||||||
|
n i
|
||||||
|
i $g(^%ZISH)["" d QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09
|
||||||
|
. n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
|
||||||
|
. s zfile=$re($p($re(filepath),"/",1)) ;file name
|
||||||
|
. s zpath=$p(filepath,zfile,1) ; file path
|
||||||
|
. s ztmp=$na(^CacheTempEWD($j,0))
|
||||||
|
. s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2
|
||||||
|
. s i=$o(^CacheTempEWD($j,""),-1) ; highest line number
|
||||||
|
q i
|
||||||
|
;
|
||||||
|
Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED
|
||||||
|
I '$D(ZD) S ZD="DerekDOM"
|
||||||
|
s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ;
|
||||||
|
d displayNodes^%zewdXPath(.nodes)
|
||||||
|
q
|
||||||
|
;
|
||||||
|
|
@ -0,0 +1,51 @@
|
||||||
|
C0PEWD2 ; CCDCCR/GPL - ePrescription utilities; 4/24/09
|
||||||
|
;;0.1;CCDCCR;nopatch;noreleasedate
|
||||||
|
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
||||||
|
;General Public License See attached copy of the License.
|
||||||
|
;
|
||||||
|
;This program is free software; you can redistribute it and/or modify
|
||||||
|
;it under the terms of the GNU General Public License as published by
|
||||||
|
;the Free Software Foundation; either version 2 of the License, or
|
||||||
|
;(at your option) any later version.
|
||||||
|
;
|
||||||
|
;This program is distributed in the hope that it will be useful,
|
||||||
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;GNU General Public License for more details.
|
||||||
|
;
|
||||||
|
;You should have received a copy of the GNU General Public License along
|
||||||
|
;with this program; if not, write to the Free Software Foundation, Inc.,
|
||||||
|
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
TEST ;
|
||||||
|
s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
|
||||||
|
D GET1URL(URL) ;
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NCScript-RegisterLP.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/GenTestRenewalFDB.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxRxNorm.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt1.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt2.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseAccept.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseDeny.xml"
|
||||||
|
D GET1URL(URL)
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
GET1URL(URL) ;
|
||||||
|
s ok=$$httpGET^%zewdGTM(URL,.gpl)
|
||||||
|
D INDEX^C0CXPATH("gpl","gpl2")
|
||||||
|
W !,"S URL=""",URL,"""",!
|
||||||
|
S G=""
|
||||||
|
F S G=$O(gpl2(G)) Q:G="" D ;
|
||||||
|
. W " S VDX(""",G,""")=""",gpl2(G),"""",!
|
||||||
|
W !
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
|
@ -0,0 +1,34 @@
|
||||||
|
C0PEWDU ; WV/SMH - E-prescription utilities; Mar 3 2009
|
||||||
|
;;0.1;WV EPrescribing;;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
CLEAN(STR) ; extrinsic function; returns string
|
||||||
|
;; Removes all non printable characters from a string.
|
||||||
|
;; STR by Value
|
||||||
|
N TR,I
|
||||||
|
F I=0:1:31 S TR=$G(TR)_$C(I)
|
||||||
|
S TR=TR_$C(127)
|
||||||
|
QUIT $TR(STR,TR)
|
||||||
|
;
|
||||||
|
GETSOAP(ENTRY,REQUEST,RESULT) ; XML SOAP Spec for NewCrop
|
||||||
|
;; Gets world processing field from Fileman for Parsing
|
||||||
|
;; ENTRY Input by Value
|
||||||
|
;; REQUEST XML Output by Reference
|
||||||
|
;; RESULT XML Output by Reference
|
||||||
|
;; Example call: D GETSOAP^C0PEWDU("DrugAllergyInteraction",.REQ,.RES)
|
||||||
|
;
|
||||||
|
N OK,ERR,IEN,F ; if call is okay, Error, IEN, File
|
||||||
|
S F=175.101
|
||||||
|
S IEN=$$FIND1^DIC(F,"","",ENTRY,"B")
|
||||||
|
S OK=$$GET1^DIQ(F,IEN,2,"","REQUEST","ERR")
|
||||||
|
I OK=""!($D(ERR)) S REQUEST=""
|
||||||
|
; M ^CacheTempEWD($j)=REQUEST
|
||||||
|
; K REQUEST
|
||||||
|
; S ok=$$parseDocument^%zewdHTMLParser("REQUEST",0)
|
||||||
|
; S ok=$$outputDOM^%zewdDOM("REQUEST",1,1)
|
||||||
|
; Q ; remove later
|
||||||
|
K OK,ERR
|
||||||
|
S OK=$$GET1^DIQ(F,IEN,3,"","RESULT","ERR")
|
||||||
|
I OK=""!($D(ERR)) S RESULT=""
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,863 @@
|
||||||
|
%zewdGTM ;Enterprise Web Developer GT.M/ Virtual Appliance Functions
|
||||||
|
;
|
||||||
|
; Product: Enterprise Web Developer version 4.0.755
|
||||||
|
; Build Date: Thu, 12 Feb 2009 09:53:12
|
||||||
|
;
|
||||||
|
; ----------------------------------------------------------------------------
|
||||||
|
; | Enterprise Web Developer for GT.M and m_apache |
|
||||||
|
; | Copyright (c) 2004-9 M/Gateway Developments Ltd, |
|
||||||
|
; | Reigate, Surrey UK. |
|
||||||
|
; | All rights reserved. |
|
||||||
|
; | |
|
||||||
|
; | http://www.mgateway.com |
|
||||||
|
; | Email: rtweed@mgateway.com |
|
||||||
|
; | |
|
||||||
|
; | This program is free software: you can redistribute it and/or modify |
|
||||||
|
; | it under the terms of the GNU Affero General Public License as |
|
||||||
|
; | published by the Free Software Foundation, either version 3 of the |
|
||||||
|
; | License, or (at your option) any later version. |
|
||||||
|
; | |
|
||||||
|
; | This program is distributed in the hope that it will be useful, |
|
||||||
|
; | but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
||||||
|
; | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
||||||
|
; | GNU Affero General Public License for more details. |
|
||||||
|
; | |
|
||||||
|
; | You should have received a copy of the GNU Affero General Public License |
|
||||||
|
; | along with this program. If not, see <http://www.gnu.org/licenses/>. |
|
||||||
|
; ----------------------------------------------------------------------------
|
||||||
|
;
|
||||||
|
;
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
; EWD Virtual Appliance Version/Build
|
||||||
|
version()
|
||||||
|
QUIT "6.0"
|
||||||
|
;
|
||||||
|
buildDate()
|
||||||
|
QUIT "29 January 2009"
|
||||||
|
;
|
||||||
|
config ;
|
||||||
|
d setApplicationRootPath^%zewdAPI("/usr/ewd/apps")
|
||||||
|
d setOutputRootPath^%zewdAPI("/usr/php","php")
|
||||||
|
;s ^%eXtc("system","license")="2vxuxs3qzqxuyuvtynezvm8yy5Wrz4i7wwwrzmsvqwwtr"
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
getMGWSIPid()
|
||||||
|
;
|
||||||
|
n io,ok,line,stop,temp
|
||||||
|
s io=$io
|
||||||
|
s temp="temp"_$p($h,",",2)_".txt"
|
||||||
|
zsystem "ps -A|grep mgwsi > "_temp
|
||||||
|
o temp:(readonly:exception="g nsFileNotExists")
|
||||||
|
u temp
|
||||||
|
r line
|
||||||
|
c temp
|
||||||
|
u io
|
||||||
|
s ok=$$deleteFile^%zewdAPI(temp)
|
||||||
|
s line=$$stripSpaces^%zewdAPI(line)
|
||||||
|
QUIT +line
|
||||||
|
startMGWSI ;
|
||||||
|
k ^%zewd("mgwsis")
|
||||||
|
d START^%ZMGWSI(0)
|
||||||
|
;s ^%zewd("mgwsi","job")=$zjob
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
stopMGWSI ;
|
||||||
|
n pid
|
||||||
|
;s pid=$g(^%zewd("mgwsi","job"))
|
||||||
|
;s pid=$$getMGWSIPid()
|
||||||
|
;i pid'="" d
|
||||||
|
;. k ^%zewd("mgwsi","job")
|
||||||
|
;. i $$pidExists(pid) zsystem "kill -TERM "_pid
|
||||||
|
s pid=""
|
||||||
|
f s pid=$o(^%zewd("mgwsis",pid)) q:pid="" d
|
||||||
|
. k ^%zewd("mgwsis",pid)
|
||||||
|
. i $$pidExists(pid) zsystem "kill -TERM "_pid
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
restartMGWSI
|
||||||
|
d stopMGWSI
|
||||||
|
d startMGWSI
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
closeMGWSI(server)
|
||||||
|
; eg server=the MGWSI "server" to be closed, eg ewd, LOCAL, etc
|
||||||
|
n ok,html,url
|
||||||
|
s url="http://127.0.0.1:7040/cgi-bin/nph-mgwsic?mgwsidef=Default_CloseDown_Server&mgwsiSYS=2&mgwsiCDN="_server_"&mgwsiSYSbOK=Close+Connections(s)"
|
||||||
|
s ok=$$httpGET(url,.html)
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
closeMGWSIConnections
|
||||||
|
n pid
|
||||||
|
s pid=""
|
||||||
|
f s pid=$o(^%zewd("mgwsis",pid)) q:pid="" d
|
||||||
|
. k ^%zewd("mgwsis",pid)
|
||||||
|
. i $$pidExists(pid) zsystem "kill -TERM "_pid
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
shutdown
|
||||||
|
zsystem "shutdown -h now"
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
restart
|
||||||
|
zsystem "shutdown -r now"
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
pidExists(pid) ;
|
||||||
|
n io,line,ok,temp
|
||||||
|
s io=$io
|
||||||
|
s temp="temp"_$p($h,",",2)_".txt"
|
||||||
|
zsystem "ps --no-heading "_pid_" > "_temp
|
||||||
|
c temp
|
||||||
|
o temp:(readonly:exception="g pidFileNotExists")
|
||||||
|
u temp r line
|
||||||
|
c temp
|
||||||
|
u io
|
||||||
|
s ok=$$deleteFile^%zewdAPI(temp)
|
||||||
|
i line'[pid QUIT 0
|
||||||
|
QUIT 1
|
||||||
|
pidFileNotExists
|
||||||
|
c temp
|
||||||
|
s ok=$$deleteFile^%zewdAPI(temp)
|
||||||
|
u io
|
||||||
|
i $p($zs,",",1)=2 QUIT 0
|
||||||
|
QUIT 0
|
||||||
|
;
|
||||||
|
validDomain(domain)
|
||||||
|
;
|
||||||
|
n exists,io,ok,line,stop,temp
|
||||||
|
s io=$io
|
||||||
|
s temp="temp"_$p($h,",",2)_".txt"
|
||||||
|
zsystem "nslookup "_domain_" >"_temp
|
||||||
|
o temp:(readonly:exception="g nsFileNotExists")
|
||||||
|
u temp
|
||||||
|
s stop=0,exists=0
|
||||||
|
f r line d q:stop
|
||||||
|
. i line["authoritative answer" s stop=1,exists=1 q
|
||||||
|
. i line["server can't find" s stop=1,exists=0 q
|
||||||
|
c temp
|
||||||
|
u io
|
||||||
|
s ok=$$deleteFile^%zewdAPI(temp)
|
||||||
|
QUIT exists
|
||||||
|
nsFileNotExists
|
||||||
|
u io
|
||||||
|
i $p($zs,",",1)=2 QUIT -1
|
||||||
|
QUIT -1
|
||||||
|
;
|
||||||
|
getIP(info)
|
||||||
|
;
|
||||||
|
n exists,io,ip,ok,line,stop,temp,value
|
||||||
|
s io=$io
|
||||||
|
s temp="temp"_$p($h,",",2)_".txt"
|
||||||
|
zsystem "ifconfig eth0 >"_temp
|
||||||
|
o temp:(readonly:exception="g ipFileNotExists")
|
||||||
|
u temp
|
||||||
|
s stop=0,ok=0,ip=""
|
||||||
|
f r line d q:stop
|
||||||
|
. i line["HWaddr" d
|
||||||
|
. . s value=$p(line,"HWaddr ",2)
|
||||||
|
. . s info("mac")=$$stripSpaces^%zewdAPI(value)
|
||||||
|
. i line["inet addr:" d
|
||||||
|
. . s value=$p(line,"inet addr:",2)
|
||||||
|
. . s ip=$p(value," ",1)
|
||||||
|
. . s info("ip")=ip
|
||||||
|
. . i ip="127.0.0.1" s stop=1
|
||||||
|
. i line["Bcast:" d
|
||||||
|
. . s value=$p(line,"Bcast:",2)
|
||||||
|
. . s value=$p(value," ",1)
|
||||||
|
. . s info("broadcast")=value
|
||||||
|
. i line["Mask:" d
|
||||||
|
. . s value=$p(line,"Mask:",2)
|
||||||
|
. . s value=$p(value," ",1)
|
||||||
|
. . s info("mask")=value
|
||||||
|
. i line["inet6 addr" s stop=1 q
|
||||||
|
. i line["Local Lookback" s stop=1 q
|
||||||
|
c temp
|
||||||
|
u io
|
||||||
|
s ok=$$deleteFile^%zewdAPI(temp)
|
||||||
|
QUIT ip
|
||||||
|
ipFileNotExists
|
||||||
|
s $zt=""
|
||||||
|
u io
|
||||||
|
i $p($zs,",",1)=2 QUIT -1
|
||||||
|
QUIT ""
|
||||||
|
;
|
||||||
|
openTCP(host,port,timeout)
|
||||||
|
n delim,dev
|
||||||
|
i host'?1N.N1"."1N.N1"."1N.N1"."1N.N,'$$validDomain(host) QUIT 0
|
||||||
|
i $g(host)="" QUIT 0
|
||||||
|
i $g(port)="" QUIT 0
|
||||||
|
i $g(timeout)="" s timeout=20
|
||||||
|
s delim=$c(13)
|
||||||
|
s dev="client$"_$p($h,",",2)
|
||||||
|
o dev:(connect=host_":"_port_":TCP":attach="client":exception="g tcperr"):timeout:"SOCKET"
|
||||||
|
QUIT dev
|
||||||
|
;
|
||||||
|
tcperr ;
|
||||||
|
QUIT 0
|
||||||
|
;
|
||||||
|
resetSecurity
|
||||||
|
;
|
||||||
|
k ^%zewd("config","security","validSubnet")
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
resetVM
|
||||||
|
n files
|
||||||
|
d resetSecurity
|
||||||
|
k ^%zewdSession
|
||||||
|
s ^%zewd("nextSessid")=1
|
||||||
|
k ^%zewd("mgwsi")
|
||||||
|
k ^%zewd("mgwsis")
|
||||||
|
k ^%zewd("emailQueue")
|
||||||
|
k ^%zewd("daemon","email")
|
||||||
|
k ^%zewd("relink")
|
||||||
|
k ^%eXtc
|
||||||
|
k ^%zewdLog
|
||||||
|
k ^%zewdError
|
||||||
|
k ^CacheTempUserNode
|
||||||
|
k ^CacheTempEWD
|
||||||
|
k ^%zewdTrace
|
||||||
|
k ^zewd("trace")
|
||||||
|
k ^%MGW,^%MGWSI
|
||||||
|
k ^rob,^robdata,^robcgi
|
||||||
|
k ^CacheTempWLD
|
||||||
|
k ^ewdDemo
|
||||||
|
d removeDOMsByPrefix^%zewdAPI()
|
||||||
|
;d getFilesInPath^%zewdHTMLParser("/usr/local/gtm/ewd",".m",.files)
|
||||||
|
;f lineNo=1:1 s line=$t(leaveAsM+lineNo) q:line["***END***" d
|
||||||
|
;. s leaveFiles($p(line,";;",2))=""
|
||||||
|
; s file=""
|
||||||
|
;f s file=$o(files(file)) q:file="" d
|
||||||
|
;. i $d(leaveFiles(file)) q
|
||||||
|
;. i file'["_zewd" q
|
||||||
|
;. s path="/usr/local/gtm/ewd/"_file
|
||||||
|
; . s ok=$$deleteFile^%zewdAPI(path)
|
||||||
|
; s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDB.m")
|
||||||
|
; s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBMgr.m")
|
||||||
|
;s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBConfig.m")
|
||||||
|
s ok=$$deleteFile^%zewdAPI("/usr/MDB/MDB.conf")
|
||||||
|
k ^MDB,^MDBUAF
|
||||||
|
zsystem "rm -f ~/.bash_history"
|
||||||
|
zsystem "history -c"
|
||||||
|
;echo " "> /var/log/apache2/access.log
|
||||||
|
;echo " "> /var/log/apache2/error.log
|
||||||
|
;echo " "> /var/log/apache2/access.log.1"
|
||||||
|
;echo " "> /var/log/apache2/error.log.1"
|
||||||
|
;zsystem "rm /usr/php/tutorial/*.*"
|
||||||
|
; Now clear down history for root
|
||||||
|
; Shutdown Apache and clear down Apache Log files - use above commented commands
|
||||||
|
; Delete all ewdapps directories and files
|
||||||
|
; Delete all PHP directories and files
|
||||||
|
; zero-space all empty content: cat /dev/zero > zero.fill;sync;sleep 1;sync;rm -f zero.fill
|
||||||
|
; Compress the virtual drives:
|
||||||
|
; G:\virtual_machines\mdb_1_0_master>"C:\Program Files\VMware\VMware Server\vmware-vdiskmanager.exe" -k Ubuntu-cl1.vmdk
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
setClock
|
||||||
|
zsystem "ntpdate ntp.ubuntu.com"
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
startVM
|
||||||
|
;
|
||||||
|
n cr,ip
|
||||||
|
s cr=$c(13)
|
||||||
|
d startMGWSI
|
||||||
|
w cr,!
|
||||||
|
d setClock
|
||||||
|
s ip=$$getIP()
|
||||||
|
w cr,!
|
||||||
|
w "======================================================="_cr,!
|
||||||
|
w " Welcome to the EWD Virtual Appliance "_cr,!
|
||||||
|
w " -- Version "_$$version()_": "_$$buildDate()_" --"_cr,!
|
||||||
|
;
|
||||||
|
i ip=""!(ip="127.0.0.1") g startVMFail
|
||||||
|
w !
|
||||||
|
w " System clock set to "_$$inetDate^%zewdAPI($h)_cr,!!
|
||||||
|
w " The EWD Virtual Appliance is now ready for use!"_cr,!
|
||||||
|
w " To run the EWD Management Portal, point your browser at http://"_ip_cr,!!
|
||||||
|
g startVMFin
|
||||||
|
startVMFail
|
||||||
|
w "Unfortunately the Virtual Appliance was unable to acquire an IP"_cr,!
|
||||||
|
w "address. Please consult the readme file for what to do next"_cr,!
|
||||||
|
startVMFin
|
||||||
|
w "======================================================="_cr,!
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
startMDBVM
|
||||||
|
;
|
||||||
|
n cr,ip
|
||||||
|
s cr=$c(13)
|
||||||
|
d startMGWSI
|
||||||
|
w cr,!
|
||||||
|
d setClock
|
||||||
|
s ip=$$getIP()
|
||||||
|
w cr,!
|
||||||
|
w "======================================================="_cr,!
|
||||||
|
w " Welcome to the M/DB Virtual Appliance "_cr,!
|
||||||
|
w " -- Version "_$$version()_": "_$$buildDate()_" --"_cr,!
|
||||||
|
;
|
||||||
|
i ip=""!(ip="127.0.0.1") g startVMFail
|
||||||
|
w !
|
||||||
|
w " System clock set to "_$$inetDate^%zewdAPI($h)_cr,!!
|
||||||
|
w " The M/DB Virtual Appliance is now ready for use!"_cr,!
|
||||||
|
w " To run the M/DB Management Portal, point your browser at http://"_ip_cr,!!
|
||||||
|
g startVMFin
|
||||||
|
;
|
||||||
|
httpGET(url,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
|
||||||
|
;
|
||||||
|
n dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
|
||||||
|
;
|
||||||
|
k rawResponse,html
|
||||||
|
s HTTPVersion="1.0"
|
||||||
|
s rawURL=url
|
||||||
|
s ssl=0
|
||||||
|
s port=80
|
||||||
|
s urllc=$$zcvt^%zewdAPI(url,"l")
|
||||||
|
i $e(urllc,1,7)="http://" d
|
||||||
|
. s url=$e(url,8,$l(url))
|
||||||
|
. s sslHost=$p(url,"/",1)
|
||||||
|
. s sslPort=80
|
||||||
|
. i sslHost[":" d
|
||||||
|
. . s sslPort=$p(sslHost,":",2)
|
||||||
|
. . s sslHost=$p(sslHost,":",1)
|
||||||
|
e i $e(urllc,1,8)="https://" d
|
||||||
|
. s url=$e(url,9,$l(url))
|
||||||
|
. s ssl=1
|
||||||
|
. s sslHost=$g(sslHost)
|
||||||
|
. i sslHost="" s sslHost="127.0.0.1"
|
||||||
|
. s sslPort=$g(sslPort)
|
||||||
|
. i sslPort="" s sslPort=89
|
||||||
|
e QUIT "Invalid URL"
|
||||||
|
s host=$p(url,"/",1)
|
||||||
|
i host[":" d
|
||||||
|
. s port=$p(host,":",2)
|
||||||
|
. s host=$p(host,":",1)
|
||||||
|
s url="/"_$p(url,"/",2,5000)
|
||||||
|
i $g(timeout)="" s timeout=20
|
||||||
|
;
|
||||||
|
s io=$io
|
||||||
|
i $g(test)'=1 d
|
||||||
|
. s dev=$$openTCP(sslHost,sslPort,timeout)
|
||||||
|
. u dev
|
||||||
|
i ssl d
|
||||||
|
. w "GET "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
|
||||||
|
e d
|
||||||
|
. w "GET "_url_" HTTP/"_HTTPVersion_$c(13,10)
|
||||||
|
w "Host: "_host
|
||||||
|
i port'=80 w ":"_port
|
||||||
|
w $c(13,10)
|
||||||
|
w "Accept: */*"_$c(13,10)
|
||||||
|
;
|
||||||
|
i $d(headerArray) d
|
||||||
|
. n n
|
||||||
|
. s n=""
|
||||||
|
. f s n=$o(headerArray(n)) q:n="" d
|
||||||
|
. . w headerArray(n)_$c(13,10)
|
||||||
|
;
|
||||||
|
w $c(13,10),!
|
||||||
|
;
|
||||||
|
; That's the request sent !
|
||||||
|
;
|
||||||
|
httpResponse ;
|
||||||
|
;
|
||||||
|
i $g(test)=1 QUIT ""
|
||||||
|
n c,dlim,header,i,no,pos,rlen,stop,str
|
||||||
|
;
|
||||||
|
k respHeaders
|
||||||
|
s stop=0,no=1
|
||||||
|
f i=1:1 d q:stop
|
||||||
|
. i i=1
|
||||||
|
. r c#1
|
||||||
|
. i c=$c(13) q
|
||||||
|
. i c'=$c(10) s respHeaders(no)=$g(respHeaders(no))_c
|
||||||
|
. i c=$c(10),$g(respHeaders(no))="" s stop=1 q
|
||||||
|
. i c=$c(10) s no=no+1
|
||||||
|
;
|
||||||
|
s rlen=999999
|
||||||
|
f i=1:1:(no-1) d
|
||||||
|
. s header=$$zcvt^%zewdAPI(respHeaders(i),"l")
|
||||||
|
. i header["content-length" d
|
||||||
|
. . s rlen=$p(header,":",2)
|
||||||
|
. . s rlen=$$stripSpaces^%zewdAPI(rlen)
|
||||||
|
;
|
||||||
|
i rlen<999999 d
|
||||||
|
. r str#rlen
|
||||||
|
e d
|
||||||
|
. s str=""
|
||||||
|
. f pos=1:1 r str#rlen:timeout g:'$t httpTimeout q:str="" s str(pos)=str q:($l(str)<999999)
|
||||||
|
i $g(test)'=1 c dev
|
||||||
|
s dlim=$c(10)
|
||||||
|
i str[$c(13,10) s dlim=$c(13,10)
|
||||||
|
s rlen=$l(str,dlim)
|
||||||
|
f i=1:1:rlen s html(i)=$p(str,dlim,i)
|
||||||
|
s rawResponse=""
|
||||||
|
f i=1:1:(no-1) s rawResponse=rawResponse_respHeaders(i)_dlim
|
||||||
|
s rawResponse=rawResponse_dlim_str
|
||||||
|
;
|
||||||
|
u io
|
||||||
|
QUIT ""
|
||||||
|
;
|
||||||
|
httpTimeout
|
||||||
|
QUIT "Timed out waiting for response"
|
||||||
|
;
|
||||||
|
httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort)
|
||||||
|
;
|
||||||
|
n contentLength,dev,host,HTTPVersion,io,port,rawURL,ssl,urllc
|
||||||
|
;
|
||||||
|
k rawResponse,html
|
||||||
|
s HTTPVersion="1.0"
|
||||||
|
s rawURL=url
|
||||||
|
s ssl=0
|
||||||
|
s port=80
|
||||||
|
s urllc=$$zcvt^%zewdAPI(url,"l")
|
||||||
|
i $e(urllc,1,7)="http://" d
|
||||||
|
. s url=$e(url,8,$l(url))
|
||||||
|
. s sslHost=$p(url,"/",1)
|
||||||
|
. s sslPort=80
|
||||||
|
e i $e(urllc,1,8)="https://" d
|
||||||
|
. s url=$e(url,9,$l(url))
|
||||||
|
. s ssl=1
|
||||||
|
. s sslHost=$g(sslHost)
|
||||||
|
. i sslHost="" s sslHost="127.0.0.1"
|
||||||
|
. s sslPort=$g(sslPort)
|
||||||
|
. i sslPort="" s sslPort=89
|
||||||
|
e QUIT "Invalid URL"
|
||||||
|
s host=$p(url,"/",1)
|
||||||
|
i host[":" d
|
||||||
|
. s port=$p(host,":",2)
|
||||||
|
. s host=$p(host,":",1)
|
||||||
|
s url="/"_$p(url,"/",2,5000)
|
||||||
|
i $g(timeout)="" s timeout=20
|
||||||
|
;
|
||||||
|
s io=$io
|
||||||
|
i $g(test)'=1 d
|
||||||
|
. s dev=$$openTCP(sslHost,sslPort,timeout)
|
||||||
|
. u dev
|
||||||
|
i ssl d
|
||||||
|
. w "POST "_rawURL_" HTTP/"_HTTPVersion_$c(13,10)
|
||||||
|
e d
|
||||||
|
. w "POST "_url_" HTTP/"_HTTPVersion_$c(13,10)
|
||||||
|
w "Host: "_host
|
||||||
|
i port'=80 w ":"_port
|
||||||
|
w $c(13,10)
|
||||||
|
w "Accept: */*"_$c(13,10)
|
||||||
|
;
|
||||||
|
i $d(headerArray) d
|
||||||
|
. n n
|
||||||
|
. s n=""
|
||||||
|
. f s n=$o(headerArray(n)) q:n="" d
|
||||||
|
. . w headerArray(n)_$c(13,10)
|
||||||
|
;
|
||||||
|
s mimeType=$g(mimeType)
|
||||||
|
i mimeType="" s mimeType="application/x-www-form-urlencoded"
|
||||||
|
s contentLength=0
|
||||||
|
i $d(payload) d
|
||||||
|
. n no
|
||||||
|
. s no=""
|
||||||
|
. f s no=$O(payload(no)) q:no="" D
|
||||||
|
. . s contentLength=contentLength+$l(payload(no))
|
||||||
|
. s contentLength=contentLength
|
||||||
|
. w "Content-Type: ",mimeType
|
||||||
|
. i $g(charset)'="" w "; charset=""",charset,""""
|
||||||
|
. w $c(13,10)
|
||||||
|
. w "Content-Length: ",contentLength,$c(13,10)
|
||||||
|
;
|
||||||
|
w $c(13,10)
|
||||||
|
i $D(payload) d
|
||||||
|
. n no
|
||||||
|
. s no=""
|
||||||
|
. f s no=$O(payload(no)) q:no="" d
|
||||||
|
. . w payload(no)
|
||||||
|
;
|
||||||
|
w $c(13,10),!
|
||||||
|
;
|
||||||
|
; That's the request sent !
|
||||||
|
;
|
||||||
|
g httpResponse
|
||||||
|
;
|
||||||
|
parseURL(url,docName)
|
||||||
|
;
|
||||||
|
n getPath,ok,server
|
||||||
|
;
|
||||||
|
i url["http://" s url=$p(url,"http://",2)
|
||||||
|
s server=$p(url,"/",1)
|
||||||
|
s getPath=$p(url,"/",2,1000)
|
||||||
|
s ok=$$parseURL^%zewdHTMLParser(server,getPath,docName)
|
||||||
|
QUIT ok
|
||||||
|
;
|
||||||
|
smtpSend(domain,from,displayFrom,to,displayTo,ccList,subject,message,dialog,authType,username,password,timeout,gmtOffset,port)
|
||||||
|
;
|
||||||
|
n attach,boundary,crlf,date,dev,error,io,mess,rcpt,resp,sent,toList
|
||||||
|
;
|
||||||
|
s timeout=$g(timeout) i timeout="" s timeout=10
|
||||||
|
s domain=$g(domain)
|
||||||
|
s port=$g(port) i port="" s port=25
|
||||||
|
s from=$g(from)
|
||||||
|
s to=$g(to)
|
||||||
|
s subject=$g(subject)
|
||||||
|
s gmtOffset=$g(gmtOffset) i gmtOffset="" s gmtOffset="GMT"
|
||||||
|
;
|
||||||
|
s error=""
|
||||||
|
i domain="" QUIT "No SMTP Domain specified"
|
||||||
|
i from="" QUIT "No sender's email address specified"
|
||||||
|
i to="" QUIT "No recipient's email address specified"
|
||||||
|
i '$d(message) QUIT "No Email content specified"
|
||||||
|
;
|
||||||
|
s date=$$inetDate^%zewdAPI($h)_" "_gmtOffset
|
||||||
|
s mess($increment(mess))="Date: "_date
|
||||||
|
i $g(displayFrom)'="" d
|
||||||
|
. s mess($increment(mess))="From: """_displayFrom_"""<"_from_">"
|
||||||
|
e d
|
||||||
|
. s mess($increment(mess))="From: "_from
|
||||||
|
i $g(displayTo)'="" d
|
||||||
|
. s mess($increment(mess))="To: """_displayTo_"""<"_to_">"
|
||||||
|
e d
|
||||||
|
. s mess($increment(mess))="To: "_to
|
||||||
|
s toList(to)=""
|
||||||
|
i $d(ccList) d
|
||||||
|
. n name
|
||||||
|
. s mess($increment(mess))="Cc: "
|
||||||
|
. i $g(ccList)'="" d
|
||||||
|
. . s toList(ccList)=""
|
||||||
|
. . s mess(mess)=mess(mess)_ccList
|
||||||
|
. s name=""
|
||||||
|
. f s name=$o(ccList(name)) q:name="" d
|
||||||
|
. . i mess(mess)'="Cc: " s mess(mess)=mess(mess)_", "
|
||||||
|
. . s mess(mess)=mess(mess)_name
|
||||||
|
. . s toList(name)=""
|
||||||
|
s mess($increment(mess))="Subject: "_subject
|
||||||
|
s mess($increment(mess))="X-Priority: 3 (Normal)"
|
||||||
|
s mess($increment(mess))="X-MSMail-Priority: Normal"
|
||||||
|
s mess($increment(mess))="X-Mailer: "_$$version^%zewdAPI()
|
||||||
|
s mess($increment(mess))="MIME-Version: 1.0"
|
||||||
|
s mess($increment(mess))="Content-Type: text/plain; charset=""us-ascii"""
|
||||||
|
s mess($increment(mess))="Content-Transfer-Encoding: 7bit"
|
||||||
|
s mess($increment(mess))=""
|
||||||
|
;
|
||||||
|
s message=$g(message)
|
||||||
|
i message'="" d
|
||||||
|
. s mess($increment(mess))=message
|
||||||
|
e d
|
||||||
|
. n mlno
|
||||||
|
. s mlno=""
|
||||||
|
. f s mlno=$o(message(mlno)) q:mlno="" d
|
||||||
|
. . s mess($increment(mess))=message(mlno)
|
||||||
|
;
|
||||||
|
k dialog
|
||||||
|
s io=$io
|
||||||
|
s crlf=$c(13,10)
|
||||||
|
s dev=$$openTCP(server,port,timeout)
|
||||||
|
i dev=0 QUIT "Unable to connect to SMTP server: "_server
|
||||||
|
u dev
|
||||||
|
r resp:timeout e d close QUIT "Unable to initiate connection with SMTP server"
|
||||||
|
s resp=$p(resp,crlf,1)
|
||||||
|
s dialog($increment(dialog))=resp
|
||||||
|
s error=""
|
||||||
|
s authType=$g(authType)
|
||||||
|
i authType="LOGIN PLAIN"!(authType="LOGIN") d i error'="" d close QUIT error
|
||||||
|
. n context,decode,passB64,str,userB64
|
||||||
|
. s context=1
|
||||||
|
. i $d(^zewd("config","MGWSI")) s context=0
|
||||||
|
. u dev w "EHLO "_domain_crlf,! s resp=$$read(.dialog)
|
||||||
|
. i resp'["250",resp'["AUTH",resp'["LOGIN" s error="Authentication type LOGIN/LOGIN PLAIN not supported on this server" q
|
||||||
|
. u dev w "AUTH LOGIN"_crlf,! s resp=$$read(.dialog)
|
||||||
|
. i resp'["334" s error="No username authentication challenge from server" q
|
||||||
|
. s str=$p(resp," ",2,1000)
|
||||||
|
. s decode=$$DB64^%ZMGWSIS(str,context)
|
||||||
|
. s resp="(decoded as : "_decode_")"
|
||||||
|
. s dialog($increment(dialog))=resp
|
||||||
|
. s userB64=$$B64^%ZMGWSIS(username,context)
|
||||||
|
. u dev w userB64_crlf,! s resp=$$read(.dialog)
|
||||||
|
. i resp'["334" s error="No password authentication challenge from server" q
|
||||||
|
. s str=$p(resp," ",2,1000)
|
||||||
|
. s decode=$$DB64^%ZMGWSIS(str,context)
|
||||||
|
. s resp="(decoded as : "_decode_")"
|
||||||
|
. s dialog($increment(dialog))=resp
|
||||||
|
. s passB64=$$B64^%ZMGWSIS(password,context)
|
||||||
|
. u dev w passB64_crlf,! s resp=$$read(.dialog)
|
||||||
|
. i resp'["235 " s error=resp q
|
||||||
|
e d i error'="" d close QUIT error
|
||||||
|
. u dev w "HELO "_domain_crlf,! s resp=$$read(.dialog)
|
||||||
|
. i resp'["250" s error=resp
|
||||||
|
;
|
||||||
|
u dev w "MAIL FROM: "_from_crlf,! s resp=$$read(.dialog)
|
||||||
|
i resp'["250" d close QUIT resp
|
||||||
|
;
|
||||||
|
s rcpt=""
|
||||||
|
f s rcpt=$o(toList(rcpt)) q:rcpt="" d i resp'[250 q
|
||||||
|
. u dev w "RCPT TO: <"_rcpt_">"_$c(13,10),!
|
||||||
|
. s resp=$$read(.dialog)
|
||||||
|
i resp'[250 d close QUIT resp
|
||||||
|
;
|
||||||
|
u dev w "DATA",crlf,! s resp=$$read(.dialog)
|
||||||
|
i resp'["250",resp'["354" d close QUIT resp
|
||||||
|
;
|
||||||
|
s message=$g(message)
|
||||||
|
i message'="" d message(message,dev)
|
||||||
|
e d
|
||||||
|
. n line,lineNo
|
||||||
|
. s lineNo=""
|
||||||
|
. f s lineNo=$o(mess(lineNo)) q:lineNo="" d
|
||||||
|
. . s line=mess(lineNo)
|
||||||
|
. . d message(line,dev)
|
||||||
|
u dev w crlf,".",crlf,! s resp=$$read(.dialog)
|
||||||
|
i resp'["250" d close QUIT resp
|
||||||
|
u dev w "QUIT",crlf,! s resp=$$read(.dialog)
|
||||||
|
d close
|
||||||
|
QUIT ""
|
||||||
|
;
|
||||||
|
read(dialog)
|
||||||
|
n resp
|
||||||
|
r resp
|
||||||
|
s resp=$p(resp,$c(13,10),1)
|
||||||
|
s dialog($increment(dialog))=resp
|
||||||
|
QUIT resp
|
||||||
|
close ;
|
||||||
|
c dev
|
||||||
|
u io
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
message(line,dev)
|
||||||
|
n buf,p1
|
||||||
|
s buf=$g(line)
|
||||||
|
i buf="" u dev w $c(13,10),! QUIT
|
||||||
|
f q:buf="" d
|
||||||
|
. s p1=$e(buf,1,254),buf=$e(buf,255,$l(buf))
|
||||||
|
. i $e(p1)="." s p1="."_p1
|
||||||
|
. i $l(p1) u dev w p1,!
|
||||||
|
u dev w $c(13,10),!
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
smtpTest
|
||||||
|
s server="relay.xxxx.net"
|
||||||
|
s from="rtweed@xxxxx.com"
|
||||||
|
s displayFrom="Rob Tweed"
|
||||||
|
s displayTo=displayFrom
|
||||||
|
s to="rtweed@xxxx.co.uk"
|
||||||
|
s ccList("rtweed@yyyy.co.uk")=""
|
||||||
|
s ccList("rtweed@zzzz.com")=""
|
||||||
|
s message(1)="Test Message"
|
||||||
|
s message(2)="This is line 2"
|
||||||
|
s message(3)="And here is line 3"
|
||||||
|
s authType="LOGIN PLAIN"
|
||||||
|
s user="xxxxxxxxx"
|
||||||
|
s pass="yyyyyyyyy"
|
||||||
|
s subject="Test email 2"
|
||||||
|
s ok=$$smtpSend(server,from,displayFrom,to,displayTo,.ccList,subject,.message,.dialog,authType,user,pass)
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
getFileInfo(path,ext,info) ; Get list of files with specified extension
|
||||||
|
;
|
||||||
|
n date,dlim,%file,%io,lineNo,ok,os,%p1,result,time,%x,%y
|
||||||
|
;
|
||||||
|
k info
|
||||||
|
s dlim="/"
|
||||||
|
i $e(ext,1)'="." s ext="."_ext
|
||||||
|
i $e(path,$l(path))=dlim s path=$e(path,1,$l(path)-1)
|
||||||
|
;
|
||||||
|
d shellCommand("ls -l """_path_"""",.result)
|
||||||
|
;
|
||||||
|
; we now have directory listing in result array
|
||||||
|
s lineNo=""
|
||||||
|
f s lineNo=$o(result(lineNo)) q:lineNo="" d
|
||||||
|
. s %file=result(lineNo)
|
||||||
|
. s %p1=$P(%file," ",1)
|
||||||
|
. i $e(%p1,1)'="d" d
|
||||||
|
. . n %e1,%e2,%rfile,%p9,%len,%name,size
|
||||||
|
. . s %rfile=$re(%file)
|
||||||
|
. . s %rfile=$$replaceAll^%zewdAPI(%rfile," "," ")
|
||||||
|
. . s %p9=$p(%rfile," ",1)
|
||||||
|
. . s time=$p(%rfile," ",2)
|
||||||
|
. . s date=$p(%rfile," ",3,4)
|
||||||
|
. . s size=$p(%rfile," ",5)
|
||||||
|
. . s %p9=$re(%p9)
|
||||||
|
. . s time=$re(time)
|
||||||
|
. . s date=$re(date)
|
||||||
|
. . ;i $$zcvt^%zewdAPI(%p9,"l")=$$zcvt^%zewdAPI(%tofile,"l") q ; ignore temp file
|
||||||
|
. . i ext=".*" s info(%p9)=date_$c(1)_time_$c(1)_size q
|
||||||
|
. . s %e1="."_$$getFileExtension^%zewdHTMLParser(%p9)
|
||||||
|
. . i %e1'=ext q
|
||||||
|
. . s info(%p9)=date_$c(1)_time_$c(1)_size
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
shellPipe ; Pipe output from shell commands to scratch global
|
||||||
|
;
|
||||||
|
n i,x
|
||||||
|
;
|
||||||
|
k ^%mgwPipe
|
||||||
|
f i=1:1:200 r x q:((i>20)&(x="")) s ^%mgwPipe(i)=x
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
deletePipe
|
||||||
|
k ^%mgwPipe
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
lockPipe
|
||||||
|
l +^%mgwPipe
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
unlockPipe
|
||||||
|
l -^%mgwPipe
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
shellCommand(command,result) ;
|
||||||
|
n lineNo
|
||||||
|
k result
|
||||||
|
d lockPipe
|
||||||
|
zsystem command_" |mumps -run shellPipe^%zewdGTM"
|
||||||
|
m result=^%mgwPipe
|
||||||
|
d deletePipe
|
||||||
|
d unlockPipe
|
||||||
|
s lineNo=""
|
||||||
|
f s lineNo=$o(result(lineNo),-1) q:lineNo="" q:result(lineNo)'="" k result(lineNo)
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
fileInfo(path,info)
|
||||||
|
n line,temp
|
||||||
|
k info
|
||||||
|
s temp="temp"_$p($h,",",2)_".txt"
|
||||||
|
i '$$fileExists^%zewdAPI(path) QUIT
|
||||||
|
zsystem "ls -l "_path_">"_temp
|
||||||
|
o temp:(readonly:exception="g fileDateNotExists")
|
||||||
|
u temp
|
||||||
|
r line
|
||||||
|
s info("date")=$p(line," ",6,8)
|
||||||
|
s info("size")=$p(line," ",5)
|
||||||
|
c temp
|
||||||
|
s ok=$$deleteFile^%zewdAPI(temp)
|
||||||
|
QUIT
|
||||||
|
fileDateNotExists
|
||||||
|
s $zt=""
|
||||||
|
i $p($zs,",",1)=2 QUIT
|
||||||
|
QUIT
|
||||||
|
shell(command,result)
|
||||||
|
n i,io,temp
|
||||||
|
k result
|
||||||
|
s io=$io
|
||||||
|
s temp="temp"_$p($h,",",2)_".txt"
|
||||||
|
zsystem command_">"_temp
|
||||||
|
o temp:(readonly)
|
||||||
|
u temp:exception="g eoshell"
|
||||||
|
f i=1:1 r result(i)
|
||||||
|
eoshell ;
|
||||||
|
c temp
|
||||||
|
u io
|
||||||
|
s ok=$$deleteFile^%zewdAPI(temp)
|
||||||
|
QUIT i-1
|
||||||
|
;
|
||||||
|
testGlobal()
|
||||||
|
s start=$h
|
||||||
|
f i=1:1:1000 d fileInfo^%zewdAPI("/usr/php/ewdMgr/user.php",.info)
|
||||||
|
s end=$h
|
||||||
|
s dur=$p(end,",",2)-$p(start,",",2)
|
||||||
|
QUIT dur
|
||||||
|
;
|
||||||
|
testFile()
|
||||||
|
s start=$h
|
||||||
|
f i=1:1:1000 d fileInfo^%zewdGTM("/usr/php/ewdMgr/user.php",.info)
|
||||||
|
s end=$h
|
||||||
|
s dur=$p(end,",",2)-$p(start,",",2)
|
||||||
|
QUIT dur
|
||||||
|
;
|
||||||
|
mySQL(sql,resultArray,username,password,database)
|
||||||
|
n nlines,str
|
||||||
|
;
|
||||||
|
i $g(username)="" s username="root"
|
||||||
|
i $g(password)="" s password="1234567"
|
||||||
|
i $g(database)="" s database="test"
|
||||||
|
s str="mysql --xml -u "_username_" -p"_password_" "_database_" -e """_sql_""""
|
||||||
|
s nlines=$$shell(str,.resultArray)
|
||||||
|
QUIT nlines
|
||||||
|
;
|
||||||
|
encodeDate(dateString)
|
||||||
|
n %DN,%DS
|
||||||
|
s %DS=dateString
|
||||||
|
d INT^%DATE
|
||||||
|
QUIT $g(%DN)
|
||||||
|
;
|
||||||
|
relink ;
|
||||||
|
s ^%zewd("relink")=1 k ^%zewd("relink","process")
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
install
|
||||||
|
n default,x
|
||||||
|
;
|
||||||
|
w !,"Installing/Configuring "_$$version^%zewdAPI(),!!
|
||||||
|
w "Note: hit Esc to go back at any point",!!
|
||||||
|
install1 ;
|
||||||
|
s default=$g(^zewd("config","applicationRootPath"))
|
||||||
|
i default="" s default="/usr/ewdapps"
|
||||||
|
w !,"Application Root Path ("_default_"): " r x
|
||||||
|
i $zb=$c(27) w !," Installation aborted",!! QUIT
|
||||||
|
i x="" s x=default w x
|
||||||
|
s ^zewd("config","applicationRootPath")=x
|
||||||
|
;
|
||||||
|
install2 ;
|
||||||
|
s default=$g(^zewd("config","routinePath","gtm"))
|
||||||
|
i default="" s default="/usr/local/gtm/ewd/"
|
||||||
|
w !,"Routine Path ("_default_"): " r x
|
||||||
|
i $zb=$c(27) w ! g install1
|
||||||
|
i x="" s x=default w x
|
||||||
|
s ^zewd("config","routinePath","gtm")=x
|
||||||
|
;
|
||||||
|
install3 ;
|
||||||
|
s default=$g(^zewd("config","jsScriptPath","gtm","outputPath"))
|
||||||
|
i default="" s default="/var/www/resources/"
|
||||||
|
w !,"Javascript and CSS File Output Path ("_default_"): " r x
|
||||||
|
i $zb=$c(27) w ! g install2
|
||||||
|
i x="" s x=default w x
|
||||||
|
i $e(x,$l(x))'="/" s x=x_"/"
|
||||||
|
s ^zewd("config","jsScriptPath","gtm","outputPath")=x
|
||||||
|
;
|
||||||
|
install4 ;
|
||||||
|
s default=$g(^zewd("config","jsScriptPath","gtm","path"))
|
||||||
|
i default="" s default="/resources/"
|
||||||
|
w !,"Javascript and CSS File URL Path ("_default_"): " r x
|
||||||
|
i $zb=$c(27) w ! g install3
|
||||||
|
i x="" s x=default w x
|
||||||
|
i $e(x,$l(x))'="/" s x=x_"/"
|
||||||
|
s ^zewd("config","jsScriptPath","gtm","path")=x
|
||||||
|
;
|
||||||
|
s ^zewd("config","backEndTechnology")="m"
|
||||||
|
i '$d(^zewd("config","defaultFormat")) s ^zewd("config","defaultFormat")="pretty"
|
||||||
|
s ^zewd("config","defaultTechnology")="gtm"
|
||||||
|
s ^zewd("config","frontEndTechnology")="gtm"
|
||||||
|
i '$d(^zewd("config","jsScriptPath","gtm","mode")) s ^zewd("config","jsScriptPath","gtm","mode")="fixed"
|
||||||
|
s ^zewd("config","sessionDatabase")="gtm"
|
||||||
|
w !!,$$version^%zewdAPI()_" is configured and ready for use",!!
|
||||||
|
QUIT
|
||||||
|
;
|
||||||
|
leaveAsM ;
|
||||||
|
;;_zewdCompiler11.m
|
||||||
|
;;_zewdCompiler12.m
|
||||||
|
;;_zewdCompiler14.m
|
||||||
|
;;_zewdCompiler15.m
|
||||||
|
;;_zewdCompiler17.m
|
||||||
|
;;_zewdCompiler18.m
|
||||||
|
;;_zewdCompiler21.m
|
||||||
|
;;_zewdCompiler2.m
|
||||||
|
;;_zewdCompiler9.m
|
||||||
|
;;_zewdDemo.m
|
||||||
|
;;_zewdDocumentation1.m
|
||||||
|
;;_zewdDocumentation2.m
|
||||||
|
;;_zewdDocumentation3.m
|
||||||
|
;;_zewdDocumentation4.m
|
||||||
|
;;_zewdEJSCData.m
|
||||||
|
;;_zewdExtJSCode.m
|
||||||
|
;;_zewdExtJSData.m
|
||||||
|
;;_zewdExtJSDat2.m
|
||||||
|
;;_zewdExtJSData3.m
|
||||||
|
;;_zewdGTM.m
|
||||||
|
;;_zewdGTMRuntime.m
|
||||||
|
;;_zewdHTTP.m
|
||||||
|
;;_zewdLAMP1.m
|
||||||
|
;;_zewdMgr.m
|
||||||
|
;;_zewdMgr2.m
|
||||||
|
;;_zewdMgr3.m
|
||||||
|
;;_zewdMgrAjax.m
|
||||||
|
;;_zewdMgrAjax2.m
|
||||||
|
;;_zewdSlideshow.m
|
||||||
|
;;_zewdYUI1.m
|
||||||
|
;;_zewdYUI2.m
|
||||||
|
;;_zewdvaMgr.m
|
||||||
|
;;***END***
|
||||||
Loading…
Reference in New Issue