hv_func.h

   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  * If USE_HASH_SEED_EXPLICIT is defined, hash randomisation is done
   8  * only if the environment variable PERL_HASH_SEED is set.
   9  * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed())
  10  */
  11
  12 #ifndef PERL_SEEN_HV_FUNC_H /* compile once */
  13 #define PERL_SEEN_HV_FUNC_H
  14
  15 #if IVSIZE == 8
  16 #define CAN64BITHASH
  17 #endif
  18
  19 /*-----------------------------------------------------------------------------
  20  * Endianess, misalignment capabilities and util macros
  21  *
  22  * The following 3 macros are defined in this section. The other macros defined
  23  * are only needed to help derive these 3.
  24  *
  25  * U8TO16_LE(x)   Read a little endian unsigned 32-bit int
  26  * U8TO32_LE(x)   Read a little endian unsigned 32-bit int
  27  * U8TO28_LE(x)   Read a little endian unsigned 32-bit int
  28  * ROTL32(x,r)      Rotate x left by r bits
  29  * ROTL64(x,r)      Rotate x left by r bits
  30  * ROTR32(x,r)      Rotate x right by r bits
  31  * ROTR64(x,r)      Rotate x right by r bits
  32  */
  33
  34 #ifndef U32_ALIGNMENT_REQUIRED
  35   #if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678)
  36     #define U8TO16_LE(ptr)   (*((const U16*)(ptr)))
  37     #define U8TO32_LE(ptr)   (*((const U32*)(ptr)))
  38     #define U8TO64_LE(ptr)   (*((const U64*)(ptr)))
  39   #elif (BYTEORDER == 0x4321 || BYTEORDER == 0x87654321)
  40     #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
  41       #define U8TO16_LE(ptr)   (__builtin_bswap16(*((U16*)(ptr))))
  42       #define U8TO32_LE(ptr)   (__builtin_bswap32(*((U32*)(ptr))))
  43       #define U8TO64_LE(ptr)   (__builtin_bswap64(*((U64*)(ptr))))
  44     #endif
  45   #endif
  46 #endif
  47
  48 #ifndef U8TO16_LE
  49     /* Without a known fast bswap32 we're just as well off doing this */
  50   #define U8TO16_LE(ptr)   ((U32)(ptr)[0]|(U32)(ptr)[1]<<8)
  51   #define U8TO32_LE(ptr)   ((U32)(ptr)[0]|(U32)(ptr)[1]<<8|(U32)(ptr)[2]<<16|(U32)(ptr)[3]<<24)
  52   #define U8TO64_LE(ptr)   ((U64)(ptr)[0]|(U64)(ptr)[1]<<8|(U64)(ptr)[2]<<16|(U64)(ptr)[3]<<24|\
  53                             (U64)(ptr)[4]<<32|(U64)(ptr)[5]<<40|\
  54                             (U64)(ptr)[6]<<48|(U64)(ptr)[7]<<56)
  55 #endif
  56
  57 #ifdef CAN64BITHASH
  58   #ifndef U64TYPE
  59   /* This probably isn't going to work, but failing with a compiler error due to
  60    lack of uint64_t is no worse than failing right now with an #error.  */
  61   #define U64 uint64_t
  62   #endif
  63 #endif
  64
  65 /* Find best way to ROTL32/ROTL64 */
  66 #if defined(_MSC_VER)
  67   #include <stdlib.h>  /* Microsoft put _rotl declaration in here */
  68   #define ROTL32(x,r)  _rotl(x,r)
  69   #define ROTR32(x,r)  _rotr(x,r)
  70   #define ROTL64(x,r)  _rotl64(x,r)
  71   #define ROTR64(x,r)  _rotr64(x,r)
  72 #else
  73   /* gcc recognises this code and generates a rotate instruction for CPUs with one */
  74   #define ROTL32(x,r)  (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r))))
  75   #define ROTR32(x,r)  (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r)))
  76   #define ROTL64(x,r)  ( ( (U64)(x) << (r) ) | ( (U64)(x) >> ( 64 - (r) ) ) )
  77   #define ROTR64(x,r)  ( ( (U64)(x) << ( 64 - (r) ) ) | ( (U64)(x) >> (r) ) )
  78 #endif
  79
  80
  81 #ifdef UV_IS_QUAD
  82 #define ROTL_UV(x,r) ROTL64(x,r)
  83 #define ROTR_UV(x,r) ROTL64(x,r)
  84 #else
  85 #define ROTL_UV(x,r) ROTL32(x,r)
  86 #define ROTR_UV(x,r) ROTR32(x,r)
  87 #endif
  88
  89 /*-----------------------------------------------------------------------------*
  90  * And now set up the actual hashing macros
  91  *-----------------------------------------------------------------------------*/
  92 #define PERL_HASH_FUNC_ZAPHOD32
  93
  94 #if !( 0 \
  95         || defined(PERL_HASH_FUNC_SIPHASH) \
  96         || defined(PERL_HASH_FUNC_SIPHASH13) \
  97         || defined(PERL_HASH_FUNC_STADTX) \
  98         || defined(PERL_HASH_FUNC_ZAPHOD32) \
  99     )
 100 #   ifdef CAN64BITHASH
 101 #       define PERL_HASH_FUNC_STADTX
 102 #   else
 103 #       define PERL_HASH_FUNC_ZAPHOD32
 104 #   endif
 105 #endif
 106
 107 #ifndef PERL_HASH_USE_SBOX32_ALSO
 108 #define PERL_HASH_USE_SBOX32_ALSO 1
 109 #endif
 110
 111 #ifndef SBOX32_MAX_LEN
 112 #define SBOX32_MAX_LEN 24
 113 #endif
 114
 115 /* this must be after the SBOX32_MAX_LEN define */
 116 #include "sbox32_hash.h"
 117
 118 #if defined(PERL_HASH_FUNC_SIPHASH)
 119 # define __PERL_HASH_FUNC "SIPHASH_2_4"
 120 # define __PERL_HASH_SEED_BYTES 16
 121 # define __PERL_HASH_STATE_BYTES 32
 122 # define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
 123 # define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_2_4_with_state((state),(U8*)(str),(len))
 124 #elif defined(PERL_HASH_FUNC_SIPHASH13)
 125 # define __PERL_HASH_FUNC "SIPHASH_1_3"
 126 # define __PERL_HASH_SEED_BYTES 16
 127 # define __PERL_HASH_STATE_BYTES 32
 128 # define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
 129 # define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_1_3_with_state((state),(U8*)(str),(len))
 130 #elif defined(PERL_HASH_FUNC_STADTX)
 131 # define __PERL_HASH_FUNC "STATDX"
 132 # define __PERL_HASH_SEED_BYTES 16
 133 # define __PERL_HASH_STATE_BYTES 32
 134 # define __PERL_HASH_SEED_STATE(seed,state) stadtx_seed_state(seed,state)
 135 # define __PERL_HASH_WITH_STATE(state,str,len) (U32)stadtx_hash_with_state((state),(U8*)(str),(len))
 136 # include "stadtx_hash.h"
 137 #elif defined(PERL_HASH_FUNC_ZAPHOD32)
 138 # define __PERL_HASH_FUNC "ZAPHOD32"
 139 # define __PERL_HASH_SEED_BYTES 12
 140 # define __PERL_HASH_STATE_BYTES 12
 141 # define __PERL_HASH_SEED_STATE(seed,state) zaphod32_seed_state(seed,state)
 142 # define __PERL_HASH_WITH_STATE(state,str,len) (U32)zaphod32_hash_with_state((state),(U8*)(str),(len))
 143 # include "zaphod32_hash.h"
 144 #endif
 145
 146 #ifndef __PERL_HASH_WITH_STATE
 147 #error "No hash function defined!"
 148 #endif
 149 #ifndef __PERL_HASH_SEED_BYTES
 150 #error "__PERL_HASH_SEED_BYTES not defined"
 151 #endif
 152 #ifndef __PERL_HASH_FUNC
 153 #error "__PERL_HASH_FUNC not defined"
 154 #endif
 155
 156
 157 #if PERL_HASH_USE_SBOX32_ALSO == 1
 158 # define _PERL_HASH_FUNC                        __PERL_HASH_FUNC
 159 # define _PERL_HASH_SEED_BYTES                  __PERL_HASH_SEED_BYTES
 160 # define _PERL_HASH_STATE_BYTES                 __PERL_HASH_STATE_BYTES
 161 # define _PERL_HASH_SEED_STATE(seed,state)      __PERL_HASH_SEED_STATE(seed,state)
 162 # define _PERL_HASH_WITH_STATE(state,str,len)   __PERL_HASH_WITH_STATE(state,str,len)
 163 #else
 164
 165 #define _PERL_HASH_FUNC         "SBOX32_WITH_" __PERL_HASH_FUNC
 166
 167 #define _PERL_HASH_SEED_BYTES   ( __PERL_HASH_SEED_BYTES + ( 3 * sizeof(U32) ) )
 168
 169 #define _PERL_HASH_STATE_BYTES  \
 170     ( __PERL_HASH_SEED_BYTES + ( ( 1 + ( 256 * SBOX32_MAX_LEN ) ) * sizeof(U32) ) )
 171
 172 #define _PERL_HASH_SEED_STATE(seed,state) STMT_START {                                      \
 173     __PERL_HASH_SEED_STATE(seed,state);                                                     \
 174     sbox32_seed_state96(seed + __PERL_HASH_SEED_BYTES , state + __PERL_HASH_STATE_BYTES);   \
 175 } STMT_END
 176
 177 #define _PERL_HASH_WITH_STATE(state,str,len)                                                \
 178     ((len <= SBOX32_MAX_LEN)                                                                \
 179         ? sbox32_hash_with_state((state + __PERL_HASH_STATE_BYTES),(U8*)(str),(len))        \
 180         : __PERL_HASH_WITH_STATE((state),(str),(len)))
 181
 182 #endif
 183
 184 PERL_STATIC_INLINE
 185 U32 S_perl_hash_with_seed(const U8 * const seed, const U8 * const str, const STRLEN len)
 186 {
 187     U8 state[_PERL_HASH_STATE_BYTES];
 188     _PERL_HASH_SEED_STATE(seed,state);
 189     return _PERL_HASH_WITH_STATE(state,str,len);
 190 }
 191
 192 #define PERL_HASH_WITH_SEED(seed,hash,str,len) \
 193     (hash) = S_perl_hash_with_seed(seed,str,len)
 194 #define PERL_HASH_WITH_STATE(state,hash,str,len) \
 195     (hash) = _PERL_HASH_WITH_STATE((state),(U8*)(str),(len))
 196 #define PERL_HASH_SEED_STATE(seed,state) _PERL_HASH_SEED_STATE(seed,state)
 197 #define PERL_HASH_SEED_BYTES _PERL_HASH_SEED_BYTES
 198 #define PERL_HASH_STATE_BYTES _PERL_HASH_STATE_BYTES
 199 #define PERL_HASH_FUNC        _PERL_HASH_FUNC
 200
 201 #ifdef PERL_USE_SINGLE_CHAR_HASH_CACHE
 202 #define PERL_HASH(state,str,len) \
 203     (hash) = ((len) < 2 ? ( (len) == 0 ? PL_hash_chars[256] : PL_hash_chars[(U8)(str)[0]] ) \
 204                        : _PERL_HASH_WITH_STATE(PL_hash_state,(U8*)(str),(len)))
 205 #else
 206 #define PERL_HASH(hash,str,len) \
 207     PERL_HASH_WITH_STATE(PL_hash_state,hash,(U8*)(str),(len))
 208 #endif
 209
 210 /* Setup the hash seed, either we do things dynamically at start up,
 211  * including reading from the environment, or we randomly setup the
 212  * seed. The seed will be passed into the PERL_HASH_SEED_STATE() function
 213  * defined for the configuration defined for this perl, which will then
 214  * initialze whatever state it might need later in hashing. */
 215
 216 #ifndef PERL_HASH_SEED
 217 #   if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
 218 #       define PERL_HASH_SEED PL_hash_seed
 219 #   else
 220        /* this is a 512 bit seed, which should be more than enough for the
 221         * configuration of any of our hash functions (with or without sbox).
 222         * If you actually use a hard coded seed, you are strongly encouraged
 223         * to replace this with something else of the correct length
 224         * for the hash function you are using (24-32 bytes depending on build
 225         * options). Repeat, you are *STRONGLY* encouraged not to use the value
 226         * provided here.
 227         */
 228 #       define PERL_HASH_SEED \
 229            ((const U8 *)"A long string of pseudorandomly "  \
 230                         "chosen bytes for hashing in Perl")
 231 #   endif
 232 #endif
 233
 234 /* legacy - only mod_perl should be doing this.  */
 235 #ifdef PERL_HASH_INTERNAL_ACCESS
 236 #define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
 237 #endif
 238
 239 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
 240  * The authors claim it is relatively secure compared to the alternatives
 241  * and that performance wise it is a suitable hash for languages like Perl.
 242  * See:
 243  *
 244  * https://www.131002.net/siphash/
 245  *
 246  * This implementation seems to perform slightly slower than one-at-a-time for
 247  * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
 248  * regardless of keys size.
 249  *
 250  * It is 64 bit only.
 251  */
 252
 253 #ifdef CAN64BITHASH
 254
 255 #define SIPROUND            \
 256   STMT_START {              \
 257     v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
 258     v2 += v3; v3=ROTL64(v3,16); v3 ^= v2;     \
 259     v0 += v3; v3=ROTL64(v3,21); v3 ^= v0;     \
 260     v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
 261   } STMT_END
 262
 263 #define SIPHASH_SEED_STATE(key,v0,v1,v2,v3) \
 264 do {                                    \
 265     v0 = v2 = U8TO64_LE(key + 0);       \
 266     v1 = v3 = U8TO64_LE(key + 8);       \
 267   /* "somepseudorandomlygeneratedbytes" */  \
 268     v0 ^= 0x736f6d6570736575ull;        \
 269     v1 ^= 0x646f72616e646f6dull;        \
 270     v2 ^= 0x6c7967656e657261ull;        \
 271     v3 ^= 0x7465646279746573ull;        \
 272 } while (0)
 273
 274 PERL_STATIC_INLINE
 275 void S_perl_siphash_seed_state(const unsigned char * const seed_buf, unsigned char * state_buf) {
 276     U64 *v= (U64*) state_buf;
 277     SIPHASH_SEED_STATE(seed_buf, v[0],v[1],v[2],v[3]);
 278 }
 279
 280 #define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \
 281 PERL_STATIC_INLINE U32 \
 282 FNC ## _with_state \
 283   (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \
 284 {                                           \
 285   const int left = inlen & 7;               \
 286   const U8 *end = in + inlen - left;        \
 287                                             \
 288   U64 b = ( ( U64 )(inlen) ) << 56;         \
 289   U64 m;                                    \
 290   U64 v0 = U8TO64_LE(state);                \
 291   U64 v1 = U8TO64_LE(state+8);              \
 292   U64 v2 = U8TO64_LE(state+16);             \
 293   U64 v3 = U8TO64_LE(state+24);             \
 294                                             \
 295   for ( ; in != end; in += 8 )              \
 296   {                                         \
 297     m = U8TO64_LE( in );                    \
 298     v3 ^= m;                                \
 299                                             \
 300     SIP_ROUNDS;                             \
 301                                             \
 302     v0 ^= m;                                \
 303   }                                         \
 304                                             \
 305   switch( left )                            \
 306   {                                         \
 307   case 7: b |= ( ( U64 )in[ 6] )  << 48;    \
 308   case 6: b |= ( ( U64 )in[ 5] )  << 40;    \
 309   case 5: b |= ( ( U64 )in[ 4] )  << 32;    \
 310   case 4: b |= ( ( U64 )in[ 3] )  << 24;    \
 311   case 3: b |= ( ( U64 )in[ 2] )  << 16;    \
 312   case 2: b |= ( ( U64 )in[ 1] )  <<  8;    \
 313   case 1: b |= ( ( U64 )in[ 0] ); break;    \
 314   case 0: break;                            \
 315   }                                         \
 316                                             \
 317   v3 ^= b;                                  \
 318                                             \
 319   SIP_ROUNDS;                               \
 320                                             \
 321   v0 ^= b;                                  \
 322                                             \
 323   v2 ^= 0xff;                               \
 324                                             \
 325   SIP_FINAL_ROUNDS                          \
 326                                             \
 327   b = v0 ^ v1 ^ v2  ^ v3;                   \
 328   return (U32)(b & U32_MAX);                \
 329 }                                           \
 330                                             \
 331 PERL_STATIC_INLINE U32                      \
 332 FNC (const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) \
 333 {                                                                   \
 334     U64 state[4];                                                   \
 335     SIPHASH_SEED_STATE(seed,state[0],state[1],state[2],state[3]);   \
 336     return FNC ## _with_state((U8*)state,in,inlen);                 \
 337 }
 338
 339
 340 PERL_SIPHASH_FNC(
 341     S_perl_hash_siphash_1_3
 342     ,SIPROUND;
 343     ,SIPROUND;SIPROUND;SIPROUND;
 344 )
 345
 346 PERL_SIPHASH_FNC(
 347     S_perl_hash_siphash_2_4
 348     ,SIPROUND;SIPROUND;
 349     ,SIPROUND;SIPROUND;SIPROUND;SIPROUND;
 350 )
 351 #endif /* defined(CAN64BITHASH) */
 352
 353
 354
 355
 356
 357 #endif /*compile once*/
 358
 359 /*
 360  * ex: set ts=8 sts=4 sw=4 et:
 361  */