zZzzZ. — /usr/lib64/perl5/CORE

Editing: hv_func.h

/* hash a key
 *--------------------------------------------------------------------------------------
 * The "hash seed" feature was added in Perl 5.8.1 to perturb the results
 * to avoid "algorithmic complexity attacks".
 *
 * If USE_HASH_SEED is defined, hash randomisation is done by default
 * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed())
 */
#ifndef PERL_SEEN_HV_FUNC_H /* compile once */
#define PERL_SEEN_HV_FUNC_H
#include "hv_macro.h"

#if !( 0 \
        || defined(PERL_HASH_FUNC_SIPHASH) \
        || defined(PERL_HASH_FUNC_SIPHASH13) \
        || defined(PERL_HASH_FUNC_STADTX) \
        || defined(PERL_HASH_FUNC_ZAPHOD32) \
    )
#   ifdef CAN64BITHASH
#       define PERL_HASH_FUNC_STADTX
#   else
#       define PERL_HASH_FUNC_ZAPHOD32
#   endif
#endif

#ifndef PERL_HASH_USE_SBOX32_ALSO
#define PERL_HASH_USE_SBOX32_ALSO 1
#endif

#ifndef SBOX32_MAX_LEN
#define SBOX32_MAX_LEN 24
#endif

/* this must be after the SBOX32_MAX_LEN define */
#include "sbox32_hash.h"

#if defined(PERL_HASH_FUNC_SIPHASH)
# define __PERL_HASH_FUNC "SIPHASH_2_4"
# define __PERL_HASH_SEED_BYTES 16
# define __PERL_HASH_STATE_BYTES 32
# define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
# define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_2_4_with_state((state),(U8*)(str),(len))
#elif defined(PERL_HASH_FUNC_SIPHASH13)
# define __PERL_HASH_FUNC "SIPHASH_1_3"
# define __PERL_HASH_SEED_BYTES 16
# define __PERL_HASH_STATE_BYTES 32
# define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
# define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_1_3_with_state((state),(U8*)(str),(len))
#elif defined(PERL_HASH_FUNC_STADTX)
# define __PERL_HASH_FUNC "STADTX"
# define __PERL_HASH_SEED_BYTES 16
# define __PERL_HASH_STATE_BYTES 32
# define __PERL_HASH_SEED_STATE(seed,state) stadtx_seed_state(seed,state)
# define __PERL_HASH_WITH_STATE(state,str,len) (U32)stadtx_hash_with_state((state),(U8*)(str),(len))
# include "stadtx_hash.h"
#elif defined(PERL_HASH_FUNC_ZAPHOD32)
# define __PERL_HASH_FUNC "ZAPHOD32"
# define __PERL_HASH_SEED_BYTES 12
# define __PERL_HASH_STATE_BYTES 12
# define __PERL_HASH_SEED_STATE(seed,state) zaphod32_seed_state(seed,state)
# define __PERL_HASH_WITH_STATE(state,str,len) (U32)zaphod32_hash_with_state((state),(U8*)(str),(len))
# include "zaphod32_hash.h"
#endif

#ifndef __PERL_HASH_WITH_STATE
#error "No hash function defined!"
#endif
#ifndef __PERL_HASH_SEED_BYTES
#error "__PERL_HASH_SEED_BYTES not defined"
#endif
#ifndef __PERL_HASH_FUNC
#error "__PERL_HASH_FUNC not defined"
#endif

#if PERL_HASH_USE_SBOX32_ALSO != 1
# define _PERL_HASH_FUNC                        __PERL_HASH_FUNC
# define _PERL_HASH_SEED_BYTES                  __PERL_HASH_SEED_BYTES
# define _PERL_HASH_STATE_BYTES                 __PERL_HASH_STATE_BYTES
# define _PERL_HASH_SEED_STATE(seed,state)      __PERL_HASH_SEED_STATE(seed,state)
# define _PERL_HASH_WITH_STATE(state,str,len)   __PERL_HASH_WITH_STATE(state,str,len)
#else

#define _PERL_HASH_FUNC         "SBOX32_WITH_" __PERL_HASH_FUNC

#define _PERL_HASH_SEED_BYTES   ( __PERL_HASH_SEED_BYTES + (int)( 3 * sizeof(U32) ) )

