source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMF5AU.m@ 1128

Last change on this file since 1128 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1XUMF5AU ;ISS/PAVEL - XUMF5 MD5 Hash API ;06/17/05
2 ;;8.0;KERNEL;**383**;July 10, 1995
3 ;
4 ;MD5 based on info from 4.005 SORT BY VUID;;original name was 'VESOUHSH' ; Secure hash functions
5 ;;(c) Copyright 1994 - 2004, ESI Technology Corp, Natick MA
6 ;; This source code contains the intellectual property of its copyright holder(s),
7 ;; and is made available under a license. If you are not familiar with the terms
8 ;; of the license, please refer to the license.txt file that is a part of the
9 ;; distribution kit.
10 ;; This is a routine version where Variables and Commands set to be Upercase. Pavel
11 ;
12 Q
13 ;;**************************************************
14 ;;MD5 'R'egular portion of the code. This will handle
15 ;; one string at a time.
16 ;;**************************************************
17MD5R(STR) ; Construct a 128-bit MD5 hash of the input.
18 N TWOTO
19 N A,B,C,D
20 N AA,BB,CC,DD
21 D INITR
22PAD1R ; Pad str out to 56 bytes mod 64
23 ; Padding is a 1 bit followed by all zero bits
24 N LEN,MOD,NPAD,PAD
25 S LEN=$L(STR),MOD=LEN#64
26 S NPAD=$S(MOD<56:56-MOD,1:120-MOD)
27 S PAD=$C(128)
28 S:NPAD>1 $P(PAD,$C(0),NPAD)=""
29 S STR=STR_PAD
30PAD2R ; Append length in bits as 64-bit integer, little endian
31 S LEN=LEN*8
32 S STR=STR_$$UI64BIT(LEN)
33PROCESSR ; Main processing and transformation loop
34 N J,POS,N,I
35 N X ; X(J) is a 4-byte word from a 64-byte block
36 S N=$L(STR)/64 ; Number of 64-byte blocks
37 F I=0:1:N-1 D
38 . F J=0:1:15 S POS=(64*I)+(4*J),X(J)=$E(STR,POS+1,POS+4)
39 . D SAVE
40 . D ROUND1
41 . D ROUND2
42 . D ROUND3
43 . D ROUND4
44 . D INCR
45 K X
46 Q A_B_C_D
47 ;
48INITR ; Initialization
49 ; Set up array of powers of two for rotation
50 N I,N
51 S N=1
52 F I=0:1:31 S TWOTO(I)=N,N=N+N
53 ; Initialize 4-byte buffers A,B,C,D
54 S A=$C(1,35,69,103)
55 S B=$C(137,171,205,239)
56 S C=$C(254,220,186,152)
57 S D=$C(118,84,50,16)
58 Q
59 ;
60 ;;**************************************************
61 ;;MD5 'E'nhanced portion of the code. This will handle
62 ;; multiple strings and produce a value for them all
63 ;; as if they were submitted as one long string.
64 ;;**************************************************
65MD5E(ABCD,STR,PP,LL) ; Construct a 128-bit MD5 hash of the input.
66 N TWOTO
67 N A,B,C,D
68 N AA,BB,CC,DD
69 D INITE(ABCD)
70PAD1E ; Pad str out to 56 bytes mod 64
71 ; Padding is a 1 bit followed by all zero bits
72 ; PP = 1 Don't pad with $C(128) !!! Pavel Set to 1 if this is not last string !!
73 ; Set to 0 if this is last string !!
74 ; LL = Lenght passed form outside for pading of little endian Pavel !!! -
75 ; Seting lenght if this is last value othervise computed lenght used...
76 N LEN,MOD,NPAD,PAD
77 S LEN=$L(STR),MOD=LEN#64
78 S:$G(LL) LEN=LL ;Pavel
79 S NPAD=$S(MOD<56:56-MOD,1:120-MOD)
80 S PAD=$C(128)
81 S:NPAD>1 $P(PAD,$C(0),NPAD)=""
82 S:'$G(PP) STR=STR_PAD ;Pavel
83 ;S STR=STR_PAD
84PAD2E ; Append length in bits as 64-bit integer, little endian
85 S LEN=LEN*8
86 S STR=STR_$$UI64BIT(LEN)
87PROCESSE ; Main processing and transformation loop
88 N J,POS,N,I
89 N X ; X(J) is a 4-byte word from a 64-byte block
90 ;S N=$L(STR)/64 ; Number of 64-byte blocks
91 S N=$L(STR)\64 ; Number of 64-byte blocks
92 F I=0:1:N-1 D
93 . F J=0:1:15 S POS=(64*I)+(4*J),X(J)=$E(STR,POS+1,POS+4)
94 . D SAVE
95 . D ROUND1
96 . D ROUND2
97 . D ROUND3
98 . D ROUND4
99 . D INCR
100 . ;W !,I," ABCD=",$$MAIN^XUMF5BYT($$HEX(A_B_C_D)),!
101 K X
102 Q A_B_C_D
103 ;
104INITE(LASTABCD) ; Initialization
105 ; Set up array of powers of two for rotation
106 N I,N,L
107 S N=1
108 F I=0:1:31 S TWOTO(I)=N,N=N+N
109 ; Initialize 4-byte buffers A,B,C,D
110 S A=$E(LASTABCD,1,4)
111 S B=$E(LASTABCD,5,8)
112 S C=$E(LASTABCD,9,12)
113 S D=$E(LASTABCD,13,16)
114 Q
115 ;
116 ;;**************************************************
117 ;;This is where common code starts, used by both
118 ;; Regular and Enhanced portions of this routine.
119 ;;**************************************************
120SAVE ; Save buffers
121 S AA=A,BB=B,CC=C,DD=D
122 Q
123 ;
124ROUND1 ; First round of transformation
125 D SUB(.A,B,C,D,X(0),7,3614090360,1)
126 D SUB(.D,A,B,C,X(1),12,3905402710,1)
127 D SUB(.C,D,A,B,X(2),17,606105819,1)
128 D SUB(.B,C,D,A,X(3),22,3250441966,1)
129 D SUB(.A,B,C,D,X(4),7,4118548399,1)
130 D SUB(.D,A,B,C,X(5),12,1200080426,1)
131 D SUB(.C,D,A,B,X(6),17,2821735955,1)
132 D SUB(.B,C,D,A,X(7),22,4249261313,1)
133 D SUB(.A,B,C,D,X(8),7,1770035416,1)
134 D SUB(.D,A,B,C,X(9),12,2336552879,1)
135 D SUB(.C,D,A,B,X(10),17,4294925233,1)
136 D SUB(.B,C,D,A,X(11),22,2304563134,1)
137 D SUB(.A,B,C,D,X(12),7,1804603682,1)
138 D SUB(.D,A,B,C,X(13),12,4254626195,1)
139 D SUB(.C,D,A,B,X(14),17,2792965006,1)
140 D SUB(.B,C,D,A,X(15),22,1236535329,1)
141 Q
142 ;
143ROUND2 ; Second round of transformation
144 D SUB(.A,B,C,D,X(1),5,4129170786,2)
145 D SUB(.D,A,B,C,X(6),9,3225465664,2)
146 D SUB(.C,D,A,B,X(11),14,643717713,2)
147 D SUB(.B,C,D,A,X(0),20,3921069994,2)
148 D SUB(.A,B,C,D,X(5),5,3593408605,2)
149 D SUB(.D,A,B,C,X(10),9,38016083,2)
150 D SUB(.C,D,A,B,X(15),14,3634488961,2)
151 D SUB(.B,C,D,A,X(4),20,3889429448,2)
152 D SUB(.A,B,C,D,X(9),5,568446438,2)
153 D SUB(.D,A,B,C,X(14),9,3275163606,2)
154 D SUB(.C,D,A,B,X(3),14,4107603335,2)
155 D SUB(.B,C,D,A,X(8),20,1163531501,2)
156 D SUB(.A,B,C,D,X(13),5,2850285829,2)
157 D SUB(.D,A,B,C,X(2),9,4243563512,2)
158 D SUB(.C,D,A,B,X(7),14,1735328473,2)
159 D SUB(.B,C,D,A,X(12),20,2368359562,2)
160 Q
161 ;
162ROUND3 ; Third round of transformation
163 D SUB(.A,B,C,D,X(5),4,4294588738,3)
164 D SUB(.D,A,B,C,X(8),11,2272392833,3)
165 D SUB(.C,D,A,B,X(11),16,1839030562,3)
166 D SUB(.B,C,D,A,X(14),23,4259657740,3)
167 D SUB(.A,B,C,D,X(1),4,2763975236,3)
168 D SUB(.D,A,B,C,X(4),11,1272893353,3)
169 D SUB(.C,D,A,B,X(7),16,4139469664,3)
170 D SUB(.B,C,D,A,X(10),23,3200236656,3)
171 D SUB(.A,B,C,D,X(13),4,681279174,3)
172 D SUB(.D,A,B,C,X(0),11,3936430074,3)
173 D SUB(.C,D,A,B,X(3),16,3572445317,3)
174 D SUB(.B,C,D,A,X(6),23,76029189,3)
175 D SUB(.A,B,C,D,X(9),4,3654602809,3)
176 D SUB(.D,A,B,C,X(12),11,3873151461,3)
177 D SUB(.C,D,A,B,X(15),16,530742520,3)
178 D SUB(.B,C,D,A,X(2),23,3299628645,3)
179 Q
180 ;
181ROUND4 ; Fourth round of transformation
182 D SUB(.A,B,C,D,X(0),6,4096336452,4)
183 D SUB(.D,A,B,C,X(7),10,1126891415,4)
184 D SUB(.C,D,A,B,X(14),15,2878612391,4)
185 D SUB(.B,C,D,A,X(5),21,4237533241,4)
186 D SUB(.A,B,C,D,X(12),6,1700485571,4)
187 D SUB(.D,A,B,C,X(3),10,2399980690,4)
188 D SUB(.C,D,A,B,X(10),15,4293915773,4)
189 D SUB(.B,C,D,A,X(1),21,2240044497,4)
190 D SUB(.A,B,C,D,X(8),6,1873313359,4)
191 D SUB(.D,A,B,C,X(15),10,4264355552,4)
192 D SUB(.C,D,A,B,X(6),15,2734768916,4)
193 D SUB(.B,C,D,A,X(13),21,1309151649,4)
194 D SUB(.A,B,C,D,X(4),6,4149444226,4)
195 D SUB(.D,A,B,C,X(11),10,3174756917,4)
196 D SUB(.C,D,A,B,X(2),15,718787259,4)
197 D SUB(.B,C,D,A,X(9),21,3951481745,4)
198 Q
199INCR ;
200 S A=$$ADD(A,AA)
201 S B=$$ADD(B,BB)
202 S C=$$ADD(C,CC)
203 S D=$$ADD(D,DD)
204 Q
205 ;
206 ; Auxiliary functions
207 ;
208SUB(A,B,C,D,X,S,AC,FN) ; FN is 1 (F), 2 (G), 3 (H) or 4 (I)
209 N INT,COMB,CMD,DO
210 S INT=$$UINT32(A)
211 S DO="COMB"_FN
212 D @DO
213 S INT=$$ADDIW(INT,COMB)
214 S INT=$$ADDIW(INT,X)
215 S INT=$$ADDII(INT,AC)
216 S INT=$$ROTLI(INT,S)
217 S INT=$$ADDIW(INT,B)
218 S A=$$UI32BIT(INT)
219 Q
220COMB ; Choose F, G, H or I
221COMB1 S COMB=$$OR($$AND(B,C),$$AND($$NOT(B),D)) Q ; F
222COMB2 S COMB=$$OR($$AND(B,D),$$AND(C,$$NOT(D))) Q ; G
223COMB3 S COMB=$$XOR($$XOR(B,C),D) Q ; H
224COMB4 S COMB=$$XOR(C,$$OR(B,$$NOT(D))) Q ; I
225 Q
226 ;
227 ; Boolean functions assume args are 4-character strings
228 ;
229AND(X,Y) ;
230 Q $ZBOOLEAN(X,Y,1) ;;EOCONDCD;CACHE
231 Q X ; Placeholder for other M implementations
232 ;
233OR(X,Y) ;
234 Q $ZBOOLEAN(X,Y,7) ;;EOCONDCD;CACHE
235 Q X ; Placeholder for other M implementations
236 ;
237XOR(X,Y) ;
238 Q $ZBOOLEAN(X,Y,6) ;;EOCONDCD;CACHE
239 Q X ; Placeholder for other M implementations
240 ;
241NOT(X) ;
242 Q $ZBOOLEAN(X,X,12) ;;EOCONDCD;CACHE
243 Q X ; Placeholder for other M implementations
244 ;
245 ; Functions to add and rotate 32-bit words
246 ; X and Y are 4-character strings
247 ; m, n and s are integers
248 ; ADD and ROTL return 4-character strings
249 ; ADDIW, ADDII and ROTLI return integers
250 ;
251ADD(X,Y) ; modulo 2**32
252 Q $$UI32BIT($$UINT32(X)+$$UINT32(Y)#4294967296)
253 ;
254ADDIW(M,Y) ; modulo 2**32
255 Q M+$$UINT32(Y)#4294967296
256 ;
257ADDII(M,N) ; modulo 2**32
258 Q M+N#4294967296
259 ;
260ROTL(X,S) ; rotate left by s bits
261 N INT,RIGHT,SWAP
262 S INT=$$UINT32(X)
263 S RIGHT=INT#TWOTO(32-S)
264 S SWAP=RIGHT*TWOTO(S)+(INT\TWOTO(32-S))
265 Q $$UI32BIT(SWAP)
266 ;
267ROTLI(N,S) ; rotate left by s bits
268 N RIGHT,SWAP
269 S RIGHT=N#TWOTO(32-S)
270 S SWAP=RIGHT*TWOTO(S)+(N\TWOTO(32-S))
271 Q SWAP
272 ;
273 ; Utility functions
274 ;
275UI64BIT(N) ; Convert unsigned integer to 64-bit form, little endian
276 ; code from CORBA ULONGLONG marshaling
277 N D,X,I
278 S D=""
279 F I=7:-1:1 D
280 . S X=0
281 . F Q:(N<(256**I)) S X=X+1,N=N-(256**I)
282 . S X(I)=X
283 S D=D_$C(N)
284 F I=1:1:7 S D=D_$C(X(I))
285 Q D
286 ;
287UI32BIT(N) ; Convert unsigned integer to 32-bit form, little endian
288 ; code from CORBA ULONG marshaling
289 Q $C(N#256,(N\256#256),(N\(65536)#256),(N\(16777216)#256))
290 ;
291UINT32(STR) ; Get integer value from bits of 4-character string
292 ; code from CORBA ULONG unmarshaling
293 Q $A(STR,1)+(256*$A(STR,2))+(65536*$A(STR,3))+(16777216*$A(STR,4))
294 ;
295HEX(STR) ; Printable hex representation of characters in string
296 N DIGITS,RET,I,J,BYTE,OFFSET
297 S DIGITS="0123456789abcdef"
298 S RET=""
299 S OFFSET=$L(STR)#4
300 S:OFFSET STR=STR_$E($C(0,0,0),1,4-OFFSET) ; PAD
301 F I=0:4:$L(STR)-4 F J=4:-1:1 D ; Reverse byte order in each word
302 . S BYTE=$A(STR,I+J)
303 . S RET=RET_$E(DIGITS,1+(BYTE\16)) ; High nibble
304 . S RET=RET_$E(DIGITS,1+(BYTE#16)) ; Low nibble
305 Q RET
306 ;
307CHR2OCT(STR) ; convert hex string to decimal byte values
308 N RET,I,BYTE,HIGH,LOW
309 S RET=""
310 F I=1:2:$L(STR) D
311 . S BYTE=$E(STR,I,I+1)
312 . Q:BYTE'?2NL
313 . S HIGH=$$CHAR1($E(BYTE,1))
314 . S LOW=$$CHAR1($E(BYTE,2))
315 . S RET=RET_(16*HIGH+LOW)_" "
316 Q RET
317 ;
318CHAR1(DIGIT) ; convert one char to its hex value
319 N X
320 S X=$F("0123456789abcdef",DIGIT)
321 Q:X=0 0
322 Q X-2
Note: See TracBrowser for help on using the repository browser.