first commit from Glenwood

This commit is contained in:
johnleoz 2010-01-27 03:53:53 +00:00
parent 10c9245df9
commit 0a3c5ae159
9 changed files with 806 additions and 0 deletions

584
KIDS.0 Normal file
View File

@ -0,0 +1,584 @@
KIDS Distribution saved on Jan 12, 2010@09:43:23
Tuesday Jan 12
**KIDS**:VWHHS*00.1*5^
**INSTALL NAME**
VWHHS*00.1*5
"BLD",7076,0)
VWHHS*00.1*5^^0^3100112^n
"BLD",7076,4,0)
^9.64PA^^
"BLD",7076,6.3)
2
"BLD",7076,"KRN",0)
^9.67PA^8989.52^19
"BLD",7076,"KRN",.4,0)
.4
"BLD",7076,"KRN",.401,0)
.401
"BLD",7076,"KRN",.402,0)
.402
"BLD",7076,"KRN",.403,0)
.403
"BLD",7076,"KRN",.5,0)
.5
"BLD",7076,"KRN",.84,0)
.84
"BLD",7076,"KRN",3.6,0)
3.6
"BLD",7076,"KRN",3.8,0)
3.8
"BLD",7076,"KRN",9.2,0)
9.2
"BLD",7076,"KRN",9.8,0)
9.8
"BLD",7076,"KRN",9.8,"NM",0)
^9.68A^7^7
"BLD",7076,"KRN",9.8,"NM",1,0)
VWHSH0^^0^B4330045
"BLD",7076,"KRN",9.8,"NM",2,0)
VWHSH3^^0^B2878674
"BLD",7076,"KRN",9.8,"NM",3,0)
VWHSH8^^0^B1242378
"BLD",7076,"KRN",9.8,"NM",4,0)
VWHSHCLX^^0^B2011086
"BLD",7076,"KRN",9.8,"NM",5,0)
VWHSHCWN^^0^B1741215
"BLD",7076,"KRN",9.8,"NM",6,0)
VWHSHGTM^^0^B1519925
"BLD",7076,"KRN",9.8,"NM",7,0)
VWHSHTST^^0^B405235
"BLD",7076,"KRN",9.8,"NM","B","VWHSH0",1)
"BLD",7076,"KRN",9.8,"NM","B","VWHSH3",2)
"BLD",7076,"KRN",9.8,"NM","B","VWHSH8",3)
"BLD",7076,"KRN",9.8,"NM","B","VWHSHCLX",4)
"BLD",7076,"KRN",9.8,"NM","B","VWHSHCWN",5)
"BLD",7076,"KRN",9.8,"NM","B","VWHSHGTM",6)
"BLD",7076,"KRN",9.8,"NM","B","VWHSHTST",7)
"BLD",7076,"KRN",19,0)
19
"BLD",7076,"KRN",19.1,0)
19.1
"BLD",7076,"KRN",101,0)
101
"BLD",7076,"KRN",409.61,0)
409.61
"BLD",7076,"KRN",771,0)
771
"BLD",7076,"KRN",870,0)
870
"BLD",7076,"KRN",8989.51,0)
8989.51
"BLD",7076,"KRN",8989.52,0)
8989.52
"BLD",7076,"KRN",8994,0)
8994
"BLD",7076,"KRN","B",.4,.4)
"BLD",7076,"KRN","B",.401,.401)
"BLD",7076,"KRN","B",.402,.402)
"BLD",7076,"KRN","B",.403,.403)
"BLD",7076,"KRN","B",.5,.5)
"BLD",7076,"KRN","B",.84,.84)
"BLD",7076,"KRN","B",3.6,3.6)
"BLD",7076,"KRN","B",3.8,3.8)
"BLD",7076,"KRN","B",9.2,9.2)
"BLD",7076,"KRN","B",9.8,9.8)
"BLD",7076,"KRN","B",19,19)
"BLD",7076,"KRN","B",19.1,19.1)
"BLD",7076,"KRN","B",101,101)
"BLD",7076,"KRN","B",409.61,409.61)
"BLD",7076,"KRN","B",771,771)
"BLD",7076,"KRN","B",870,870)
"BLD",7076,"KRN","B",8989.51,8989.51)
"BLD",7076,"KRN","B",8989.52,8989.52)
"BLD",7076,"KRN","B",8994,8994)
"BLD",7076,"QUES",0)
^9.62^^0
"BLD",7076,"REQB",0)
^9.611^^
"MBREQ")
0
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")
"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
7
"RTN","VWHSH0")
0^1^B4330045
"RTN","VWHSH0",1,0)
VWHSH0 ;;GpZ; - ; IMPROVED HASHING UTILITY: MAIN INSTALL MODULE; 01/08/2010
"RTN","VWHSH0",2,0)
V ;;8.0;KERNEL;;Jul 10, 1995
"RTN","VWHSH0",3,0)
;; VWHSH
"RTN","VWHSH0",4,0)
CHECK ;;
"RTN","VWHSH0",5,0)
N %S,%D,%ZR,HSH,HASH,HASHLIST,MUMPS,OS,PATH,SCR,ZTOS
"RTN","VWHSH0",6,0)
DO
"RTN","VWHSH0",7,0)
. IF $$EN^XUSHSH("TEST")="TEST" S HASH="NONE" QUIT
"RTN","VWHSH0",8,0)
. S HASH=$P($G(^%ZOSF("HASHLIST")),"|") ; ID installed HASH from earlier version.
"RTN","VWHSH0",9,0)
. S HASH=$S($$EN^XUSHSH("TEST")="TEST":"NONE",$L($G(HASH))>0:HASH,1:"LEGACY") ; query current XUSHSH
"RTN","VWHSH0",10,0)
DO DEFHASH
"RTN","VWHSH0",11,0)
IF HASHLIST'[" MD5 " S ABORT="gpg FAILURE; CHECK for gnupg dependency & its PATH" GOTO ABORT
"RTN","VWHSH0",12,0)
S %S=$S(ZTOS=8:"VWHSHGTM",HASHLIST["Linux":"VWHSHCLX",1:"VWHSHCWN")
"RTN","VWHSH0",13,0)
S %D="XUSHSH",U="^",SCR="I 1"
"RTN","VWHSH0",14,0)
IF $T(^VWHSHLEG)="" S %S="XUSHSH^"_%S,%D="VWHSHLEG^"_%D
"RTN","VWHSH0",15,0)
; preserve old ^XUSHSH as ^VWHSHLEG
"RTN","VWHSH0",16,0)
S U="^",SCR="I 1"
"RTN","VWHSH0",17,0)
DO MOVE^ZTMGRSET
"RTN","VWHSH0",18,0)
QUIT
"RTN","VWHSH0",19,0)
;
"RTN","VWHSH0",20,0)
DEFHASH ;; Entry point for changing default hash.
"RTN","VWHSH0",21,0)
IF '$L($G(HASH)) DO
"RTN","VWHSH0",22,0)
. S HASH=$P($G(^%ZOSF("HASHLIST")),"|")
"RTN","VWHSH0",23,0)
. QUIT:$L($G(HASH))
"RTN","VWHSH0",24,0)
. S:$T(^VWHSHLEG)>"" HASH=$S($$EN^VWHSHLEG("TEST")="TEST":"NONE",1:"LEGACY")
"RTN","VWHSH0",25,0)
. QUIT:$L($G(HASH))
"RTN","VWHSH0",26,0)
. S HASH="LEGACY" ; hard-coded default hash is LEGACY
"RTN","VWHSH0",27,0)
. QUIT
"RTN","VWHSH0",28,0)
S HASH=$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","VWHSH0",29,0)
S MUMPS=^%ZOSF("OS"),ZTOS=$S(MUMPS["GT.M":8,MUMPS["OpenM":3)
"RTN","VWHSH0",30,0)
; SHOULD ERROR IF neither GTM nor Cache.
"RTN","VWHSH0",31,0)
S HASHLIST=HASH_"||"_$$INIT^@("VWHSH"_ZTOS)()
"RTN","VWHSH0",32,0)
S ^%ZOSF("HASHLIST")=HASHLIST
"RTN","VWHSH0",33,0)
QUIT
"RTN","VWHSH0",34,0)
;
"RTN","VWHSH0",35,0)
ABORT ;; Failed to find gpg hashes.
"RTN","VWHSH0",36,0)
U 0 W !,ABORT,! W $G(^%ZOSF("HASHLIST")),!
"RTN","VWHSH3")
0^2^B2878674
"RTN","VWHSH3",1,0)
VWHSH3 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, OpenM; 01/08/2010
"RTN","VWHSH3",2,0)
V ;;8.0;KERNEL;;Jul 10, 1995
"RTN","VWHSH3",3,0)
;
"RTN","VWHSH3",4,0)
QUIT
"RTN","VWHSH3",5,0)
;
"RTN","VWHSH3",6,0)
INIT() S MUMPS=^%ZOSF("OS"),OS=$$OPENM("uname -o","Linux")
"RTN","VWHSH3",7,0)
IF OS'["Linux" S OS=$$OPENM("Ver","Microsoft") DO
"RTN","VWHSH3",8,0)
. S PIPE="PATH"
"RTN","VWHSH3",9,0)
. OPEN PIPE:"Q" USE PIPE READ PATH CLOSE PIPE
"RTN","VWHSH3",10,0)
. S PATH=PATH_";C:\""Program Files""\GNU\GnuPG\"
"RTN","VWHSH3",11,0)
. F I=1:1:$L(PATH,";") Q:($P(PATH,";",I)["GnuPG")
"RTN","VWHSH3",12,0)
. S PATH=$P(PATH,";",I)
"RTN","VWHSH3",13,0)
ELSE S PATH=$P($P($$OPENM("whereis gpg","gpg")," ",2),"gpg")
"RTN","VWHSH3",14,0)
S ZUT=$ZUTIL(68,40,1)
"RTN","VWHSH3",15,0)
S PIPE=$G(PATH)_"gpg --version"
"RTN","VWHSH3",16,0)
OPEN PIPE:"Q"
"RTN","VWHSH3",17,0)
F I=1:1:20 USE PIPE R HASHLIST QUIT:$ZEOF<0 D:HASHLIST["'gpg' is not recognized" q:HASHLIST["Hash:"
"RTN","VWHSH3",18,0)
. S HASHLIST="Hash:gpg_not_found:gpg_HASHES_not_available"
"RTN","VWHSH3",19,0)
CLOSE PIPE
"RTN","VWHSH3",20,0)
S ZUT=$ZUTIL(68,40,ZUT)
"RTN","VWHSH3",21,0)
S HASHLIST=HASHLIST
"RTN","VWHSH3",22,0)
S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
"RTN","VWHSH3",23,0)
S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
"RTN","VWHSH3",24,0)
QUIT HASHLIST
"RTN","VWHSH3",25,0)
;
"RTN","VWHSH3",26,0)
OPENM(PIPE,SEEKING) ;;
"RTN","VWHSH3",27,0)
N (PIPE,SEEKING)
"RTN","VWHSH3",28,0)
S ZUT=$ZUTIL(68,40,1)
"RTN","VWHSH3",29,0)
OPEN PIPE:"Q"
"RTN","VWHSH3",30,0)
F I=1:1:4 USE PIPE READ X Q:$ZEOF<0 Q:X[SEEKING
"RTN","VWHSH3",31,0)
CLOSE PIPE
"RTN","VWHSH3",32,0)
S ZUT=$ZUTIL(68,40,ZUT)
"RTN","VWHSH3",33,0)
QUIT X
"RTN","VWHSH8")
0^3^B1242378
"RTN","VWHSH8",1,0)
VWHSH8 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, GT.M; 01/08/2010
"RTN","VWHSH8",2,0)
V ;;8.0;KERNEL;;Jul 10, 1995
"RTN","VWHSH8",3,0)
;
"RTN","VWHSH8",4,0)
QUIT
"RTN","VWHSH8",5,0)
;
"RTN","VWHSH8",6,0)
INIT() S MUMPS=^%ZOSF("OS"),OS=$$GTM("uname -o")
"RTN","VWHSH8",7,0)
S PATH=$P($P($$GTM("whereis gpg")," ",2),"gpg")
"RTN","VWHSH8",8,0)
S X=$TR("host:"_MUMPS_OS_":","^ ","-")
"RTN","VWHSH8",9,0)
O "PIPE":(COMM="gpg --version|grep -E ^Hash:":READONLY)::"PIPE"
"RTN","VWHSH8",10,0)
U "PIPE" R HASHLIST
"RTN","VWHSH8",11,0)
C "PIPE" U 0
"RTN","VWHSH8",12,0)
S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
"RTN","VWHSH8",13,0)
S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
"RTN","VWHSH8",14,0)
QUIT HASHLIST
"RTN","VWHSH8",15,0)
;
"RTN","VWHSH8",16,0)
GTM(PIPE) ;
"RTN","VWHSH8",17,0)
N (PIPE)
"RTN","VWHSH8",18,0)
OPEN "PIPE":(command=PIPE)::"pipe"
"RTN","VWHSH8",19,0)
S X="" F I=1:1:4 U "PIPE" R XX Q:$ZEOF S X=X_XX
"RTN","VWHSH8",20,0)
CLOSE "PIPE"
"RTN","VWHSH8",21,0)
QUIT X
"RTN","VWHSHCLX")
0^4^B2011086
"RTN","VWHSHCLX",1,0)
XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: for Cache/Linux (VWHSHCLX); 01/08/2010
"RTN","VWHSHCLX",2,0)
V ;;8.0;KERNEL;;Jul 10, 1995
"RTN","VWHSHCLX",3,0)
;;
"RTN","VWHSHCLX",4,0)
A S X=$$EN(X) Q
"RTN","VWHSHCLX",5,0)
;;
"RTN","VWHSHCLX",6,0)
EN(X,HASH) ;;
"RTN","VWHSHCLX",7,0)
N (X,HASH)
"RTN","VWHSHCLX",8,0)
D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
"RTN","VWHSHCLX",9,0)
S HASHLIST=^%ZOSF("HASHLIST")
"RTN","VWHSHCLX",10,0)
S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
"RTN","VWHSHCLX",11,0)
IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
"RTN","VWHSHCLX",12,0)
Q:HASHLIST'[(" "_HASH_" ") X
"RTN","VWHSHCLX",13,0)
S SED="sed -e 's/$/\r/'|"
"RTN","VWHSHCLX",14,0)
N PIPE,ZUT,I
"RTN","VWHSHCLX",15,0)
S ZUT=$ZUTIL(68,40,1) ;; MSM-style End-of-File Handling
"RTN","VWHSHCLX",16,0)
S PIPE=" echo "_X_"||"_SED_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
"RTN","VWHSHCLX",17,0)
OPEN PIPE:"Q"
"RTN","VWHSHCLX",18,0)
F I=1:1:4 USE PIPE R X Q:$ZEOF<0 S HASHOUT=$G(HASHOUT)_X
"RTN","VWHSHCLX",19,0)
CLOSE PIPE
"RTN","VWHSHCLX",20,0)
S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
"RTN","VWHSHCLX",21,0)
Q $TR(X," ")
"RTN","VWHSHCWN")
0^5^B1741215
"RTN","VWHSHCWN",1,0)
XUSHSH ;;GpZ; ; IMPROVED HASHING UTILITY: Cache/Windows (VWHSHCWN);01/08/2010
"RTN","VWHSHCWN",2,0)
V ;;8.0;KERNEL;;Jul 10, 1995
"RTN","VWHSHCWN",3,0)
;;
"RTN","VWHSHCWN",4,0)
A S X=$$EN(X) Q
"RTN","VWHSHCWN",5,0)
;;
"RTN","VWHSHCWN",6,0)
EN(X,HASH) ;;
"RTN","VWHSHCWN",7,0)
N (X,HASH)
"RTN","VWHSHCWN",8,0)
D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
"RTN","VWHSHCWN",9,0)
S HASHLIST=^%ZOSF("HASHLIST")
"RTN","VWHSHCWN",10,0)
S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
"RTN","VWHSHCWN",11,0)
IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
"RTN","VWHSHCWN",12,0)
Q:HASHLIST'[(" "_HASH_" ") X
"RTN","VWHSHCWN",13,0)
N PIPE,ZUT,I
"RTN","VWHSHCWN",14,0)
S ZUT=$ZUTIL(68,40,1)
"RTN","VWHSHCWN",15,0)
S PIPE=" echo "_X_"||"_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
"RTN","VWHSHCWN",16,0)
OPEN PIPE:"Q"
"RTN","VWHSHCWN",17,0)
F I=1:1:4 USE PIPE R X Q:$ZEOF<0 S HASHOUT=$G(HASHOUT)_X
"RTN","VWHSHCWN",18,0)
CLOSE PIPE
"RTN","VWHSHCWN",19,0)
S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
"RTN","VWHSHCWN",20,0)
Q $TR(X," ")
"RTN","VWHSHGTM")
0^6^B1519925
"RTN","VWHSHGTM",1,0)
XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: GT.M Version (VWHSHGTM); 01/08/2010
"RTN","VWHSHGTM",2,0)
V ;;8.0;KERNEL;;Jul 10, 1995
"RTN","VWHSHGTM",3,0)
;;
"RTN","VWHSHGTM",4,0)
A S X=$$EN(X) Q
"RTN","VWHSHGTM",5,0)
;;
"RTN","VWHSHGTM",6,0)
EN(X,HASH) ;;
"RTN","VWHSHGTM",7,0)
N (X,HASH)
"RTN","VWHSHGTM",8,0)
D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
"RTN","VWHSHGTM",9,0)
S HASHLIST=^%ZOSF("HASHLIST")
"RTN","VWHSHGTM",10,0)
S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
"RTN","VWHSHGTM",11,0)
IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
"RTN","VWHSHGTM",12,0)
Q:HASHLIST'[(" "_HASH_" ") X
"RTN","VWHSHGTM",13,0)
S SED="sed -e 's/$/\r/'|"
"RTN","VWHSHGTM",14,0)
OPEN "PIPE":(COMM=SED_"gpg --print-md "_HASH)::"PIPE"
"RTN","VWHSHGTM",15,0)
USE "PIPE" W X,! W /EOF
"RTN","VWHSHGTM",16,0)
F R X Q:$ZEOF S HASHOUT=$G(HASHOUT)_X
"RTN","VWHSHGTM",17,0)
CLOSE "PIPE"
"RTN","VWHSHGTM",18,0)
Q $TR(HASHOUT," ")
"RTN","VWHSHTST")
0^7^B405235
"RTN","VWHSHTST",1,0)
XUSHSH ;JL.Z; ROBUST PASSWORD HASH TEST xushsh; 11 SEPTEMBER 2009
"RTN","VWHSHTST",2,0)
;;8.0;KERNEL;**60**;Jul 10, 1995
"RTN","VWHSHTST",3,0)
;;
"RTN","VWHSHTST",4,0)
;;
"RTN","VWHSHTST",5,0)
;;SF-ISC/STAFF - PASSWORD ENCRYPTION ;3/23/89 15:09 ; 4/14/05 1:22pm
"RTN","VWHSHTST",6,0)
;;8.0;KERNEL;;Jul 10, 1995
"RTN","VWHSHTST",7,0)
;; Input in X
"RTN","VWHSHTST",8,0)
;; Output in X
"RTN","VWHSHTST",9,0)
;; Algorithm for VistA Office EHR encryption (BSL)
"RTN","VWHSHTST",10,0)
A ;
"RTN","VWHSHTST",11,0)
S X=$$EN(X)
"RTN","VWHSHTST",12,0)
Q
"RTN","VWHSHTST",13,0)
;
"RTN","VWHSHTST",14,0)
EN(X)
"RTN","VWHSHTST",15,0)
Q X
"RTN","VWHSHTST",16,0)
"RTN","VWHSHTST",17,0)
"RTN","VWHSHTST",18,0)
"RTN","VWHSHTST",19,0)
"RTN","VWHSHTST",20,0)
"RTN","VWHSHTST",21,0)
"RTN","VWHSHTST",22,0)
"RTN","VWHSHTST",23,0)
"RTN","VWHSHTST",24,0)
"RTN","VWHSHTST",25,0)
"RTN","VWHSHTST",26,0)
"RTN","VWHSHTST",27,0)
"RTN","VWHSHTST",28,0)
"RTN","VWHSHTST",29,0)
"RTN","VWHSHTST",30,0)
"RTN","VWHSHTST",31,0)
"RTN","VWHSHTST",32,0)
"RTN","VWHSHTST",33,0)
"RTN","VWHSHTST",34,0)
"RTN","VWHSHTST",35,0)
"VER")
8.0^22.0
**END**
**END**

