xref: /openbsd/gnu/usr.bin/perl/hv_func.h (revision d89ec533)
1 /* hash a key
2  *--------------------------------------------------------------------------------------
3  * The "hash seed" feature was added in Perl 5.8.1 to perturb the results
4  * to avoid "algorithmic complexity attacks".
5  *
6  * If USE_HASH_SEED is defined, hash randomisation is done by default
7  * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed())
8  */
9 #ifndef PERL_SEEN_HV_FUNC_H /* compile once */
10 #define PERL_SEEN_HV_FUNC_H
11 #include "hv_macro.h"
12 
13 #if !( 0 \
14         || defined(PERL_HASH_FUNC_SIPHASH) \
15         || defined(PERL_HASH_FUNC_SIPHASH13) \
16         || defined(PERL_HASH_FUNC_STADTX) \
17         || defined(PERL_HASH_FUNC_ZAPHOD32) \
18     )
19 #   ifdef CAN64BITHASH
20 #       define PERL_HASH_FUNC_STADTX
21 #   else
22 #       define PERL_HASH_FUNC_ZAPHOD32
23 #   endif
24 #endif
25 
26 #ifndef PERL_HASH_USE_SBOX32_ALSO
27 #define PERL_HASH_USE_SBOX32_ALSO 1
28 #endif
29 
30 #ifndef SBOX32_MAX_LEN
31 #define SBOX32_MAX_LEN 24
32 #endif
33 
34 /* this must be after the SBOX32_MAX_LEN define */
35 #include "sbox32_hash.h"
36 
37 #if defined(PERL_HASH_FUNC_SIPHASH)
38 # define __PERL_HASH_FUNC "SIPHASH_2_4"
39 # define __PERL_HASH_WORD_TYPE U64
40 # define __PERL_HASH_WORD_SIZE sizeof(__PERL_HASH_WORD_TYPE)
41 # define __PERL_HASH_SEED_BYTES (__PERL_HASH_WORD_SIZE * 2)
42 # define __PERL_HASH_STATE_BYTES (__PERL_HASH_WORD_SIZE * 4)
43 # define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
44 # define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_2_4_with_state((state),(U8*)(str),(len))
45 #elif defined(PERL_HASH_FUNC_SIPHASH13)
46 # define __PERL_HASH_FUNC "SIPHASH_1_3"
47 # define __PERL_HASH_WORD_TYPE U64
48 # define __PERL_HASH_WORD_SIZE sizeof(__PERL_HASH_WORD_TYPE)
49 # define __PERL_HASH_SEED_BYTES (__PERL_HASH_WORD_SIZE * 2)
50 # define __PERL_HASH_STATE_BYTES (__PERL_HASH_WORD_SIZE * 4)
51 # define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
52 # define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_1_3_with_state((state),(U8*)(str),(len))
53 #elif defined(PERL_HASH_FUNC_STADTX)
54 # define __PERL_HASH_FUNC "STADTX"
55 # define __PERL_HASH_WORD_TYPE U64
56 # define __PERL_HASH_WORD_SIZE sizeof(__PERL_HASH_WORD_TYPE)
57 # define __PERL_HASH_SEED_BYTES (__PERL_HASH_WORD_SIZE * 2)
58 # define __PERL_HASH_STATE_BYTES (__PERL_HASH_WORD_SIZE * 4)
59 # define __PERL_HASH_SEED_STATE(seed,state) stadtx_seed_state(seed,state)
60 # define __PERL_HASH_WITH_STATE(state,str,len) (U32)stadtx_hash_with_state((state),(U8*)(str),(len))
61 # include "stadtx_hash.h"
62 #elif defined(PERL_HASH_FUNC_ZAPHOD32)
63 # define __PERL_HASH_FUNC "ZAPHOD32"
64 # define __PERL_HASH_WORD_TYPE U32
65 # define __PERL_HASH_WORD_SIZE sizeof(__PERL_HASH_WORD_TYPE)
66 # define __PERL_HASH_SEED_BYTES (__PERL_HASH_WORD_SIZE * 3)
67 # define __PERL_HASH_STATE_BYTES (__PERL_HASH_WORD_SIZE * 3)
68 # define __PERL_HASH_SEED_STATE(seed,state) zaphod32_seed_state(seed,state)
69 # define __PERL_HASH_WITH_STATE(state,str,len) (U32)zaphod32_hash_with_state((state),(U8*)(str),(len))
70 # include "zaphod32_hash.h"
71 #endif
72 
73 #ifndef __PERL_HASH_WITH_STATE
74 #error "No hash function defined!"
75 #endif
76 #ifndef __PERL_HASH_SEED_BYTES
77 #error "__PERL_HASH_SEED_BYTES not defined"
78 #endif
79 #ifndef __PERL_HASH_FUNC
80 #error "__PERL_HASH_FUNC not defined"
81 #endif
82 
83 
84 #define __PERL_HASH_SEED_roundup(x, y)   ( ( ( (x) + ( (y) - 1 ) ) / (y) ) * (y) )
85 #define _PERL_HASH_SEED_roundup(x) __PERL_HASH_SEED_roundup(x,__PERL_HASH_WORD_SIZE)
86 
87 #define PL_hash_seed ((U8 *)PL_hash_seed_w)
88 #define PL_hash_state ((U8 *)PL_hash_state_w)
89 
90 #if PERL_HASH_USE_SBOX32_ALSO != 1
91 # define _PERL_HASH_FUNC                        __PERL_HASH_FUNC
92 # define _PERL_HASH_SEED_BYTES                  __PERL_HASH_SEED_BYTES
93 # define _PERL_HASH_STATE_BYTES                 __PERL_HASH_STATE_BYTES
94 # define _PERL_HASH_SEED_STATE(seed,state)      __PERL_HASH_SEED_STATE(seed,state)
95 # define _PERL_HASH_WITH_STATE(state,str,len)   __PERL_HASH_WITH_STATE(state,str,len)
96 #else
97 
98 #define _PERL_HASH_FUNC         "SBOX32_WITH_" __PERL_HASH_FUNC
99 /* note the 3 in the below code comes from the fact the seed to initialize the SBOX is 96 bits */
100 #define _PERL_HASH_SEED_BYTES   ( __PERL_HASH_SEED_BYTES + (int)( 3 * sizeof(U32)) )
101 
102 #define _PERL_HASH_STATE_BYTES  \
103     ( __PERL_HASH_STATE_BYTES + ( ( 1 + ( 256 * SBOX32_MAX_LEN ) ) * sizeof(U32) ) )
104 
105 #define _PERL_HASH_SEED_STATE(seed,state) STMT_START {                                      \
106     __PERL_HASH_SEED_STATE(seed,state);                                                     \
107     sbox32_seed_state96(seed + __PERL_HASH_SEED_BYTES, state + __PERL_HASH_STATE_BYTES);    \
108 } STMT_END
109 
110 #define _PERL_HASH_WITH_STATE(state,str,len)                                            \
111     (LIKELY(len <= SBOX32_MAX_LEN)                                                      \
112         ? sbox32_hash_with_state((state + __PERL_HASH_STATE_BYTES),(U8*)(str),(len))    \
113         : __PERL_HASH_WITH_STATE((state),(str),(len)))
114 
115 #endif
116 
117 #define PERL_HASH_WITH_SEED(seed,hash,str,len) \
118     (hash) = S_perl_hash_with_seed((const U8 *) seed, (const U8 *) str,len)
119 #define PERL_HASH_WITH_STATE(state,hash,str,len) \
120     (hash) = _PERL_HASH_WITH_STATE((state),(U8*)(str),(len))
121 
122 #define PERL_HASH_SEED_STATE(seed,state) _PERL_HASH_SEED_STATE(seed,state)
123 #define PERL_HASH_SEED_BYTES _PERL_HASH_SEED_roundup(_PERL_HASH_SEED_BYTES)
124 #define PERL_HASH_STATE_BYTES _PERL_HASH_SEED_roundup(_PERL_HASH_STATE_BYTES)
125 #define PERL_HASH_FUNC        _PERL_HASH_FUNC
126 
127 #define PERL_HASH_SEED_WORDS (PERL_HASH_SEED_BYTES/__PERL_HASH_WORD_SIZE)
128 #define PERL_HASH_STATE_WORDS (PERL_HASH_STATE_BYTES/__PERL_HASH_WORD_SIZE)
129 
130 #ifdef PERL_USE_SINGLE_CHAR_HASH_CACHE
131 #define PERL_HASH(state,str,len) \
132     (hash) = ((len) < 2 ? ( (len) == 0 ? PL_hash_chars[256] : PL_hash_chars[(U8)(str)[0]] ) \
133                        : _PERL_HASH_WITH_STATE(PL_hash_state,(U8*)(str),(len)))
134 #else
135 #define PERL_HASH(hash,str,len) \
136     PERL_HASH_WITH_STATE(PL_hash_state,hash,(U8*)(str),(len))
137 #endif
138 
139 /* Setup the hash seed, either we do things dynamically at start up,
140  * including reading from the environment, or we randomly setup the
141  * seed. The seed will be passed into the PERL_HASH_SEED_STATE() function
142  * defined for the configuration defined for this perl, which will then
143  * initialize whatever state it might need later in hashing. */
144 
145 #ifndef PERL_HASH_SEED
146 #   if defined(USE_HASH_SEED)
147 #       define PERL_HASH_SEED PL_hash_seed
148 #   else
149        /* this is a 512 bit seed, which should be more than enough for the
150         * configuration of any of our hash functions (with or without sbox).
151         * If you actually use a hard coded seed, you are strongly encouraged
152         * to replace this with something else of the correct length
153         * for the hash function you are using (24-32 bytes depending on build
154         * options). Repeat, you are *STRONGLY* encouraged not to use the value
155         * provided here.
156         */
157 #       define PERL_HASH_SEED \
158            ((const U8 *)"A long string of pseudorandomly "  \
159                         "chosen bytes for hashing in Perl")
160 #   endif
161 #endif
162 
163 /* legacy - only mod_perl should be doing this.  */
164 #ifdef PERL_HASH_INTERNAL_ACCESS
165 #define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
166 #endif
167 
168 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
169  * The authors claim it is relatively secure compared to the alternatives
170  * and that performance wise it is a suitable hash for languages like Perl.
171  * See:
172  *
173  * https://www.131002.net/siphash/
174  *
175  * This implementation seems to perform slightly slower than one-at-a-time for
176  * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
177  * regardless of keys size.
178  *
179  * It is 64 bit only.
180  */
181 
182 #ifdef CAN64BITHASH
183 
184 #define SIPROUND            \
185   STMT_START {              \
186     v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
187     v2 += v3; v3=ROTL64(v3,16); v3 ^= v2;     \
188     v0 += v3; v3=ROTL64(v3,21); v3 ^= v0;     \
189     v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
190   } STMT_END
191 
192 #define SIPHASH_SEED_STATE(key,v0,v1,v2,v3) \
193 do {                                    \
194     v0 = v2 = U8TO64_LE(key + 0);       \
195     v1 = v3 = U8TO64_LE(key + 8);       \
196   /* "somepseudorandomlygeneratedbytes" */  \
197     v0 ^= UINT64_C(0x736f6d6570736575);  \
198     v1 ^= UINT64_C(0x646f72616e646f6d);      \
199     v2 ^= UINT64_C(0x6c7967656e657261);      \
200     v3 ^= UINT64_C(0x7465646279746573);      \
201 } while (0)
202 
203 PERL_STATIC_INLINE
204 void S_perl_siphash_seed_state(const unsigned char * const seed_buf, unsigned char * state_buf) {
205     U64 *v= (U64*) state_buf;
206     SIPHASH_SEED_STATE(seed_buf, v[0],v[1],v[2],v[3]);
207 }
208 
209 #define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \
210 PERL_STATIC_INLINE U64 \
211 FNC ## _with_state_64 \
212   (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \
213 {                                           \
214   const int left = inlen & 7;               \
215   const U8 *end = in + inlen - left;        \
216                                             \
217   U64 b = ( ( U64 )(inlen) ) << 56;         \
218   U64 m;                                    \
219   U64 v0 = U8TO64_LE(state);                \
220   U64 v1 = U8TO64_LE(state+8);              \
221   U64 v2 = U8TO64_LE(state+16);             \
222   U64 v3 = U8TO64_LE(state+24);             \
223                                             \
224   for ( ; in != end; in += 8 )              \
225   {                                         \
226     m = U8TO64_LE( in );                    \
227     v3 ^= m;                                \
228                                             \
229     SIP_ROUNDS;                             \
230                                             \
231     v0 ^= m;                                \
232   }                                         \
233                                             \
234   switch( left )                            \
235   {                                         \
236   case 7: b |= ( ( U64 )in[ 6] )  << 48; /*FALLTHROUGH*/    \
237   case 6: b |= ( ( U64 )in[ 5] )  << 40; /*FALLTHROUGH*/    \
238   case 5: b |= ( ( U64 )in[ 4] )  << 32; /*FALLTHROUGH*/    \
239   case 4: b |= ( ( U64 )in[ 3] )  << 24; /*FALLTHROUGH*/    \
240   case 3: b |= ( ( U64 )in[ 2] )  << 16; /*FALLTHROUGH*/    \
241   case 2: b |= ( ( U64 )in[ 1] )  <<  8; /*FALLTHROUGH*/    \
242   case 1: b |= ( ( U64 )in[ 0] ); break;    \
243   case 0: break;                            \
244   }                                         \
245                                             \
246   v3 ^= b;                                  \
247                                             \
248   SIP_ROUNDS;                               \
249                                             \
250   v0 ^= b;                                  \
251                                             \
252   v2 ^= 0xff;                               \
253                                             \
254   SIP_FINAL_ROUNDS                          \
255                                             \
256   b = v0 ^ v1 ^ v2  ^ v3;                   \
257   return b;                                 \
258 }                                           \
259                                             \
260 PERL_STATIC_INLINE U32                      \
261 FNC ## _with_state                          \
262   (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \
263 {                                           \
264     union {                                 \
265         U64 h64;                            \
266         U32 h32[2];                         \
267     } h;                                    \
268     h.h64= FNC ## _with_state_64(state,in,inlen); \
269     return h.h32[0] ^ h.h32[1];             \
270 }                                           \
271                                             \
272                                             \
273 PERL_STATIC_INLINE U32                      \
274 FNC (const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) \
275 {                                                                   \
276     U64 state[4];                                                   \
277     SIPHASH_SEED_STATE(seed,state[0],state[1],state[2],state[3]);   \
278     return FNC ## _with_state((U8*)state,in,inlen);                 \
279 }
280 
281 
282 PERL_SIPHASH_FNC(
283     S_perl_hash_siphash_1_3
284     ,SIPROUND;
285     ,SIPROUND;SIPROUND;SIPROUND;
286 )
287 
288 PERL_SIPHASH_FNC(
289     S_perl_hash_siphash_2_4
290     ,SIPROUND;SIPROUND;
291     ,SIPROUND;SIPROUND;SIPROUND;SIPROUND;
292 )
293 
294 #endif /* defined(CAN64BITHASH) */
295 
296 
297 PERL_STATIC_INLINE U32
298 S_perl_hash_with_seed(const U8 * seed, const U8 *str, STRLEN len) {
299     __PERL_HASH_WORD_TYPE state[PERL_HASH_STATE_WORDS];
300     _PERL_HASH_SEED_STATE(seed,(U8*)state);
301     return _PERL_HASH_WITH_STATE((U8*)state,str,len);
302 }
303 
304 #endif /*compile once*/
305 
306 /*
307  * ex: set ts=8 sts=4 sw=4 et:
308  */
309