Ticket #11: VWHSH.ro

File VWHSH.ro, 5.5 KB (added by John Leo Zimmer, 14 years ago)

VWHSH.ro contains seven (7) routines proposed for KIDS distribution

Line 
1Jan 08 2010
2GT.M 08-JAN-2010 21:12:13
3VWHSH0
4VWHSH0 ;;GpZ; - ; IMPROVED HASHING UTILITY: MAIN INSTALL MODULE; 01/08/2010
5V ;;8.0;KERNEL;;Jul 10, 1995
6 ;; VWHSH
7CHECK ;;
8 N %S,%D,%ZR,HSH,HASH,HASHLIST,MUMPS,OS,PATH,SCR,ZTOS
9 S HASH=$P($G(^%ZOSF("HASHLIST")),"|") ; ID installed HASH from earlier version.
10 S HASH=$S($$EN^XUSHSH("TEST")="TEST":"NONE",$L($G(HASH))>0:HASH,1:"LEGACY") ; query current XUSHSH
11 DO DEFHASH
12 IF HASHLIST'[" MD5 " S ABORT="gpg FAILURE; CHECK for gnupg dependency & its PATH" GOTO ABORT
13 S %S=$S(ZTOS=8:"VWHSHGTM",HASHLIST["Linux":"VWHSHCLX",1:"VWHSHCWN")
14 S %D="XUSHSH",U="^",SCR="I 1"
15 IF $T(^VWHSHLEG)="" S %S="XUSHSH^"_%S,%D="VWHSHLEG^"_%D
16 ; preserve old ^XUSHSH as ^VWHSHLEG
17 S U="^",SCR="I 1"
18 DO MOVE^ZTMGRSET
19 QUIT
20 ;
21DEFHASH ;; Entry point for changing default hash.
22 IF '$L($G(HASH)) DO
23 . S HASH=$P($G(^%ZOSF("HASHLIST")),"|")
24 . QUIT:$L($G(HASH))
25 . S:$T(^VWHSHLEG)>"" HASH=$S($$EN^VWHSHLEG("TEST")="TEST":"NONE",1:"LEGACY")
26 . QUIT:$L($G(HASH))
27 . S HASH="LEGACY" ; hard-coded default hash is LEGACY
28 . QUIT
29 S HASH=$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
30 S MUMPS=^%ZOSF("OS"),ZTOS=$S(MUMPS["GT.M":8,MUMPS["OpenM":3)
31 ; SHOULD ERROR IF neither GTM nor Cache.
32 S HASHLIST=HASH_"||"_$$INIT^@("VWHSH"_ZTOS)()
33 S ^%ZOSF("HASHLIST")=HASHLIST
34 QUIT
35 ;
36ABORT ;; Failed to find gpg hashes.
37 U 0 W !,ABORT,! W $G(^%ZOSF("HASHLIST")),!
38
39VWHSH3
40VWHSH3 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, OpenM; 01/08/2010
41V ;;8.0;KERNEL;;Jul 10, 1995
42 ;
43 QUIT
44 ;
45INIT() S MUMPS=^%ZOSF("OS"),OS=$$OPENM("uname -o","Linux")
46 IF OS'["Linux" S OS=$$OPENM("Ver","Microsoft") DO
47 . S PIPE="PATH"
48 . OPEN PIPE:"Q" USE PIPE READ PATH CLOSE PIPE
49 . S PATH=PATH_";C:\""Program Files""\GNU\GnuPG\"
50 . F I=1:1:$L(PATH,";") Q:($P(PATH,";",I)["GnuPG")
51 . S PATH=$P(PATH,";",I)
52 ELSE S PATH=$P($P($$OPENM("whereis gpg","gpg")," ",2),"gpg")
53 S ZUT=$ZUTIL(68,40,1)
54 S PIPE=$G(PATH)_"gpg --version"
55 OPEN PIPE:"Q"
56 F I=1:1:20 USE PIPE R HASHLIST QUIT:$ZEOF<0 D:HASHLIST["'gpg' is not recognized" q:HASHLIST["Hash:"
57 . S HASHLIST="Hash:gpg_not_found:gpg_HASHES_not_available"
58 CLOSE PIPE
59 S ZUT=$ZUTIL(68,40,ZUT)
60 S HASHLIST=HASHLIST
61 S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
62 S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
63 QUIT HASHLIST
64 ;
65OPENM(PIPE,SEEKING) ;;
66 N (PIPE,SEEKING)
67 S ZUT=$ZUTIL(68,40,1)
68 OPEN PIPE:"Q"
69 F I=1:1:4 USE PIPE READ X Q:$ZEOF<0 Q:X[SEEKING
70 CLOSE PIPE
71 S ZUT=$ZUTIL(68,40,ZUT)
72 QUIT X
73
74VWHSH8
75VWHSH8 ;;GpZ; - ; IMPROVED HASHING UTILITY: INSTALL MODULE, GT.M; 01/08/2010
76V ;;8.0;KERNEL;;Jul 10, 1995
77 ;
78 QUIT
79 ;
80INIT() S MUMPS=^%ZOSF("OS"),OS=$$GTM("uname -o")
81 S PATH=$P($P($$GTM("whereis gpg")," ",2),"gpg")
82 S X=$TR("host:"_MUMPS_OS_":","^ ","-")
83 O "PIPE":(COMM="gpg --version|grep -E ^Hash:":READONLY)::"PIPE"
84 U "PIPE" R HASHLIST
85 C "PIPE" U 0
86 S HASHLIST=$TR($P(HASHLIST,"Hash:",2),",")
87 S HASHLIST=HASHLIST_" ||"_PATH_"||"_MUMPS_OS_"||"
88 QUIT HASHLIST
89 ;
90GTM(PIPE) ;
91 N (PIPE)
92 OPEN "PIPE":(command=PIPE)::"pipe"
93 S X="" F I=1:1:4 U "PIPE" R XX Q:$ZEOF S X=X_XX
94 CLOSE "PIPE"
95 QUIT X
96
97VWHSHCLX
98XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: for Cache/Linux (VWHSHCLX); 01/08/2010
99V ;;8.0;KERNEL;;Jul 10, 1995
100 ;;
101A S X=$$EN(X) Q
102 ;;
103EN(X,HASH) ;;
104 N (X,HASH)
105 D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
106 S HASHLIST=^%ZOSF("HASHLIST")
107 S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
108 IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
109 Q:HASHLIST'[(" "_HASH_" ") X
110 S SED="sed -e 's/$/\r/'|"
111 N PIPE,ZUT,I
112 S ZUT=$ZUTIL(68,40,1) ;; MSM-style End-of-File Handling
113 S PIPE=" echo "_X_"||"_SED_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
114 OPEN PIPE:"Q"
115 F I=1:1:4 USE PIPE R X Q:$ZEOF<0 S HASHOUT=$G(HASHOUT)_X
116 CLOSE PIPE
117 S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
118 Q $TR(X," ")
119
120VWHSHCWN
121XUSHSH ;;GpZ; ; IMPROVED HASHING UTILITY: Cache/Windows (VWHSHCWN);01/08/2010
122V ;;8.0;KERNEL;;Jul 10, 1995
123 ;;
124A S X=$$EN(X) Q
125 ;;
126EN(X,HASH) ;;
127 N (X,HASH)
128 D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
129 S HASHLIST=^%ZOSF("HASHLIST")
130 S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
131 IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
132 Q:HASHLIST'[(" "_HASH_" ") X
133 N PIPE,ZUT,I
134 S ZUT=$ZUTIL(68,40,1)
135 S PIPE=" echo "_X_"||"_$P(HASHLIST,"||",3)_"gpg --print-md "_HASH
136 OPEN PIPE:"Q"
137 F I=1:1:4 USE PIPE R X Q:$ZEOF<0 S HASHOUT=$G(HASHOUT)_X
138 CLOSE PIPE
139 S ZUT=$ZUTIL(68,40,ZUT),X=HASHOUT
140 Q $TR(X," ")
141
142VWHSHGTM
143XUSHSH ;;GpZ; - ; IMPROVED HASHING UTILITY: GT.M Version (VWHSHGTM); 01/08/2010
144V ;;8.0;KERNEL;;Jul 10, 1995
145 ;;
146A S X=$$EN(X) Q
147 ;;
148EN(X,HASH) ;;
149 N (X,HASH)
150 D:'$L($G(^%ZOSF("HASHLIST"))) DEFHASH^VWHSH0
151 S HASHLIST=^%ZOSF("HASHLIST")
152 S HASH=$S('$L($G(HASH)):$P(HASHLIST,"|",1),1:$TR(HASH,"abcdefghijklmnopqrstuvwxyz- ","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
153 IF HASH="LEGACY" QUIT $$EN^VWHSHLEG(X)
154 Q:HASHLIST'[(" "_HASH_" ") X
155 S SED="sed -e 's/$/\r/'|"
156 OPEN "PIPE":(COMM=SED_"gpg --print-md "_HASH)::"PIPE"
157 USE "PIPE" W X,! W /EOF
158 F R X Q:$ZEOF S HASHOUT=$G(HASHOUT)_X
159 CLOSE "PIPE"
160 Q $TR(HASHOUT," ")
161
162VWHSTEST
163XUSHSH ;JL.Z; ROBUST PASSWORD HASH TEST xushsh; 11 SEPTEMBER 2009
164 ;; Test routine to provide a strawman version ^XUSHSH
165 ;;8.0;KERNEL;**60**;Jul 10, 1995
166 ;;
167 ;;
168 ;;SF-ISC/STAFF - PASSWORD ENCRYPTION ;3/23/89 15:09 ; 4/14/05 1:22pm
169 ;;8.0;KERNEL;;Jul 10, 1995
170 ;; Input in X
171 ;; Output in X
172 ;; Algorithm for VistA Office EHR encryption (BSL)
173A ;
174 S X=$$EN(X)
175 Q
176 ;
177EN(X)
178 Q X