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