From 0a3c5ae1593e63d78d6dde82e4df13a837da5631 Mon Sep 17 00:00:00 2001 From: johnleoz Date: Wed, 27 Jan 2010 03:53:53 +0000 Subject: [PATCH] first commit from Glenwood --- KIDS.0 | 584 +++++++++++++++++++++++++++++++++++++++++++++++++++++ VWHSH0.m | 36 ++++ VWHSH3.m | 33 +++ VWHSH8.m | 21 ++ VWHSHCLX.m | 21 ++ VWHSHCWN.m | 20 ++ VWHSHGTM.m | 18 ++ VWHSHLEG.m | 35 ++++ VWHSHTST.m | 38 ++++ 9 files changed, 806 insertions(+) create mode 100644 KIDS.0 create mode 100644 VWHSH0.m create mode 100644 VWHSH3.m create mode 100644 VWHSH8.m create mode 100644 VWHSHCLX.m create mode 100644 VWHSHCWN.m create mode 100644 VWHSHGTM.m create mode 100644 VWHSHLEG.m create mode 100644 VWHSHTST.m diff --git a/KIDS.0 b/KIDS.0 new file mode 100644 index 0000000..0f27697 --- /dev/null +++ b/KIDS.0 @@ -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** diff --git a/VWHSH0.m b/VWHSH0.m new file mode 100644 index 0000000..7deced7 --- /dev/null +++ b/VWHSH0.m @@ -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")),! diff --git a/VWHSH3.m b/VWHSH3.m new file mode 100644 index 0000000..da0e1e4 --- /dev/null +++ b/VWHSH3.m @@ -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 diff --git a/VWHSH8.m b/VWHSH8.m new file mode 100644 index 0000000..39663cc --- /dev/null +++ b/VWHSH8.m @@ -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 diff --git a/VWHSHCLX.m b/VWHSHCLX.m new file mode 100644 index 0000000..b58dee0 --- /dev/null +++ b/VWHSHCLX.m @@ -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," ") diff --git a/VWHSHCWN.m b/VWHSHCWN.m new file mode 100644 index 0000000..6632c45 --- /dev/null +++ b/VWHSHCWN.m @@ -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," ") diff --git a/VWHSHGTM.m b/VWHSHGTM.m new file mode 100644 index 0000000..de59bb6 --- /dev/null +++ b/VWHSHGTM.m @@ -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," ") diff --git a/VWHSHLEG.m b/VWHSHLEG.m new file mode 100644 index 0000000..bcdaa93 --- /dev/null +++ b/VWHSHLEG.m @@ -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 + + + + + + + + + + + + + + + + + + + + diff --git a/VWHSHTST.m b/VWHSHTST.m new file mode 100644 index 0000000..e1aeb3e --- /dev/null +++ b/VWHSHTST.m @@ -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 + + + + + + + + + + + + + + + + + + + +