Fix erlang:decode_packet(httph_bin,..) to not return faulty header strings

Unrecognized Http header names was sometimes returned as corrupt
sub-binaries pointing to a stack allocated buffer. This only happened
on 32-bit VM if the header name was between 16 and 20 characters
long. It could in some cases lead to segmentation fault.
The solution was to avoid creating sub-binary if the returned string
was not part of the original binary.

2 files changed, 39 insertions, 12 deletions

diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index 0389177fbe..2ba9dc00b7 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -1079,27 +1079,33 @@ struct packet_callback_args
     Eterm res;   /* Out */
     int string_as_bin; /* return strings as binaries (http_bin): */
     byte* aligned_ptr;
+    Uint bin_sz;
     Eterm orig;
     Uint bin_offs;
     byte bin_bitoffs;
 };
 
+#define in_area(ptr,start,nbytes) \
+    ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes))
+
 static Eterm
 http_bld_string(struct packet_callback_args* pca, Uint **hpp, Uint *szp,
 		const char *str, Sint len)
 {
     Eterm res = THE_NON_VALUE;
     Uint size;
+    int make_subbin;
 
     if (pca->string_as_bin) {
 	size = heap_bin_size(len);
-    
+	make_subbin = (size > ERL_SUB_BIN_SIZE
+		       && in_area(str, pca->aligned_ptr, pca->bin_sz));
 	if (szp) {
-	    *szp += (size > ERL_SUB_BIN_SIZE) ? ERL_SUB_BIN_SIZE : size;	
+	    *szp += make_subbin ? ERL_SUB_BIN_SIZE : size;
 	}
 	if (hpp) {
 	    res = make_binary(*hpp);
-	    if (size > ERL_SUB_BIN_SIZE) {
+	    if (make_subbin) {
 		ErlSubBin* bin = (ErlSubBin*) *hpp;
 		bin->thing_word = HEADER_SUB_BIN;
 		bin->size = len;
@@ -1330,7 +1336,7 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
     int packet_sz;           /*-------Binaries involved: ------------------*/
     byte* bin_ptr;           /*| orig: original binary                     */
     byte bin_bitsz;          /*| bin: BIF_ARG_2, may be sub-binary of orig */
-    Uint bin_sz;             /*| packet: prefix of bin                     */
+	                     /*| packet: prefix of bin                     */
     char* body_ptr;          /*| body: part of packet to return            */
     int body_sz;             /*| rest: bin without packet                  */
     struct packet_callback_args pca;
@@ -1391,18 +1397,18 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
     }
 
 
-    bin_sz = binary_size(BIF_ARG_2);
+    pca.bin_sz = binary_size(BIF_ARG_2);
     ERTS_GET_BINARY_BYTES(BIF_ARG_2, bin_ptr, pca.bin_bitoffs, bin_bitsz);  
     if (pca.bin_bitoffs != 0) {
-        pca.aligned_ptr = erts_alloc(ERTS_ALC_T_TMP, bin_sz);
-        erts_copy_bits(bin_ptr, pca.bin_bitoffs, 1, pca.aligned_ptr, 0, 1, bin_sz*8);
+        pca.aligned_ptr = erts_alloc(ERTS_ALC_T_TMP, pca.bin_sz);
+        erts_copy_bits(bin_ptr, pca.bin_bitoffs, 1, pca.aligned_ptr, 0, 1, pca.bin_sz*8);
     }
     else {
         pca.aligned_ptr = bin_ptr;
     }
-    packet_sz = packet_get_length(type, (char*)pca.aligned_ptr, bin_sz,
+    packet_sz = packet_get_length(type, (char*)pca.aligned_ptr, pca.bin_sz,
                                   max_plen, trunc_len, &http_state);
-    if (!(packet_sz > 0 && packet_sz <= bin_sz)) {
+    if (!(packet_sz > 0 && packet_sz <= pca.bin_sz)) {
         if (packet_sz < 0) {
 	    goto error;
         }
@@ -1458,7 +1464,7 @@ error:
 
     rest = (ErlSubBin *) hp;
     rest->thing_word = HEADER_SUB_BIN;
-    rest->size = bin_sz - packet_sz;
+    rest->size = pca.bin_sz - packet_sz;
     rest->offs = pca.bin_offs + packet_sz;
     rest->orig = pca.orig;
     rest->bitoffs = pca.bin_bitoffs;
diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl
index 13f17e972c..add14ac87c 100644
--- a/erts/emulator/test/decode_packet_SUITE.erl
+++ b/erts/emulator/test/decode_packet_SUITE.erl
@@ -24,10 +24,10 @@
 -include("test_server.hrl").
 
 -export([all/1,init_per_testcase/2,fin_per_testcase/2,
-	 basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1]).
+	 basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1]).
 
 all(suite) ->
-    [basic, packet_size, neg, http, line, ssl].
+    [basic, packet_size, neg, http, line, ssl, otp_8536].
 
 init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
     Seed = {S1,S2,S3} = now(),
@@ -504,6 +504,27 @@ ssl(Config) when is_list(Config) ->
     F(v2hello),
     ok.
 
+otp_8536(doc) -> ["Corrupt sub-binary-strings from httph_bin"];
+otp_8536(Config) when is_list(Config) ->
+    lists:foreach(fun otp_8536_do/1, lists:seq(1,50)),
+    ok.
+
+otp_8536_do(N) ->
+    Data = <<"some data 123">>,
+    Letters = <<"bcdefghijklmnopqrstuvwxyzyxwvutsrqponmlkjihgfedcba">>,
+    <<HdrTail:N/binary,_/binary>> = Letters,
+    Hdr = <<$A, HdrTail/binary>>,
+    Bin = <<Hdr/binary, ": ", Data/binary, "\r\n\r\n">>,
+
+    io:format("Bin='~p'\n",[Bin]),
+    ?line {ok,{http_header,0,Hdr2,undefined,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin,  []),
+
+    %% Do something to trash the C-stack, how about another decode_packet:
+    decode_pkt(httph_bin,<<Letters/binary, ": ", Data/binary, "\r\n\r\n">>, []),
+
+    %% Now check that we got the expected binaries
+    {Hdr, Data} = {Hdr2, Data2}.
+
 decode_pkt(Type,Bin) ->
     decode_pkt(Type,Bin,[]).		       
 decode_pkt(Type,Bin,Opts) ->