Merge branch 'jv/binary_to_term-opts' into ccase/r13b04_dev

* jv/binary_to_term-opts:
  document ErtsExternalDist flags and CON_ID mask
  add options to binary_to_term

OTP-8367  There is new erlang:binary_to_binary/2 BIF that takes an option
          list. The option safe can be used to prevent creation of
          resources that are not garbage collected (such as atoms). (Thanks
          to Jayson Vantuyl.)

5 files changed, 154 insertions, 44 deletions

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 04eac2d807..3ce26c4a7a 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -1,19 +1,19 @@
 #
 # %CopyrightBegin%
-# 
-# Copyright Ericsson AB 1996-2009. All Rights Reserved.
-# 
+#
+# Copyright Ericsson AB 1996-2010. All Rights Reserved.
+#
 # The contents of this file are subject to the Erlang Public License,
 # Version 1.1, (the "License"); you may not use this file except in
 # compliance with the License. You should have received a copy of the
 # Erlang Public License along with this software. If not, it can be
 # retrieved online at http://www.erlang.org/.
-# 
+#
 # Software distributed under the License is distributed on an "AS IS"
 # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 # the License for the specific language governing rights and limitations
 # under the License.
-# 
+#
 # %CopyrightEnd%
 #
 
@@ -446,6 +446,7 @@ atom running
 atom running_ports
 atom running_procs
 atom runtime
+atom safe
 atom save_calls
 atom scheduler 
 atom scheduler_id
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 85a729208f..b6fa06354a 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -1,19 +1,19 @@
 #
 # %CopyrightBegin%
-# 
-# Copyright Ericsson AB 1996-2009. All Rights Reserved.
-# 
+#
+# Copyright Ericsson AB 1996-2010. All Rights Reserved.
+#
 # The contents of this file are subject to the Erlang Public License,
 # Version 1.1, (the "License"); you may not use this file except in
 # compliance with the License. You should have received a copy of the
 # Erlang Public License along with this software. If not, it can be
 # retrieved online at http://www.erlang.org/.
-# 
+#
 # Software distributed under the License is distributed on an "AS IS"
 # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 # the License for the specific language governing rights and limitations
 # under the License.
-# 
+#
 # %CopyrightEnd%
 #
 
@@ -755,6 +755,11 @@ bif erlang:call_on_load_function/1
 bif erlang:finish_after_on_load/2
 
 #
+# New Bifs in R13B4
+#
+bif erlang:binary_to_term/2
+
+#
 # Obsolete
 #
 
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index f856cce18f..f380e7732e 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -1,19 +1,19 @@
 /*
  * %CopyrightBegin%
- * 
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- * 
+ *
+ * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ *
  * The contents of this file are subject to the Erlang Public License,
  * Version 1.1, (the "License"); you may not use this file except in
  * compliance with the License. You should have received a copy of the
  * Erlang Public License along with this software. If not, it can be
  * retrieved online at http://www.erlang.org/.
- * 
+ *
  * Software distributed under the License is distributed on an "AS IS"
  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  * the License for the specific language governing rights and limitations
  * under the License.
- * 
+ *
  * %CopyrightEnd%
  */
 
@@ -1059,10 +1059,10 @@ binary2term_abort(ErtsBinary2TermState *state)
 }
 
 static ERTS_INLINE Eterm