#define _PERL_HASH_STATE_BYTES  \
    ( __PERL_HASH_STATE_BYTES + ( ( 1 + ( 256 * SBOX32_MAX_LEN ) ) * sizeof(U32) ) )

#define _PERL_HASH_SEED_STATE(seed,state) STMT_START {                                      \
    __PERL_HASH_SEED_STATE(seed,state);                                                     \
    sbox32_seed_state96(seed + __PERL_HASH_SEED_BYTES, state + __PERL_HASH_STATE_BYTES);    \
} STMT_END

#define _PERL_HASH_WITH_STATE(state,str,len)                                            \
    (LIKELY(len <= SBOX32_MAX_LEN)                                                      \
        ? sbox32_hash_with_state((state + __PERL_HASH_STATE_BYTES),(U8*)(str),(len))    \
        : __PERL_HASH_WITH_STATE((state),(str),(len)))

#endif

PERL_STATIC_INLINE
U32 S_perl_hash_with_seed(const U8 * const seed, const U8 * const str, const STRLEN len)
{
    U8 state[_PERL_HASH_STATE_BYTES];
    _PERL_HASH_SEED_STATE(seed,state);
    return _PERL_HASH_WITH_STATE(state,str,len);
}

#define PERL_HASH_WITH_SEED(seed,hash,str,len) \
    (hash) = S_perl_hash_with_seed((const U8 *) seed, (const U8 *) str,len)
#define PERL_HASH_WITH_STATE(state,hash,str,len) \
    (hash) = _PERL_HASH_WITH_STATE((state),(U8*)(str),(len))
#define PERL_HASH_SEED_STATE(seed,state) _PERL_HASH_SEED_STATE(seed,state)
#define PERL_HASH_SEED_BYTES _PERL_HASH_SEED_BYTES
#define PERL_HASH_STATE_BYTES _PERL_HASH_STATE_BYTES
#define PERL_HASH_FUNC        _PERL_HASH_FUNC

#ifdef PERL_USE_SINGLE_CHAR_HASH_CACHE
#define PERL_HASH(state,str,len) \
    (hash) = ((len) < 2 ? ( (len) == 0 ? PL_hash_chars[256] : PL_hash_chars[(U8)(str)[0]] ) \
                       : _PERL_HASH_WITH_STATE(PL_hash_state,(U8*)(str),(len)))
#else
#define PERL_HASH(hash,str,len) \
    PERL_HASH_WITH_STATE(PL_hash_state,hash,(U8*)(str),(len))
#endif

/* Setup the hash seed, either we do things dynamically at start up,
 * including reading from the environment, or we randomly setup the
 * seed. The seed will be passed into the PERL_HASH_SEED_STATE() function
 * defined for the configuration defined for this perl, which will then
 * initialize whatever state it might need later in hashing. */

#ifndef PERL_HASH_SEED
#   if defined(USE_HASH_SEED)
#       define PERL_HASH_SEED PL_hash_seed
#   else
       /* this is a 512 bit seed, which should be more than enough for the
        * configuration of any of our hash functions (with or without sbox).
        * If you actually use a hard coded seed, you are strongly encouraged
        * to replace this with something else of the correct length
        * for the hash function you are using (24-32 bytes depending on build
        * options). Repeat, you are *STRONGLY* encouraged not to use the value
        * provided here.
        */
#       define PERL_HASH_SEED \
           ((const U8 *)"A long string of pseudorandomly "  \
                        "chosen bytes for hashing in Perl")
#   endif
#endif

/* legacy - only mod_perl should be doing this.  */
#ifdef PERL_HASH_INTERNAL_ACCESS
#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
#endif

/* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
 * The authors claim it is relatively secure compared to the alternatives
 * and that performance wise it is a suitable hash for languages like Perl.
 * See:
 *
 * https://www.131002.net/siphash/
 *
 * This implementation seems to perform slightly slower than one-at-a-time for
 * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
 * regardless of keys size.
 *
 * It is 64 bit only.
 */

#ifdef CAN64BITHASH

#define SIPROUND            \
  STMT_START {              \
    v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
    v2 += v3; v3=ROTL64(v3,16); v3 ^= v2;     \
    v0 += v3; v3=ROTL64(v3,21); v3 ^= v0;     \
    v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
  } STMT_END

