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  * (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_SEED_BYTES 16
  40 # define __PERL_HASH_STATE_BYTES 32
  41 # define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
  42 # define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_2_4_with_state((state),(U8*)(str),(len))
  43 #elif defined(PERL_HASH_FUNC_SIPHASH13)
  44 # define __PERL_HASH_FUNC "SIPHASH_1_3"
  45 # define __PERL_HASH_SEED_BYTES 16
  46 # define __PERL_HASH_STATE_BYTES 32
  47 # define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
  48 # define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_1_3_with_state((state),(U8*)(str),(len))
  49 #elif defined(PERL_HASH_FUNC_STADTX)
  50 # define __PERL_HASH_FUNC "STATDX"
  51 # define __PERL_HASH_SEED_BYTES 16
  52 # define __PERL_HASH_STATE_BYTES 32
  53 # define __PERL_HASH_SEED_STATE(seed,state) stadtx_seed_state(seed,state)
  54 # define __PERL_HASH_WITH_STATE(state,str,len) (U32)stadtx_hash_with_state((state),(U8*)(str),(len))
  55 # include "stadtx_hash.h"
  56 #elif defined(PERL_HASH_FUNC_ZAPHOD32)
  57 # define __PERL_HASH_FUNC "ZAPHOD32"
  58 # define __PERL_HASH_SEED_BYTES 12
  59 # define __PERL_HASH_STATE_BYTES 12
  60 # define __PERL_HASH_SEED_STATE(seed,state) zaphod32_seed_state(seed,state)
  61 # define __PERL_HASH_WITH_STATE(state,str,len) (U32)zaphod32_hash_with_state((state),(U8*)(str),(len))
  62 # include "zaphod32_hash.h"
  63 #endif
  64
  65 #ifndef __PERL_HASH_WITH_STATE
  66 #error "No hash function defined!"
  67 #endif
  68 #ifndef __PERL_HASH_SEED_BYTES
  69 #error "__PERL_HASH_SEED_BYTES not defined"
  70 #endif
  71 #ifndef __PERL_HASH_FUNC
  72 #error "__PERL_HASH_FUNC not defined"
  73 #endif
  74
  75
  76 #if PERL_HASH_USE_SBOX32_ALSO == 1
  77 # define _PERL_HASH_FUNC                        __PERL_HASH_FUNC
  78 # define _PERL_HASH_SEED_BYTES                  __PERL_HASH_SEED_BYTES
  79 # define _PERL_HASH_STATE_BYTES                 __PERL_HASH_STATE_BYTES
  80 # define _PERL_HASH_SEED_STATE(seed,state)      __PERL_HASH_SEED_STATE(seed,state)
  81 # define _PERL_HASH_WITH_STATE(state,str,len)   __PERL_HASH_WITH_STATE(state,str,len)
  82 #else
  83
  84 #define _PERL_HASH_FUNC         "SBOX32_WITH_" __PERL_HASH_FUNC
  85
  86 #define _PERL_HASH_SEED_BYTES   ( __PERL_HASH_SEED_BYTES + ( 3 * sizeof(U32) ) )
  87
  88 #define _PERL_HASH_STATE_BYTES  \
  89     ( __PERL_HASH_SEED_BYTES + ( ( 1 + ( 256 * SBOX32_MAX_LEN ) ) * sizeof(U32) ) )
  90
  91 #define _PERL_HASH_SEED_STATE(seed,state) STMT_START {                                      \
  92     __PERL_HASH_SEED_STATE(seed,state);                                                     \
  93     sbox32_seed_state96(seed + __PERL_HASH_SEED_BYTES , state + __PERL_HASH_STATE_BYTES);   \
  94 } STMT_END
  95
  96 #define _PERL_HASH_WITH_STATE(state,str,len)                                            \
  97     (LIKELY(len <= SBOX32_MAX_LEN)                                                      \
  98         ? sbox32_hash_with_state((state + __PERL_HASH_STATE_BYTES),(U8*)(str),(len))    \
  99         : UNLIKELY(len > (STRLEN) I32_MAX)                                              \
 100           ? Perl_croak_nocontext("Sorry, hash keys must be smaller than 2**31 bytes")   \
 101           : __PERL_HASH_WITH_STATE((state),(str),(len)))
 102
 103 #endif
 104
 105 PERL_STATIC_INLINE
 106 U32 S_perl_hash_with_seed(const U8 * const seed, const U8 * const str, const STRLEN len)
 107 {
 108     U8 state[_PERL_HASH_STATE_BYTES];
 109     _PERL_HASH_SEED_STATE(seed,state);
 110     return _PERL_HASH_WITH_STATE(state,str,len);
 111 }
 112
 113 #define PERL_HASH_WITH_SEED(seed,hash,str,len) \
 114     (hash) = S_perl_hash_with_seed(seed,str,len)
 115 #define PERL_HASH_WITH_STATE(state,hash,str,len) \
 116     (hash) = _PERL_HASH_WITH_STATE((state),(U8*)(str),(len))
 117 #define PERL_HASH_SEED_STATE(seed,state) _PERL_HASH_SEED_STATE(seed,state)
 118 #define PERL_HASH_SEED_BYTES _PERL_HASH_SEED_BYTES
 119 #define PERL_HASH_STATE_BYTES _PERL_HASH_STATE_BYTES
 120 #define PERL_HASH_FUNC        _PERL_HASH_FUNC
 121
 122 #ifdef PERL_USE_SINGLE_CHAR_HASH_CACHE
 123 #define PERL_HASH(state,str,len) \
 124     (hash) = ((len) < 2 ? ( (len) == 0 ? PL_hash_chars[256] : PL_hash_chars[(U8)(str)[0]] ) \
 125                        : _PERL_HASH_WITH_STATE(PL_hash_state,(U8*)(str),(len)))
 126 #else
 127 #define PERL_HASH(hash,str,len) \
 128     PERL_HASH_WITH_STATE(PL_hash_state,hash,(U8*)(str),(len))
 129 #endif
 130
 131 /* Setup the hash seed, either we do things dynamically at start up,
 132  * including reading from the environment, or we randomly setup the
 133  * seed. The seed will be passed into the PERL_HASH_SEED_STATE() function
 134  * defined for the configuration defined for this perl, which will then
 135  * initialze whatever state it might need later in hashing. */
 136
 137 #ifndef PERL_HASH_SEED
 138 #   if defined(USE_HASH_SEED)
 139 #       define PERL_HASH_SEED PL_hash_seed
 140 #   else
 141        /* this is a 512 bit seed, which should be more than enough for the
 142         * configuration of any of our hash functions (with or without sbox).
 143         * If you actually use a hard coded seed, you are strongly encouraged
 144         * to replace this with something else of the correct length
 145         * for the hash function you are using (24-32 bytes depending on build
 146         * options). Repeat, you are *STRONGLY* encouraged not to use the value
 147         * provided here.
 148         */
 149 #       define PERL_HASH_SEED \
 150            ((const U8 *)"A long string of pseudorandomly "  \
 151                         "chosen bytes for hashing in Perl")
 152 #   endif
 153 #endif
 154
 155 /* legacy - only mod_perl should be doing this.  */
 156 #ifdef PERL_HASH_INTERNAL_ACCESS
 157 #define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
 158 #endif
 159
 160 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
 161  * The authors claim it is relatively secure compared to the alternatives
 162  * and that performance wise it is a suitable hash for languages like Perl.
 163  * See:
 164  *
 165  * https://www.131002.net/siphash/
 166  *
 167  * This implementation seems to perform slightly slower than one-at-a-time for
 168  * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
 169  * regardless of keys size.
 170  *
 171  * It is 64 bit only.
 172  */
 173
 174 #ifdef CAN64BITHASH
 175
 176 #define SIPROUND            \
 177   STMT_START {              \
 178     v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
 179     v2 += v3; v3=ROTL64(v3,16); v3 ^= v2;     \
 180     v0 += v3; v3=ROTL64(v3,21); v3 ^= v0;     \
 181     v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
 182   } STMT_END
 183
 184 #define SIPHASH_SEED_STATE(key,v0,v1,v2,v3) \
 185 do {                                    \
 186     v0 = v2 = U8TO64_LE(key + 0);       \
 187     v1 = v3 = U8TO64_LE(key + 8);       \
 188   /* "somepseudorandomlygeneratedbytes" */  \
 189     v0 ^= 0x736f6d6570736575ull;        \
 190     v1 ^= 0x646f72616e646f6dull;        \
 191     v2 ^= 0x6c7967656e657261ull;        \
 192     v3 ^= 0x7465646279746573ull;        \
 193 } while (0)
 194
 195 PERL_STATIC_INLINE
 196 void S_perl_siphash_seed_state(const unsigned char * const seed_buf, unsigned char * state_buf) {
 197     U64 *v= (U64*) state_buf;
 198     SIPHASH_SEED_STATE(seed_buf, v[0],v[1],v[2],v[3]);
 199 }
 200
 201 #define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \
 202 PERL_STATIC_INLINE U32 \
 203 FNC ## _with_state \
 204   (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \
 205 {                                           \
 206   const int left = inlen & 7;               \
 207   const U8 *end = in + inlen - left;        \
 208                                             \
 209   U64 b = ( ( U64 )(inlen) ) << 56;         \
 210   U64 m;                                    \
 211   U64 v0 = U8TO64_LE(state);                \
 212   U64 v1 = U8TO64_LE(state+8);              \
 213   U64 v2 = U8TO64_LE(state+16);             \
 214   U64 v3 = U8TO64_LE(state+24);             \
 215                                             \
 216   for ( ; in != end; in += 8 )              \
 217   {                                         \
 218     m = U8TO64_LE( in );                    \
 219     v3 ^= m;                                \
 220                                             \
 221     SIP_ROUNDS;                             \
 222                                             \
 223     v0 ^= m;                                \
 224   }                                         \
 225                                             \
 226   switch( left )                            \
 227   {                                         \
 228   case 7: b |= ( ( U64 )in[ 6] )  << 48;    \
 229   case 6: b |= ( ( U64 )in[ 5] )  << 40;    \
 230   case 5: b |= ( ( U64 )in[ 4] )  << 32;    \
 231   case 4: b |= ( ( U64 )in[ 3] )  << 24;    \
 232   case 3: b |= ( ( U64 )in[ 2] )  << 16;    \
 233   case 2: b |= ( ( U64 )in[ 1] )  <<  8;    \
 234   case 1: b |= ( ( U64 )in[ 0] ); break;    \
 235   case 0: break;                            \
 236   }                                         \
 237                                             \
 238   v3 ^= b;                                  \
 239                                             \
 240   SIP_ROUNDS;                               \
 241                                             \
 242   v0 ^= b;                                  \
 243                                             \
 244   v2 ^= 0xff;                               \
 245                                             \
 246   SIP_FINAL_ROUNDS                          \
 247                                             \
 248   b = v0 ^ v1 ^ v2  ^ v3;                   \
 249   return (U32)(b & U32_MAX);                \
 250 }                                           \
 251                                             \
 252 PERL_STATIC_INLINE U32                      \
 253 FNC (const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) \
 254 {                                                                   \
 255     U64 state[4];                                                   \
 256     SIPHASH_SEED_STATE(seed,state[0],state[1],state[2],state[3]);   \
 257     return FNC ## _with_state((U8*)state,in,inlen);                 \
 258 }
 259
 260
 261 PERL_SIPHASH_FNC(
 262     S_perl_hash_siphash_1_3
 263     ,SIPROUND;
 264     ,SIPROUND;SIPROUND;SIPROUND;
 265 )
 266
 267 PERL_SIPHASH_FNC(
 268     S_perl_hash_siphash_2_4
 269     ,SIPROUND;SIPROUND;
 270     ,SIPROUND;SIPROUND;SIPROUND;SIPROUND;
 271 )
 272 #endif /* defined(CAN64BITHASH) */
 273
 274
 275 #endif /*compile once*/
 276
 277 /*
 278  * ex: set ts=8 sts=4 sw=4 et:
 279  */