-binary2term_create(ErtsBinary2TermState *state, Eterm **hpp, ErlOffHeap *ohp)
+binary2term_create(ErtsDistExternal *edep, ErtsBinary2TermState *state, Eterm **hpp, ErlOffHeap *ohp)
 {
     Eterm res;
-    if (!dec_term(NULL, hpp, state->extp, ohp, &res))
+    if (!dec_term(edep, hpp, state->extp, ohp, &res))
 	res = THE_NON_VALUE;
     if (state->exttmp) {
 	state->exttmp = 0;
@@ -1086,7 +1086,7 @@ erts_binary2term_abort(ErtsBinary2TermState *state)
 Eterm
 erts_binary2term_create(ErtsBinary2TermState *state, Eterm **hpp, ErlOffHeap *ohp)
 {
-    return binary2term_create(state, hpp, ohp);
+    return binary2term_create(NULL,state, hpp, ohp);
 }
 
 BIF_RETTYPE binary_to_term_1(BIF_ALIST_1)
@@ -1114,7 +1114,67 @@ BIF_RETTYPE binary_to_term_1(BIF_ALIST_1)
     hp = HAlloc(BIF_P, heap_size);
     endp = hp + heap_size;
 
-    res = binary2term_create(&b2ts, &hp, &MSO(BIF_P));
+    res = binary2term_create(NULL, &b2ts, &hp, &MSO(BIF_P));
+
+    erts_free_aligned_binary_bytes(temp_alloc);
+
+    if (hp > endp) {
+	erl_exit(1, ":%s, line %d: heap overrun by %d words(s)\n",
+		 __FILE__, __LINE__, hp-endp);
+    }
+
+    HRelease(BIF_P, endp, hp);
+
+    if (res == THE_NON_VALUE)
+	goto error;
+
+    return res;
+}
+
+BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
+{
+    Sint heap_size;
+    Eterm res;
+    Eterm opts;
+    Eterm opt;
+    Eterm* hp;
+    Eterm* endp;
+    Sint size;
+    byte* bytes;
+    byte* temp_alloc = NULL;
+    ErtsBinary2TermState b2ts;
+    ErtsDistExternal fakedep;
+
+    fakedep.flags = 0;
+    opts = BIF_ARG_2;
+    while (is_list(opts)) {
+        opt = CAR(list_val(opts));
+        if (opt == am_safe) {
+	    fakedep.flags |= ERTS_DIST_EXT_BTT_SAFE;
+        } else {
+            goto error;
+        }
+        opts = CDR(list_val(opts));
+    }
+
+    if (is_not_nil(opts))
+        goto error;
+
+    if ((bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) == NULL) {
+    error:
+	erts_free_aligned_binary_bytes(temp_alloc);
+	BIF_ERROR(BIF_P, BADARG);
+    }
+    size = binary_size(BIF_ARG_1);
+
+    heap_size = binary2term_prepare(&b2ts, bytes, size);
+    if (heap_size < 0)
+	goto error;
+
+    hp = HAlloc(BIF_P, heap_size);
+    endp = hp + heap_size;
+
+    res = binary2term_create(&fakedep, &b2ts, &hp, &MSO(BIF_P));
 
     erts_free_aligned_binary_bytes(temp_alloc);
 
@@ -1300,7 +1360,7 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp)
 
     switch (*ep++) {
     case ATOM_CACHE_REF:
-	if (!(edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB))
+	if (!(edep && (edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)))
 	    goto error;
 	n = get_int8(ep);
 	ep++;
@@ -1312,13 +1372,18 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp)
     case ATOM_EXT:
 	len = get_int16(ep),
 	ep += 2;
-	*objp = am_atom_put((char*)ep, len);
-	ep += len;
-	break;
+        goto dec_atom_common;
     case SMALL_ATOM_EXT:
 	len = get_int8(ep);
 	ep++;
-	*objp = am_atom_put((char*)ep, len);
+    dec_atom_common:
+        if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) {
+	    if (!erts_atom_get((char*)ep, len, objp)) {
+                goto error;
+	    }
+        } else {
+            *objp = am_atom_put((char*)ep, len);
+        }
 	ep += len;
 	break;
     default:
@@ -1864,13 +1929,18 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Et
 	case ATOM_EXT:
 	    n = get_int16(ep);
 	    ep += 2;
-	    *objp = am_atom_put((char*)ep, n);
-	    ep += n;
-	    break;
+            goto dec_term_atom_common;
 	case SMALL_ATOM_EXT:
 	    n = get_int8(ep);
 	    ep++;
-	    *objp = am_atom_put((char*)ep, n);
+dec_term_atom_common:
+	    if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) {
+		if (!erts_atom_get((char*)ep, n, objp)) {
+		    goto error;
+		}
+	    } else {
+	        *objp = am_atom_put((char*)ep, n);
+	    }
 	    ep += n;
 	    break;
 	case LARGE_TUPLE_EXT:
@@ -2039,7 +2109,6 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Et
 		goto ref_ext_common;
 
 	    case NEW_REFERENCE_EXT:
-
 		ref_words = get_int16(ep);
 		ep += 2;
 
@@ -2218,6 +2287,10 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Et
 		if (arity < 0) {
 		    goto error;
 		}
+		if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) {
+		    if (!erts_find_export_entry(mod, name, arity))
+			goto error;
+                }
 		*objp = make_export(hp);
 		*hp++ = HEADER_EXPORT;
 		*hp++ = (Eterm) erts_export_get_or_make_stub(mod, name, arity);
diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h
index f308680f89..eada6d4f27 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -1,19 +1,19 @@
 /*
  * %CopyrightBegin%
- * 
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- * 
+ *
+ * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ *
  * The contents of this file are subject to the Erlang Public License,
  * Version 1.1, (the "License"); you may not use this file except in
  * compliance with the License. You should have received a copy of the
  * Erlang Public License along with this software. If not, it can be
  * retrieved online at http://www.erlang.org/.
- * 
+ *
  * Software distributed under the License is distributed on an "AS IS"
  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  * the License for the specific language governing rights and limitations
  * under the License.
- * 
+ *
  * %CopyrightEnd%
  */
 
@@ -98,9 +98,19 @@ typedef struct {
     Eterm atom[ERTS_ATOM_CACHE_SIZE];
 } ErtsAtomTranslationTable;
 