#define SIPHASH_SEED_STATE(key,v0,v1,v2,v3) \
do {                                    \
    v0 = v2 = U8TO64_LE(key + 0);       \
    v1 = v3 = U8TO64_LE(key + 8);       \
  /* "somepseudorandomlygeneratedbytes" */  \
    v0 ^= UINT64_C(0x736f6d6570736575);  \
    v1 ^= UINT64_C(0x646f72616e646f6d);      \
    v2 ^= UINT64_C(0x6c7967656e657261);      \
    v3 ^= UINT64_C(0x7465646279746573);      \
} while (0)

PERL_STATIC_INLINE
void S_perl_siphash_seed_state(const unsigned char * const seed_buf, unsigned char * state_buf) {
    U64 *v= (U64*) state_buf;
    SIPHASH_SEED_STATE(seed_buf, v[0],v[1],v[2],v[3]);
}

#define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \
PERL_STATIC_INLINE U64 \
FNC ## _with_state_64 \
  (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \
{                                           \
  const int left = inlen & 7;               \
  const U8 *end = in + inlen - left;        \
                                            \
  U64 b = ( ( U64 )(inlen) ) << 56;         \
  U64 m;                                    \
  U64 v0 = U8TO64_LE(state);                \
  U64 v1 = U8TO64_LE(state+8);              \
  U64 v2 = U8TO64_LE(state+16);             \
  U64 v3 = U8TO64_LE(state+24);             \
                                            \
  for ( ; in != end; in += 8 )              \
  {                                         \
    m = U8TO64_LE( in );                    \
    v3 ^= m;                                \
                                            \
    SIP_ROUNDS;                             \
                                            \
    v0 ^= m;                                \
  }                                         \
                                            \
  switch( left )                            \
  {                                         \
  case 7: b |= ( ( U64 )in[ 6] )  << 48; /*FALLTHROUGH*/    \
  case 6: b |= ( ( U64 )in[ 5] )  << 40; /*FALLTHROUGH*/    \
  case 5: b |= ( ( U64 )in[ 4] )  << 32; /*FALLTHROUGH*/    \
  case 4: b |= ( ( U64 )in[ 3] )  << 24; /*FALLTHROUGH*/    \
  case 3: b |= ( ( U64 )in[ 2] )  << 16; /*FALLTHROUGH*/    \
  case 2: b |= ( ( U64 )in[ 1] )  <<  8; /*FALLTHROUGH*/    \
  case 1: b |= ( ( U64 )in[ 0] ); break;    \
  case 0: break;                            \
  }                                         \
                                            \
  v3 ^= b;                                  \
                                            \
  SIP_ROUNDS;                               \
                                            \
  v0 ^= b;                                  \
                                            \
  v2 ^= 0xff;                               \
                                            \
  SIP_FINAL_ROUNDS                          \
                                            \
  b = v0 ^ v1 ^ v2  ^ v3;                   \
  return b;                                 \
}                                           \
                                            \
PERL_STATIC_INLINE U32                      \
FNC ## _with_state                          \
  (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \
{                                           \
    union {                                 \
        U64 h64;                            \
        U32 h32[2];                         \
    } h;                                    \
    h.h64= FNC ## _with_state_64(state,in,inlen); \
    return h.h32[0] ^ h.h32[1];             \
}                                           \
                                            \
                                            \
PERL_STATIC_INLINE U32                      \
FNC (const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) \
{                                                                   \
    U64 state[4];                                                   \
    SIPHASH_SEED_STATE(seed,state[0],state[1],state[2],state[3]);   \
    return FNC ## _with_state((U8*)state,in,inlen);                 \
}

PERL_SIPHASH_FNC(
    S_perl_hash_siphash_1_3
    ,SIPROUND;
    ,SIPROUND;SIPROUND;SIPROUND;
)

PERL_SIPHASH_FNC(
    S_perl_hash_siphash_2_4
    ,SIPROUND;SIPROUND;
    ,SIPROUND;SIPROUND;SIPROUND;SIPROUND;
)

#endif /* defined(CAN64BITHASH) */

#endif /*compile once*/

/*
 * ex: set ts=8 sts=4 sw=4 et:
 */