36
VWHSH0.m Normal file
View File

@ -0,0 +1,36 @@
VWHSH0 ;;GpZ; - ; IMPROVED HASHING UTILITY: MAIN INSTALL MODULE; 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
;; VWHSH
CHECK ;;
N %S,%D,%ZR,HSH,HASH,HASHLIST,MUMPS,OS,PATH,SCR,ZTOS
DO
. IF $$EN^XUSHSH("TEST")="TEST" S HASH="NONE" QUIT
. S HASH=$P($G(^%ZOSF("HASHLIST")),"|") ; ID installed HASH from earlier version.
. S HASH=$S($$EN^XUSHSH("TEST")="TEST":"NONE",$L($G(HASH))>0:HASH,1:"LEGACY") ; query current XUSHSH
DO DEFHASH
IF HASHLIST'[" MD5 " S ABORT="gpg FAILURE; CHECK for gnupg dependency & its PATH" GOTO ABORT
S %S=$S(ZTOS=8:"VWHSHGTM",HASHLIST["Linux":"VWHSHCLX",1:"VWHSHCWN")
S %D="XUSHSH",U="^",SCR="I 1"
IF $T(^VWHSHLEG)="" S %S="XUSHSH^"_%S,%D="VWHSHLEG^"_%D
; preserve old ^XUSHSH as ^VWHSHLEG
S U="^",SCR="I 1"
DO MOVE^ZTMGRSET
QUIT
;
DEFHASH ;; Entry point for changing default hash.
IF '$L($G(HASH)) DO
. S HASH=$P($G(^%ZOSF("HASHLIST")),"|")
. QUIT:$L($G(HASH))
. S:$T(^VWHSHLEG)>"" HASH=$S($$EN^VWHSHLEG("TEST")="TEST":"NONE",1:"LEGACY")
. QUIT:$L($G(HASH))
. S HASH="LEGACY" ; hard-coded default hash is LEGACY
. QUIT
S HASH=$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S MUMPS=^%ZOSF("OS"),ZTOS=$S(MUMPS["GT.M":8,MUMPS["OpenM":3)
; SHOULD ERROR IF neither GTM nor Cache.
S HASHLIST=HASH_"||"_$$INIT^@("VWHSH"_ZTOS)()
S ^%ZOSF("HASHLIST")=HASHLIST
QUIT
;
ABORT ;; Failed to find gpg hashes.
U 0 W !,ABORT,! W $G(^%ZOSF("HASHLIST")),!

33
VWHSH3.m Normal file
View File

@ -0,0 +1,33 @@
VWHSH3 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, OpenM; 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
;
QUIT
;
INIT() S MUMPS=^%ZOSF("OS"),OS=$$OPENM("uname -o","Linux")
IF OS'["Linux" S OS=$$OPENM("Ver","Microsoft") DO
. S PIPE="PATH"
. OPEN PIPE:"Q" USE PIPE READ PATH CLOSE PIPE
. S PATH=PATH_";C:\""Program Files""\GNU\GnuPG\"
. F I=1:1:$L(PATH,";") Q:($P(PATH,";",I)["GnuPG")
. S PATH=$P(PATH,";",I)
ELSE S PATH=$P($P($$OPENM("whereis gpg","gpg")," ",2),"gpg")
S ZUT=$ZUTIL(68,40,1)
S PIPE=$G(PATH)_"gpg --version"
OPEN PIPE:"Q"
F I=1:1:20 USE PIPE R HASHLIST QUIT:$ZEOF<0 D:HASHLIST["'gpg' is not recognized" q:HASHLIST["Hash:"
. S HASHLIST="Hash:gpg_not_found:gpg_HASHES_not_available"
CLOSE PIPE
S ZUT=$ZUTIL(68,40,ZUT)
S HASHLIST=HASHLIST
S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
QUIT HASHLIST
;
OPENM(PIPE,SEEKING) ;;
N (PIPE,SEEKING)
S ZUT=$ZUTIL(68,40,1)
OPEN PIPE:"Q"
F I=1:1:4 USE PIPE READ X Q:$ZEOF<0 Q:X[SEEKING
CLOSE PIPE
S ZUT=$ZUTIL(68,40,ZUT)
QUIT X

21
VWHSH8.m Normal file
View File

@ -0,0 +1,21 @@
VWHSH8 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, GT.M; 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
;
QUIT
;
INIT() S MUMPS=^%ZOSF("OS"),OS=$$GTM("uname -o")
S PATH=$P($P($$GTM("whereis gpg")," ",2),"gpg")
S X=$TR("host:"_MUMPS_OS_":","^ ","-")
O "PIPE":(COMM="gpg --version|grep -E ^Hash:":READONLY)::"PIPE"
U "PIPE" R HASHLIST
C "PIPE" U 0
S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
QUIT HASHLIST
;
GTM(PIPE) ;
N (PIPE)
OPEN "PIPE":(command=PIPE)::"pipe"
S X="" F I=1:1:4 U "PIPE" R XX Q:$ZEOF S X=X_XX
CLOSE "PIPE"
QUIT X

21
VWHSHCLX.m Normal file
View File

@ -0,0 +1,21 @@
XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: for Cache/Linux (VWHSHCLX); 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
;;
A S X=$$EN(X) Q
;;
EN(X,HASH) ;;
N (X,HASH)
D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
S HASHLIST=^%ZOSF("HASHLIST")
S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
Q:HASHLIST'[(" "_HASH_" ") X
S SED="sed -e 's/$/\r/'|"
N PIPE,ZUT,I
S ZUT=$ZUTIL(68,40,1) ;; MSM-style End-of-File Handling
S PIPE=" echo "_X_"||"_SED_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
OPEN PIPE:"Q"
F I=1:1:4 USE PIPE R X Q:$ZEOF<0 S HASHOUT=$G(HASHOUT)_X
CLOSE PIPE
S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
Q $TR(X," ")

20
VWHSHCWN.m Normal file
View File

@ -0,0 +1,20 @@
XUSHSH ;;GpZ; ; IMPROVED HASHING UTILITY: Cache/Windows (VWHSHCWN);01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
;;
A S X=$$EN(X) Q
;;
EN(X,HASH) ;;
N (X,HASH)
D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
S HASHLIST=^%ZOSF("HASHLIST")
S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
Q:HASHLIST'[(" "_HASH_" ") X
N PIPE,ZUT,I
S ZUT=$ZUTIL(68,40,1)
S PIPE=" echo "_X_"||"_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
OPEN PIPE:"Q"
F I=1:1:4 USE PIPE R X Q:$ZEOF<0 S HASHOUT=$G(HASHOUT)_X
CLOSE PIPE
S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
Q $TR(X," ")

18
VWHSHGTM.m Normal file
View File

@ -0,0 +1,18 @@
XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: GT.M Version (VWHSHGTM); 01/08/2010
V ;;8.0;KERNEL;;Jul 10, 1995
;;
A S X=$$EN(X) Q
;;
EN(X,HASH) ;;
N (X,HASH)
D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
S HASHLIST=^%ZOSF("HASHLIST")
S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
Q:HASHLIST'[(" "_HASH_" ") X
S SED="sed -e 's/$/\r/'|"
OPEN "PIPE":(COMM=SED_"gpg --print-md "_HASH)::"PIPE"
USE "PIPE" W X,! W /EOF
F R X Q:$ZEOF S HASHOUT=$G(HASHOUT)_X
CLOSE "PIPE"
Q $TR(HASHOUT," ")

35
VWHSHLEG.m Normal file
View File

@ -0,0 +1,35 @@
XUSHSH ;JL.Z; ROBUST PASSWORD HASH TEST xushsh; 11 SEPTEMBER 2009
;;8.0;KERNEL;**60**;Jul 10, 1995
;;
;;
;;SF-ISC/STAFF - PASSWORD ENCRYPTION ;3/23/89 15:09 ; 4/14/05 1:22pm
;;8.0;KERNEL;;Jul 10, 1995
;; Input in X
;; Output in X
;; Algorithm for VistA Office EHR encryption (BSL)
A ;
S X=$$EN(X)
Q
;
EN(X)
Q X

38
VWHSHTST.m Normal file
View File

@ -0,0 +1,38 @@
XUSHSH ;JL.Z; ROBUST PASSWORD HASH TEST xushsh; 11 SEPTEMBER 2009
V ;;8.0;KERNEL;**60**;Jul 10, 1995
;;
;; This is intended as a replacement XUSHSH for testing purposes only.
;; This version returns a NULL (unhashed) result, like openvista's XUSHSH.
;; Probably not to be part of a final KIDS release.
;;
;;SF-ISC/STAFF - PASSWORD ENCRYPTION ;3/23/89 15:09 ; 4/14/05 1:22pm
;;8.0;KERNEL;;Jul 10, 1995
;; Input in X
;; Output in X
;; Algorithm for VistA Office EHR encryption (BSL)
A ;
S X=$$EN(X)
Q
;
EN(X)
Q X