-#define ERTS_DIST_EXT_DFLAG_HDR (((Uint32) 1) << 31)
-#define ERTS_DIST_EXT_ATOM_TRANS_TAB (((Uint32) 1) << 30)
-#define ERTS_DIST_EXT_CON_ID_MASK ((Uint32) 0x3fffffff)
+/*
+ * These flags are tagged onto the high bits of a connection ID and stored in
+ * the ErtsDistExternal structure's flags field.  They are used to indicate
+ * various bits of state necessary to decode binaries in a variety of
+ * scenarios. The mask ERTS_DIST_EXT_CON_ID_MASK is used later to separate the
+ * connection ID from the flags. Be careful to ensure that the mask does not
+ * overlap any of the bits used for flags, or ERTS will leak flags bits into
+ * connection IDs and leak connection ID bits into the flags.
+ */
+#define ERTS_DIST_EXT_DFLAG_HDR      ((Uint32) 0x80000000)
+#define ERTS_DIST_EXT_ATOM_TRANS_TAB ((Uint32) 0x40000000)
+#define ERTS_DIST_EXT_BTT_SAFE       ((Uint32) 0x20000000)
+#define ERTS_DIST_EXT_CON_ID_MASK    ((Uint32) 0x1fffffff)
 
 #define ERTS_DIST_EXT_CON_ID(DIST_EXTP) \
   ((DIST_EXTP)->flags & ERTS_DIST_EXT_CON_ID_MASK)
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index e47dfa18f7..44b6bbe785 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -1,19 +1,19 @@
 %%
 %% %CopyrightBegin%
-%% 
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%% 
+%%
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%%
 %% The contents of this file are subject to the Erlang Public License,
 %% Version 1.1, (the "License"); you may not use this file except in
 %% compliance with the License. You should have received a copy of the
 %% Erlang Public License along with this software. If not, it can be
 %% retrieved online at http://www.erlang.org/.
-%% 
+%%
 %% Software distributed under the License is distributed on an "AS IS"
 %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 %% the License for the specific language governing rights and limitations
 %% under the License.
-%% 
+%%
 %% %CopyrightEnd%
 %%
 
@@ -27,6 +27,7 @@
 %%	binary_to_list/1
 %%	binary_to_list/3
 %%	binary_to_term/1
+%%  	binary_to_term/2
 %%      bitstr_to_list/1
 %%	term_to_binary/1
 %%      erlang:external_size/1
@@ -49,7 +50,7 @@
 	 t_hash/1,
 	 bad_size/1,
 	 bad_term_to_binary/1,
-	 bad_binary_to_term_2/1,
+	 bad_binary_to_term_2/1,safe_binary_to_term2/1,
 	 bad_binary_to_term/1, bad_terms/1, more_bad_terms/1,
 	 otp_5484/1,otp_5933/1,
 	 ordering/1,unaligned_order/1,gc_test/1,
@@ -66,7 +67,7 @@ all(suite) ->
      t_split_binary, bad_split, t_concat_binary,
      bad_list_to_binary, bad_binary_to_list, terms, terms_float,
      external_size, t_iolist_size,
-     bad_binary_to_term_2,
+     bad_binary_to_term_2,safe_binary_to_term2,
      bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary,
      more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order,
      gc_test, bit_sized_binary_sizes, bitlevel_roundtrip, otp_6817, otp_8117,
@@ -438,8 +439,11 @@ terms(Config) when is_list(Config) ->
 			      ok
 		      end,
 		      Term = binary_to_term(Bin),
+		      Term = erlang:binary_to_term(Bin, [safe]),
 		      Unaligned = make_unaligned_sub_binary(Bin),
 		      Term = binary_to_term(Unaligned),
+		      Term = erlang:binary_to_term(Unaligned, []),
+		      Term = erlang:binary_to_term(Bin, [safe]),
 		      BinC = erlang:term_to_binary(Term, [compressed]),
 		      Term = binary_to_term(BinC),
 		      true = size(BinC) =< size(Bin),
@@ -538,6 +542,23 @@ bad_binary_to_term(Config) when is_list(Config) ->
 bad_bin_to_term(BadBin) ->
     {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin)).
 
+bad_bin_to_term(BadBin,Opts) ->
+    {'EXIT',{badarg,_}} = (catch erlang:binary_to_term(BadBin,Opts)).
+
+safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2";
+safe_binary_to_term2(Config) when is_list(Config) ->
+    ?line bad_bin_to_term(<<131,100,0,14,"undefined_atom">>, [safe]),
+    ?line bad_bin_to_term(<<131,100,0,14,"other_bad_atom">>, [safe]),
+    BadHostAtom = <<100,0,14,"badguy@badhost">>,
+    Empty = <<0,0,0,0>>,
+    BadRef = <<131,114,0,3,BadHostAtom/binary,0,<<0,0,0,255>>/binary,
+	      Empty/binary,Empty/binary>>,
+    ?line bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom
+    ?line fullsweep_after = erlang:binary_to_term(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
+    BadExtFun = <<131,113,100,0,4,98,108,117,101,100,0,4,109,111,111,110,97,3>>,
+    ?line bad_bin_to_term(BadExtFun, [safe]),
+    ok.
+
 %% Tests bad input to binary_to_term/1.
 
 bad_terms(suite) -> [];