1 /***************************************************************************
2  * Copyright (c) 2024 Microsoft Corporation
3  *
4  * This program and the accompanying materials are made available under the
5  * terms of the MIT License which is available at
6  * https://opensource.org/licenses/MIT.
7  *
8  * SPDX-License-Identifier: MIT
9  **************************************************************************/
10 
11 
12 /**************************************************************************/
13 /**************************************************************************/
14 /**                                                                       */
15 /** NetX Crypto Component                                                 */
16 /**                                                                       */
17 /**   SHA-512 Digest Algorithm (SHA5)                                     */
18 /**                                                                       */
19 /**************************************************************************/
20 /**************************************************************************/
21 
22 #include "nx_crypto_sha5.h"
23 
24 /* Constants used in the SHA-512 digest calculation. */
25 const ULONG64 _sha5_round_constants[] =
26 {
27     0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f, 0xe9b5dba58189dbbc,
28     0x3956c25bf348b538, 0x59f111f1b605d019, 0x923f82a4af194f9b, 0xab1c5ed5da6d8118,
29     0xd807aa98a3030242, 0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2,
30     0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235, 0xc19bf174cf692694,
31     0xe49b69c19ef14ad2, 0xefbe4786384f25e3, 0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65,
32     0x2de92c6f592b0275, 0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5,
33     0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f, 0xbf597fc7beef0ee4,
34     0xc6e00bf33da88fc2, 0xd5a79147930aa725, 0x06ca6351e003826f, 0x142929670a0e6e70,
35     0x27b70a8546d22ffc, 0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df,
36     0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6, 0x92722c851482353b,
37     0xa2bfe8a14cf10364, 0xa81a664bbc423001, 0xc24b8b70d0f89791, 0xc76c51a30654be30,
38     0xd192e819d6ef5218, 0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8,
39     0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99, 0x34b0bcb5e19b48a8,
40     0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb, 0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3,
41     0x748f82ee5defb2fc, 0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec,
42     0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915, 0xc67178f2e372532b,
43     0xca273eceea26619c, 0xd186b8c721c0c207, 0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178,
44     0x06f067aa72176fba, 0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b,
45     0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc, 0x431d67c49c100d4c,
46     0x4cc5d4becb3e42b6, 0x597f299cfc657e2a, 0x5fcb6fab3ad6faec, 0x6c44198c4a475817,
47 };
48 
49 
50 /* Define the SHA5 logic functions.  */
51 #define CH_FUNC(x, y, z)           (((x) & (y)) ^ ((~(x)) & (z)))
52 #define MAJ_FUNC(x, y, z)          (((x) & (y)) ^ ((x) & (z)) ^ ((y) & (z)))
53 
54 #define RIGHT_SHIFT_CIRCULAR(x, n) (((x) >> (n)) | ((x) << (64 - (n))))
55 #define LARGE_SIGMA_0(x)           (RIGHT_SHIFT_CIRCULAR((x),  28) ^ RIGHT_SHIFT_CIRCULAR((x), 34) ^ RIGHT_SHIFT_CIRCULAR((x), 39))
56 #define LARGE_SIGMA_1(x)           (RIGHT_SHIFT_CIRCULAR((x),  14) ^ RIGHT_SHIFT_CIRCULAR((x), 18) ^ RIGHT_SHIFT_CIRCULAR((x), 41))
57 #define SMALL_SIGMA_0(x)           (RIGHT_SHIFT_CIRCULAR((x),  1) ^ RIGHT_SHIFT_CIRCULAR((x), 8) ^ ((x) >> 7))
58 #define SMALL_SIGMA_1(x)           (RIGHT_SHIFT_CIRCULAR((x), 19) ^ RIGHT_SHIFT_CIRCULAR((x), 61) ^ ((x) >> 6))
59 
60 /* Define the padding array.  This is used to pad the message such that its length is
61    64 bits shy of being a multiple of 512 bits long.  */
62 const UCHAR   _nx_crypto_sha512_padding[] =
63 {
64     0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
65     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
66     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
67     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
68     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
69     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
70     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
71     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
72 };
73 
74 
75 /**************************************************************************/
76 /*                                                                        */
77 /*  FUNCTION                                               RELEASE        */
78 /*                                                                        */
79 /*    _nx_crypto_sha512_initialize                        PORTABLE C      */
80 /*                                                           6.1          */
81 /*                                                                        */
82 /*  AUTHOR                                                                */
83 /*                                                                        */
84 /*    Timothy Stapko, Microsoft Corporation                               */
85 /*                                                                        */
86 /*  DESCRIPTION                                                           */
87 /*                                                                        */
88 /*    This function initializes the SHA512 context. It must be called     */
89 /*    prior to creating a SHA512 digest.                                  */
90 /*                                                                        */
91 /*  INPUT                                                                 */
92 /*                                                                        */
93 /*    context                               SHA512 context pointer        */
94 /*    algorithm                             SHA384 or SHA512              */
95 /*                                                                        */
96 /*  OUTPUT                                                                */
97 /*                                                                        */
98 /*    status                                Completion status             */
99 /*                                                                        */
100 /*  CALLS                                                                 */
101 /*                                                                        */
102 /*    None                                                                */
103 /*                                                                        */
104 /*  CALLED BY                                                             */
105 /*                                                                        */
106 /*    _nx_crypto_method_sha512_operation    Handle SHA512 operation       */
107 /*                                                                        */
108 /*  RELEASE HISTORY                                                       */
109 /*                                                                        */
110 /*    DATE              NAME                      DESCRIPTION             */
111 /*                                                                        */
112 /*  05-19-2020     Timothy Stapko           Initial Version 6.0           */
113 /*  09-30-2020     Timothy Stapko           Modified comment(s),          */
114 /*                                            resulting in version 6.1    */
115 /*                                                                        */
116 /**************************************************************************/
_nx_crypto_sha512_initialize(NX_CRYPTO_SHA512 * context,UINT algorithm)117 NX_CRYPTO_KEEP UINT  _nx_crypto_sha512_initialize(NX_CRYPTO_SHA512 *context, UINT algorithm)
118 {
119     /* Determine if the context is non-null.  */
120     if (context == NX_CRYPTO_NULL)
121     {
122         return(NX_CRYPTO_PTR_ERROR);
123     }
124 
125     /* First, clear the bit count for this context.  */
126     context -> nx_sha512_bit_count[0] =  0;                   /* Clear the lower 64-bits of the count.*/
127     context -> nx_sha512_bit_count[1] =  0;                   /* Clear the upper 64-bits of the count.*/
128 
129     if ((algorithm == NX_CRYPTO_AUTHENTICATION_HMAC_SHA2_512) ||
130         (algorithm == NX_CRYPTO_HASH_SHA512))
131     {
132 
133         /* Initialize SHA-512 state. */
134         context -> nx_sha512_states[0] = 0x6a09e667f3bcc908; /* A H0 */
135         context -> nx_sha512_states[1] = 0xbb67ae8584caa73b; /* B H1 */
136         context -> nx_sha512_states[2] = 0x3c6ef372fe94f82b; /* C H2 */
137         context -> nx_sha512_states[3] = 0xa54ff53a5f1d36f1; /* D H3 */
138         context -> nx_sha512_states[4] = 0x510e527fade682d1; /* E H4 */
139         context -> nx_sha512_states[5] = 0x9b05688c2b3e6c1f; /* F H5 */
140         context -> nx_sha512_states[6] = 0x1f83d9abfb41bd6b; /* G H6 */
141         context -> nx_sha512_states[7] = 0x5be0cd19137e2179; /* H H7 */
142     }
143     else if ((algorithm == NX_CRYPTO_AUTHENTICATION_HMAC_SHA2_512_224) ||
144              (algorithm == NX_CRYPTO_HASH_SHA512_224))
145     {
146 
147         /* Initialize SHA-512/224 state. */
148         context -> nx_sha512_states[0] = 0x8c3d37c819544da2; /* A H0 */
149         context -> nx_sha512_states[1] = 0x73e1996689dcd4d6; /* B H1 */
150         context -> nx_sha512_states[2] = 0x1dfab7ae32ff9c82; /* C H2 */
151         context -> nx_sha512_states[3] = 0x679dd514582f9fcf; /* D H3 */
152         context -> nx_sha512_states[4] = 0x0f6d2b697bd44da8; /* E H4 */
153         context -> nx_sha512_states[5] = 0x77e36f7304c48942; /* F H5 */
154         context -> nx_sha512_states[6] = 0x3f9d85a86a1d36c8; /* G H6 */
155         context -> nx_sha512_states[7] = 0x1112e6ad91d692a1; /* H H7 */
156     }
157     else if ((algorithm == NX_CRYPTO_AUTHENTICATION_HMAC_SHA2_512_256) ||
158              (algorithm == NX_CRYPTO_HASH_SHA512_256))
159     {
160 
161         /* Initialize SHA-512/256 state. */
162         context -> nx_sha512_states[0] = 0x22312194fc2bf72c; /* A H0 */
163         context -> nx_sha512_states[1] = 0x9f555fa3c84c64c2; /* B H1 */
164         context -> nx_sha512_states[2] = 0x2393b86b6f53b151; /* C H2 */
165         context -> nx_sha512_states[3] = 0x963877195940eabd; /* D H3 */
166         context -> nx_sha512_states[4] = 0x96283ee2a88effe3; /* E H4 */
167         context -> nx_sha512_states[5] = 0xbe5e1e2553863992; /* F H5 */
168         context -> nx_sha512_states[6] = 0x2b0199fc2c85b8aa; /* G H6 */
169         context -> nx_sha512_states[7] = 0x0eb72ddc81c52ca2; /* H H7 */
170     }
171     else
172     {
173 
174         /* Initialize SHA-384 state. */
175         context -> nx_sha512_states[0] = 0xcbbb9d5dc1059ed8; /* A H0 */
176         context -> nx_sha512_states[1] = 0x629a292a367cd507; /* B H1 */
177         context -> nx_sha512_states[2] = 0x9159015a3070dd17; /* C H2 */
178         context -> nx_sha512_states[3] = 0x152fecd8f70e5939; /* D H3 */
179         context -> nx_sha512_states[4] = 0x67332667ffc00b31; /* E H4 */
180         context -> nx_sha512_states[5] = 0x8eb44a8768581511; /* F H5 */
181         context -> nx_sha512_states[6] = 0xdb0c2e0d64f98fa7; /* G H6 */
182         context -> nx_sha512_states[7] = 0x47b5481dbefa4fa4; /* H H7 */
183     }
184 
185     /* Return success.  */
186     return(NX_CRYPTO_SUCCESS);
187 }
188 
189 
190 /**************************************************************************/
191 /*                                                                        */
192 /*  FUNCTION                                               RELEASE        */
193 /*                                                                        */
194 /*    _nx_crypto_sha512_update                            PORTABLE C      */
195 /*                                                           6.1          */
196 /*                                                                        */
197 /*  AUTHOR                                                                */
198 /*                                                                        */
199 /*    Timothy Stapko, Microsoft Corporation                               */
200 /*                                                                        */
201 /*  DESCRIPTION                                                           */
202 /*                                                                        */
203 /*    This function updates the SHA512 digest with new input from the     */
204 /*    caller.                                                             */
205 /*                                                                        */
206 /*  INPUT                                                                 */
207 /*                                                                        */
208 /*    context                               SHA512 context pointer        */
209 /*    input_ptr                             Pointer to input data         */
210 /*    input_length                          Number of bytes in input      */
211 /*                                                                        */
212 /*  OUTPUT                                                                */
213 /*                                                                        */
214 /*    status                                Completion status             */
215 /*                                                                        */
216 /*  CALLS                                                                 */
217 /*                                                                        */
218 /*    _nx_crypto_sha512_process_buffer      Process complete buffer       */
219 /*                                            using SHA512                */
220 /*                                                                        */
221 /*  CALLED BY                                                             */
222 /*                                                                        */
223 /*    _nx_crypto_sha512_digest_calculate    Calculate the SHA512 digest   */
224 /*    _nx_crypto_method_sha512_operation    Handle SHA512 operation       */
225 /*                                                                        */
226 /*  RELEASE HISTORY                                                       */
227 /*                                                                        */
228 /*    DATE              NAME                      DESCRIPTION             */
229 /*                                                                        */
230 /*  05-19-2020     Timothy Stapko           Initial Version 6.0           */
231 /*  09-30-2020     Timothy Stapko           Modified comment(s),          */
232 /*                                            verified memcpy use cases,  */
233 /*                                            resulting in version 6.1    */
234 /*                                                                        */
235 /**************************************************************************/
_nx_crypto_sha512_update(NX_CRYPTO_SHA512 * context,UCHAR * input_ptr,UINT input_length)236 NX_CRYPTO_KEEP UINT _nx_crypto_sha512_update(NX_CRYPTO_SHA512 *context, UCHAR *input_ptr, UINT input_length)
237 {
238 ULONG64 current_bytes;
239 ULONG64 needed_fill_bytes;
240 
241     /* Determine if the context is non-null.  */
242     if (context == NX_CRYPTO_NULL)
243     {
244         return(NX_CRYPTO_PTR_ERROR);
245     }
246 
247     /* Determine if there is a length.  */
248     if (input_length == 0)
249     {
250         return(NX_CRYPTO_SUCCESS);
251     }
252 
253     /* Calculate the current byte count mod 128. Note the reason for the
254        shift by 3 is to account for the 8 bits per byte.  */
255     current_bytes =  (context -> nx_sha512_bit_count[0] >> 3) & 0x7F;
256 
257     /* Calculate the current number of bytes needed to be filled.  */
258     needed_fill_bytes =  NX_CRYPTO_SHA512_BLOCK_SIZE_IN_BYTES - current_bytes;
259 
260     /* Update the total bit count based on the input length.  */
261     context -> nx_sha512_bit_count[0] += (input_length << 3);
262 
263     /* Determine if there is roll-over of the bit count into the MSW.  */
264     if (context -> nx_sha512_bit_count[0] < (input_length << 3))
265     {
266 
267         /* Yes, increment the MSW of the bit count.  */
268         context -> nx_sha512_bit_count[1]++;
269     }
270 
271     /* Update upper total bit count word.  */
272     context -> nx_sha512_bit_count[1] +=  (input_length >> 29);
273 
274     /* Check for a partial buffer that needs to be transformed.  */
275     if ((current_bytes) && (input_length >= needed_fill_bytes))
276     {
277         /* Yes, we can complete the buffer and transform it.  */
278 
279         /* Copy the appropriate portion of the input buffer into the internal
280            buffer of the context.  */
281         NX_CRYPTO_MEMCPY((void *)&(context -> nx_sha512_buffer[current_bytes]), (void *)input_ptr, (UINT)needed_fill_bytes); /* Use case of memcpy is verified. */
282 
283         /* Process the 128-byte (1024 bit) buffer.  */
284         _nx_crypto_sha512_process_buffer(context, context -> nx_sha512_buffer);
285 
286         /* Adjust the pointers and length accordingly.  */
287         input_length =  (UINT)(input_length - needed_fill_bytes);
288         input_ptr =     input_ptr + needed_fill_bytes;
289 
290         /* Clear the remaining bits, since the buffer was processed.  */
291         current_bytes =  0;
292     }
293 
294     /* Process any and all whole blocks of input.  */
295     while (input_length >= NX_CRYPTO_SHA512_BLOCK_SIZE_IN_BYTES)
296     {
297 
298         /* Process this 128-byte (1024 bit) buffer.  */
299         _nx_crypto_sha512_process_buffer(context, input_ptr);
300 
301         /* Adjust the pointers and length accordingly.  */
302         input_length =  input_length - NX_CRYPTO_SHA512_BLOCK_SIZE_IN_BYTES;
303         input_ptr =     input_ptr + NX_CRYPTO_SHA512_BLOCK_SIZE_IN_BYTES;
304     }
305 
306     /* Determine if there is anything left.  */
307     if (input_length)
308     {
309         /* Save the remaining bytes in the internal buffer after any remaining bytes
310            so that it is processed later.  */
311         NX_CRYPTO_MEMCPY((void *)&(context -> nx_sha512_buffer[current_bytes]), (void *)input_ptr, input_length); /* Use case of memcpy is verified. */
312     }
313 
314     /* Return success.  */
315     return(NX_CRYPTO_SUCCESS);
316 }
317 
318 
319 /**************************************************************************/
320 /*                                                                        */
321 /*  FUNCTION                                               RELEASE        */
322 /*                                                                        */
323 /*    _nx_crypto_sha512_digest_calculate                  PORTABLE C      */
324 /*                                                           6.1          */
325 /*                                                                        */
326 /*  AUTHOR                                                                */
327 /*                                                                        */
328 /*    Timothy Stapko, Microsoft Corporation                               */
329 /*                                                                        */
330 /*  DESCRIPTION                                                           */
331 /*                                                                        */
332 /*    This function calculates the final SHA512 digest. It is called      */
333 /*    when there is no more input for the digest and returns the 32-byte  */
334 /*    (512-bit) SHA512 digest to the caller.                              */
335 /*                                                                        */
336 /*  INPUT                                                                 */
337 /*                                                                        */
338 /*    context                               SHA512 context pointer        */
339 /*    digest                                Pointer to return buffer      */
340 /*    algorithm                             SHA384 or SHA512              */
341 /*                                                                        */
342 /*  OUTPUT                                                                */
343 /*                                                                        */
344 /*    status                                Completion status             */
345 /*                                                                        */
346 /*  CALLS                                                                 */
347 /*                                                                        */
348 /*    _nx_crypto_sha512_update              Final update to the digest    */
349 /*                                            with padding and length     */
350 /*                                                                        */
351 /*  CALLED BY                                                             */
352 /*                                                                        */
353 /*    _nx_crypto_method_sha512_operation    Handle SHA512 operation       */
354 /*                                                                        */
355 /*  RELEASE HISTORY                                                       */
356 /*                                                                        */
357 /*    DATE              NAME                      DESCRIPTION             */
358 /*                                                                        */
359 /*  05-19-2020     Timothy Stapko           Initial Version 6.0           */
360 /*  09-30-2020     Timothy Stapko           Modified comment(s),          */
361 /*                                            resulting in version 6.1    */
362 /*                                                                        */
363 /**************************************************************************/
_nx_crypto_sha512_digest_calculate(NX_CRYPTO_SHA512 * context,UCHAR * digest,UINT algorithm)364 NX_CRYPTO_KEEP UINT _nx_crypto_sha512_digest_calculate(NX_CRYPTO_SHA512 *context, UCHAR *digest, UINT algorithm)
365 {
366 UCHAR bit_count_string[16];
367 ULONG current_byte_count;
368 ULONG padding_bytes;
369 UINT  i;
370 UINT  loop;
371 
372 
373     /* Move the lower portion of the bit count into the array.  */
374     bit_count_string[0] =  (UCHAR)(context -> nx_sha512_bit_count[1] >> 56);
375     bit_count_string[1] =  (UCHAR)(context -> nx_sha512_bit_count[1] >> 48);
376     bit_count_string[2] =  (UCHAR)(context -> nx_sha512_bit_count[1] >> 40);
377     bit_count_string[3] =  (UCHAR)(context -> nx_sha512_bit_count[1] >> 32);
378     bit_count_string[4] =  (UCHAR)(context -> nx_sha512_bit_count[1] >> 24);
379     bit_count_string[5] =  (UCHAR)(context -> nx_sha512_bit_count[1] >> 16);
380     bit_count_string[6] =  (UCHAR)(context -> nx_sha512_bit_count[1] >> 8);
381     bit_count_string[7] =  (UCHAR)(context -> nx_sha512_bit_count[1]);
382     bit_count_string[8] =  (UCHAR)(context -> nx_sha512_bit_count[0] >> 56);
383     bit_count_string[9] =  (UCHAR)(context -> nx_sha512_bit_count[0] >> 48);
384     bit_count_string[10] =  (UCHAR)(context -> nx_sha512_bit_count[0] >> 40);
385     bit_count_string[11] =  (UCHAR)(context -> nx_sha512_bit_count[0] >> 32);
386     bit_count_string[12] =  (UCHAR)(context -> nx_sha512_bit_count[0] >> 24);
387     bit_count_string[13] =  (UCHAR)(context -> nx_sha512_bit_count[0] >> 16);
388     bit_count_string[14] =  (UCHAR)(context -> nx_sha512_bit_count[0] >> 8);
389     bit_count_string[15] =  (UCHAR)(context -> nx_sha512_bit_count[0]);
390 
391     /* Calculate the current byte count.  */
392     current_byte_count =  (context -> nx_sha512_bit_count[0] >> 3) & 0x7F;
393 
394     /* Calculate the padding bytes needed.  */
395     padding_bytes =  (current_byte_count < 112) ? (112 - current_byte_count) : (240 - current_byte_count);
396 
397     /* Add any padding required.  */
398     _nx_crypto_sha512_update(context, (UCHAR *)_nx_crypto_sha512_padding, padding_bytes);
399 
400     /* Add the in the length.  */
401     _nx_crypto_sha512_update(context, bit_count_string, sizeof(bit_count_string));
402 
403     if ((algorithm == NX_CRYPTO_AUTHENTICATION_HMAC_SHA2_512) ||
404         (algorithm == NX_CRYPTO_HASH_SHA512))
405     {
406         loop = 8;
407     }
408     else if ((algorithm == NX_CRYPTO_AUTHENTICATION_HMAC_SHA2_512_224) ||
409              (algorithm == NX_CRYPTO_HASH_SHA512_224))
410     {
411         loop = 3;
412     }
413     else if ((algorithm == NX_CRYPTO_AUTHENTICATION_HMAC_SHA2_512_256) ||
414              (algorithm == NX_CRYPTO_HASH_SHA512_256))
415     {
416         loop = 4;
417     }
418     else
419     {
420         loop = 6;
421     }
422 
423     /* Now store the digest in the caller specified destination.  */
424     for (i = 0; i < loop; i++)
425     {
426         digest[0] =  (UCHAR)(context -> nx_sha512_states[i] >> 56);
427         digest[1] =  (UCHAR)(context -> nx_sha512_states[i] >> 48);
428         digest[2] =  (UCHAR)(context -> nx_sha512_states[i] >> 40);
429         digest[3] =  (UCHAR)(context -> nx_sha512_states[i] >> 32);
430         digest[4] =  (UCHAR)(context -> nx_sha512_states[i] >> 24);
431         digest[5] =  (UCHAR)(context -> nx_sha512_states[i] >> 16);
432         digest[6] =  (UCHAR)(context -> nx_sha512_states[i] >> 8);
433         digest[7] =  (UCHAR)(context -> nx_sha512_states[i]);
434         digest += 8;
435     }
436 
437     if ((algorithm == NX_CRYPTO_AUTHENTICATION_HMAC_SHA2_512_224) ||
438         (algorithm == NX_CRYPTO_HASH_SHA512_224))
439     {
440 
441         /* The last 32 bits for SHA512/224. */
442         digest[0] =  (UCHAR)(context -> nx_sha512_states[3] >> 56);
443         digest[1] =  (UCHAR)(context -> nx_sha512_states[3] >> 48);
444         digest[2] =  (UCHAR)(context -> nx_sha512_states[3] >> 40);
445         digest[3] =  (UCHAR)(context -> nx_sha512_states[3] >> 32);
446     }
447 
448 #ifdef NX_SECURE_KEY_CLEAR
449     NX_CRYPTO_MEMSET(bit_count_string, 0, sizeof(bit_count_string));
450 #endif /* NX_SECURE_KEY_CLEAR  */
451 
452     /* Return successful completion.  */
453     return(NX_CRYPTO_SUCCESS);
454 }
455 
456 
457 /**************************************************************************/
458 /*                                                                        */
459 /*  FUNCTION                                               RELEASE        */
460 /*                                                                        */
461 /*    _nx_crypto_sha512_process_buffer                    PORTABLE C      */
462 /*                                                           6.1          */
463 /*                                                                        */
464 /*  AUTHOR                                                                */
465 /*                                                                        */
466 /*    Timothy Stapko, Microsoft Corporation                               */
467 /*                                                                        */
468 /*  DESCRIPTION                                                           */
469 /*                                                                        */
470 /*    This function implements the SHA512 algorithm which works on        */
471 /*    128-byte (1024-bit) blocks of data.                                 */
472 /*                                                                        */
473 /*  INPUT                                                                 */
474 /*                                                                        */
475 /*    context                               SHA512 context pointer        */
476 /*    buffer                                Pointer to 128-byte buffer    */
477 /*                                                                        */
478 /*  OUTPUT                                                                */
479 /*                                                                        */
480 /*    None                                                                */
481 /*                                                                        */
482 /*  CALLS                                                                 */
483 /*                                                                        */
484 /*    None                                                                */
485 /*                                                                        */
486 /*  CALLED BY                                                             */
487 /*                                                                        */
488 /*    _nx_crypto_sha512_update              Update the digest with padding*/
489 /*                                            and length of digest        */
490 /*                                                                        */
491 /*  RELEASE HISTORY                                                       */
492 /*                                                                        */
493 /*    DATE              NAME                      DESCRIPTION             */
494 /*                                                                        */
495 /*  05-19-2020     Timothy Stapko           Initial Version 6.0           */
496 /*  09-30-2020     Timothy Stapko           Modified comment(s),          */
497 /*                                            resulting in version 6.1    */
498 /*                                                                        */
499 /**************************************************************************/
_nx_crypto_sha512_process_buffer(NX_CRYPTO_SHA512 * context,UCHAR * buffer)500 NX_CRYPTO_KEEP VOID _nx_crypto_sha512_process_buffer(NX_CRYPTO_SHA512 *context, UCHAR *buffer)
501 {
502 ULONG64 *w;
503 UINT     t;
504 ULONG64  temp1, temp2;
505 ULONG64  a, b, c, d, e, f, g, h;
506 
507 
508     /* Setup pointers to the word array.  */
509     w =  context -> nx_sha512_word_array;
510 
511     /* Initialize the first 16 words of the word array, taking care of the
512        endian issues at the same time.  */
513     for (t = 0; t < 16; t++)
514     {
515         /* Setup each entry.  */
516         w[t] =  (((ULONG64)buffer[0]) << 56) |
517             (((ULONG64)buffer[1]) << 48) |
518             (((ULONG64)buffer[2]) << 40) |
519             (((ULONG64)buffer[3]) << 32) |
520             (((ULONG64)buffer[4]) << 24) |
521             (((ULONG64)buffer[5]) << 16) |
522             (((ULONG64)buffer[6]) << 8) |
523             ((ULONG64)buffer[7]);
524         buffer += 8;
525     }
526 
527     /* Setup the remaining entries of the word array.  */
528     for (t = 16; t < 80; t++)
529     {
530         /* Setup each entry.  */
531         w[t] =  SMALL_SIGMA_1(w[t - 2]) + w[t - 7] + SMALL_SIGMA_0(w[t - 15]) + w[t - 16];
532     }
533 
534     /* Initialize the state variables.  */
535     a =  context -> nx_sha512_states[0];
536     b =  context -> nx_sha512_states[1];
537     c =  context -> nx_sha512_states[2];
538     d =  context -> nx_sha512_states[3];
539     e =  context -> nx_sha512_states[4];
540     f =  context -> nx_sha512_states[5];
541     g =  context -> nx_sha512_states[6];
542     h =  context -> nx_sha512_states[7];
543 
544     /* Now, perform Round operations.  */
545     for (t = 0; t < 80; t++)
546     {
547         temp1 = h + LARGE_SIGMA_1(e) + CH_FUNC(e, f, g) + _sha5_round_constants[t] + w[t];
548         temp2 = LARGE_SIGMA_0(a) + MAJ_FUNC(a, b, c);
549         h = g;
550         g = f;
551         f = e;
552         e = d + temp1;
553         d = c;
554         c = b;
555         b = a;
556         a = temp1 + temp2;
557     }
558 
559     /* Save the resulting in this SHA512 context.  */
560     context -> nx_sha512_states[0] +=  a;
561     context -> nx_sha512_states[1] +=  b;
562     context -> nx_sha512_states[2] +=  c;
563     context -> nx_sha512_states[3] +=  d;
564     context -> nx_sha512_states[4] +=  e;
565     context -> nx_sha512_states[5] +=  f;
566     context -> nx_sha512_states[6] +=  g;
567     context -> nx_sha512_states[7] +=  h;
568 
569 #ifdef NX_SECURE_KEY_CLEAR
570     a = 0; b = 0; c = 0; d = 0;
571     e = 0; f = 0; g = 0; h = 0;
572     temp1 = 0; temp2 = 0;
573 #endif /* NX_SECURE_KEY_CLEAR  */
574 }
575 
576 
577 /**************************************************************************/
578 /*                                                                        */
579 /*  FUNCTION                                               RELEASE        */
580 /*                                                                        */
581 /*    _nx_crypto_method_sha512_init                       PORTABLE C      */
582 /*                                                           6.3.0        */
583 /*  AUTHOR                                                                */
584 /*                                                                        */
585 /*    Timothy Stapko, Microsoft Corporation                               */
586 /*                                                                        */
587 /*  DESCRIPTION                                                           */
588 /*                                                                        */
589 /*    This function is the common crypto method init callback for         */
590 /*    Microsoft supported SHA512 cryptographic algorithm.                 */
591 /*                                                                        */
592 /*  INPUT                                                                 */
593 /*                                                                        */
594 /*    method                                Pointer to crypto method      */
595 /*    key                                   Pointer to key                */
596 /*    key_size_in_bits                      Length of key size in bits    */
597 /*    handler                               Returned crypto handler       */
598 /*    crypto_metadata                       Metadata area                 */
599 /*    crypto_metadata_size                  Size of the metadata area     */
600 /*                                                                        */
601 /*  OUTPUT                                                                */
602 /*                                                                        */
603 /*    status                                Completion status             */
604 /*                                                                        */
605 /*  CALLS                                                                 */
606 /*                                                                        */
607 /*    None                                                                */
608 /*                                                                        */
609 /*  CALLED BY                                                             */
610 /*                                                                        */
611 /*    Application Code                                                    */
612 /*                                                                        */
613 /*  RELEASE HISTORY                                                       */
614 /*                                                                        */
615 /*    DATE              NAME                      DESCRIPTION             */
616 /*                                                                        */
617 /*  05-19-2020     Timothy Stapko           Initial Version 6.0           */
618 /*  09-30-2020     Timothy Stapko           Modified comment(s),          */
619 /*                                            resulting in version 6.1    */
620 /*  10-31-2023     Yanwu Cai                Modified comment(s),          */
621 /*                                            resulting in version 6.3.0  */
622 /*                                                                        */
623 /**************************************************************************/
_nx_crypto_method_sha512_init(struct NX_CRYPTO_METHOD_STRUCT * method,UCHAR * key,NX_CRYPTO_KEY_SIZE key_size_in_bits,VOID ** handle,VOID * crypto_metadata,ULONG crypto_metadata_size)624 NX_CRYPTO_KEEP UINT  _nx_crypto_method_sha512_init(struct  NX_CRYPTO_METHOD_STRUCT *method,
625                                                    UCHAR *key, NX_CRYPTO_KEY_SIZE key_size_in_bits,
626                                                    VOID  **handle,
627                                                    VOID  *crypto_metadata,
628                                                    ULONG crypto_metadata_size)
629 {
630 
631     NX_CRYPTO_PARAMETER_NOT_USED(key);
632     NX_CRYPTO_PARAMETER_NOT_USED(key_size_in_bits);
633     NX_CRYPTO_PARAMETER_NOT_USED(handle);
634 
635     NX_CRYPTO_STATE_CHECK
636 
637     if ((method == NX_CRYPTO_NULL) || (crypto_metadata == NX_CRYPTO_NULL))
638     {
639         return(NX_CRYPTO_PTR_ERROR);
640     }
641 
642     /* Verify the metadata address is 4-byte aligned. */
643     if((((ULONG)crypto_metadata) & 0x3) != 0)
644     {
645         return(NX_CRYPTO_PTR_ERROR);
646     }
647 
648     if(crypto_metadata_size < sizeof(NX_CRYPTO_SHA512))
649     {
650         return(NX_CRYPTO_PTR_ERROR);
651     }
652 
653     return(NX_CRYPTO_SUCCESS);
654 }
655 
656 
657 /**************************************************************************/
658 /*                                                                        */
659 /*  FUNCTION                                               RELEASE        */
660 /*                                                                        */
661 /*    _nx_crypto_method_sha512_cleanup                    PORTABLE C      */
662 /*                                                           6.1          */
663 /*  AUTHOR                                                                */
664 /*                                                                        */
665 /*    Timothy Stapko, Microsoft Corporation                               */
666 /*                                                                        */
667 /*  DESCRIPTION                                                           */
668 /*                                                                        */
669 /*    This function cleans up the crypto metadata.                        */
670 /*                                                                        */
671 /*  INPUT                                                                 */
672 /*                                                                        */
673 /*    crypto_metadata                       Crypto metadata               */
674 /*                                                                        */
675 /*  OUTPUT                                                                */
676 /*                                                                        */
677 /*    status                                Completion status             */
678 /*                                                                        */
679 /*  CALLS                                                                 */
680 /*                                                                        */
681 /*    NX_CRYPTO_MEMSET                      Set the memory                */
682 /*                                                                        */
683 /*  CALLED BY                                                             */
684 /*                                                                        */
685 /*    Application Code                                                    */
686 /*                                                                        */
687 /*  RELEASE HISTORY                                                       */
688 /*                                                                        */
689 /*    DATE              NAME                      DESCRIPTION             */
690 /*                                                                        */
691 /*  05-19-2020     Timothy Stapko           Initial Version 6.0           */
692 /*  09-30-2020     Timothy Stapko           Modified comment(s),          */
693 /*                                            resulting in version 6.1    */
694 /*                                                                        */
695 /**************************************************************************/
_nx_crypto_method_sha512_cleanup(VOID * crypto_metadata)696 NX_CRYPTO_KEEP UINT  _nx_crypto_method_sha512_cleanup(VOID *crypto_metadata)
697 {
698 
699     NX_CRYPTO_STATE_CHECK
700 
701 #ifdef NX_SECURE_KEY_CLEAR
702     if (!crypto_metadata)
703         return (NX_CRYPTO_SUCCESS);
704 
705     /* Clean up the crypto metadata.  */
706     NX_CRYPTO_MEMSET(crypto_metadata, 0, sizeof(NX_CRYPTO_SHA512));
707 #else
708     NX_CRYPTO_PARAMETER_NOT_USED(crypto_metadata);
709 #endif/* NX_SECURE_KEY_CLEAR  */
710 
711     return(NX_CRYPTO_SUCCESS);
712 }
713 
714 
715 /**************************************************************************/
716 /*                                                                        */
717 /*  FUNCTION                                               RELEASE        */
718 /*                                                                        */
719 /*    _nx_crypto_method_sha512_operation                 PORTABLE C       */
720 /*                                                           6.3.0        */
721 /*  AUTHOR                                                                */
722 /*                                                                        */
723 /*    Timothy Stapko, Microsoft Corporation                               */
724 /*                                                                        */
725 /*  DESCRIPTION                                                           */
726 /*                                                                        */
727 /*    This function encrypts and decrypts a message using                 */
728 /*    the SHA512 algorithm.                                               */
729 /*                                                                        */
730 /*  INPUT                                                                 */
731 /*                                                                        */
732 /*    op                                    SHA512 operation              */
733 /*    handle                                Crypto handle                 */
734 /*    method                                Cryption Method Object        */
735 /*    key                                   Encryption Key                */
736 /*    key_size_in_bits                      Key size in bits              */
737 /*    input                                 Input data                    */
738 /*    input_length_in_byte                  Input data size               */
739 /*    iv_ptr                                Initial vector                */
740 /*    output                                Output buffer                 */
741 /*    output_length_in_byte                 Output buffer size            */
742 /*    crypto_metadata                       Metadata area                 */
743 /*    crypto_metadata_size                  Metadata area size            */
744 /*    packet_ptr                            Pointer to packet             */
745 /*    nx_crypto_hw_process_callback         Callback function pointer     */
746 /*                                                                        */
747 /*  OUTPUT                                                                */
748 /*                                                                        */
749 /*    status                                Completion status             */
750 /*                                                                        */
751 /*  CALLS                                                                 */
752 /*                                                                        */
753 /*    _nx_crypto_sha512_initialize          Initialize the SHA512 context */
754 /*    _nx_crypto_sha512_update              Update the digest with padding*/
755 /*                                            and length of digest        */
756 /*    _nx_crypto_sha512_digest_calculate    Calculate the SHA512 digest   */
757 /*                                                                        */
758 /*  CALLED BY                                                             */
759 /*                                                                        */
760 /*    Application Code                                                    */
761 /*                                                                        */
762 /*  RELEASE HISTORY                                                       */
763 /*                                                                        */
764 /*    DATE              NAME                      DESCRIPTION             */
765 /*                                                                        */
766 /*  05-19-2020     Timothy Stapko           Initial Version 6.0           */
767 /*  09-30-2020     Timothy Stapko           Modified comment(s),          */
768 /*                                            resulting in version 6.1    */
769 /*  10-31-2023     Yanwu Cai                Modified comment(s),          */
770 /*                                            resulting in version 6.3.0  */
771 /*                                                                        */
772 /**************************************************************************/
_nx_crypto_method_sha512_operation(UINT op,VOID * handle,struct NX_CRYPTO_METHOD_STRUCT * method,UCHAR * key,NX_CRYPTO_KEY_SIZE key_size_in_bits,UCHAR * input,ULONG input_length_in_byte,UCHAR * iv_ptr,UCHAR * output,ULONG output_length_in_byte,VOID * crypto_metadata,ULONG crypto_metadata_size,VOID * packet_ptr,VOID (* nx_crypto_hw_process_callback)(VOID * packet_ptr,UINT status))773 NX_CRYPTO_KEEP UINT  _nx_crypto_method_sha512_operation(UINT op,      /* Encrypt, Decrypt, Authenticate */
774                                                         VOID *handle, /* Crypto handler */
775                                                         struct NX_CRYPTO_METHOD_STRUCT *method,
776                                                         UCHAR *key,
777                                                         NX_CRYPTO_KEY_SIZE key_size_in_bits,
778                                                         UCHAR *input,
779                                                         ULONG input_length_in_byte,
780                                                         UCHAR *iv_ptr,
781                                                         UCHAR *output,
782                                                         ULONG output_length_in_byte,
783                                                         VOID *crypto_metadata,
784                                                         ULONG crypto_metadata_size,
785                                                         VOID *packet_ptr,
786                                                         VOID (*nx_crypto_hw_process_callback)(VOID *packet_ptr, UINT status))
787 {
788 UINT                status = NX_CRYPTO_NOT_SUCCESSFUL;
789 NX_CRYPTO_SHA512   *ctx;
790 
791     NX_CRYPTO_PARAMETER_NOT_USED(handle);
792     NX_CRYPTO_PARAMETER_NOT_USED(key);
793     NX_CRYPTO_PARAMETER_NOT_USED(key_size_in_bits);
794     NX_CRYPTO_PARAMETER_NOT_USED(iv_ptr);
795     NX_CRYPTO_PARAMETER_NOT_USED(packet_ptr);
796     NX_CRYPTO_PARAMETER_NOT_USED(nx_crypto_hw_process_callback);
797 
798     NX_CRYPTO_STATE_CHECK
799 
800     if (method == NX_CRYPTO_NULL)
801     {
802         return(NX_CRYPTO_PTR_ERROR);
803     }
804 
805     /* Verify the metadata address is 4-byte aligned. */
806     if((crypto_metadata == NX_CRYPTO_NULL) || ((((ULONG)crypto_metadata) & 0x3) != 0))
807     {
808         return(NX_CRYPTO_PTR_ERROR);
809     }
810 
811     if(crypto_metadata_size < sizeof(NX_CRYPTO_SHA512))
812     {
813         return(NX_CRYPTO_PTR_ERROR);
814     }
815 
816     ctx = (NX_CRYPTO_SHA512 *)crypto_metadata;
817 
818     if (op != NX_CRYPTO_AUTHENTICATE && op != NX_CRYPTO_VERIFY && op != NX_CRYPTO_HASH_INITIALIZE &&
819         op != NX_CRYPTO_HASH_UPDATE && op != NX_CRYPTO_HASH_CALCULATE)
820     {
821         /* Incorrect Operation. */
822         return status;
823     }
824 
825     if ((method -> nx_crypto_algorithm != NX_CRYPTO_HASH_SHA384) &&
826         (method -> nx_crypto_algorithm != NX_CRYPTO_HASH_SHA512) &&
827         (method -> nx_crypto_algorithm != NX_CRYPTO_HASH_SHA512_224) &&
828         (method -> nx_crypto_algorithm != NX_CRYPTO_HASH_SHA512_256))
829     {
830         /* Incorrect method. */
831         return status;
832     }
833 
834     switch (op)
835     {
836     case NX_CRYPTO_HASH_INITIALIZE:
837         _nx_crypto_sha512_initialize((NX_CRYPTO_SHA512 *)crypto_metadata, method -> nx_crypto_algorithm);
838         break;
839 
840     case NX_CRYPTO_HASH_UPDATE:
841         _nx_crypto_sha512_update((NX_CRYPTO_SHA512 *)crypto_metadata, input, input_length_in_byte);
842         break;
843 
844     case NX_CRYPTO_HASH_CALCULATE:
845         if(((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA512) && (output_length_in_byte < 64)) ||
846            ((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA384) && (output_length_in_byte < 48)) ||
847            ((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA512_224) && (output_length_in_byte < 28)) ||
848            ((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA512_256) && (output_length_in_byte < 32)))
849             return(NX_CRYPTO_INVALID_BUFFER_SIZE);
850 
851 
852         _nx_crypto_sha512_digest_calculate((NX_CRYPTO_SHA512 *)crypto_metadata, output, method -> nx_crypto_algorithm);
853         break;
854 
855     default:
856         if(((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA512) && (output_length_in_byte < 64)) ||
857            ((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA384) && (output_length_in_byte < 48)) ||
858            ((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA512_224) && (output_length_in_byte < 28)) ||
859            ((method -> nx_crypto_algorithm == NX_CRYPTO_HASH_SHA512_256) && (output_length_in_byte < 32)))
860             return(NX_CRYPTO_INVALID_BUFFER_SIZE);
861         _nx_crypto_sha512_initialize(ctx, method -> nx_crypto_algorithm);
862         _nx_crypto_sha512_update(ctx, input, input_length_in_byte);
863         _nx_crypto_sha512_digest_calculate(ctx, output, method -> nx_crypto_algorithm);
864         break;
865     }
866 
867     return NX_CRYPTO_SUCCESS;
868 }
869 
870