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 !( 0 \
  16         || defined(PERL_HASH_FUNC_SIPHASH) \
  17         || defined(PERL_HASH_FUNC_SIPHASH13) \
  18         || defined(PERL_HASH_FUNC_HYBRID_OAATHU_SIPHASH13) \
  19         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD) \
  20     )
  21 #if IVSIZE == 8
  22 #define PERL_HASH_FUNC_HYBRID_OAATHU_SIPHASH13
  23 #else
  24 #define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
  25 #endif
  26 #endif
  27
  28 #if defined(PERL_HASH_FUNC_SIPHASH)
  29 #   define PERL_HASH_FUNC "SIPHASH_2_4"
  30 #   define PERL_HASH_SEED_BYTES 16
  31 #   define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_siphash_2_4((seed),(U8*)(str),(len))
  32 #elif defined(PERL_HASH_FUNC_SIPHASH13)
  33 #   define PERL_HASH_FUNC "SIPHASH_1_3"
  34 #   define PERL_HASH_SEED_BYTES 16
  35 #   define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_siphash_1_3((seed),(U8*)(str),(len))
  36 #elif defined(PERL_HASH_FUNC_HYBRID_OAATHU_SIPHASH13)
  37 #   define PERL_HASH_FUNC "HYBRID_OAATHU_SIPHASH_1_3"
  38 #   define PERL_HASH_SEED_BYTES 24
  39 #   define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_oaathu_siphash_1_3((seed),(U8*)(str),(len))
  40 #elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD)
  41 #   define PERL_HASH_FUNC "ONE_AT_A_TIME_HARD"
  42 #   define PERL_HASH_SEED_BYTES 8
  43 #   define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_one_at_a_time_hard((seed),(U8*)(str),(len))
  44 #endif
  45
  46 #ifndef PERL_HASH_WITH_SEED
  47 #error "No hash function defined!"
  48 #endif
  49 #ifndef PERL_HASH_SEED_BYTES
  50 #error "PERL_HASH_SEED_BYTES not defined"
  51 #endif
  52 #ifndef PERL_HASH_FUNC
  53 #error "PERL_HASH_FUNC not defined"
  54 #endif
  55
  56 #ifndef PERL_HASH_SEED
  57 #   if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
  58 #       define PERL_HASH_SEED PL_hash_seed
  59 #   elif PERL_HASH_SEED_BYTES == 4
  60 #       define PERL_HASH_SEED ((const U8 *)"PeRl")
  61 #   elif PERL_HASH_SEED_BYTES == 8
  62 #       define PERL_HASH_SEED ((const U8 *)"PeRlHaSh")
  63 #   elif PERL_HASH_SEED_BYTES == 16
  64 #       define PERL_HASH_SEED ((const U8 *)"PeRlHaShhAcKpErl")
  65 #   else
  66 #       error "No PERL_HASH_SEED definition for " PERL_HASH_FUNC
  67 #   endif
  68 #endif
  69
  70 #define PERL_HASH(hash,str,len) PERL_HASH_WITH_SEED(PERL_HASH_SEED,hash,str,len)
  71
  72 /* legacy - only mod_perl should be doing this.  */
  73 #ifdef PERL_HASH_INTERNAL_ACCESS
  74 #define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
  75 #endif
  76
  77 /*-----------------------------------------------------------------------------
  78  * Endianess, misalignment capabilities and util macros
  79  *
  80  * The following 3 macros are defined in this section. The other macros defined
  81  * are only needed to help derive these 3.
  82  *
  83  * U8TO32_LE(x)   Read a little endian unsigned 32-bit int
  84  * UNALIGNED_SAFE   Defined if unaligned access is safe
  85  * ROTL32(x,r)      Rotate x left by r bits
  86  */
  87
  88 #if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \
  89   || defined(_MSC_VER) || defined (__TURBOC__)
  90 #define U8TO16_LE(d) (*((const U16 *) (d)))
  91 #endif
  92
  93 #if !defined (U8TO16_LE)
  94 #define U8TO16_LE(d) ((((const U8 *)(d))[1] << 8)\
  95                       +((const U8 *)(d))[0])
  96 #endif
  97
  98 #if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) && U32SIZE == 4
  99   /* CPU endian matches murmurhash algorithm, so read 32-bit word directly */
 100   #define U8TO32_LE(ptr)   (*((const U32*)(ptr)))
 101 #elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
 102   /* TODO: Add additional cases below where a compiler provided bswap32 is available */
 103   #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
 104     #define U8TO32_LE(ptr)   (__builtin_bswap32(*((U32*)(ptr))))
 105   #else
 106     /* Without a known fast bswap32 we're just as well off doing this */
 107     #define U8TO32_LE(ptr)   (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
 108     #define UNALIGNED_SAFE
 109   #endif
 110 #else
 111   /* Unknown endianess so last resort is to read individual bytes */
 112   #define U8TO32_LE(ptr)   (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
 113   /* Since we're not doing word-reads we can skip the messing about with realignment */
 114   #define UNALIGNED_SAFE
 115 #endif
 116
 117 #ifdef HAS_QUAD
 118 #ifndef U64TYPE
 119 /* This probably isn't going to work, but failing with a compiler error due to
 120    lack of uint64_t is no worse than failing right now with an #error.  */
 121 #define U64 uint64_t
 122 #endif
 123 #endif
 124
 125 /* Find best way to ROTL32/ROTL64 */
 126 #if defined(_MSC_VER)
 127   #include <stdlib.h>  /* Microsoft put _rotl declaration in here */
 128   #define ROTL32(x,r)  _rotl(x,r)
 129   #ifdef HAS_QUAD
 130     #define ROTL64(x,r)  _rotl64(x,r)
 131   #endif
 132 #else
 133   /* gcc recognises this code and generates a rotate instruction for CPUs with one */
 134   #define ROTL32(x,r)  (((U32)x << r) | ((U32)x >> (32 - r)))
 135   #ifdef HAS_QUAD
 136     #define ROTL64(x,r)  (((U64)x << r) | ((U64)x >> (64 - r)))
 137   #endif
 138 #endif
 139
 140
 141 #ifdef UV_IS_QUAD
 142 #define ROTL_UV(x,r) ROTL64(x,r)
 143 #else
 144 #define ROTL_UV(x,r) ROTL32(x,r)
 145 #endif
 146
 147 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
 148  * The authors claim it is relatively secure compared to the alternatives
 149  * and that performance wise it is a suitable hash for languages like Perl.
 150  * See:
 151  *
 152  * https://www.131002.net/siphash/
 153  *
 154  * This implementation seems to perform slightly slower than one-at-a-time for
 155  * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
 156  * regardless of keys size.
 157  *
 158  * It is 64 bit only.
 159  */
 160
 161 #ifdef HAS_QUAD
 162
 163 #define U8TO64_LE(p) \
 164   (((U64)((p)[0])      ) | \
 165    ((U64)((p)[1]) <<  8) | \
 166    ((U64)((p)[2]) << 16) | \
 167    ((U64)((p)[3]) << 24) | \
 168    ((U64)((p)[4]) << 32) | \
 169    ((U64)((p)[5]) << 40) | \
 170    ((U64)((p)[6]) << 48) | \
 171    ((U64)((p)[7]) << 56))
 172
 173 #define SIPROUND            \
 174   STMT_START {              \
 175     v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
 176     v2 += v3; v3=ROTL64(v3,16); v3 ^= v2;     \
 177     v0 += v3; v3=ROTL64(v3,21); v3 ^= v0;     \
 178     v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
 179   } STMT_END
 180
 181 /* SipHash-2-4 */
 182
 183
 184 #define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \
 185 PERL_STATIC_INLINE U32 \
 186 FNC(const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) { \
 187   /* "somepseudorandomlygeneratedbytes" */  \
 188   U64 v0 = UINT64_C(0x736f6d6570736575);    \
 189   U64 v1 = UINT64_C(0x646f72616e646f6d);    \
 190   U64 v2 = UINT64_C(0x6c7967656e657261);    \
 191   U64 v3 = UINT64_C(0x7465646279746573);    \
 192                                             \
 193   U64 b;                                    \
 194   U64 k0 = ((const U64*)seed)[0];           \
 195   U64 k1 = ((const U64*)seed)[1];           \
 196   U64 m;                                    \
 197   const int left = inlen & 7;               \
 198   const U8 *end = in + inlen - left;        \
 199                                             \
 200   b = ( ( U64 )(inlen) ) << 56;             \
 201   v3 ^= k1;                                 \
 202   v2 ^= k0;                                 \
 203   v1 ^= k1;                                 \
 204   v0 ^= k0;                                 \
 205                                             \
 206   for ( ; in != end; in += 8 )              \
 207   {                                         \
 208     m = U8TO64_LE( in );                    \
 209     v3 ^= m;                                \
 210                                             \
 211     SIP_ROUNDS;                             \
 212                                             \
 213     v0 ^= m;                                \
 214   }                                         \
 215                                             \
 216   switch( left )                            \
 217   {                                         \
 218   case 7: b |= ( ( U64 )in[ 6] )  << 48;    \
 219   case 6: b |= ( ( U64 )in[ 5] )  << 40;    \
 220   case 5: b |= ( ( U64 )in[ 4] )  << 32;    \
 221   case 4: b |= ( ( U64 )in[ 3] )  << 24;    \
 222   case 3: b |= ( ( U64 )in[ 2] )  << 16;    \
 223   case 2: b |= ( ( U64 )in[ 1] )  <<  8;    \
 224   case 1: b |= ( ( U64 )in[ 0] ); break;    \
 225   case 0: break;                            \
 226   }                                         \
 227                                             \
 228   v3 ^= b;                                  \
 229                                             \
 230   SIP_ROUNDS;                               \
 231                                             \
 232   v0 ^= b;                                  \
 233                                             \
 234   v2 ^= 0xff;                               \
 235                                             \
 236   SIP_FINAL_ROUNDS                          \
 237                                             \
 238   b = v0 ^ v1 ^ v2  ^ v3;                   \
 239   return (U32)(b & U32_MAX);                \
 240 }
 241
 242 PERL_SIPHASH_FNC(
 243     S_perl_hash_siphash_1_3
 244     ,SIPROUND;
 245     ,SIPROUND;SIPROUND;SIPROUND;
 246 )
 247
 248 PERL_SIPHASH_FNC(
 249     S_perl_hash_siphash_2_4
 250     ,SIPROUND;SIPROUND;
 251     ,SIPROUND;SIPROUND;SIPROUND;SIPROUND;
 252 )
 253
 254 #endif /* defined(HAS_QUAD) */
 255
 256 /* - ONE_AT_A_TIME_HARD is the 5.17+ recommend ONE_AT_A_TIME variant */
 257
 258 /* This is derived from the "One-at-a-Time" algorithm by Bob Jenkins
 259  * from requirements by Colin Plumb.
 260  * (http://burtleburtle.net/bob/hash/doobs.html)
 261  * Modified by Yves Orton to increase security for Perl 5.17 and later.
 262  */
 263 PERL_STATIC_INLINE U32
 264 S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
 265     const unsigned char * const end = (const unsigned char *)str + len;
 266     U32 hash = *((const U32*)seed) + (U32)len;
 267
 268     while (str < end) {
 269         hash += (hash << 10);
 270         hash ^= (hash >> 6);
 271         hash += *str++;
 272     }
 273
 274     hash += (hash << 10);
 275     hash ^= (hash >> 6);
 276     hash += seed[4];
 277
 278     hash += (hash << 10);
 279     hash ^= (hash >> 6);
 280     hash += seed[5];
 281
 282     hash += (hash << 10);
 283     hash ^= (hash >> 6);
 284     hash += seed[6];
 285
 286     hash += (hash << 10);
 287     hash ^= (hash >> 6);
 288     hash += seed[7];
 289
 290     hash += (hash << 10);
 291     hash ^= (hash >> 6);
 292
 293     hash += (hash << 3);
 294     hash ^= (hash >> 11);
 295     return (hash + (hash << 15));
 296 }
 297
 298 #ifdef HAS_QUAD
 299
 300 /* Hybrid hash function
 301  *
 302  * For short strings, 16 bytes or shorter, we use an optimised variant
 303  * of One At A Time Hard, and for longer strings, we use siphash_1_3.
 304  *
 305  * The optimisation of One At A Time Hard means we read the key in
 306  * reverse from normal, but by doing so we avoid the loop overhead.
 307  */
 308 PERL_STATIC_INLINE U32
 309 S_perl_hash_oaathu_siphash_1_3(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
 310     U32 hash = *((const U32*)seed) + (U32)len;
 311     switch (len) {
 312         case 16:
 313             hash += (hash << 10);
 314             hash ^= (hash >> 6);
 315             hash += str[15];
 316         case 15:
 317             hash += (hash << 10);
 318             hash ^= (hash >> 6);
 319             hash += str[14];
 320         case 14:
 321             hash += (hash << 10);
 322             hash ^= (hash >> 6);
 323             hash += str[13];
 324         case 13:
 325             hash += (hash << 10);
 326             hash ^= (hash >> 6);
 327             hash += str[12];
 328         case 12:
 329             hash += (hash << 10);
 330             hash ^= (hash >> 6);
 331             hash += str[11];
 332         case 11:
 333             hash += (hash << 10);
 334             hash ^= (hash >> 6);
 335             hash += str[10];
 336         case 10:
 337             hash += (hash << 10);
 338             hash ^= (hash >> 6);
 339             hash += str[9];
 340         case 9:
 341             hash += (hash << 10);
 342             hash ^= (hash >> 6);
 343             hash += str[8];
 344         case 8:
 345             hash += (hash << 10);
 346             hash ^= (hash >> 6);
 347             hash += str[7];
 348         case 7:
 349             hash += (hash << 10);
 350             hash ^= (hash >> 6);
 351             hash += str[6];
 352         case 6:
 353             hash += (hash << 10);
 354             hash ^= (hash >> 6);
 355             hash += str[5];
 356         case 5:
 357             hash += (hash << 10);
 358             hash ^= (hash >> 6);
 359             hash += str[4];
 360         case 4:
 361             hash += (hash << 10);
 362             hash ^= (hash >> 6);
 363             hash += str[3];
 364         case 3:
 365             hash += (hash << 10);
 366             hash ^= (hash >> 6);
 367             hash += str[2];
 368         case 2:
 369             hash += (hash << 10);
 370             hash ^= (hash >> 6);
 371             hash += str[1];
 372         case 1:
 373             hash += (hash << 10);
 374             hash ^= (hash >> 6);
 375             hash += str[0];
 376         case 0:
 377             hash += (hash << 10);
 378             hash ^= (hash >> 6);
 379             hash += seed[4];
 380             hash += (hash << 10);
 381             hash ^= (hash >> 6);
 382             hash += seed[5];
 383             hash += (hash << 10);
 384             hash ^= (hash >> 6);
 385             hash += seed[6];
 386             hash += (hash << 10);
 387             hash ^= (hash >> 6);
 388             hash += seed[7];
 389             hash += (hash << 10);
 390             hash ^= (hash >> 6);
 391
 392             hash += (hash << 3);
 393             hash ^= (hash >> 11);
 394             return (hash + (hash << 15));
 395     }
 396     return S_perl_hash_siphash_1_3(seed+8, str, len);
 397 }
 398 #endif /* defined(HAS_QUAD) */
 399
 400
 401 #endif /*compile once*/
 402
 403 /*
 404  * ex: set ts=8 sts=4 sw=4 et:
 405  */