Fix out of memory bug in the implementation of maps

This commit fixes a bug that could cause a crash or memory usage to
grow until the machine ran out of memory when adding a key-value pair
to a map. This could happen when inserting a new key-value pair with a
key K1 containing a binary B1 into a map M having a key K2 with a
binary B2 if the following conditions were met:

* size(B1) >= 4294967296
* size(B2) >= 4294967296
* size(M) >= 32
* (size(B1) rem 4294967296)  == (size(B2) rem 4294967296)
* the first (size(B1) rem 4294967296) bytes are the same both in B1
  and B2
* substituting B1 in K1 with B2 would result in a term with the same
  value as K2

The root cause of the bug is that the map implementation only hashed
the first (X modulo 4294967296) bytes of binaries so that different
binaries could get hashed to the same hash value independently of the
hash seed.

3 files changed, 93 insertions, 8 deletions

diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h
index 880febba8b..430ac305c5 100644
--- a/erts/emulator/beam/erl_utils.h
+++ b/erts/emulator/beam/erl_utils.h
@@ -69,7 +69,6 @@ int erts_fit_in_bits_int32(Sint32);
 int erts_fit_in_bits_uint(Uint);
 Sint erts_list_length(Eterm);
 int erts_is_builtin(Eterm, Eterm, int);
-Uint32 block_hash(byte *, unsigned, Uint32);
 Uint32 make_hash2(Eterm);
 Uint32 make_hash(Eterm);
 Uint32 make_internal_hash(Eterm, Uint32 salt);
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 36cfe0548e..0bbae65e28 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1069,11 +1069,11 @@ do {                               \
 
 #define HCONST 0x9e3779b9UL /* the golden ratio; an arbitrary value */
 
-Uint32
-block_hash(byte *k, unsigned length, Uint32 initval)
+static Uint32
+block_hash(byte *k, Uint length, Uint32 initval)
 {
    Uint32 a,b,c;
-   unsigned len;
+   Uint len;
 
    /* Set up the internal state */
    len = length;
@@ -1749,7 +1749,7 @@ make_internal_hash(Eterm term, Uint32 salt)
 	    case SUB_BINARY_SUBTAG:
 	    {
 		byte* bptr;
-		unsigned sz = binary_size(term);
+		Uint sz = binary_size(term);
 		Uint32 con = HCONST_13 + hash;
 		Uint bitoffs;
 		Uint bitsize;
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index d0a6763fe5..9ea59e1084 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -17,7 +17,7 @@
 %% %CopyrightEnd%
 %%
 -module(map_SUITE).
--export([all/0, suite/0]).
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]).
 
 -export([t_build_and_match_literals/1, t_build_and_match_literals_large/1,
          t_update_literals/1, t_update_literals_large/1,
@@ -84,7 +84,10 @@
          %% instruction-level tests
          t_has_map_fields/1,
          y_regs/1,
-         badmap_17/1]).
+         badmap_17/1,
+
+         %%Bugs
+         t_large_unequal_bins_same_hash_bug/1]).
 
 -include_lib("stdlib/include/ms_transform.hrl").
 
@@ -149,7 +152,26 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large,
           %% instruction-level tests
           t_has_map_fields,
           y_regs,
-          badmap_17].
+          badmap_17,
+
+          %% Bugs
+          t_large_unequal_bins_same_hash_bug].
+
+init_per_suite(Config) ->
+    A0 = case application:start(sasl) of
+	     ok -> [sasl];
+	     _ -> []
+	 end,
+    A = case application:start(os_mon) of
+	     ok -> [os_mon|A0];
+	     _ -> A0
+	 end,
+    [{started_apps, A}|Config].
+
+end_per_suite(Config) ->
+    As = proplists:get_value(started_apps, Config),
+    lists:foreach(fun (A) -> application:stop(A) end, As),
+    Config.
 
 %% tests
 
@@ -3374,3 +3396,67 @@ fannerl() ->
       104,2,97,9,97,16,70,63,184,100,97,32,0,0,0,104,2,97,10,97,16,70,63,169,174,
       254,64,0,0,0,104,2,97,11,97,16,70,191,119,121,234,0,0,0,0,104,2,97,12,97,
       16,70,63,149,12,170,128,0,0,0,104,2,97,13,97,16,70,191,144,193,191,0,0,0,0>>.
+
+%% This test case checks that the bug with ticket number OTP-15707 is
+%% fixed. The bug could cause a crash or memory usage to grow until
+%% the machine ran out of memory.
+t_large_unequal_bins_same_hash_bug(Config) when is_list(Config) ->
+    run_when_enough_resources(
+      fun() ->
+              K1 = get_4GB_bin(1),
+              K2 = get_4GB_bin(2),
+              Map = make_map(500),
+              Map2 = maps:put(K1, 42, Map),
+              %% The map needed to contain at least 32 key-value pairs
+              %% at this point to get the crash or out of memory
+              %% problem on the next line
+              Map3 = maps:put(K2, 43, Map2),
+              %% The following line should avoid that the compiler
+              %% optimizes away the above
+              io:format("~p ~p~n", [erlang:phash2(Map3), maps:size(Map3)])
+      end).
+
+make_map(0) -> 
+    #{};
+make_map(Size) ->
+    maps:put(Size, Size, make_map(Size-1)).
+
+get_4GB_bin(Value) ->
+    List = lists:duplicate(65536, Value),
+    Bin = erlang:iolist_to_binary(List),
+    IOList4GB = duplicate_iolist(Bin, 16),
+    Bin4GB = erlang:iolist_to_binary(IOList4GB),
+    4294967296 = size(Bin4GB),
+    Bin4GB.
+
+duplicate_iolist(IOList, 0) ->
+    IOList;
+duplicate_iolist(IOList, NrOfTimes) ->
+    duplicate_iolist([IOList, IOList], NrOfTimes - 1).
+
+run_when_enough_resources(Fun) ->
+    case {total_memory(), erlang:system_info(wordsize)} of
+        {Mem, 8} when is_integer(Mem) andalso Mem >= 31 ->
+            Fun();
+        {Mem, WordSize} ->
+            {skipped, 
+             io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)",
+                           [Mem, WordSize])}
+    end.
+
+total_memory() ->
+    %% Total memory in GB.
+    try
+	MemoryData = memsup:get_system_memory_data(),
+	case lists:keysearch(total_memory, 1, MemoryData) of
+	    {value, {total_memory, TM}} ->
+		TM div (1024*1024*1024);
+	    false ->
+		{value, {system_total_memory, STM}} =
+		    lists:keysearch(system_total_memory, 1, MemoryData),
+		STM div (1024*1024*1024)
+	end
+    catch
+	_ : _ ->
+	    undefined
+    end.