Fix segfault in filehandle duplication

[perl5.git] / hv_func.h

diff --git a/hv_func.h b/hv_func.h
index fdb4ad8..b2bde90 100644 (file)
--- a/hv_func.h
+++ b/hv_func.h
@@ -13,18 +13,16 @@
 #define PERL_SEEN_HV_FUNC_H
 
 #if !( 0 \
+        || defined(PERL_HASH_FUNC_SIPHASH) \
         || defined(PERL_HASH_FUNC_SDBM) \
         || defined(PERL_HASH_FUNC_DJB2) \
         || defined(PERL_HASH_FUNC_SUPERFAST) \
         || defined(PERL_HASH_FUNC_MURMUR3) \
         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME) \
+        || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD) \
         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD) \
     )
-#ifdef HAS_QUAD
-#define PERL_HASH_FUNC_SIPHASH
-#else
-#define PERL_HASH_FUNC_ONE_AT_A_TIME
-#endif
+#define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
 #endif
 
 #if defined(PERL_HASH_FUNC_SIPHASH)
@@ -47,6 +45,10 @@
 #   define PERL_HASH_FUNC "SDBM"
 #   define PERL_HASH_SEED_BYTES 4
 #   define PERL_HASH(hash,str,len) (hash)= S_perl_hash_sdbm(PERL_HASH_SEED,(U8*)(str),(len))
+#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD)
+#   define PERL_HASH_FUNC "ONE_AT_A_TIME_HARD"
+#   define PERL_HASH_SEED_BYTES 8
+#   define PERL_HASH(hash,str,len) (hash)= S_perl_hash_one_at_a_time_hard(PERL_HASH_SEED,(U8*)(str),(len))
 #elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME)
 #   define PERL_HASH_FUNC "ONE_AT_A_TIME"
 #   define PERL_HASH_SEED_BYTES 4
@@ -121,16 +123,36 @@
   #define UNALIGNED_SAFE
 #endif
 
-/* Find best way to ROTL32 */
+#ifdef HAS_QUAD
+#ifndef U64TYPE
+/* This probably isn't going to work, but failing with a compiler error due to
+   lack of uint64_t is no worse than failing right now with an #error.  */
+#define U64TYPE uint64_t
+#endif
+#endif
+
+/* Find best way to ROTL32/ROTL64 */
 #if defined(_MSC_VER)
   #include <stdlib.h>  /* Microsoft put _rotl declaration in here */
   #define ROTL32(x,r)  _rotl(x,r)
+  #ifdef HAS_QUAD
+    #define ROTL64(x,r)  _rotl64(x,r)
+  #endif
 #else
   /* gcc recognises this code and generates a rotate instruction for CPUs with one */
   #define ROTL32(x,r)  (((U32)x << r) | ((U32)x >> (32 - r)))
+  #ifdef HAS_QUAD
+    #define ROTL64(x,r)  (((U64TYPE)x << r) | ((U64TYPE)x >> (64 - r)))
+  #endif
 #endif
 
 
+#ifdef UV_IS_QUAD
+#define ROTL_UV(x,r) ROTL64(x,r)
+#else
+#define ROTL_UV(x,r) ROTL32(x,r)
+#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.
@@ -147,15 +169,6 @@
 
 #ifdef HAS_QUAD
 
-#ifndef U64TYPE
-/* This probably isn't going to work, but failing with a compiler error due to
-   lack of uint64_t is no worse than failing right now with an #error.  */
-#define U64TYPE uint64_t
-#endif
-
-
-#define ROTL64(x,b) (U64TYPE)( ((x) << (b)) | ( (x) >> (64 - (b))) )
-
 #define U8TO64_LE(p) \
   (((U64TYPE)((p)[0])      ) | \
    ((U64TYPE)((p)[1]) <<  8) | \
@@ -375,7 +388,7 @@ S_perl_hash_murmur3(const unsigned char * const seed, const unsigned char *ptr,
     /* This CPU does not handle unaligned word access */
 
     /* Consume enough so that the next data byte is word aligned */
-    int i = -(long)ptr & 3;
+    STRLEN i = -PTR2IV(ptr) & 3;
     if(i && i <= len) {
       MURMUR_DOBYTES(i, h1, carry, bytes_in_carry, ptr, len);
     }
@@ -459,10 +472,22 @@ S_perl_hash_sdbm(const unsigned char * const seed, const unsigned char *str, con
     return hash;
 }
 
+/* - ONE_AT_A_TIME_HARD is the 5.17+ recommend ONE_AT_A_TIME algorithm
+ * - ONE_AT_A_TIME_OLD is the unmodified 5.16 and older algorithm
+ * - ONE_AT_A_TIME is a 5.17+ tweak of ONE_AT_A_TIME_OLD to
+ *   prevent strings of only \0 but different lengths from colliding
+ *
+ * Security-wise, from best to worst,
+ * ONE_AT_A_TIME_HARD > ONE_AT_A_TIME > ONE_AT_A_TIME_OLD
+ * There is a big drop-off in security between ONE_AT_A_TIME_HARD and
+ * ONE_AT_A_TIME
+ * */
 
-/* FYI: This is the "One-at-a-Time" algorithm by Bob Jenkins
+/* This is the "One-at-a-Time" algorithm by Bob Jenkins
  * from requirements by Colin Plumb.
- * (http://burtleburtle.net/bob/hash/doobs.html) */
+ * (http://burtleburtle.net/bob/hash/doobs.html)
+ * With seed/len tweak.
+ * */
 PERL_STATIC_INLINE U32
 S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
     const unsigned char * const end = (const unsigned char *)str + len;
@@ -477,6 +502,42 @@ S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char
     return (hash + (hash << 15));
 }
 
+/* Derived from "One-at-a-Time" algorithm by Bob Jenkins */
+PERL_STATIC_INLINE U32
+S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
+    const unsigned char * const end = (const unsigned char *)str + len;
+    U32 hash = *((U32*)seed) + len;
+    
+    while (str < end) {
+        hash += (hash << 10);
+        hash ^= (hash >> 6);
+        hash += *str++;
+    }
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[4];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[5];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[6];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[7];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+
+    hash += (hash << 3);
+    hash ^= (hash >> 11);
+    return (hash + (hash << 15));
+}
+
 PERL_STATIC_INLINE U32
 S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
     const unsigned char * const end = (const unsigned char *)str + len;