aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore3
-rw-r--r--erts/aclocal.m43
-rwxr-xr-xerts/autoconf/win32.config.cache.static2
-rw-r--r--erts/configure.in24
-rw-r--r--erts/doc/src/erl.xml2
-rw-r--r--erts/doc/src/erl_nif.xml4
-rw-r--r--erts/emulator/beam/beam_emu.c87
-rw-r--r--erts/emulator/beam/beam_load.c129
-rw-r--r--erts/emulator/beam/erl_nif.c5
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h2
-rw-r--r--erts/emulator/beam/ops.tab102
-rw-r--r--erts/emulator/drivers/common/inet_drv.c4
-rw-r--r--erts/emulator/sys/vxworks/sys.c3
-rw-r--r--erts/emulator/test/nif_SUITE.erl25
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c4
-rwxr-xr-xerts/emulator/utils/beam_makeops188
-rwxr-xr-xerts/emulator/utils/make_preload1
-rw-r--r--lib/asn1/c_src/Makefile2
-rw-r--r--lib/cosEvent/src/Makefile2
-rw-r--r--lib/cosEventDomain/src/Makefile2
-rw-r--r--lib/cosFileTransfer/src/Makefile2
-rw-r--r--lib/cosNotification/src/Makefile2
-rw-r--r--lib/cosProperty/src/Makefile2
-rw-r--r--lib/cosTime/src/Makefile2
-rw-r--r--lib/cosTransactions/src/Makefile2
-rw-r--r--lib/crypto/c_src/crypto.c48
-rw-r--r--lib/crypto/doc/src/crypto.xml79
-rw-r--r--lib/crypto/src/crypto.erl51
-rw-r--r--lib/crypto/test/crypto_SUITE.erl114
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl81
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl77
-rw-r--r--lib/diameter/test/Makefile2
-rw-r--r--lib/diameter/test/diameter_failover_SUITE.erl262
-rw-r--r--lib/diameter/test/diameter_relay_SUITE.erl114
-rw-r--r--lib/diameter/test/diameter_tls_SUITE.erl52
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl47
-rw-r--r--lib/diameter/test/diameter_transport_SUITE.erl53
-rw-r--r--lib/diameter/test/diameter_util.erl142
-rw-r--r--lib/diameter/test/modules.mk3
-rw-r--r--lib/erl_docgen/priv/xsl/db_man.xsl19
-rw-r--r--lib/ic/doc/src/Makefile8
-rw-r--r--lib/ic/doc/src/notes.xml16
-rw-r--r--lib/ic/examples/pre_post_condition/Makefile2
-rw-r--r--lib/ic/src/ic_pragma.erl6
-rw-r--r--lib/ic/vsn.mk2
-rw-r--r--lib/orber/COSS/CosNaming/Makefile2
-rw-r--r--lib/orber/examples/Stack/Makefile2
-rw-r--r--lib/orber/src/Makefile2
-rw-r--r--lib/ssl/src/ssl.erl20
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl40
-rw-r--r--lib/stdlib/doc/src/lists.xml26
-rw-r--r--lib/stdlib/doc/src/random.xml5
-rw-r--r--lib/stdlib/src/dets.erl108
-rw-r--r--lib/stdlib/src/dets.hrl3
-rw-r--r--lib/stdlib/src/dets_v8.erl16
-rw-r--r--lib/stdlib/src/dets_v9.erl118
-rw-r--r--lib/stdlib/src/lists.erl29
-rw-r--r--lib/stdlib/src/random.erl42
-rw-r--r--lib/stdlib/test/dets_SUITE.erl97
59 files changed, 1569 insertions, 723 deletions
diff --git a/.gitignore b/.gitignore
index e5f0869f27..e6920fbeca 100644
--- a/.gitignore
+++ b/.gitignore
@@ -100,6 +100,9 @@ make/win32/
# Used by ic & orber & cos* applications.
IDL-GENERATED
+# Used by applications that run javadoc (e.g. ic).
+JAVADOC-GENERATED
+
# Anchored from $ERL_TOP
/bin
/config.log
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4
index 27f643921e..bd228a2d1f 100644
--- a/erts/aclocal.m4
+++ b/erts/aclocal.m4
@@ -1366,9 +1366,6 @@ case "$GCC-$host_cpu" in
;;
esac
-test $enable_ethread_pre_pentium4_compatibility = yes &&
- AC_DEFINE(ETHR_PRE_PENTIUM4_COMPAT, 1, [Define if you want compatibility with x86 processors before pentium4.])
-
AC_DEFINE(ETHR_HAVE_ETHREAD_DEFINES, 1, \
[Define if you have all ethread defines])
diff --git a/erts/autoconf/win32.config.cache.static b/erts/autoconf/win32.config.cache.static
index d25b1df9d9..b387db2b22 100755
--- a/erts/autoconf/win32.config.cache.static
+++ b/erts/autoconf/win32.config.cache.static
@@ -96,7 +96,6 @@ ac_cv_func_sbrk=${ac_cv_func_sbrk=no}
ac_cv_func_select=${ac_cv_func_select=no}
ac_cv_func_setlocale=${ac_cv_func_setlocale=yes}
ac_cv_func_setsid=${ac_cv_func_setsid=no}
-ac_cv_func_setvbuf_reversed=${ac_cv_func_setvbuf_reversed=yes}
ac_cv_func_socket=${ac_cv_func_socket=no}
ac_cv_func_strchr=${ac_cv_func_strchr=yes}
ac_cv_func_strerror=${ac_cv_func_strerror=yes}
@@ -124,7 +123,6 @@ ac_cv_header_ieeefp_h=${ac_cv_header_ieeefp_h=no}
ac_cv_header_inttypes_h=${ac_cv_header_inttypes_h=no}
ac_cv_header_langinfo_h=${ac_cv_header_langinfo_h=no}
ac_cv_header_limits_h=${ac_cv_header_limits_h=yes}
-ac_cv_header_mach_o_dyld_h=${ac_cv_header_mach_o_dyld_h=no}
ac_cv_header_malloc_h=${ac_cv_header_malloc_h=yes}
ac_cv_header_memory_h=${ac_cv_header_memory_h=yes}
ac_cv_header_net_errno_h=${ac_cv_header_net_errno_h=no}
diff --git a/erts/configure.in b/erts/configure.in
index ea76a2f400..fafa1c7e92 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -259,13 +259,6 @@ AS_HELP_STRING([--enable-m32-build],
esac
],enable_m32_build=no)
-AC_ARG_ENABLE(fixalloc,
-AS_HELP_STRING([--disable-fixalloc], [disable the use of fix_alloc]))
-if test x${enable_fixalloc} = xno ; then
- AC_DEFINE(NO_FIX_ALLOC,[],
- [Define if you don't want the fix allocator in Erlang])
-fi
-
AC_SUBST(PERFCTR_PATH)
AC_ARG_WITH(perfctr,
AS_HELP_STRING([--with-perfctr=PATH],
@@ -914,16 +907,6 @@ fi
AC_SUBST(ERLANG_OSTYPE)
-dnl Which sysv4 would this be, and what is it for???
-dnl XXX: replace with feature tests.
-case $host_os in
- sysv4*)
- AC_DEFINE(SOCKOPT_CONNECT_STAT,[],[Obscure SYSV feature])
- AC_DEFINE(NO_PRAGMA_WEAK,[],[Obscure SYSV feature])
- LIBS="$LIBS -lgen -lc -L /usr/ucblib -lucb"
- ;;
-esac
-
# Check how to export functions from the emulator executable, needed
# when dynamically loaded drivers are loaded (so that they can find
# emulator functions).
@@ -1484,7 +1467,7 @@ AC_CHECK_HEADERS(fcntl.h limits.h unistd.h syslog.h dlfcn.h ieeefp.h \
sys/types.h sys/stropts.h sys/sysctl.h \
sys/ioctl.h sys/time.h sys/uio.h \
sys/socket.h sys/sockio.h sys/socketio.h \
- net/errno.h malloc.h mach-o/dyld.h arpa/nameser.h \
+ net/errno.h malloc.h arpa/nameser.h \
pty.h util.h utmp.h langinfo.h poll.h sdkddkver.h)
AC_CHECK_HEADER(sys/resource.h,
@@ -1809,11 +1792,6 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop
AC_CHECK_DECLS([posix2time],,,[#include <time.h>])
-if test "X$host" = "Xwin32"; then
- ac_cv_func_setvbuf_reversed=yes
-fi
-AC_FUNC_SETVBUF_REVERSED
-
disable_vfork=false
if test "x$EMU_THR_LIB_NAME" != "x"; then
AC_MSG_CHECKING([if vfork is known to hang multithreaded applications])
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index 8502ceadd2..39c79a29df 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -994,7 +994,7 @@
the <c><![CDATA[-extra]]></c> section, i.e. the end of the command line
following after an <c><![CDATA[-extra]]></c> flag.</p>
</item>
- <tag><c><![CDATA[ERL_ZFLAGS]]></c>and <c><![CDATA[ERL_FLAGS]]></c></tag>
+ <tag><c><![CDATA[ERL_ZFLAGS]]></c> and <c><![CDATA[ERL_FLAGS]]></c></tag>
<item>
<p>The content of these environment variables will be added to the
end of the command line for <c><![CDATA[erl]]></c>.</p>
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 980fc0cc39..8daa67aa87 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -692,6 +692,10 @@ typedef enum {
<fsummary>Determine if a term is an exception</fsummary>
<desc><p>Return true if <c>term</c> is an exception.</p></desc>
</func>
+ <func><name><ret>int</ret><nametext>enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
+ <fsummary>Determine if a term is a number (integer or float)</fsummary>
+ <desc><p>Return true if <c>term</c> is a number.</p></desc>
+ </func>
<func><name><ret>int</ret><nametext>enif_is_fun(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
<fsummary>Determine if a term is a fun</fsummary>
<desc><p>Return true if <c>term</c> is a fun.</p></desc>
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 62a14dbacf..76912ebbd6 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -4862,92 +4862,6 @@ void process_main(void)
}
/*
- * Instructions for allocating on the message area.
- */
-
- OpCase(i_global_cons):
- {
- BeamInstr *next;
-#ifdef HYBRID
- Eterm *hp;
-
- PreFetch(0,next);
- TestGlobalHeap(2,2,hp);
- hp[0] = r(0);
- hp[1] = x(1);
- r(0) = make_list(hp);
-#ifndef INCREMENTAL
- global_htop += 2;
-#endif
- NextPF(0,next);
-#else
- PreFetch(0,next);
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- OpCase(i_global_tuple):
- {
- BeamInstr *next;
- int len;
-#ifdef HYBRID
- Eterm list;
- Eterm *hp;
-#endif
-
- if ((len = list_length(r(0))) < 0) {
- goto badarg;
- }
-
- PreFetch(0,next);
-#ifdef HYBRID
- TestGlobalHeap(len + 1,1,hp);
- list = r(0);
- r(0) = make_tuple(hp);
- *hp++ = make_arityval(len);
- while(is_list(list))
- {
- Eterm* cons = list_val(list);
- *hp++ = CAR(cons);
- list = CDR(cons);
- }
-#ifndef INCREMENTAL
- global_htop += len + 1;
-#endif
- NextPF(0,next);
-#else
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- OpCase(i_global_copy):
- {
- BeamInstr *next;
- PreFetch(0,next);
-#ifdef HYBRID
- if (!IS_CONST(r(0)))
- {
- BM_SWAP_TIMER(system,copy);
- SWAPOUT;
- reg[0] = r(0);
- reg[1] = NIL;
- r(0) = copy_struct_lazy(c_p,r(0),0);
- ASSERT(ma_src_top == 0);
- ASSERT(ma_dst_top == 0);
- ASSERT(ma_offset_top == 0);
- SWAPIN;
- BM_SWAP_TIMER(copy,system);
- }
- NextPF(0,next);
-#else
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- /*
* New floating point instructions.
*/
@@ -5240,7 +5154,6 @@ void process_main(void)
OpCase(int_code_end):
OpCase(label_L):
- OpCase(too_old_compiler):
OpCase(on_load):
OpCase(line_I):
erl_exit(1, "meta op\n");
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 16dd5795c7..de4b32b238 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -1887,14 +1887,6 @@ load_code(LoaderState* stp)
}
/*
- * Special error message instruction.
- */
- if (stp->genop->op == genop_too_old_compiler_0) {
- LoadError0(stp, "please re-compile this module with an "
- ERLANG_OTP_RELEASE " compiler");
- }
-
- /*
* From the collected generic instruction, find the specific
* instruction.
*/
@@ -1945,7 +1937,27 @@ load_code(LoaderState* stp)
ERLANG_OTP_RELEASE " compiler ");
}
- LoadError0(stp, "no specific operation found");
+ /*
+ * Some generic instructions should have a special
+ * error message.
+ */
+ switch (stp->genop->op) {
+ case genop_too_old_compiler_0:
+ LoadError0(stp, "please re-compile this module with an "
+ ERLANG_OTP_RELEASE " compiler");
+ case genop_unsupported_guard_bif_3:
+ {
+ Eterm Mod = (Eterm) stp->genop->a[0].val;
+ Eterm Name = (Eterm) stp->genop->a[1].val;
+ Uint arity = (Uint) stp->genop->a[2].val;
+ FREE_GENOP(stp, stp->genop);
+ stp->genop = 0;
+ LoadError3(stp, "unsupported guard BIF: %T:%T/%d\n",
+ Mod, Name, arity);
+ }
+ default:
+ LoadError0(stp, "no specific operation found");
+ }
}
stp->specific_op = specific;
@@ -2409,6 +2421,8 @@ load_code(LoaderState* stp)
#define no_fpe_signals(St) 0
#endif
+#define never(St) 0
+
/*
* Predicate that tests whether a jump table can be used.
*/
@@ -3664,10 +3678,7 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_i_gc_bif1_5;
- op->arity = 5;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
@@ -3688,19 +3699,30 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
} else if (bf == trunc_1) {
op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_i_gc_bif1_5;
+ op->arity = 5;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = Src;
op->a[3] = Live;
op->a[4] = Dst;
- op->next = NULL;
return op;
}
/*
- * This is used by the ops.tab rule that rewrites gc_bifs with two parameters
+ * This is used by the ops.tab rule that rewrites gc_bifs with two parameters.
* The instruction returned is then again rewritten to an i_load instruction
- * folowed by i_gc_bif2_jIId, to handle literals properly.
+ * followed by i_gc_bif2_jIId, to handle literals properly.
* As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is
* always rewritten, regardless of if there actually are any literals.
*/
@@ -3712,31 +3734,39 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_ii_gc_bif2_6;
- op->arity = 6;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
if (bf == binary_part_2) {
op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_ii_gc_bif2_6;
+ op->arity = 6;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = S1;
op->a[3] = S2;
op->a[4] = Live;
op->a[5] = Dst;
- op->next = NULL;
return op;
}
/*
- * This is used by the ops.tab rule that rewrites gc_bifs with three parameters
+ * This is used by the ops.tab rule that rewrites gc_bifs with three parameters.
* The instruction returned is then again rewritten to a move instruction that
* uses r[0] for temp storage, followed by an i_load instruction,
- * folowed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
+ * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
* always occur, as with the gc_bif2 counterpart.
*/
static GenOp*
@@ -3747,18 +3777,27 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_ii_gc_bif3_7;
- op->arity = 7;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
if (bf == binary_part_3) {
op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_ii_gc_bif3_7;
+ op->arity = 7;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = S1;
op->a[3] = S2;
op->a[4] = S3;
@@ -4225,6 +4264,7 @@ transform_engine(LoaderState* st)
GenOp* instr;
Uint* pc;
int rval;
+ static Uint restart_fail[1] = {TOP_fail};
ASSERT(gen_opc[st->genop->op].transform != -1);
pc = op_transform + gen_opc[st->genop->op].transform;
@@ -4238,7 +4278,6 @@ transform_engine(LoaderState* st)
ASSERT(restart != NULL);
pc = restart;
ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
- ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail);
instr = st->genop;
#define RETURN(r) rval = (r); goto do_return;
@@ -4251,7 +4290,9 @@ transform_engine(LoaderState* st)
op = *pc++;
switch (op) {
- case TOP_is_op:
+ case TOP_next_instr:
+ instr = instr->next;
+ ap = 0;
if (instr == NULL) {
/*
* We'll need at least one more instruction to decide whether
@@ -4438,10 +4479,6 @@ transform_engine(LoaderState* st)
case TOP_next_arg:
ap++;
break;
- case TOP_next_instr:
- instr = instr->next;
- ap = 0;
- break;
case TOP_commit:
instr = instr->next; /* The next_instr was optimized away. */
@@ -4459,8 +4496,8 @@ transform_engine(LoaderState* st)
#endif
break;
-#if defined(TOP_call)
- case TOP_call:
+#if defined(TOP_call_end)
+ case TOP_call_end:
{
GenOp** lastp;
GenOp* new_instr;
@@ -4497,7 +4534,7 @@ transform_engine(LoaderState* st)
*lastp = st->genop;
st->genop = new_instr;
}
- break;
+ RETURN(TE_OK);
#endif
case TOP_new_instr:
/*
@@ -4506,12 +4543,10 @@ transform_engine(LoaderState* st)
NEW_GENOP(st, instr);
instr->next = st->genop;
st->genop = instr;
+ instr->op = op = *pc++;
+ instr->arity = gen_opc[op].arity;
ap = 0;
break;
- case TOP_store_op:
- instr->op = *pc++;
- instr->arity = *pc++;
- break;
case TOP_store_type:
i = *pc++;
instr->a[ap].type = i;
@@ -4521,21 +4556,25 @@ transform_engine(LoaderState* st)
i = *pc++;
instr->a[ap].val = i;
break;
- case TOP_store_var:
+ case TOP_store_var_next_arg:
i = *pc++;
ASSERT(i < TE_MAX_VARS);
instr->a[ap].type = var[i].type;
instr->a[ap].val = var[i].val;
+ ap++;
break;
case TOP_try_me_else:
restart = pc + 1;
restart += *pc++;
ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
break;
+ case TOP_try_me_else_fail:
+ restart = restart_fail;
+ break;
case TOP_end:
RETURN(TE_OK);
case TOP_fail:
- RETURN(TE_FAIL)
+ RETURN(TE_FAIL);
default:
ASSERT(0);
}
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index f3db3f9326..51f1fad811 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -435,6 +435,11 @@ int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)
return term == THE_NON_VALUE;
}
+int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)
+{
+ return is_number(term);
+}
+
static void aligned_binary_dtor(struct enif_tmp_obj_t* obj)
{
erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP);
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index 4af9f61000..18f2c022eb 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -137,6 +137,7 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64));
#endif
ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list));
+ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term));
/*
** Add new entries here to keep compatibility on Windows!!!
@@ -258,6 +259,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term,
# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception)
# define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list)
+# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number)
/*
** Add new entries here
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 538f0b94af..34bd5d0653 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -25,30 +25,12 @@
# instruction transformations; thus, they never occur in BEAM files.
#
-# Special instruction used to generate an error message when
-# trying to load a module compiled by the V1 compiler (R5 & R6).
-# (Specially treated in beam_load.c.)
+# The too_old_compiler/0 instruction is specially handled in beam_load.c
+# to produce a user-friendly message informing the user that the module
+# needs to be re-compiled with a modern compiler.
too_old_compiler/0
-too_old_compiler
-
-#
-# Obsolete instruction usage follow. (Nowdays we use f with
-# a zero label instead of p.)
-#
-
-is_list p S => too_old_compiler
-is_nonempty_list p R => too_old_compiler
-is_nil p R => too_old_compiler
-
-is_tuple p S => too_old_compiler
-test_arity p S Arity => too_old_compiler
-
-is_integer p R => too_old_compiler
-is_float p R => too_old_compiler
-is_atom p R => too_old_compiler
-
-is_eq_exact p S1 S2 => too_old_compiler
+too_old_compiler | never() =>
# In R9C and earlier, the loader used to insert special instructions inside
# the module_info/0,1 functions. (In R10B and later, the compiler inserts
@@ -88,9 +70,6 @@ i_time_breakpoint
i_return_time_trace
i_return_to_trace
i_yield
-i_global_cons
-i_global_tuple
-i_global_copy
return
@@ -310,8 +289,6 @@ raise s s
badarg j
system_limit j
-move R R =>
-
move C=cxy r | jump Lbl => move_jump Lbl C
%macro: move_jump MoveJump -nonext
@@ -618,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg
original_reg Reg Pos =>
-get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst
-
original_reg/2
extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
@@ -908,23 +883,6 @@ call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate
call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate
#
-# Hybrid memory architecture need special cons and tuple instructions
-# that allocate on the message area. These looks like BIFs in the BEAM code.
-#
-
-call_ext u==2 u$func:hybrid:cons/2 => i_global_cons
-call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D
-call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return
-
-call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple
-call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D
-call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return
-
-call_ext u==1 u$func:hybrid:copy/1 => i_global_copy
-call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D
-call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return
-
-#
# The general case for BIFs that have no special instructions.
# A BIF used in the tail must be followed by a return instruction.
#
@@ -961,9 +919,9 @@ move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func
move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r
move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r
-call_ext Ar=u Func => i_call_ext Func
-call_ext_last Ar=u Func D => i_call_ext_last Func D
-call_ext_only Ar=u Func => i_call_ext_only Func
+call_ext Ar Func => i_call_ext Func
+call_ext_last Ar Func D => i_call_ext_last Func D
+call_ext_only Ar Func => i_call_ext_only Func
i_apply
i_apply_last P
@@ -997,7 +955,7 @@ bif1 p Bif S1 Dst => bif1_body Bif S1 Dst
bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst
bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst
-bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
+bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
i_get s d
@@ -1080,8 +1038,8 @@ i_move_call_ext_only e c r
# Fun calls.
-call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D
-call_fun Arity=u => i_call_fun Arity
+call_fun Arity | deallocate D | return => i_call_fun_last Arity D
+call_fun Arity => i_call_fun Arity
i_call_fun I
i_call_fun_last I P
@@ -1337,13 +1295,13 @@ i_bs_utf16_size s d
bs_put_utf8 Fail=j Flags=u Literal=q => \
move Literal x | bs_put_utf8 Fail Flags x
-bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src
+bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src
i_bs_put_utf8 j s
bs_put_utf16 Fail=j Flags=u Literal=q => \
move Literal x | bs_put_utf16 Fail Flags x
-bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
+bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
i_bs_put_utf16 j I s
@@ -1508,34 +1466,13 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler
#
# Guard BIFs.
#
-gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \
+gc_bif1 Fail I Bif Src Dst => \
gen_guard_bif1(Fail, I, Bif, Src, Dst)
-gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \
+gc_bif2 Fail I Bif S1 S2 Dst => \
gen_guard_bif2(Fail, I, Bif, S1, S2, Dst)
-gc_bif3 Fail I Bif=u$bif:erlang:binary_part/3 S1 S2 S3 Dst=d => \
+gc_bif3 Fail I Bif S1 S2 S3 Dst => \
gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst)
i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D
@@ -1553,6 +1490,15 @@ ii_gc_bif3/7
ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D
i_gc_bif3 j I s I d
+
+#
+# The following instruction is specially handled in beam_load.c
+# to produce a user-friendly message if an unsupported guard BIF is
+# encountered.
+#
+unsupported_guard_bif/3
+unsupported_guard_bif A B C | never() =>
+
#
# R13B03
#
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 43114c6039..426917bd2c 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -9307,7 +9307,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
goto done;
}
}
-#endif /* SOCKOPT_CONNECT_STAT */
+#endif /* SO_ERROR */
#endif /* !__WIN32__ */
desc->inet.state = TCP_STATE_CONNECTED;
@@ -10112,7 +10112,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
goto done;
}
}
-#endif /* SOCKOPT_CONNECT_STAT */
+#endif /* SO_ERROR */
#endif /* !__WIN32__ */
desc->state = PACKET_STATE_CONNECTED;
diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c
index c6e7b65f32..a59e4ec26a 100644
--- a/erts/emulator/sys/vxworks/sys.c
+++ b/erts/emulator/sys/vxworks/sys.c
@@ -2025,9 +2025,6 @@ int erl_memory_show(int p0, int p1, int p2, int p3, int p4, int p5,
erts_printf("The memory block used by elib is save_malloc'ed "
"at 0x%08x.\n", (unsigned int) alloc_pool_ptr);
}
-#ifdef NO_FIX_ALLOC
- erts_printf("Fix_alloc is disabled in this build\n");
-#endif
erts_printf("Statistics from elib_malloc:\n");
ELIB_LOCK;
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index d95789fa6e..5c82a01bd1 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -1165,7 +1165,28 @@ is_checks(Config) when is_list(Config) ->
?line ensure_lib_loaded(Config, 1),
?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
- {hejsan, "hejsan", [$h,"ejs",<<"an">>]}),
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2),
try
?line error = check_is_exception(),
?line throw(expected_badarg)
@@ -1303,7 +1324,7 @@ get_resource(_,_) -> ?nif_stub.
release_resource(_) -> ?nif_stub.
last_resource_dtor_call() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
-check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
+check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
check_is_exception() -> ?nif_stub.
length_test(_,_,_,_,_) -> ?nif_stub.
make_atoms() -> ?nif_stub.
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index cf2ec4aaf0..35f54d62c5 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -832,6 +832,7 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER
* argv[7] an empty list
* argv[8] a non-empty list
* argv[9] a tuple
+ * argv[10] a number (small, big integer or float)
*/
static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
@@ -848,6 +849,7 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
if (!enif_is_list(env, argv[7])) return enif_make_badarg(env);
if (!enif_is_list(env, argv[8])) return enif_make_badarg(env);
if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env);
+ if (!enif_is_number(env, argv[10])) return enif_make_badarg(env);
return ok_atom;
}
@@ -1455,7 +1457,7 @@ static ErlNifFunc nif_funcs[] =
{"release_resource", 1, release_resource},
{"last_resource_dtor_call", 0, last_resource_dtor_call},
{"make_new_resource", 2, make_new_resource},
- {"check_is", 10, check_is},
+ {"check_is", 11, check_is},
{"check_is_exception", 0, check_is_exception},
{"length_test", 5, length_test},
{"make_atoms", 0, make_atoms},
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index ebf7db3277..58c36c3bdc 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -105,7 +105,9 @@ my %match_engine_ops; # All opcodes for the match engine.
my %gen_transform_offset;
my @transformations;
my @call_table;
+my %call_table;
my @pred_table;
+my %pred_table;
# Operand types for generic instructions.
@@ -187,6 +189,12 @@ sub define_type_bit {
}
#
+# Pre-define the 'fail' instruction. It is used internally
+# by the 'try_me_else_fail' instruction.
+#
+$match_engine_ops{'TOP_fail'} = 1;
+
+#
# Sanity checks.
#
@@ -1304,7 +1312,8 @@ sub tr_gen {
foreach $ref (@g) {
my($line, $orig_transform, $from_ref, $to_ref) = @$ref;
- my $so_far = tr_gen_from($line, @$from_ref);
+ my $used_ref = used_vars($from_ref, $to_ref);
+ my $so_far = tr_gen_from($line, $used_ref, @$from_ref);
tr_gen_to($line, $orig_transform, $so_far, @$to_ref);
}
@@ -1313,9 +1322,22 @@ sub tr_gen {
#
my($offset) = 0;
print "Uint op_transform[] = {\n";
- foreach $key (keys %gen_transform) {
+ foreach $key (sort keys %gen_transform) {
$gen_transform_offset{$key} = $offset;
- foreach $instr (@{$gen_transform{$key}}) {
+ my @instr = @{$gen_transform{$key}};
+
+ #
+ # If the last instruction is 'fail', remove it and
+ # convert the previous 'try_me_else' to 'try_me_else_fail'.
+ #
+ if (is_instr($instr[$#instr], 'fail')) {
+ pop(@instr);
+ my $i = $#instr;
+ $i-- while !is_instr($instr[$i], 'try_me_else');
+ $instr[$i] = make_op('', 'try_me_else_fail');
+ }
+
+ foreach $instr (@instr) {
my($size, $instr_ref, $comment) = @$instr;
my($op, @args) = @$instr_ref;
print " ";
@@ -1342,8 +1364,48 @@ sub tr_gen {
print "};\n\n";
}
+sub used_vars {
+ my($from_ref,$to_ref) = @_;
+ my %used;
+ my %seen;
+
+ foreach my $ref (@$from_ref) {
+ my($name,$arity,@ops) = @$ref;
+ if ($name =~ /^[.]/) {
+ foreach my $var (@ops) {
+ $used{$var} = 1;
+ }
+ } else {
+ # Any variable that is used at least twice on the
+ # left-hand side is used. (E.g. "move R R".)
+ foreach my $op (@ops) {
+ my($var, $type, $type_val) = @$op;
+ next if $var eq '';
+ $used{$var} = 1 if $seen{$var};
+ $seen{$var} = 1;
+ }
+ }
+ }
+
+ foreach my $ref (@$to_ref) {
+ my($name, $arity, @ops) = @$ref;
+ if ($name =~ /^[.]/) {
+ foreach my $var (@ops) {
+ $used{$var} = 1;
+ }
+ } else {
+ foreach my $op (@ops) {
+ my($var, $type, $type_val) = @$op;
+ next if $var eq '';
+ $used{$var} = 1;
+ }
+ }
+ }
+ \%used;
+}
+
sub tr_gen_from {
- my($line, @tr) = @_;
+ my($line,$used_ref,@tr) = @_;
my(%var) = ();
my(%var_type);
my($var_num) = 0;
@@ -1353,25 +1415,30 @@ sub tr_gen_from {
my(@fix_pred_funcs);
my($op, $ref); # Loop variables.
my $where = "left side of transformation in line $line: ";
+ my %var_used = %$used_ref;
+ my $may_fail = 0;
+ my $is_first = 1;
foreach $ref (@tr) {
my($name, $arity, @ops) = @$ref;
my($key) = "$name/$arity";
my($opnum);
+ $may_fail = 1 unless $is_first;
+ $is_first = 0;
+
#
# A name starting with a period is a C pred function to be called.
#
if ($name =~ /^\.(\w+)/) {
$name = $1;
+ $may_fail = 1;
my $var;
my(@args);
- my $next_instr = pop(@code); # Get rid of 'next_instr'
push(@fix_pred_funcs, scalar(@code));
push(@code, [$name, @ops]);
- push(@code, $next_instr);
next;
}
@@ -1383,17 +1450,21 @@ sub tr_gen_from {
unless defined $gen_opnum{$name,$arity};
$opnum = $gen_opnum{$name,$arity};
- push(@code, &make_op("$name/$arity", 'is_op', $opnum));
+ push(@code, make_op("$name/$arity", 'next_instr', $opnum));
$min_window++;
foreach $op (@ops) {
my($var, $type, $type_val, $cond, $val) = @$op;
+ my $ignored_var = "$var (ignored)";
if ($type ne '' && $type ne '*') {
+ $may_fail = 1;
+
#
# The is_bif, is_not_bif, and is_func instructions have
# their own built-in type test and don't need to
# be guarded with a type test instruction.
#
+ $ignored_var = '';
unless ($cond eq 'is_bif' or
$cond eq 'is_not_bif' or
$cond eq 'is_func') {
@@ -1407,7 +1478,7 @@ sub tr_gen_from {
push(@code, &make_op($types, 'is_type', $type_mask));
} else {
$cond = '';
- push(@code, &make_op($types, 'is_type_eq',
+ push(@code, &make_op("$types== $val", 'is_type_eq',
$type_mask, $val));
}
}
@@ -1415,46 +1486,55 @@ sub tr_gen_from {
if ($cond eq 'is_func') {
my($m, $f, $a) = split(/:/, $val);
+ $ignored_var = '';
+ $may_fail = 1;
push(@code, &make_op('', "$cond", "am_$m",
"am_$f", $a));
} elsif ($cond ne '') {
+ $ignored_var = '';
+ $may_fail = 1;
push(@code, &make_op('', "$cond", $val));
}
if ($var ne '') {
if (defined $var{$var}) {
+ $ignored_var = '';
+ $may_fail = 1;
push(@code, &make_op($var, 'is_same_var', $var{$var}));
} elsif ($type eq '*') {
#
# Reserve a hole for a 'rest_args' instruction.
#
+ $ignored_var = '';
push(@fix_rest_args, scalar(@code));
push(@code, $var);
- } else {
+ } elsif ($var_used{$var}) {
+ $ignored_var = '';
$var_type{$var} = 'scalar';
$var{$var} = $var_num;
$var_num++;
push(@code, &make_op($var, 'set_var', $var{$var}));
}
}
- if (is_set_var_instr($code[$#code])) {
+ if (is_instr($code[$#code], 'set_var')) {
my $ref = pop @code;
my $comment = $ref->[2];
my $var = $ref->[1][1];
push(@code, make_op($comment, 'set_var_next_arg', $var));
} else {
- push(@code, &make_op('', 'next_arg'));
+ push(@code, &make_op($ignored_var, 'next_arg'));
}
}
- push(@code, &make_op('', 'next_instr'));
- pop(@code) if $code[$#code]->[1][0] eq 'next_arg';
+
+ # Remove redundant 'next_arg' instructions before the end
+ # of the instruction.
+ pop(@code) while is_instr($code[$#code], 'next_arg');
}
#
# Insert the commit operation.
#
- pop(@code); # Get rid of 'next_instr'
- push(@code, &make_op('', 'commit'));
+ push(@code, make_op($may_fail ? '' : 'always reached', 'commit'));
#
# If there is an rest_args instruction, we must insert its correct
@@ -1484,9 +1564,8 @@ sub tr_gen_from {
push(@args, "var+$var{$var}");
}
}
- splice(@code, $index, 1, &make_op("$name()",
- 'pred', scalar(@pred_table)));
- push(@pred_table, [$name, @args]);
+ my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args);
+ splice(@code, $index, 1, make_op("$name()", 'pred', $pi));
}
$te_max_vars = $var_num
@@ -1503,6 +1582,10 @@ sub tr_gen_to {
my($op, $ref); # Loop variables.
my($where) = "right side of transformation in line $line: ";
+ my $last_instr = $code[$#code];
+ my $cannot_fail = is_instr($last_instr, 'commit') &&
+ (get_comment($last_instr) =~ /^always/);
+
foreach $ref (@tr) {
my($name, $arity, @ops) = @$ref;
@@ -1524,9 +1607,10 @@ sub tr_gen_to {
push(@args, "var+$var{$var}");
}
}
- pop(@code); # Get rid of 'next_instr'
- push(@code, &make_op("$name()", 'call', scalar(@call_table)));
- push(@call_table, [$name, @args]);
+ pop(@code); # Get rid of 'commit' instruction
+ my $index = tr_next_index(\@call_table, \%call_table,
+ $name, @args);
+ push(@code, make_op("$name()", 'call_end', $index));
last;
}
@@ -1543,27 +1627,27 @@ sub tr_gen_to {
# Create code to build the generic instruction.
#
- push(@code, &make_op('', 'new_instr'));
- push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity));
+ push(@code, make_op("$name/$arity", 'new_instr', $opnum));
foreach $op (@ops) {
my($var, $type, $type_val) = @$op;
if ($var ne '') {
&error($where, "variable '$var' unbound")
unless defined $var{$var};
- push(@code, &make_op($var, 'store_var', $var{$var}));
+ push(@code, &make_op($var, 'store_var_next_arg', $var{$var}));
} elsif ($type ne '') {
push(@code, &make_op('', 'store_type', "TAG_$type"));
if ($type_val) {
push(@code, &make_op('', 'store_val', $type_val));
}
+ push(@code, make_op('', 'next_arg'));
}
- push(@code, &make_op('', 'next_arg'));
}
- pop(@code) if $code[$#code]->[1][0] eq 'next_arg';
+ pop(@code) if is_instr($code[$#code], 'next_arg');
}
- push(@code, &make_op('', 'end'));
+ push(@code, make_op('', 'end'))
+ unless is_instr($code[$#code], 'call_end');
#
# Chain together all codes segments having the same first operation.
@@ -1575,11 +1659,20 @@ sub tr_gen_to {
$min_window{$key} = $min_window
if $min_window{$key} > $min_window;
- pop(@{$gen_transform{$key}})
+ my $prev_last;
+ $prev_last = pop(@{$gen_transform{$key}})
if defined @{$gen_transform{$key}}; # Fail
- my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code)));
- unshift(@code, @prefix);
- push(@{$gen_transform{$key}}, @code, &make_op('', 'fail'));
+
+ if ($prev_last && !is_instr($prev_last, 'fail')) {
+ error("Line $line: A previous transformation shadows '$orig_transform'");
+ }
+ unless ($cannot_fail) {
+ unshift(@code, make_op('', 'try_me_else',
+ tr_code_len(@code)));
+ push(@code, make_op(""), make_op("$key", 'fail'));
+ }
+ unshift(@code, make_op($comment));
+ push(@{$gen_transform{$key}}, @code),
}
sub tr_code_len {
@@ -1597,21 +1690,38 @@ sub make_op {
[scalar(@op), [@op], $comment];
}
-sub is_set_var_instr {
- my($ref) = @_;
+sub is_instr {
+ my($ref,$op) = @_;
return 0 unless ref($ref) eq 'ARRAY';
- $ref->[1][0] eq 'set_var';
+ $ref->[1][0] eq $op;
+}
+
+sub get_comment {
+ my($ref,$op) = @_;
+ return '' unless ref($ref) eq 'ARRAY';
+ $ref->[2];
+}
+
+sub tr_next_index {
+ my($lref,$href,$name,@args) = @_;
+ my $code = "RVAL = $name(" . join(', ', 'st', @args) . "); break;\n";
+ my $index;
+
+ if (defined $$href{$code}) {
+ $index = $$href{$code};
+ } else {
+ $index = scalar(@$lref);
+ push(@$lref, $code);
+ $$href{$code} = $index;
+ }
+ $index;
}
sub tr_gen_call {
my(@call_table) = @_;
my($i);
- print "\n";
for ($i = 0; $i < @call_table; $i++) {
- my $ref = $call_table[$i];
- my($name, @args) = @$ref;
- print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n";
+ print "case $i: $call_table[$i]";
}
- print "\n";
}
diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload
index d0671e998d..d22f08f993 100755
--- a/erts/emulator/utils/make_preload
+++ b/erts/emulator/utils/make_preload
@@ -88,6 +88,7 @@ foreach $file (@ARGV) {
print "unsigned char preloaded_$module", "[] = {\n";
for ($i = 0; $i < length($_); $i++) {
if ($i % 8 == 0 && $comment ne '') {
+ $comment =~ s@/\*@..@g; # Comment start -- avoid warning.
$comment =~ s@\*/@..@g; # Comment terminator.
print " /* $comment */\n ";
$comment = '';
diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile
index f7213b9651..8c06be56f8 100644
--- a/lib/asn1/c_src/Makefile
+++ b/lib/asn1/c_src/Makefile
@@ -62,7 +62,7 @@ NIF_OBJ_FILES = $(OBJDIR)/asn1_erl_nif.o
ifeq ($(TARGET),win32)
-NIF_SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_nif.dll
+NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.dll
CLIB_FLAGS =
LN=cp
else
diff --git a/lib/cosEvent/src/Makefile b/lib/cosEvent/src/Makefile
index c774d18380..736b95538a 100644
--- a/lib/cosEvent/src/Makefile
+++ b/lib/cosEvent/src/Makefile
@@ -164,7 +164,7 @@ debug:
@${MAKE} TYPE=debug opt
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/cosEventDomain/src/Makefile b/lib/cosEventDomain/src/Makefile
index 91bef4e7e6..5af790c760 100644
--- a/lib/cosEventDomain/src/Makefile
+++ b/lib/cosEventDomain/src/Makefile
@@ -137,7 +137,7 @@ debug:
@${MAKE} TYPE=debug opt
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/cosFileTransfer/src/Makefile b/lib/cosFileTransfer/src/Makefile
index 17e82f9bc2..b811ef1106 100644
--- a/lib/cosFileTransfer/src/Makefile
+++ b/lib/cosFileTransfer/src/Makefile
@@ -147,7 +147,7 @@ cleanb:
rm -f errs core *~
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/cosNotification/src/Makefile b/lib/cosNotification/src/Makefile
index b976ab94f3..be52d1a06f 100644
--- a/lib/cosNotification/src/Makefile
+++ b/lib/cosNotification/src/Makefile
@@ -328,7 +328,7 @@ cleanb:
rm -f errs core *~
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/cosProperty/src/Makefile b/lib/cosProperty/src/Makefile
index d12554b18d..b72019f37d 100644
--- a/lib/cosProperty/src/Makefile
+++ b/lib/cosProperty/src/Makefile
@@ -147,7 +147,7 @@ cleanb:
rm -f errs core *~
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/cosTime/src/Makefile b/lib/cosTime/src/Makefile
index 1793822fb6..fa456249bd 100644
--- a/lib/cosTime/src/Makefile
+++ b/lib/cosTime/src/Makefile
@@ -162,7 +162,7 @@ cleanb:
rm -f errs core *~
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/cosTransactions/src/Makefile b/lib/cosTransactions/src/Makefile
index 4b77251c3c..e7d4b0b080 100644
--- a/lib/cosTransactions/src/Makefile
+++ b/lib/cosTransactions/src/Makefile
@@ -141,7 +141,7 @@ debug:
@${MAKE} TYPE=debug
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index c781ccb302..10fe333d18 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -134,8 +134,10 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -210,8 +212,10 @@ static ErlNifFunc nif_funcs[] = {
{"hmac_final", 1, hmac_final},
{"hmac_final_n", 2, hmac_final},
{"des_cbc_crypt", 4, des_cbc_crypt},
+ {"des_cfb_crypt", 4, des_cfb_crypt},
{"des_ecb_crypt", 3, des_ecb_crypt},
{"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt},
+ {"des_ede3_cfb_crypt", 6, des_ede3_cfb_crypt},
{"aes_cfb_128_crypt", 4, aes_cfb_128_crypt},
{"aes_ctr_encrypt", 3, aes_ctr_encrypt},
{"aes_ctr_decrypt", 3, aes_ctr_encrypt},
@@ -693,6 +697,25 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
return ret;
}
+static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key, Ivec, Text, IsEncrypt) */
+ ErlNifBinary key, ivec, text;
+ DES_key_schedule schedule;
+ DES_cblock ivec_clone; /* writable copy */
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8
+ || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
+ return enif_make_badarg(env);
+ }
+ memcpy(&ivec_clone, ivec.data, 8);
+ DES_set_key((const_DES_cblock*)key.data, &schedule);
+ DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret),
+ 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true));
+ return ret;
+}
+
static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, Text/Cipher, IsEncrypt) */
ErlNifBinary key, text;
@@ -735,6 +758,31 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T
return ret;
}
+static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */
+ ErlNifBinary key1, key2, key3, ivec, text;
+ DES_key_schedule schedule1, schedule2, schedule3;
+ DES_cblock ivec_clone; /* writable copy */
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8
+ || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[4], &text)) {
+ return enif_make_badarg(env);
+ }
+
+ memcpy(&ivec_clone, ivec.data, 8);
+ DES_set_key((const_DES_cblock*)key1.data, &schedule1);
+ DES_set_key((const_DES_cblock*)key2.data, &schedule2);
+ DES_set_key((const_DES_cblock*)key3.data, &schedule3);
+ DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret),
+ 8, text.size, &schedule1, &schedule2, &schedule3,
+ &ivec_clone, (argv[5] == atom_true));
+ return ret;
+}
+
static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, IVec, Data, IsEncrypt) */
ErlNifBinary key, ivec, text;
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 4c20f81cae..824be09438 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -404,6 +404,51 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</desc>
</func>
<func>
+ <name>des_cfb_encrypt(Key, IVec, Text) -> Cipher</name>
+ <fsummary>Encrypt <c>Text</c>according to DES in CFB mode</fsummary>
+ <type>
+ <v>Key = Text = iolist() | binary()</v>
+ <v>IVec = Cipher = binary()</v>
+ </type>
+ <desc>
+ <p>Encrypts <c>Text</c> according to DES in 8-bit CFB
+ mode. <c>Key</c> is the DES key, and <c>IVec</c> is an
+ arbitrary initializing vector. The lengths of <c>Key</c> and
+ <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
+ <func>
+ <name>des_cfb_decrypt(Key, IVec, Cipher) -> Text</name>
+ <fsummary>Decrypt <c>Cipher</c>according to DES in CFB mode</fsummary>
+ <type>
+ <v>Key = Cipher = iolist() | binary()</v>
+ <v>IVec = Text = binary()</v>
+ </type>
+ <desc>
+ <p>Decrypts <c>Cipher</c> according to DES in 8-bit CFB mode.
+ <c>Key</c> is the DES key, and <c>IVec</c> is an arbitrary
+ initializing vector. <c>Key</c> and <c>IVec</c> must have
+ the same values as those used when encrypting. The lengths of
+ <c>Key</c> and <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
+ <func>
+ <name>des_cfb_ivec(IVec, Data) -> NextIVec</name>
+ <fsummary>Get <c>IVec</c> to be used in next iteration of
+ <c>des_cfb_[ecrypt|decrypt]</c></fsummary>
+ <type>
+ <v>IVec = iolist() | binary()</v>
+ <v>Data = iolist() | binary()</v>
+ <v>NextIVec = binary()</v>
+ </type>
+ <desc>
+ <p>Returns the <c>IVec</c> to be used in a next iteration of
+ <c>des_cfb_[encrypt|decrypt]</c>. <c>IVec</c> is the vector
+ used in the previous iteration step. <c>Data</c> is the encrypted
+ data from the previous iteration step.</p>
+ </desc>
+ </func>
+ <func>
<name>des3_cbc_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name>
<fsummary>Encrypt <c>Text</c>according to DES3 in CBC mode</fsummary>
<type>
@@ -421,7 +466,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</func>
<func>
<name>des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name>
- <fsummary>Decrypt <c>Cipher</c>according to DES in CBC mode</fsummary>
+ <fsummary>Decrypt <c>Cipher</c>according to DES3 in CBC mode</fsummary>
<type>
<v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v>
<v>IVec = Text = binary()</v>
@@ -437,6 +482,38 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
<c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p>
</desc>
</func>
+ <func>
+ <name>des3_cfb_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name>
+ <fsummary>Encrypt <c>Text</c>according to DES3 in CFB mode</fsummary>
+ <type>
+ <v>Key1 =Key2 = Key3 Text = iolist() | binary()</v>
+ <v>IVec = Cipher = binary()</v>
+ </type>
+ <desc>
+ <p>Encrypts <c>Text</c> according to DES3 in 8-bit CFB
+ mode. <c>Key1</c>, <c>Key2</c>, <c>Key3</c>, are the DES
+ keys, and <c>IVec</c> is an arbitrary initializing
+ vector. The lengths of each of <c>Key1</c>, <c>Key2</c>,
+ <c>Key3</c> and <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
+ <func>
+ <name>des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name>
+ <fsummary>Decrypt <c>Cipher</c>according to DES3 in CFB mode</fsummary>
+ <type>
+ <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v>
+ <v>IVec = Text = binary()</v>
+ </type>
+ <desc>
+ <p>Decrypts <c>Cipher</c> according to DES3 in 8-bit CFB mode.
+ <c>Key1</c>, <c>Key2</c>, <c>Key3</c> are the DES key, and
+ <c>IVec</c> is an arbitrary initializing vector.
+ <c>Key1</c>, <c>Key2</c>, <c>Key3</c> and <c>IVec</c> must
+ and <c>IVec</c> must have the same values as those used when
+ encrypting. The lengths of <c>Key1</c>, <c>Key2</c>,
+ <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
<func>
<name>des_ecb_encrypt(Key, Text) -> Cipher</name>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index c3e13d6b91..e3b921f9fa 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -31,7 +31,9 @@
-export([hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]).
-export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]).
-export([des_ecb_encrypt/2, des_ecb_decrypt/2]).
+-export([des_cfb_encrypt/3, des_cfb_decrypt/3, des_cfb_ivec/2]).
-export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]).
+-export([des3_cfb_encrypt/5, des3_cfb_decrypt/5]).
-export([blowfish_ecb_encrypt/2, blowfish_ecb_decrypt/2]).
-export([blowfish_cbc_encrypt/3, blowfish_cbc_decrypt/3]).
-export([blowfish_cfb64_encrypt/3, blowfish_cfb64_decrypt/3]).
@@ -68,8 +70,10 @@
sha_mac, sha_mac_96,
sha_mac_init, sha_mac_update, sha_mac_final,
des_cbc_encrypt, des_cbc_decrypt,
+ des_cfb_encrypt, des_cfb_decrypt,
des_ecb_encrypt, des_ecb_decrypt,
des_ede3_cbc_encrypt, des_ede3_cbc_decrypt,
+ des_ede3_cfb_encrypt, des_ede3_cfb_decrypt,
aes_cfb_128_encrypt, aes_cfb_128_decrypt,
rand_bytes,
strong_rand_bytes,
@@ -294,6 +298,33 @@ des_cbc_ivec(Data) when is_list(Data) ->
des_cbc_ivec(list_to_binary(Data)).
%%
+%% DES - in 8-bits cipher feedback mode (CFB)
+%%
+-spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary().
+-spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary().
+
+des_cfb_encrypt(Key, IVec, Data) ->
+ des_cfb_crypt(Key, IVec, Data, true).
+
+des_cfb_decrypt(Key, IVec, Data) ->
+ des_cfb_crypt(Key, IVec, Data, false).
+
+des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+
+%%
+%% dec_cfb_ivec(IVec, Data) -> binary()
+%%
+%% Returns the IVec to be used in the next iteration of
+%% des_cfb_[encrypt|decrypt].
+%%
+-spec des_cfb_ivec(iodata(), iodata()) -> binary().
+
+des_cfb_ivec(IVec, Data) ->
+ IVecAndData = list_to_binary([IVec, Data]),
+ {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8),
+ NewIVec.
+
+%%
%% DES - in electronic codebook mode (ECB)
%%
-spec des_ecb_encrypt(iodata(), iodata()) -> binary().
@@ -326,6 +357,26 @@ des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) ->
des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
%%
+%% DES3 - in 8-bits cipher feedback mode (CFB)
+%%
+-spec des3_cfb_encrypt(iodata(), iodata(), iodata(), binary(), iodata()) ->
+ binary().
+-spec des3_cfb_decrypt(iodata(), iodata(), iodata(), binary(), iodata()) ->
+ binary().
+
+des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data).
+des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true).
+
+des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data).
+des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false).
+
+des_ede3_cfb_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+
+%%
%% Blowfish
%%
-spec blowfish_ecb_encrypt(iodata(), iodata()) -> binary().
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 486751766b..53b4c2a7e1 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -44,7 +44,11 @@
md5_mac_io/1,
des_cbc/1,
des_cbc_iter/1,
+ des_cfb/1,
+ des_cfb_iter/1,
des_ecb/1,
+ des3_cbc/1,
+ des3_cfb/1,
aes_cfb/1,
aes_cbc/1,
aes_cbc_iter/1,
@@ -75,8 +79,8 @@ all() ->
md5_mac_io, sha, sha_update,
hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5,
%% sha256, sha256_update, sha512,sha512_update,
- des_cbc, aes_cfb, aes_cbc,
- aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb,
+ des_cbc, des_cfb, des3_cbc, des3_cfb, aes_cfb, aes_cbc,
+ aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_cfb_iter, des_ecb,
rand_uniform_test, strong_rand_test,
rsa_verify_test, dsa_verify_test, rsa_sign_test,
dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test,
@@ -292,7 +296,7 @@ sha(Config) when is_list(Config) ->
hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")).
-%%
+%%
hmac_update_sha_n(doc) ->
["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. "
"Expected values for examples are generated using crypto:sha_mac." ];
@@ -547,6 +551,40 @@ des_cbc_iter(Config) when is_list(Config) ->
%%
%%
+des_cfb(doc) ->
+ "Encrypt and decrypt according to CFB DES. and check the result. "
+ "Example is from FIPS-81.";
+des_cfb(suite) ->
+ [];
+des_cfb(Config) when is_list(Config) ->
+ ?line Key = hexstr2bin("0123456789abcdef"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain = "Now is the",
+ ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain),
+ ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")),
+ ?line m(list_to_binary(Plain),
+ crypto:des_cfb_decrypt(Key, IVec, Cipher)).
+
+%%
+%%
+des_cfb_iter(doc) ->
+ "Encrypt and decrypt according to CFB DES in two steps, and "
+ "check the result. Example is from FIPS-81.";
+des_cfb_iter(suite) ->
+ [];
+des_cfb_iter(Config) when is_list(Config) ->
+ ?line Key = hexstr2bin("0123456789abcdef"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain1 = "Now i",
+ ?line Plain2 = "s the",
+ ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1),
+ ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1),
+ ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2),
+ ?line Cipher = list_to_binary([Cipher1, Cipher2]),
+ ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")).
+
+%%
+%%
des_ecb(doc) ->
"Encrypt and decrypt according to ECB DES and check the result. "
"Example are from FIPS-81.";
@@ -569,6 +607,66 @@ des_ecb(Config) when is_list(Config) ->
%%
%%
+des3_cbc(doc) ->
+ "Encrypt and decrypt according to CBC 3DES, and check the result.";
+des3_cbc(suite) ->
+ [];
+des3_cbc(Config) when is_list(Config) ->
+ ?line Key1 = hexstr2bin("0123456789abcdef"),
+ ?line Key2 = hexstr2bin("fedcba9876543210"),
+ ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain = "Now is the time for all ",
+ ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain),
+ ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480"
+ "0bac1ae66970fb2b89")),
+ ?line m(list_to_binary(Plain),
+ crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)),
+ ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0],
+ ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2),
+ ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5"
+ "4c83cee22907f7f0041ca1b7abe202bfafe")),
+ ?line m(list_to_binary(Plain2),
+ crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)),
+
+ ?line Key = hexstr2bin("0123456789abcdef"),
+ ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain),
+ ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c"
+ "0f683788499a7c05f6")),
+ ?line m(list_to_binary(Plain),
+ crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)),
+ ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2),
+ ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9"
+ "9484521388fa59ae67d58d2e77e86062733")),
+ ?line m(list_to_binary(Plain2),
+ crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)).
+
+%%
+%%
+des3_cfb(doc) ->
+ "Encrypt and decrypt according to CFB 3DES, and check the result.";
+des3_cfb(suite) ->
+ [];
+des3_cfb(Config) when is_list(Config) ->
+ ?line Key1 = hexstr2bin("0123456789abcdef"),
+ ?line Key2 = hexstr2bin("fedcba9876543210"),
+ ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain = "Now is the time for all ",
+ ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain),
+ ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937"
+ "1deab42a00666db02c")),
+ ?line m(list_to_binary(Plain),
+ crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)),
+ ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0],
+ ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2),
+ ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c"
+ "e413f5efab838fce7e41e2ba67705bad5bc")),
+ ?line m(list_to_binary(Plain2),
+ crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)).
+
+%%
+%%
aes_cfb(doc) ->
"Encrypt and decrypt according to AES CFB 128 bit and check "
"the result. Example are from NIST SP 800-38A.";
@@ -1233,8 +1331,8 @@ rc4_test(doc) ->
rc4_test(suite) ->
[];
rc4_test(Config) when is_list(Config) ->
- CT1 = <<"hej p� dig">>,
- R1 = <<71,112,14,44,140,33,212,144,155,47>>,
+ CT1 = <<"Yo baby yo">>,
+ R1 = <<118,122,68,110,157,166,141,212,139,39>>,
K = "apaapa",
R1 = crypto:rc4_encrypt(K, CT1),
CT1 = crypto:rc4_encrypt(K, R1),
@@ -1248,14 +1346,14 @@ rc4_stream_test(doc) ->
rc4_stream_test(suite) ->
[];
rc4_stream_test(Config) when is_list(Config) ->
- CT1 = <<"hej">>,
- CT2 = <<" p� dig">>,
+ CT1 = <<"Yo ">>,
+ CT2 = <<"baby yo">>,
K = "apaapa",
State0 = crypto:rc4_set_key(K),
{State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1),
{_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2),
R = list_to_binary([R1, R2]),
- <<71,112,14,44,140,33,212,144,155,47>> = R,
+ <<118,122,68,110,157,166,141,212,139,39>> = R,
ok.
blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."];
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index cb024c77b1..209f8c01c1 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -37,6 +37,9 @@
code_change/3,
terminate/2]).
+-export([ports/0,
+ ports/1]).
+
-include_lib("kernel/include/inet_sctp.hrl").
-include_lib("diameter/include/diameter.hrl").
@@ -118,8 +121,8 @@ s({accept, Ref} = A, Addrs, Opts) ->
%% gen_sctp in order to be able to accept a new association only
%% *after* an accepting transport has been spawned.
-s({connect = C, _}, Addrs, Opts) ->
- diameter_sctp_sup:start_child({C, self(), Opts, Addrs}).
+s({connect = C, Ref}, Addrs, Opts) ->
+ diameter_sctp_sup:start_child({C, self(), Opts, Addrs, Ref}).
%% start_link/1
@@ -149,28 +152,36 @@ i({listen, Ref, {Opts, Addrs}}) ->
socket = Sock});
%% A connecting transport.
-i({connect, Pid, Opts, Addrs}) ->
+i({connect, Pid, Opts, Addrs, Ref}) ->
{[As, Ps], Rest} = proplists:split(Opts, [raddr, rport]),
RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- As],
[RP] = [P || {rport, P} <- Ps] ++ [P || P <- [?DEFAULT_PORT], [] == Ps],
{LAs, Sock} = open(Addrs, Rest, 0),
+ putr(ref, Ref),
proc_lib:init_ack({ok, self(), LAs}),
erlang:monitor(process, Pid),
#transport{parent = Pid,
mode = {connect, connect(Sock, RAs, RP, [])},
socket = Sock};
+i({connect, _, _, _} = T) -> %% from old code
+ x(T);
%% An accepting transport spawned by diameter.
-i({accept, Pid, LPid, Sock}) ->
+i({accept, Pid, LPid, Sock, Ref})
+ when is_pid(Pid) ->
+ putr(ref, Ref),
proc_lib:init_ack({ok, self()}),
erlang:monitor(process, Pid),
erlang:monitor(process, LPid),
#transport{parent = Pid,
mode = {accept, LPid},
socket = Sock};
+i({accept, _, _, _} = T) -> %% from old code
+ x(T);
%% An accepting transport spawned at association establishment.
i({accept, Ref, LPid, Sock, Id}) ->
+ putr(ref, Ref),
proc_lib:init_ack({ok, self()}),
MRef = erlang:monitor(process, LPid),
%% Wait for a signal that the transport has been started before
@@ -250,13 +261,33 @@ gen_opts(Opts) ->
[binary, {active, once} | Opts].
%% ---------------------------------------------------------------------------
+%% # ports/0-1
+%% ---------------------------------------------------------------------------
+
+ports() ->
+ Ts = diameter_reg:match({?MODULE, '_', '_'}),
+ [{type(T), N, Pid} || {{?MODULE, T, {_, {_, S}}}, Pid} <- Ts,
+ {ok, N} <- [inet:port(S)]].
+
+ports(Ref) ->
+ Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}),
+ [{type(T), N, Pid} || {{?MODULE, T, {R, {_, S}}}, Pid} <- Ts,
+ R == Ref,
+ {ok, N} <- [inet:port(S)]].
+
+type(listener) ->
+ listen;
+type(T) ->
+ T.
+
+%% ---------------------------------------------------------------------------
%% # handle_call/3
%% ---------------------------------------------------------------------------
handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref,
count = N}
= S) ->
- {TPid, NewS} = accept(Pid, S),
+ {TPid, NewS} = accept(Ref, Pid, S),
{reply, {ok, TPid}, NewS#listener{count = N+1}};
handle_call(_, _, State) ->
@@ -306,6 +337,12 @@ terminate(_, #listener{socket = Sock}) ->
%% ---------------------------------------------------------------------------
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
%% start_timer/1
start_timer(#listener{count = 0} = S) ->
@@ -425,21 +462,27 @@ transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) ->
%% Parent process has died.
transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) ->
- stop.
+ stop;
+
+%% Request for the local port number.
+transition({resolve_port, Pid}, #transport{socket = Sock})
+ when is_pid(Pid) ->
+ Pid ! inet:port(Sock),
+ ok.
%% Crash on anything unexpected.
-%% accept/2
+%% accept/3
%%
%% Start a new transport process or use one that's already been
%% started as a consequence of association establishment.
%% No pending associations: spawn a new transport.
-accept(Pid, #listener{socket = Sock,
- tmap = T,
- pending = {0,_} = Q}
- = S) ->
- Arg = {accept, Pid, self(), Sock},
+accept(Ref, Pid, #listener{socket = Sock,
+ tmap = T,
+ pending = {0,_} = Q}
+ = S) ->
+ Arg = {accept, Pid, self(), Sock, Ref},
{ok, TPid} = diameter_sctp_sup:start_child(Arg),
MRef = erlang:monitor(process, TPid),
ets:insert(T, [{MRef, TPid}, {TPid, MRef}]),
@@ -450,12 +493,12 @@ accept(Pid, #listener{socket = Sock,
%% Accepting transport has died. This can happen if a new transport is
%% started before the DOWN has arrived.
-accept(Pid, #listener{pending = [TPid | {0,_} = Q]} = S) ->
+accept(Ref, Pid, #listener{pending = [TPid | {0,_} = Q]} = S) ->
false = is_process_alive(TPid), %% assert
- accept(Pid, S#listener{pending = Q});
+ accept(Ref, Pid, S#listener{pending = Q});
%% Pending associations: attach to the first in the queue.
-accept(Pid, #listener{ref = Ref, pending = {N,Q}} = S) ->
+accept(_, Pid, #listener{ref = Ref, pending = {N,Q}} = S) ->
TPid = ets:first(Q),
TPid ! {Ref, Pid},
ets:delete(Q, TPid),
@@ -507,8 +550,14 @@ recv({[], #sctp_assoc_change{state = comm_up,
outbound_streams = OS,
inbound_streams = IS,
assoc_id = Id}},
- #transport{assoc_id = undefined}
+ #transport{assoc_id = undefined,
+ mode = {T, _},
+ socket = Sock}
= S) ->
+ Ref = getr(ref),
+ is_reference(Ref) %% started in new code
+ andalso
+ (true = diameter_reg:add_new({?MODULE, T, {Ref, {Id, Sock}}})),
up(S#transport{assoc_id = Id,
streams = {IS, OS}});
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index 33b9daf0d9..78dbda6888 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -37,6 +37,9 @@
code_change/3,
terminate/2]).
+-export([ports/0,
+ ports/1]).
+
-include_lib("diameter/include/diameter.hrl").
-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})).
@@ -130,10 +133,13 @@ i({T, Ref, Mod, Pid, Opts, Addrs})
MPid ! {stop, self()}, %% tell the monitor to die
M = if SslOpts -> ssl; true -> Mod end,
setopts(M, Sock),
+ putr(ref, Ref),
#transport{parent = Pid,
module = M,
socket = Sock,
ssl = SslOpts};
+%% Put the reference in the process dictionary since we now use it
+%% advertise the ssl socket after TLS upgrade.
%% A monitor process to kill the transport if the parent dies.
i(#monitor{parent = Pid, transport = TPid} = S) ->
@@ -152,9 +158,9 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) ->
LAddr = get_addr(LA, Addrs),
LPort = get_port(LP),
{ok, LSock} = Mod:listen(LPort, gen_opts(LAddr, Rest)),
+ true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}),
proc_lib:init_ack({ok, self(), {LAddr, LSock}}),
erlang:monitor(process, APid),
- true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}),
start_timer(#listener{socket = LSock}).
ssl(Opts) ->
@@ -181,20 +187,22 @@ i(Type, Ref, Mod, Pid, true, Opts, Addrs) ->
i(Type, Ref, Mod, Pid, _, Opts, Addrs) ->
i(Type, Ref, Mod, Pid, Opts, Addrs).
-i(accept, Ref, Mod, Pid, Opts, Addrs) ->
+i(accept = T, Ref, Mod, Pid, Opts, Addrs) ->
{LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}),
proc_lib:init_ack({ok, self(), [LAddr]}),
Sock = ok(accept(Mod, LSock)),
+ true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}),
diameter_peer:up(Pid),
Sock;
-i(connect, _, Mod, Pid, Opts, Addrs) ->
+i(connect = T, Ref, Mod, Pid, Opts, Addrs) ->
{[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]),
LAddr = get_addr(LA, Addrs),
RAddr = get_addr(RA, []),
RPort = get_port(RP),
proc_lib:init_ack({ok, self(), [LAddr]}),
Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddr, Rest))),
+ true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}),
diameter_peer:up(Pid, {RAddr, RPort}),
Sock.
@@ -255,6 +263,43 @@ gen_opts(LAddr, Opts) ->
| Opts].
%% ---------------------------------------------------------------------------
+%% # ports/1
+%% ---------------------------------------------------------------------------
+
+ports() ->
+ Ts = diameter_reg:match({?MODULE, '_', '_'}),
+ [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {_,S}}, Pid} <- Ts].
+
+ports(Ref) ->
+ Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}),
+ [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {R,S}}, Pid} <- Ts,
+ R == Ref].
+
+type(listener) ->
+ listen;
+type(T) ->
+ T.
+
+sock(listener, {_LAddr, Sock}) ->
+ Sock;
+sock(_, Sock) ->
+ Sock.
+
+resolve(Type, S) ->
+ Sock = sock(Type, S),
+ try
+ ok(portnr(Sock))
+ catch
+ _:_ -> Sock
+ end.
+
+portnr(Sock)
+ when is_port(Sock) ->
+ portnr(gen_tcp, Sock);
+portnr(Sock) ->
+ portnr(ssl, Sock).
+
+%% ---------------------------------------------------------------------------
%% # handle_call/3
%% ---------------------------------------------------------------------------
@@ -300,6 +345,12 @@ terminate(_, _) ->
%% ---------------------------------------------------------------------------
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
%% start_timer/1
start_timer(#listener{count = 0} = S) ->
@@ -436,10 +487,10 @@ transition({timeout, TRef, flush}, S) ->
flush(TRef, S);
%% Request for the local port number.
-transition({resolve_port, RPid}, #transport{socket = Sock,
- module = M})
- when is_pid(RPid) ->
- RPid ! lport(M, Sock),
+transition({resolve_port, Pid}, #transport{socket = Sock,
+ module = M})
+ when is_pid(Pid) ->
+ Pid ! portnr(M, Sock),
ok;
%% Parent process has died.
@@ -470,6 +521,10 @@ tls_handshake(Type, true, #transport{socket = Sock,
ssl = Opts}
= S) ->
{ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]),
+ Ref = getr(ref),
+ is_reference(Ref) %% started in new code
+ andalso
+ (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})),
S#transport{socket = SSock,
module = ssl};
@@ -637,16 +692,16 @@ setopts(M, Sock) ->
X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect
end.
-%% lport/2
+%% portnr/2
-lport(gen_tcp, Sock) ->
+portnr(gen_tcp, Sock) ->
inet:port(Sock);
-lport(ssl, Sock) ->
+portnr(ssl, Sock) ->
case ssl:sockname(Sock) of
{ok, {_Addr, PortNr}} ->
{ok, PortNr};
{error, _} = No ->
No
end;
-lport(M, Sock) ->
+portnr(M, Sock) ->
M:port(Sock).
diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile
index dba1f126dc..04e686c969 100644
--- a/lib/diameter/test/Makefile
+++ b/lib/diameter/test/Makefile
@@ -77,7 +77,7 @@ ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \
all: $(SUITES)
-tests debug opt: $(TARGET_FILES)
+beam tests debug opt: $(TARGET_FILES)
clean:
rm -f $(TARGET_FILES)
diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl
new file mode 100644
index 0000000000..c25e9682f0
--- /dev/null
+++ b/lib/diameter/test/diameter_failover_SUITE.erl
@@ -0,0 +1,262 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. 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%
+%%
+
+%%
+%% Tests of traffic between six Diameter nodes in three realms,
+%% connected as follows.
+%%
+%% ----- SERVER1.REALM2
+%% /
+%% / ----- SERVER2.REALM2
+%% | /
+%% CLIENT.REALM1 ------ SERVER3.REALM2
+%% | \
+%% | \
+%% \ ---- SERVER1.REALM3
+%% \
+%% ----- SERVER2.REALM3
+%%
+
+-module(diameter_failover_SUITE).
+
+-export([suite/0,
+ all/0]).
+
+%% testcases
+-export([start/1,
+ start_services/1,
+ connect/1,
+ send_ok/1,
+ send_nok/1,
+ stop_services/1,
+ stop/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/4,
+ prepare_request/3,
+ prepare_retransmit/3,
+ handle_answer/4,
+ handle_error/4,
+ handle_request/3]).
+
+-ifdef(DIAMETER_CT).
+-include("diameter_gen_base_rfc3588.hrl").
+-else.
+-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
+-endif.
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(ADDR, {127,0,0,1}).
+
+-define(CLIENT, "CLIENT.REALM1").
+-define(SERVER1, "SERVER1.REALM2").
+-define(SERVER2, "SERVER2.REALM2").
+-define(SERVER3, "SERVER3.REALM2").
+-define(SERVER4, "SERVER1.REALM3").
+-define(SERVER5, "SERVER2.REALM3").
+
+-define(SERVICES, [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]).
+
+-define(DICT_COMMON, ?DIAMETER_DICT_COMMON).
+
+-define(APP_ALIAS, the_app).
+-define(APP_ID, ?DICT_COMMON:id()).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Host, Dict),
+ [{'Origin-Host', Host},
+ {'Origin-Realm', realm(Host)},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Acct-Application-Id', [Dict:id()]},
+ {application, [{alias, ?APP_ALIAS},
+ {dictionary, Dict},
+ {module, ?MODULE},
+ {answer_errors, callback}]}]).
+
+-define(SUCCESS, 2001).
+
+-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [start,
+ start_services,
+ connect,
+ send_ok,
+ send_nok,
+ stop_services,
+ stop].
+
+%% ===========================================================================
+%% start/stop testcases
+
+start(_Config) ->
+ ok = diameter:start().
+
+start_services(_Config) ->
+ S = [server(N, ?DICT_COMMON) || N <- tl(?SERVICES)],
+
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
+
+ {save_config, [{?CLIENT, S}]}.
+
+connect(Config) ->
+ {_, Conns} = proplists:get_value(saved_config, Config),
+
+ lists:foreach(fun({CN,Ss}) -> connect(CN, Ss) end, Conns).
+
+stop_services(_Config) ->
+ [] = [{H,T} || H <- ?SERVICES,
+ T <- [diameter:stop_service(H)],
+ T /= ok].
+
+stop(_Config) ->
+ ok = diameter:stop().
+
+%% ----------------------------------------
+
+server(Name, Dict) ->
+ ok = diameter:start_service(Name, ?SERVICE(Name, Dict)),
+ {Name, ?util:listen(Name, tcp)}.
+
+connect(Name, Refs) ->
+ [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs].
+
+%% ===========================================================================
+%% traffic testcases
+
+%% Send an STR and expect success after SERVER3 answers after a couple
+%% of failovers.
+send_ok(_Config) ->
+ Req = ['STR', {'Destination-Realm', realm(?SERVER1)},
+ {'Termination-Cause', ?LOGOUT},
+ {'Auth-Application-Id', ?APP_ID}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Origin-Host' = ?SERVER3}
+ = call(Req, [{filter, realm}]).
+
+%% Send an STR and expect failure when both servers fail.
+send_nok(_Config) ->
+ Req = ['STR', {'Destination-Realm', realm(?SERVER4)},
+ {'Termination-Cause', ?LOGOUT},
+ {'Auth-Application-Id', ?APP_ID}],
+ {error, failover} = call(Req, [{filter, realm}]).
+
+%% ===========================================================================
+
+realm(Host) ->
+ tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
+
+call(Req, Opts) ->
+ diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts).
+
+set([H|T], Vs) ->
+ [H | Vs ++ T].
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/4
+
+%% Choose a server other than SERVER3 or SERVER5 if possible.
+pick_peer(Peers, _, ?CLIENT, _State) ->
+ case lists:partition(fun({_, #diameter_caps{origin_host = {_, OH}}}) ->
+ OH /= ?SERVER3 andalso OH /= ?SERVER5
+ end,
+ Peers)
+ of
+ {[], [Peer]} ->
+ {ok, Peer};
+ {[Peer | _], _} ->
+ {ok, Peer}
+ end.
+
+%% prepare_request/3
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) ->
+ {send, prepare(Pkt, Caps)}.
+
+prepare(#diameter_packet{msg = Req}, Caps) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR}]).
+
+%% prepare_retransmit/3
+
+prepare_retransmit(Pkt, ?CLIENT, _Peer) ->
+ {send, Pkt}.
+
+%% handle_answer/4
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
+ #diameter_packet{msg = Rec, errors = []} = Pkt,
+ Rec.
+
+%% handle_error/4
+
+handle_error(Reason, _Req, ?CLIENT, _Peer) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+%% Only SERVER3 actually answers.
+handle_request(Pkt, ?SERVER3, {_, Caps}) ->
+ #diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId,
+ 'Origin-Host' = ?CLIENT}}
+ = Pkt,
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR}};
+
+%% Others kill the transport to force failover.
+handle_request(_, _, {TPid, _}) ->
+ exit(TPid, kill),
+ discard.
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
index 60babd0b9a..03f1115496 100644
--- a/lib/diameter/test/diameter_relay_SUITE.erl
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -110,19 +110,6 @@
{module, ?MODULE},
{answer_errors, callback}]}]).
-%% Config for diameter:add_transport/2. In the listening case, listen
-%% on a free port that we then lookup using the implementation detail
-%% that diameter_tcp registers the port with diameter_reg.
--define(CONNECT(PortNr),
- {connect, [{transport_module, diameter_tcp},
- {transport_config, [{raddr, ?ADDR},
- {rport, PortNr},
- {ip, ?ADDR},
- {port, 0}]}]}).
--define(LISTEN,
- {listen, [{transport_module, diameter_tcp},
- {transport_config, [{ip, ?ADDR}, {port, 0}]}]}).
-
-define(SUCCESS, 2001).
-define(LOOP_DETECTED, 3005).
-define(UNABLE_TO_DELIVER, 3002).
@@ -130,9 +117,6 @@
-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
-define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY').
--define(A, list_to_atom).
--define(L, atom_to_list).
-
%% ===========================================================================
suite() ->
@@ -173,47 +157,29 @@ start(_Config) ->
ok = diameter:start().
start_services(_Config) ->
- S = [server(N, ?DICT_COMMON) || N <- [?SERVER1,
- ?SERVER2,
- ?SERVER3,
- ?SERVER4]],
- R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]],
+ [S1,S2,S3,S4] = [server(N, ?DICT_COMMON) || N <- [?SERVER1,
+ ?SERVER2,
+ ?SERVER3,
+ ?SERVER4]],
+ [R1,R2] = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]],
ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
- {save_config, S ++ R}.
+ {save_config, [{?RELAY1, [S1,S2,R2]},
+ {?RELAY2, [S3,S4]},
+ {?CLIENT, [R1,R2]}]}.
connect(Config) ->
- {_, [S1,S2,S3,S4,R1,R2] = SR} = proplists:get_value(saved_config, Config),
-
- true = diameter:subscribe(?RELAY1),
- true = diameter:subscribe(?RELAY2),
- true = diameter:subscribe(?CLIENT),
+ {_, Conns} = proplists:get_value(saved_config, Config),
- [R1S1,R1S2] = connect(?RELAY1, [S1,S2]),
- [R2S3,R2S4] = connect(?RELAY2, [S3,S4]),
- [CR1,CR2] = connect(?CLIENT, [R1,R2]),
+ ?util:write_priv(Config,
+ "cfg",
+ lists:flatmap(fun({CN,Ss}) -> connect(CN, Ss) end,
+ Conns)).
- R1R2 = connect(?RELAY1, R2),
-
- ?util:write_priv(Config, "cfg", SR ++ [R1S1,R1S2,R2S3,R2S4,CR1,CR2,R1R2]).
-
-%% Remove the client transports and expect the corresponding server
-%% transport to go down.
disconnect(Config) ->
- [S1,S2,S3,S4,R1,R2,R1S1,R1S2,R2S3,R2S4,CR1,CR2,R1R2]
- = ?util:read_priv(Config, "cfg"),
-
- [?CLIENT | Svcs] = ?SERVICES,
- [] = [{S,T} || S <- Svcs, T <- [diameter:subscribe(S)], T /= true],
-
- disconnect(?RELAY1, S1, R1S1),
- disconnect(?RELAY1, S2, R1S2),
- disconnect(?RELAY2, S3, R2S3),
- disconnect(?RELAY2, S4, R2S4),
- disconnect(?CLIENT, R1, CR1),
- disconnect(?CLIENT, R2, CR2),
- disconnect(?RELAY1, R2, R1R2).
+ lists:foreach(fun({{CN,CR},{SN,SR}}) -> ?util:disconnect(CN,CR,SN,SR) end,
+ ?util:read_priv(Config, "cfg")).
stop_services(_Config) ->
[] = [{H,T} || H <- ?SERVICES,
@@ -223,6 +189,15 @@ stop_services(_Config) ->
stop(_Config) ->
ok = diameter:stop().
+%% ----------------------------------------
+
+server(Name, Dict) ->
+ ok = diameter:start_service(Name, ?SERVICE(Name, Dict)),
+ {Name, ?util:listen(Name, tcp)}.
+
+connect(Name, Refs) ->
+ [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs].
+
%% ===========================================================================
%% traffic testcases
@@ -266,45 +241,6 @@ send_timeout(Tmo) ->
realm(Host) ->
tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
-server(Host, Dict) ->
- ok = diameter:start_service(Host, ?SERVICE(Host, Dict)),
- {ok, LRef} = diameter:add_transport(Host, ?LISTEN),
- {LRef, portnr(LRef)}.
-
-portnr(LRef) ->
- portnr(LRef, 20).
-
-portnr(LRef, N)
- when 0 < N ->
- case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of
- [{T, _Pid}] ->
- {_, _, {LRef, {_Addr, LSock}}} = T,
- {ok, PortNr} = inet:port(LSock),
- PortNr;
- [] ->
- receive after 50 -> ok end,
- portnr(LRef, N-1)
- end.
-
-connect(Host, {_LRef, PortNr}) ->
- {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)),
- ok = receive
- #diameter_event{service = Host,
- info = {up, Ref, _, _, #diameter_packet{}}} ->
- ok
- after 2000 ->
- false
- end,
- Ref;
-connect(Host, Ports) ->
- [connect(Host, P) || P <- Ports].
-
-disconnect(Client, {LRef, _PortNr}, CRef) ->
- ok = diameter:remove_transport(Client, CRef),
- ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
- after 2000 -> false
- end.
-
call(Server) ->
Realm = realm(Server),
Req = ['STR', {'Destination-Realm', Realm},
@@ -340,7 +276,7 @@ peer_down(_SvcName, _Peer, State) ->
pick_peer([Peer | _], _, Svc, _State)
when Svc == ?RELAY1;
Svc == ?RELAY2;
- Svc == ?CLIENT->
+ Svc == ?CLIENT ->
{ok, Peer}.
%% prepare_request/3
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
index 90e32c834f..99f92ca0e0 100644
--- a/lib/diameter/test/diameter_tls_SUITE.erl
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -44,6 +44,7 @@
%% testcases
-export([start_ssl/1,
start_diameter/1,
+ make_certs/1, make_certs/0,
start_services/1,
add_transports/1,
send1/1,
@@ -134,11 +135,12 @@
%% ===========================================================================
suite() ->
- [{timetrap, {seconds, 15}}].
+ [{timetrap, {seconds, 10}}].
all() ->
[start_ssl,
start_diameter,
+ make_certs,
start_services,
add_transports]
++ [{group, N} || {N, _, _} <- groups()]
@@ -184,6 +186,18 @@ start_ssl(_Config) ->
start_diameter(_Config) ->
ok = diameter:start().
+make_certs() ->
+ [{timetrap, {seconds, 30}}].
+
+make_certs(Config) ->
+ Dir = proplists:get_value(priv_dir, Config),
+
+ [] = ?util:run([[fun make_cert/2, Dir, B] || B <- ["server1",
+ "server2",
+ "server4",
+ "server5",
+ "client"]]).
+
start_services(Config) ->
Dir = proplists:get_value(priv_dir, Config),
Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS],
@@ -325,8 +339,12 @@ inband_security(Ids) ->
[{'Inband-Security-Id', Ids}].
ssl_options(Dir, Base) ->
- {Key, Cert} = make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"),
- [{ssl_options, [{certfile, Cert}, {keyfile, Key}]}].
+ Root = filename:join([Dir, Base]),
+ [{ssl_options, [{certfile, Root ++ "_ca.pem"},
+ {keyfile, Root ++ "_key.pem"}]}].
+
+make_cert(Dir, Base) ->
+ make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem").
make_cert(Dir, Keyfile, Certfile) ->
[K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]],
@@ -351,7 +369,7 @@ join(Strs) ->
server(Host, {Caps, Opts}) ->
ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)),
{ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)),
- {LRef, portnr(LRef)}.
+ {LRef, hd([_] = ?util:lport(tcp, LRef, 20))}.
sopts(?SERVER1, Dir) ->
{inband_security([?TLS]),
@@ -369,32 +387,6 @@ sopts(?SERVER5, Dir) ->
ssl([{ssl_options = T, Opts}]) ->
[{T, true} | Opts].
-portnr(LRef) ->
- portnr(LRef, 20).
-
-portnr(LRef, N)
- when 0 < N ->
- case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of
- [{T, _Pid}] ->
- {_, _, {LRef, {_Addr, LSock}}} = T,
- {ok, PortNr} = to_portnr(LSock) ,
- PortNr;
- [] ->
- receive after 500 -> ok end,
- portnr(LRef, N-1)
- end.
-
-to_portnr(Sock)
- when is_port(Sock) ->
- inet:port(Sock);
-to_portnr(Sock) ->
- case ssl:sockname(Sock) of
- {ok, {_,N}} ->
- {ok, N};
- No ->
- No
- end.
-
%% connect/3
connect(Host, {_LRef, PortNr}, {Caps, Opts}) ->
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index f6905473b7..6704f24532 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -127,19 +127,6 @@
{module, ?MODULE},
{answer_errors, callback}]}]).
-%% Config for diameter:add_transport/2. In the listening case, listen
-%% on a free port that we then lookup using the implementation detail
-%% that diameter_tcp registers the port with diameter_reg.
--define(CONNECT(PortNr),
- {connect, [{transport_module, diameter_tcp},
- {transport_config, [{raddr, ?ADDR},
- {rport, PortNr},
- {ip, ?ADDR},
- {port, 0}]}]}).
--define(LISTEN,
- {listen, [{transport_module, diameter_tcp},
- {transport_config, [{ip, ?ADDR}, {port, 0}]}]}).
-
-define(SUCCESS,
?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS').
-define(COMMAND_UNSUPPORTED,
@@ -253,21 +240,6 @@ tc() ->
send_multiple_filters_3,
send_anything].
-portnr() ->
- portnr(20).
-
-portnr(N)
- when 0 < N ->
- case diameter_reg:match({diameter_tcp, listener, '_'}) of
- [{T, _Pid}] ->
- {_, _, {_LRef, {_Addr, LSock}}} = T,
- {ok, PortNr} = inet:port(LSock),
- PortNr;
- [] ->
- receive after 50 -> ok end,
- portnr(N-1)
- end.
-
%% ===========================================================================
%% start/stop testcases
@@ -279,26 +251,13 @@ start_services(_Config) ->
ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)).
add_transports(Config) ->
- {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN),
- true = diameter:subscribe(?CLIENT),
- {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())),
- {up, CRef, _Peer, _Cfg, #diameter_packet{}}
- = receive #diameter_event{service = ?CLIENT, info = I} -> I
- after 2000 -> false
- end,
- true = diameter:unsubscribe(?CLIENT),
+ LRef = ?util:listen(?SERVER, tcp),
+ CRef = ?util:connect(?CLIENT, tcp, LRef),
?util:write_priv(Config, "transport", {LRef, CRef}).
-%% Remove the client transport and expect the server transport to
-%% go down.
remove_transports(Config) ->
{LRef, CRef} = ?util:read_priv(Config, "transport"),
- true = diameter:subscribe(?SERVER),
- ok = diameter:remove_transport(?CLIENT, CRef),
- {down, LRef, _, _}
- = receive #diameter_event{service = ?SERVER, info = I} -> I
- after 2000 -> false
- end.
+ ?util:disconnect(?CLIENT, CRef, ?SERVER, LRef).
stop_services(_Config) ->
ok = diameter:stop_service(?CLIENT),
diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl
index d556a903e5..a9520ef5bd 100644
--- a/lib/diameter/test/diameter_transport_SUITE.erl
+++ b/lib/diameter/test/diameter_transport_SUITE.erl
@@ -69,16 +69,6 @@
= #diameter_caps{host_ip_address
= Addrs}}).
-%% The term diameter_tcp/sctp registers after opening a listening
-%% socket. This is an implementation detail that should probably be
-%% replaced by some documented way of getting at the port number of
-%% the listening socket, which is what we're after since we specify
-%% port 0 to get something unused.
--define(TCP_LISTENER(Ref, Addr, LSock),
- {diameter_tcp, listener, {Ref, {Addr, LSock}}}).
--define(SCTP_LISTENER(Ref, Addr, LSock),
- {diameter_sctp, listener, {Ref, {[Addr], LSock}}}).
-
%% The term we register after open a listening port with gen_tcp.
-define(TEST_LISTENER(Ref, PortNr),
{?MODULE, listen, Ref, PortNr}).
@@ -227,7 +217,7 @@ init(accept, {Prot, Ref}) ->
init(gen_connect, {Prot, Ref}) ->
%% Lookup the peer's listening socket.
- {ok, PortNr} = inet:port(lsock(Prot, Ref)),
+ [PortNr] = ?util:lport(Prot, Ref, 20),
%% Connect, send a message and receive it back.
{ok, Sock} = gen_connect(Prot, PortNr, Ref),
@@ -264,22 +254,16 @@ init(connect, {Prot, Ref}) ->
MRef = erlang:monitor(process, TPid),
?RECV({'DOWN', MRef, process, _, _}).
-lsock(sctp, Ref) ->
- [{?SCTP_LISTENER(_ , _, LSock), _}]
- = match(?SCTP_LISTENER(Ref, ?ADDR, '_')),
- LSock;
-lsock(tcp, Ref) ->
- [{?TCP_LISTENER(_ , _, LSock), _}]
- = match(?TCP_LISTENER(Ref, ?ADDR, '_')),
- LSock.
-
match(Pat) ->
- case diameter_reg:match(Pat) of
- [] ->
+ match(Pat, 20).
+
+match(Pat, T) ->
+ L = diameter_reg:match(Pat),
+ if [] /= L orelse 1 == T ->
+ L;
+ true ->
?WAIT(50),
- match(Pat);
- L ->
- L
+ match(Pat, T-1)
end.
bin(sctp, #diameter_packet{bin = Bin}) ->
@@ -343,7 +327,7 @@ start_accept(Prot, Ref) ->
%% Configure the same port number for transports on the same
%% reference.
- PortNr = portnr(Prot, Ref),
+ [PortNr | _] = ?util:lport(Prot, Ref) ++ [0],
{Mod, Opts} = tmod(Prot),
try
@@ -373,23 +357,6 @@ tmod(sctp) ->
tmod(tcp) ->
{diameter_tcp, []}.
-portnr(sctp, Ref) ->
- case diameter_reg:match(?SCTP_LISTENER(Ref, ?ADDR, '_')) of
- [{?SCTP_LISTENER(_, _, LSock), _}] ->
- {ok, N} = inet:port(LSock),
- N;
- [] ->
- 0
- end;
-portnr(tcp, Ref) ->
- case diameter_reg:match(?TCP_LISTENER(Ref, ?ADDR, '_')) of
- [{?TCP_LISTENER(_, _, LSock), _}] ->
- {ok, N} = inet:port(LSock),
- N;
- [] ->
- 0
- end.
-
%% ===========================================================================
%% gen_connect/3
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
index f9942c3408..3fe8ea5363 100644
--- a/lib/diameter/test/diameter_util.erl
+++ b/lib/diameter/test/diameter_util.erl
@@ -23,16 +23,28 @@
%% Utility functions.
%%
+%% generic
-export([consult/2,
run/1,
fold/3,
foldl/3,
- scramble/1,
- write_priv/3,
- read_priv/2]).
+ scramble/1]).
+
+%% diameter-specific
+-export([lport/2,
+ lport/3,
+ listen/2,
+ connect/3,
+ disconnect/4]).
+
+%% common_test-specific
+-export([write_priv/3,
+ read_priv/2,
+ map_priv/3]).
-define(L, atom_to_list).
+%% ---------------------------------------------------------------------------
%% consult/2
%%
%% Extract info from the app/appup file (presumably) of the named
@@ -57,6 +69,7 @@ consult(Path) ->
%% Name/Path in the return value distinguish the errors and allow for
%% a useful badmatch.
+%% ---------------------------------------------------------------------------
%% run/1
%%
%% Evaluate functions in parallel and return a list of those that
@@ -72,6 +85,7 @@ cons(true, _, _, Acc) ->
cons(false, F, RC, Acc) ->
[{F, RC} | Acc].
+%% ---------------------------------------------------------------------------
%% fold/3
%%
%% Parallel fold. Results are folded in the order received.
@@ -117,6 +131,7 @@ down(MRef) ->
down() ->
receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end.
+%% ---------------------------------------------------------------------------
%% foldl/3
%%
%% Parallel fold. Results are folded in order of the function list.
@@ -132,6 +147,7 @@ recvl([{MRef, F} | L], Ref, Fun, Acc) ->
R = down(MRef),
recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)).
+%% ---------------------------------------------------------------------------
%% scramble/1
%%
%% Sort a list into random order.
@@ -151,7 +167,10 @@ s(Acc, L) ->
{H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L),
s([T|Acc], H ++ Rest).
+%% ---------------------------------------------------------------------------
%% eval/1
+%%
+%% Evaluate a function in one of a number of forms.
eval({M,[F|A]})
when is_atom(F) ->
@@ -172,17 +191,126 @@ eval(F)
when is_function(F,0) ->
F().
+%% ---------------------------------------------------------------------------
%% write_priv/3
+%%
+%% Write an arbitrary term to a named file.
write_priv(Config, Name, Term) ->
- Dir = proplists:get_value(priv_dir, Config),
- Path = filename:join([Dir, Name]),
+ write(path(Config, Name), Term).
+
+write(Path, Term) ->
ok = file:write_file(Path, term_to_binary(Term)).
%% read_priv/2
+%%
+%% Read a term from a file.
read_priv(Config, Name) ->
- Dir = proplists:get_value(priv_dir, Config),
- Path = filename:join([Dir, Name]),
+ read(path(Config, Name)).
+
+read(Path) ->
{ok, Bin} = file:read_file(Path),
binary_to_term(Bin).
+
+%% map_priv/3
+%%
+%% Modify a term in a file and return both old and new values.
+
+map_priv(Config, Name, Fun1) ->
+ map(path(Config, Name), Fun1).
+
+map(Path, Fun1) ->
+ T0 = read(Path),
+ T1 = Fun1(T0),
+ write(Path, T1),
+ {T0, T1}.
+
+path(Config, Name)
+ when is_atom(Name) ->
+ path(Config, ?L(Name));
+path(Config, Name) ->
+ Dir = proplists:get_value(priv_dir, Config),
+ filename:join([Dir, Name]).
+
+%% ---------------------------------------------------------------------------
+%% lport/2-3
+%%
+%% Lookup the port number of a tcp/sctp listening transport.
+
+lport(M, Ref) ->
+ lport(M, Ref, 1).
+
+lport(M, Ref, Tries) ->
+ lp(tmod(M), Ref, Tries).
+
+lp(M, Ref, T) ->
+ L = [N || {listen, N, _} <- M:ports(Ref)],
+ if [] /= L orelse T =< 1 ->
+ L;
+ true ->
+ receive after 50 -> ok end,
+ lp(M, Ref, T-1)
+ end.
+
+%% ---------------------------------------------------------------------------
+%% listen/2
+%%
+%% Add a listening transport on the loopback address and a free port.
+
+listen(SvcName, Prot) ->
+ add_transport(SvcName, {listen, opts(Prot, listen)}).
+
+%% ---------------------------------------------------------------------------
+%% connect/3
+%%
+%% Add a connecting transport on and connect to a listening transport
+%% with the specified reference.
+
+connect(Client, Prot, LRef) ->
+ [PortNr] = lport(Prot, LRef, 20),
+ Ref = add_transport(Client, {connect, opts(Prot, PortNr)}),
+ true = diameter:subscribe(Client),
+ ok = receive
+ {diameter_event, Client, {up, Ref, _, _, _}} -> ok
+ after 2000 ->
+ {Client, Prot, PortNr, process_info(self(), messages)}
+ end,
+ Ref.
+
+%% ---------------------------------------------------------------------------
+%% disconnect/4
+%%
+%% Remove the client transport and expect the server transport to go
+%% down.
+
+disconnect(Client, Ref, Server, LRef) ->
+ true = diameter:subscribe(Server),
+ ok = diameter:remove_transport(Client, Ref),
+ ok = receive
+ {diameter_event, Server, {down, LRef, _, _}} -> ok
+ after 2000 ->
+ {Client, Ref, Server, LRef, process_info(self(), messages)}
+ end.
+
+%% ---------------------------------------------------------------------------
+
+-define(ADDR, {127,0,0,1}).
+
+add_transport(SvcName, T) ->
+ {ok, Ref} = diameter:add_transport(SvcName, T),
+ Ref.
+
+tmod(tcp) ->
+ diameter_tcp;
+tmod(sctp) ->
+ diameter_sctp.
+
+opts(Prot, T) ->
+ [{transport_module, tmod(Prot)},
+ {transport_config, [{ip, ?ADDR}, {port, 0} | opts(T)]}].
+
+opts(listen) ->
+ [];
+opts(PortNr) ->
+ [{raddr, ?ADDR}, {rport, PortNr}].
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index 7c691c302b..531aca2799 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -35,7 +35,8 @@ MODULES = \
diameter_transport_SUITE \
diameter_traffic_SUITE \
diameter_relay_SUITE \
- diameter_tls_SUITE
+ diameter_tls_SUITE \
+ diameter_failover_SUITE
INTERNAL_HRL_FILES = \
diameter_ct.hrl
diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl
index 1df96caa36..0aca74bc97 100644
--- a/lib/erl_docgen/priv/xsl/db_man.xsl
+++ b/lib/erl_docgen/priv/xsl/db_man.xsl
@@ -137,8 +137,9 @@
(there is no spec with more than one clause) -->
<xsl:if test="count($clause/guard) > 0 or count($type) > 0">
<xsl:text>&#10;.RS</xsl:text>
- <xsl:text>&#10;.TP 3</xsl:text>
+ <xsl:text>&#10;.LP</xsl:text>
<xsl:text>&#10;Types:&#10;</xsl:text>
+ <xsl:text>&#10;.RS 3</xsl:text>
<xsl:choose>
<xsl:when test="$output_subtypes">
@@ -164,6 +165,8 @@
<xsl:with-param name="type_desc" select="$type_desc"/>
<xsl:with-param name="local_types" select="$local_types"/>
</xsl:call-template>
+ <xsl:text>&#10;.RE</xsl:text>
+
<xsl:text>&#10;.RE</xsl:text>
</xsl:if>
@@ -257,8 +260,8 @@
<!-- Similar to <d> -->
<xsl:template match="type_desc">
- <xsl:text>&#10;</xsl:text><xsl:apply-templates/>
- <xsl:text>&#10;.br</xsl:text>
+ <xsl:text>&#10;.RS 2&#10;</xsl:text><xsl:apply-templates/>
+ <xsl:text>&#10;.RE</xsl:text>
</xsl:template>
<!-- Datatypes -->
@@ -757,24 +760,26 @@
<!-- The case where @name != 0 is taken care of in "type_name" -->
<xsl:if test="string-length(@name) = 0 and string-length(@variable) = 0">
<xsl:text>&#10;.RS</xsl:text>
- <xsl:text>&#10;.TP 3</xsl:text>
+ <xsl:text>&#10;.LP</xsl:text>
<xsl:text>&#10;Types:&#10;</xsl:text>
+ <xsl:text>&#10;.RS 3</xsl:text>
<xsl:apply-templates/>
<xsl:text>&#10;.RE</xsl:text>
+ <xsl:text>&#10;.RE</xsl:text>
</xsl:if>
</xsl:template>
<!-- V -->
<xsl:template match="v">
- <xsl:text>&#10;</xsl:text><xsl:value-of select="normalize-space(text())"/>
+ <xsl:text>&#10;</xsl:text><xsl:apply-templates/>
<xsl:text>&#10;.br</xsl:text>
</xsl:template>
<!-- D -->
<xsl:template match="d">
- <xsl:text>&#10;</xsl:text><xsl:apply-templates/>
- <xsl:text>&#10;.br</xsl:text>
+ <xsl:text>&#10;.RS 2&#10;</xsl:text><xsl:apply-templates/>
+ <xsl:text>&#10;.RE</xsl:text>
</xsl:template>
<!-- Desc -->
diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile
index acb6848fee..f255183e1f 100644
--- a/lib/ic/doc/src/Makefile
+++ b/lib/ic/doc/src/Makefile
@@ -206,8 +206,6 @@ JAVADOCFLAGS = \
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(JAVA_OUT_DIR))
-
$(HTMLDIR)/%.gif: %.gif
$(INSTALL_DATA) $< $@
@@ -255,11 +253,15 @@ clean clean_docs clean_tex:
rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE)
rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN)
rm -rf $(JAVA_OUT_DIR)
+ rm -f JAVADOC-GENERATED
endif
-$(JAVADOC_GENERATED_FILES):
+$(JAVADOC_GENERATED_FILES): JAVADOC-GENERATED
+
+JAVADOC-GENERATED: $(JAVA_SOURCE_FILES:%=$(JAVA_SOURCE_DIR)/%)
@(cd ../../java_src; $(JAVADOC) $(JAVADOCFLAGS) com.ericsson.otp.ic)
+ >JAVADOC-GENERATED
man: $(MAN3_FILES)
diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml
index de519d5f84..ff289bd76c 100644
--- a/lib/ic/doc/src/notes.xml
+++ b/lib/ic/doc/src/notes.xml
@@ -31,6 +31,22 @@
</header>
<section>
+ <title>IC 4.2.28</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>
+ Incorrect use of ets:match changed to ets:match_object.</p>
+ <p>
+ Own Id: OTP-9630 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
<title>IC 4.2.27</title>
<section>
diff --git a/lib/ic/examples/pre_post_condition/Makefile b/lib/ic/examples/pre_post_condition/Makefile
index 85cbbdb9ff..d57133c964 100644
--- a/lib/ic/examples/pre_post_condition/Makefile
+++ b/lib/ic/examples/pre_post_condition/Makefile
@@ -100,7 +100,7 @@ YRL_FLAGS =
debug opt: $(TARGET_FILES)
clean:
- rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES)
+ rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED
rm -f errs core *~
docs:
diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl
index 7f2216b9dc..beaa2852ab 100644
--- a/lib/ic/src/ic_pragma.erl
+++ b/lib/ic/src/ic_pragma.erl
@@ -1601,7 +1601,7 @@ remove_inheriters(S,RS,InheriterList) ->
ReducedInhList;
_Other ->
CleanList =
- ets:match(S, {inherits,'_','_'}),
+ ets:match_object(S, {inherits,'_','_'}),
% CodeOptList =
% [X || X <- EtsList, element(1,X) == codeopt],
NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList),
@@ -1648,7 +1648,7 @@ remove_inh([X],[Y],List,EtsList) ->
%%%----------------------------------------------
remove_inherited(S,InheriterList) ->
CleanList =
- ets:match(S, {inherits, '_', '_'}),
+ ets:match_object(S, {inherits, '_', '_'}),
remove_inherited(S,InheriterList,CleanList).
@@ -1766,7 +1766,7 @@ inherits2(_X,Y,Z,EtsList) ->
%% false otherwise
%%
is_inherited_by(Interface1,Interface2,PragmaTab) ->
- InheritsList = ets:match(PragmaTab, {inherits, '_', '_'}),
+ InheritsList = ets:match_object(PragmaTab, {inherits, '_', '_'}),
inherits(Interface2,Interface1,InheritsList).
diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk
index 6561ccd2a7..703c8d29eb 100644
--- a/lib/ic/vsn.mk
+++ b/lib/ic/vsn.mk
@@ -1 +1 @@
-IC_VSN = 4.2.27
+IC_VSN = 4.2.28
diff --git a/lib/orber/COSS/CosNaming/Makefile b/lib/orber/COSS/CosNaming/Makefile
index 28b4d9cacc..d4b2079036 100644
--- a/lib/orber/COSS/CosNaming/Makefile
+++ b/lib/orber/COSS/CosNaming/Makefile
@@ -113,7 +113,7 @@ debug:
@${MAKE} TYPE=debug
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC)
diff --git a/lib/orber/examples/Stack/Makefile b/lib/orber/examples/Stack/Makefile
index ccb65038a3..215e57fcbe 100644
--- a/lib/orber/examples/Stack/Makefile
+++ b/lib/orber/examples/Stack/Makefile
@@ -96,7 +96,7 @@ ERL_COMPILE_FLAGS += \
debug opt: $(TARGET_FILES)
clean:
- rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES)
+ rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED
rm -f errs core *~
docs:
diff --git a/lib/orber/src/Makefile b/lib/orber/src/Makefile
index ed62c94b98..e812e22b46 100644
--- a/lib/orber/src/Makefile
+++ b/lib/orber/src/Makefile
@@ -212,7 +212,7 @@ debug:
opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
rm -f errs core *~
$(APP_TARGET): $(APP_SRC) ../vsn.mk
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 5819553bd4..35f9410562 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -27,16 +27,13 @@
transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3,
cipher_suites/0, cipher_suites/1, close/1, shutdown/2,
connect/3, connect/2, connect/4, connection_info/1,
- controlling_process/2, listen/2, pid/1, peername/1, recv/2,
- recv/3, send/2, getopts/2, setopts/2, sockname/1,
+ controlling_process/2, listen/2, pid/1, peername/1, peercert/1,
+ recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1,
versions/0, session_info/1, format_error/1,
renegotiate/1]).
-%% Should be deprecated as soon as old ssl is removed
-deprecated({pid, 1, next_major_release}).
-%-deprecated({peercert, 2, next_major_release}).
-%%-include("ssl_int.hrl").
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
-include("ssl_cipher.hrl").
@@ -288,6 +285,19 @@ peername(#sslsocket{pid = Pid}) ->
ssl_connection:peername(Pid).
%%--------------------------------------------------------------------
+-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}.
+%%
+%% Description: Returns the peercert.
+%%--------------------------------------------------------------------
+peercert(#sslsocket{pid = Pid}) ->
+ case ssl_connection:peer_certificate(Pid) of
+ {ok, undefined} ->
+ {error, no_peercert};
+ Result ->
+ Result
+ end.
+
+%%--------------------------------------------------------------------
-spec cipher_suites() -> [erl_cipher_suite()].
-spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()].
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index d5cd3b3b4b..a9109c5a6e 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -207,7 +207,7 @@ all() ->
[app, alerts, connection_info, protocol_versions,
empty_protocol_versions, controlling_process,
controller_dies, client_closes_socket,
- connect_dist, peername, sockname, socket_options,
+ connect_dist, peername, peercert, sockname, socket_options,
invalid_inet_get_option, invalid_inet_get_option_not_list,
invalid_inet_get_option_improper_list,
invalid_inet_set_option, invalid_inet_set_option_not_list,
@@ -663,6 +663,44 @@ peername_result(S) ->
ssl:peername(S).
%%--------------------------------------------------------------------
+peercert(doc) ->
+ [""];
+peercert(suite) ->
+ [];
+peercert(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, peercert_result, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, peercert_result, []}},
+ {options, ClientOpts}]),
+
+ CertFile = proplists:get_value(certfile, ServerOpts),
+ [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile),
+
+ ServerMsg = {error, no_peercert},
+ ClientMsg = {ok, BinCert},
+
+ test_server:format("Testcase ~p, Client ~p Server ~p ~n",
+ [self(), Client, Server]),
+
+ ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+peercert_result(Socket) ->
+ ssl:peercert(Socket).
+
+%%--------------------------------------------------------------------
sockname(doc) ->
["Test API function sockname/1"];
diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml
index 6f3ed7af98..7042c84437 100644
--- a/lib/stdlib/doc/src/lists.xml
+++ b/lib/stdlib/doc/src/lists.xml
@@ -240,7 +240,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keydelete" arity="3"/>
<fsummary>Delete an element from a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a copy of <c><anno>TupleList1</anno></c> where the first
occurrence of a tuple whose <c><anno>N</anno></c>th element compares equal to
@@ -266,7 +266,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keymap" arity="3"/>
<fsummary>Map a function over a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a list of tuples where, for each tuple in
<c><anno>TupleList1</anno></c>, the <c><anno>N</anno></c>th element <c><anno>Term1</anno></c> of the tuple
@@ -298,7 +298,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keymerge" arity="3"/>
<fsummary>Merge two key-sorted lists of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c>
and <c><anno>TupleList2</anno></c>. The merge is performed on
@@ -312,7 +312,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keyreplace" arity="4"/>
<fsummary>Replace an element in a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a copy of <c><anno>TupleList1</anno></c> where the first
occurrence of a <c>T</c> tuple whose <c><anno>N</anno></c>th element
@@ -342,7 +342,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keysort" arity="2"/>
<fsummary>Sort a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a list containing the sorted elements of the list
<c><anno>TupleList1</anno></c>. Sorting is performed on the <c><anno>N</anno></c>th
@@ -352,7 +352,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keystore" arity="4"/>
<fsummary>Store an element in a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a copy of <c><anno>TupleList1</anno></c> where the first
occurrence of a tuple <c>T</c> whose <c><anno>N</anno></c>th element
@@ -366,7 +366,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keytake" arity="3"/>
<fsummary>Extract an element from a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Searches the list of tuples <c><anno>TupleList1</anno></c> for a tuple
whose <c><anno>N</anno></c>th element compares equal to <c><anno>Key</anno></c>.
@@ -500,7 +500,7 @@ flatmap(Fun, List1) ->
<func>
<name name="nth" arity="2"/>
<fsummary>Return the Nth element of a list</fsummary>
- <type_desc variable="N">1..length(List)</type_desc>
+ <type_desc variable="N">1..length(<anno>List</anno>)</type_desc>
<desc>
<p>Returns the <c><anno>N</anno></c>th element of <c><anno>List</anno></c>. For example:</p>
<pre>
@@ -511,7 +511,7 @@ c</pre>
<func>
<name name="nthtail" arity="2"/>
<fsummary>Return the Nth tail of a list</fsummary>
- <type_desc variable="N">0..length(List)</type_desc>
+ <type_desc variable="N">0..length(<anno>List</anno>)</type_desc>
<desc>
<p>Returns the <c><anno>N</anno></c>th tail of <c><anno>List</anno></c>, that is, the sublist of
<c><anno>List</anno></c> starting at <c><anno>N</anno>+1</c> and continuing up to
@@ -630,7 +630,7 @@ length(lists:seq(From, To, Incr)) == (To-From+Incr) div Incr</code>
<func>
<name name="split" arity="2"/>
<fsummary>Split a list into two lists</fsummary>
- <type_desc variable="N">0..length(List1)</type_desc>
+ <type_desc variable="N">0..length(<anno>List1</anno>)</type_desc>
<desc>
<p>Splits <c><anno>List1</anno></c> into <c><anno>List2</anno></c> and <c><anno>List3</anno></c>.
<c><anno>List2</anno></c> contains the first <c><anno>N</anno></c> elements and
@@ -670,7 +670,7 @@ splitwith(Pred, List) ->
<func>
<name name="sublist" arity="3"/>
<fsummary>Return a sub-list starting at a given position and with a given number of elements</fsummary>
- <type_desc variable="Start">1..(length(List1)+1)</type_desc>
+ <type_desc variable="Start">1..(length(<anno>List1</anno>)+1)</type_desc>
<desc>
<p>Returns the sub-list of <c><anno>List1</anno></c> starting at <c><anno>Start</anno></c>
and with (max) <c><anno>Len</anno></c> elements. It is not an error for
@@ -732,7 +732,7 @@ splitwith(Pred, List) ->
<func>
<name name="ukeymerge" arity="3"/>
<fsummary>Merge two key-sorted lists of tuples, removing duplicates</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c>
and <c><anno>TupleList2</anno></c>. The merge is performed on the
@@ -746,7 +746,7 @@ splitwith(Pred, List) ->
<func>
<name name="ukeysort" arity="2"/>
<fsummary>Sort a list of tuples, removing duplicates</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a list containing the sorted elements of the list
<c><anno>TupleList1</anno></c> where all but the first tuple of the
diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml
index 93affc3191..1b8fa44883 100644
--- a/lib/stdlib/doc/src/random.xml
+++ b/lib/stdlib/doc/src/random.xml
@@ -136,6 +136,11 @@
<c>random_seed</c> to remember the current seed.</p>
<p>If a process calls <c>uniform/0</c> or <c>uniform/1</c> without
setting a seed first, <c>seed/0</c> is called automatically.</p>
+ <p>The implementation changed in R15. Upgrading to R15 will break
+ applications that expect a specific output for a given seed. The output
+ is still deterministic number series, but different compared to releases
+ older than R15. The seed <c>{0,0,0}</c> will for example no longer
+ produce a flawed series of only zeros.</p>
</section>
</erlref>
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index fa0641ffd9..c0f9ce34b0 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -1754,17 +1754,6 @@ system_code_change(State, _Module, _OldVsn, _Extra) ->
%%% Internal functions
%%%----------------------------------------------------------------------
-constants(FH, FileName) ->
- Version = FH#fileheader.version,
- if
- Version =< 8 ->
- dets_v8:constants();
- Version =:= 9 ->
- dets_v9:constants();
- true ->
- throw({error, {not_a_dets_file, FileName}})
- end.
-
%% -> {ok, Fd, fileheader()} | throw(Error)
read_file_header(FileName, Access, RamFile) ->
BF = if
@@ -1842,7 +1831,11 @@ do_bchunk_init(Head, Tab) ->
{H2, {error, old_version}};
Parms ->
L = dets_utils:all_allocated(H2),
- C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L},
+ Bin = if
+ L =:= <<>> -> eof;
+ true -> <<>>
+ end,
+ C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L},
BinParms = term_to_binary(Parms),
{H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk},
[BinParms]}}
@@ -2475,10 +2468,23 @@ fopen2(Fname, Tab) ->
%% Fd is not always closed upon error, but exit is soon called.
{ok, Fd, FH} = read_file_header(Fname, Acc, Ram),
Mod = FH#fileheader.mod,
- case Mod:check_file_header(FH, Fd) of
- {error, not_closed} ->
- io:format(user,"dets: file ~p not properly closed, "
- "repairing ...~n", [Fname]),
+ Do = case Mod:check_file_header(FH, Fd) of
+ {ok, Head1, ExtraInfo} ->
+ Head2 = Head1#head{filename = Fname},
+ try {ok, Mod:init_freelist(Head2, ExtraInfo)}
+ catch
+ throw:_ ->
+ {repair, " has bad free lists, repairing ..."}
+ end;
+ {error, not_closed} ->
+ M = " not properly closed, repairing ...",
+ {repair, M};
+ Else ->
+ Else
+ end,
+ case Do of
+ {repair, Mess} ->
+ io:format(user, "dets: file ~p~s~n", [Fname, Mess]),
Version = default,
case fsck(Fd, Tab, Fname, FH, default, default, Version) of
ok ->
@@ -2486,9 +2492,9 @@ fopen2(Fname, Tab) ->
Error ->
throw(Error)
end;
- {ok, Head, ExtraInfo} ->
+ {ok, Head} ->
open_final(Head, Fname, Acc, Ram, ?DEFAULT_CACHE,
- Tab, ExtraInfo, false);
+ Tab, false);
{error, Reason} ->
throw({error, {Reason, Fname}})
end;
@@ -2520,12 +2526,13 @@ fopen_existing_file(Tab, OpenArgs) ->
V9 = (Version =:= 9) or (Version =:= default),
MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots),
MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots),
- Do = case (FH#fileheader.mod):check_file_header(FH, Fd) of
+ Mod = (FH#fileheader.mod),
+ Wh = case Mod:check_file_header(FH, Fd) of
{ok, Head, true} when Rep =:= force, Acc =:= read_write,
FH#fileheader.version =:= 9,
FH#fileheader.no_colls =/= undefined,
MinF, MaxF, V9 ->
- {compact, Head};
+ {compact, Head, true};
{ok, _Head, _Extra} when Rep =:= force, Acc =:= read ->
throw({error, {access_mode, Fname}});
{ok, Head, need_compacting} when Acc =:= read ->
@@ -2555,6 +2562,17 @@ fopen_existing_file(Tab, OpenArgs) ->
{error, Reason} ->
throw({error, {Reason, Fname}})
end,
+ Do = case Wh of
+ {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact ->
+ Hd1 = Hd#head{filename = Fname},
+ try {Tag, Mod:init_freelist(Hd1, Extra)}
+ catch
+ throw:_ ->
+ {repair, " has bad free lists, repairing ..."}
+ end;
+ Else ->
+ Else
+ end,
case Do of
_ when FH#fileheader.type =/= Type ->
throw({error, {type_mismatch, Fname}});
@@ -2563,8 +2581,7 @@ fopen_existing_file(Tab, OpenArgs) ->
{compact, SourceHead} ->
io:format(user, "dets: file ~p is now compacted ...~n", [Fname]),
{ok, NewSourceHead} = open_final(SourceHead, Fname, read, false,
- ?DEFAULT_CACHE, Tab, true,
- Debug),
+ ?DEFAULT_CACHE, Tab, Debug),
case catch compact(NewSourceHead) of
ok ->
erlang:garbage_collect(),
@@ -2584,9 +2601,9 @@ fopen_existing_file(Tab, OpenArgs) ->
Version, OpenArgs);
_ when FH#fileheader.version =/= Version, Version =/= default ->
throw({error, {version_mismatch, Fname}});
- {final, H, EI} ->
+ {final, H} ->
H1 = H#head{auto_save = Auto},
- open_final(H1, Fname, Acc, Ram, CacheSz, Tab, EI, Debug)
+ open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug)
end.
do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) ->
@@ -2600,19 +2617,16 @@ do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) ->
end.
%% -> {ok, head()} | throw(Error)
-open_final(Head, Fname, Acc, Ram, CacheSz, Tab, ExtraInfo, Debug) ->
+open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) ->
Head1 = Head#head{access = Acc,
ram_file = Ram,
filename = Fname,
name = Tab,
cache = dets_utils:new_cache(CacheSz)},
init_disk_map(Head1#head.version, Tab, Debug),
- Mod = Head#head.mod,
- Mod:cache_segps(Head1#head.fptr, Fname, Head1#head.next),
- Ftab = Mod:init_freelist(Head1, ExtraInfo),
+ (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next),
check_growth(Head1),
- NewHead = Head1#head{freelists = Ftab},
- {ok, NewHead}.
+ {ok, Head1}.
%% -> {ok, head()} | throw(Error)
fopen_init_file(Tab, OpenArgs) ->
@@ -3139,8 +3153,12 @@ init_scan(Head, NoObjs) ->
check_safe_fixtable(Head),
FreeLists = dets_utils:get_freelists(Head),
Base = Head#head.base,
- {From, To} = dets_utils:find_next_allocated(FreeLists, Base, Base),
- #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From, To, <<>>}}.
+ case dets_utils:find_next_allocated(FreeLists, Base, Base) of
+ {From, To} ->
+ #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From,To,<<>>}};
+ none ->
+ #dets_cont{no_objs = NoObjs, bin = eof, alloc = <<>>}
+ end.
check_safe_fixtable(Head) ->
case (Head#head.fixed =:= false) andalso
@@ -3241,18 +3259,20 @@ view(FileName) ->
case catch read_file_header(FileName, read, false) of
{ok, Fd, FH} ->
Mod = FH#fileheader.mod,
- case Mod:check_file_header(FH, Fd) of
- {ok, H0, ExtraInfo} ->
- Ftab = Mod:init_freelist(H0, ExtraInfo),
- {_Bump, Base} = constants(FH, FileName),
- H = H0#head{freelists=Ftab, base = Base},
- v_free_list(H),
- Mod:v_segments(H),
- file:close(Fd);
- X ->
- file:close(Fd),
- X
- end;
+ try Mod:check_file_header(FH, Fd) of
+ {ok, H0, ExtraInfo} ->
+ Mod = FH#fileheader.mod,
+ case Mod:check_file_header(FH, Fd) of
+ {ok, H0, ExtraInfo} ->
+ H = Mod:init_freelist(H0, ExtraInfo),
+ v_free_list(H),
+ Mod:v_segments(H),
+ ok;
+ X ->
+ X
+ end
+ after file:close(Fd)
+ end;
X ->
X
end.
diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl
index fbffc9d008..a3f99357a2 100644
--- a/lib/stdlib/src/dets.hrl
+++ b/lib/stdlib/src/dets.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2011. 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
@@ -92,6 +92,7 @@
%% Info extracted from the file header.
-record(fileheader, {
freelist,
+ fl_base,
cookie,
closed_properly,
type,
diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl
index cdd38d5604..3e962a1c8b 100644
--- a/lib/stdlib/src/dets_v8.erl
+++ b/lib/stdlib/src/dets_v8.erl
@@ -21,7 +21,7 @@
%% Dets files, implementation part. This module handles versions up to
%% and including 8(c). To be called from dets.erl only.
--export([constants/0, mark_dirty/1, read_file_header/2,
+-export([mark_dirty/1, read_file_header/2,
check_file_header/2, do_perform_save/1, initiate_file/11,
init_freelist/2, fsck_input/4,
bulk_input/3, output_objs/4, write_cache/1, may_grow/3,
@@ -196,10 +196,6 @@
%%-define(DEBUGF(X,Y), io:format(X, Y)).
-define(DEBUGF(X,Y), void).
-%% {Bump}
-constants() ->
- {?BUMP, ?BASE}.
-
%% -> ok | throw({NewHead,Error})
mark_dirty(Head) ->
Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}],
@@ -308,8 +304,9 @@ init_freelist(Head, {convert_freelist,_Version}) ->
Pos = Head#head.freelists_p,
case catch prterm(Head, Pos, ?OHDSZ) of
{0, _Sz, Term} ->
- FreeList = lists:reverse(Term),
- dets_utils:init_slots_from_old_file(FreeList, Ftab);
+ FreeList1 = lists:reverse(Term),
+ FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab),
+ Head#head{freelists = FreeList, base = ?BASE};
_ ->
throw({error, {bad_freelists, Head#head.filename}})
end;
@@ -318,7 +315,7 @@ init_freelist(Head, _) ->
Pos = Head#head.freelists_p,
case catch prterm(Head, Pos, ?OHDSZ) of
{0, _Sz, Term} ->
- Term;
+ Head#head{freelists = Term, base = ?BASE};
_ ->
throw({error, {bad_freelists, Head#head.filename}})
end.
@@ -331,6 +328,7 @@ read_file_header(Fd, FileName) ->
{ok, EOF} = dets_utils:position_close(Fd, FileName, eof),
{ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4),
FH = #fileheader{freelist = Freelist,
+ fl_base = ?BASE,
cookie = Cookie,
closed_properly = CP,
type = dets_utils:code_to_type(Type2),
@@ -413,7 +411,7 @@ check_file_header(FH, Fd) ->
version = ?FILE_FORMAT_VERSION,
mod = ?MODULE,
bump = ?BUMP,
- base = ?BASE},
+ base = FH#fileheader.fl_base},
{ok, H, ExtraInfo};
Error ->
Error
diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl
index 132af01f79..f577b4410f 100644
--- a/lib/stdlib/src/dets_v9.erl
+++ b/lib/stdlib/src/dets_v9.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2011. 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
@@ -21,7 +21,7 @@
%% Dets files, implementation part. This module handles version 9.
%% To be called from dets.erl only.
--export([constants/0, mark_dirty/1, read_file_header/2,
+-export([mark_dirty/1, read_file_header/2,
check_file_header/2, do_perform_save/1, initiate_file/11,
prep_table_copy/9, init_freelist/2, fsck_input/4,
bulk_input/3, output_objs/4, bchunk_init/2,
@@ -70,6 +70,17 @@
%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum.
%% (FreelistsPointer, Cookie and ClosedProperly are not digested.)
%% 128 Reserved for future versions. Initially zeros.
+%% Version 9(d), introduced in R15A, has instead:
+%% 112 28 counters for the buddy system sizes (as for 9(b)).
+%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum.
+%% (FreelistsPointer, Cookie and ClosedProperly are not digested.)
+%% 4 Base of the buddy system.
+%% 0 (zero) if the base is equal to ?BASE. Compatible with R14B.
+%% File size at the end of the file is RealFileSize - Base.
+%% The reason for modifying file size is that when a file created
+%% by R15 is read by R14 a repair takes place immediately, which
+%% is acceptable when downgrading.
+%% 124 Reserved for future versions. Initially zeros.
%% ---
%% ------------------ end of file header
%% 4*256 SegmentArray Pointers.
@@ -86,7 +97,7 @@
%% -----------------------------
%% ??? Free lists
%% -----------------------------
-%% 4 File size, in bytes.
+%% 4 File size, in bytes. See 9(d) obove.
%% Before we can find an object we must find the slot where the
%% object resides. Each slot is a (possibly empty) list (or chain) of
@@ -177,14 +188,14 @@
%%% File header
%%%
--define(RESERVED, 128). % Reserved for future use.
+-define(RESERVED, 124). % Reserved for future use.
-define(COLL_CNTRS, (28*4)). % Counters for the buddy system.
-define(MD5SZ, 16).
+-define(FL_BASE, 4).
--define(HEADSZ,
- 56+?COLL_CNTRS+?MD5SZ). % The size of the file header, in bytes,
- % not including the reserved part.
+-define(HEADSZ, 56+?COLL_CNTRS % The size of the file header, in bytes,
+ +?MD5SZ+?FL_BASE). % not including the reserved part.
-define(HEADEND, (?HEADSZ+?RESERVED)).
% End of header and reserved area.
-define(SEGSZ, 512). % Size of a segment, in words. SZOBJP*SEGSZP.
@@ -270,10 +281,6 @@
%%-define(DEBUGF(X,Y), io:format(X, Y)).
-define(DEBUGF(X,Y), void).
-%% {Bump}
-constants() ->
- {?BUMP, ?BASE}.
-
%% -> ok | throw({NewHead,Error})
mark_dirty(Head) ->
Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}],
@@ -356,7 +363,7 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz,
cache = dets_utils:new_cache(CacheSz),
version = ?FILE_FORMAT_VERSION,
bump = ?BUMP,
- base = ?BASE,
+ base = ?BASE, % to be overwritten
mod = ?MODULE
},
@@ -378,13 +385,20 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz,
{Head1, Ws1} = init_parts(Head0, 0, no_parts(Next), Zero, []),
NoSegs = no_segs(Next),
- {Head, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []),
+ {Head2, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []),
Ws2 = if
DoInitSegments -> WsP ++ WsI;
true -> WsP
end,
dets_utils:pwrite(Fd, Fname, [W0 | lists:append(Ws1) ++ Ws2]),
- true = hash_invars(Head),
+ true = hash_invars(Head2),
+ %% The allocations that have been made so far (parts, segments)
+ %% are permanent; the table will never shrink. Therefore the base
+ %% of the Buddy system can be set to the first free object.
+ %% This is used in allocate_all(), see below.
+ {_, Where, _} = dets_utils:alloc(Head2, ?BUMP),
+ NewFtab = dets_utils:init_alloc(Where),
+ Head = Head2#head{freelists = NewFtab, base = Where},
{ok, Head}.
%% Returns a power of two not less than 256.
@@ -451,8 +465,9 @@ read_file_header(Fd, FileName) ->
Version:32, M:32, Next:32, Kp:32,
NoObjects:32, NoKeys:32, MinNoSlots:32, MaxNoSlots:32,
HashMethod:32, N:32, NoCollsB:?COLL_CNTRS/binary,
- MD5:?MD5SZ/binary>> = Bin,
- <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-12)/binary,_/binary>> = Bin,
+ MD5:?MD5SZ/binary, FlBase:32>> = Bin,
+ <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-?FL_BASE-12)/binary,
+ _/binary>> = Bin,
{ok, EOF} = dets_utils:position_close(Fd, FileName, eof),
{ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4),
{CL, <<>>} = lists:foldl(fun(LSz, {Acc,<<NN:32,R/binary>>}) ->
@@ -468,8 +483,12 @@ read_file_header(Fd, FileName) ->
true ->
lists:reverse(CL)
end,
-
+ Base = case FlBase of
+ 0 -> ?BASE;
+ _ -> FlBase
+ end,
FH = #fileheader{freelist = FreeList,
+ fl_base = Base,
cookie = Cookie,
closed_properly = CP,
type = dets_utils:code_to_type(Type2),
@@ -486,7 +505,7 @@ read_file_header(Fd, FileName) ->
read_md5 = MD5,
has_md5 = <<0:?MD5SZ/unit:8>> =/= MD5,
md5 = erlang:md5(MD5DigestedPart),
- trailer = FileSize,
+ trailer = FileSize + FlBase,
eof = EOF,
n = N,
mod = ?MODULE},
@@ -544,7 +563,7 @@ check_file_header(FH, Fd) ->
version = ?FILE_FORMAT_VERSION,
mod = ?MODULE,
bump = ?BUMP,
- base = ?BASE},
+ base = FH#fileheader.fl_base},
{ok, H, ExtraInfo};
Error ->
Error
@@ -1185,41 +1204,25 @@ write_loop(Head, BytesToWrite, Bin) ->
write_loop(Head, BytesToWrite, SmallBin).
%% By allocating bigger objects before smaller ones, holes in the
-%% buddy system memory map are avoided. Unfortunately, the segments
-%% are always allocated first, so if there are objects bigger than a
-%% segment, there is a hole to handle. (Haven't considered placing the
-%% segments among other objects of the same size.)
+%% buddy system memory map are avoided.
allocate_all_objects(Head, SizeT) ->
DTL = lists:reverse(lists:keysort(1, ets:tab2list(SizeT))),
MaxSz = element(1, hd(DTL)),
- SegSize = ?ACTUAL_SEG_SIZE,
- {Head1, HSz, HN, HA} = alloc_hole(MaxSz, Head, SegSize),
- {Head2, NL} = allocate_all(Head1, DTL, []),
+ {Head1, NL} = allocate_all(Head, DTL, []),
%% Find the position that will be the end of the file by allocating
%% a minimal object.
- {_Head, EndOfFile, _} = dets_utils:alloc(Head2, ?BUMP),
- Head3 = free_hole(Head2, HSz, HN, HA),
- NewHead = Head3#head{maxobjsize = max_objsize(Head3#head.no_collections)},
+ {_Head, EndOfFile, _} = dets_utils:alloc(Head1, ?BUMP),
+ NewHead = Head1#head{maxobjsize = max_objsize(Head1#head.no_collections)},
{NewHead, NL, MaxSz, EndOfFile}.
-alloc_hole(LSize, Head, SegSz) when ?POW(LSize-1) > SegSz ->
- Size = ?POW(LSize-1),
- {_, SegAddr, _} = dets_utils:alloc(Head, adjsz(SegSz)),
- {_, Addr, _} = dets_utils:alloc(Head, adjsz(Size)),
- N = (Addr - SegAddr) div SegSz,
- Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr),
- {Head1, SegSz, N, SegAddr};
-alloc_hole(_MaxSz, Head, _SegSz) ->
- {Head, 0, 0, 0}.
-
-free_hole(Head, _Size, 0, _Addr) ->
- Head;
-free_hole(Head, Size, N, Addr) ->
- {Head1, _} = dets_utils:free(Head, Addr, adjsz(Size)),
- free_hole(Head1, Size, N-1, Addr+Size).
-
%% One (temporary) file for each buddy size, write all objects of that
%% size to the file.
+%%
+%% Before R15 a "hole" was needed before the first bucket if the size
+%% of the biggest bucket was greater than the size of a segment. The
+%% hole proved to be a problem with almost full tables with huge
+%% buckets. Since R15 the hole is no longer needed due to the fact
+%% that the base of the Buddy system is flexible.
allocate_all(Head, [{?FSCK_SEGMENT,_,Data,_}], L) ->
%% And one file for the segments...
%% Note that space for the array parts and the segments has
@@ -1593,23 +1596,28 @@ do_perform_save(H) ->
H1 = H#head{freelists_p = FreeListsPointer},
{FLW, FLSize} = free_lists_to_file(H1),
FileSize = FreeListsPointer + FLSize + 4,
- ok = dets_utils:write(H1, [FLW | <<FileSize:32>>]),
+ AdjustedFileSize = case H#head.base of
+ ?BASE -> FileSize;
+ Base -> FileSize - Base
+ end,
+ ok = dets_utils:write(H1, [FLW | <<AdjustedFileSize:32>>]),
FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY),
case dets_utils:debug_mode() of
true ->
- TmpHead = H1#head{freelists = init_freelist(H1, true),
- fixed = false},
+ TmpHead0 = init_freelist(H1#head{fixed = false}, true),
+ TmpHead = TmpHead0#head{base = H1#head.base},
case
catch dets_utils:all_allocated_as_list(TmpHead)
=:= dets_utils:all_allocated_as_list(H1)
- of
+ of
true ->
dets_utils:pwrite(H1, [{0, FileHeader}]);
_ ->
+ throw(
dets_utils:corrupt_reason(H1, {failed_to_save_free_lists,
FreeListsPointer,
TmpHead#head.freelists,
- H1#head.freelists})
+ H1#head.freelists}))
end;
false ->
dets_utils:pwrite(H1, [{0, FileHeader}])
@@ -1648,7 +1656,11 @@ file_header(Head, FreeListsPointer, ClosedProperly, NoColls) ->
true -> erlang:md5(DigH);
false -> <<0:?MD5SZ/unit:8>>
end,
- [H1, DigH, MD5 | <<0:?RESERVED/unit:8>>].
+ Base = case Head#head.base of
+ ?BASE -> <<0:32>>;
+ FlBase -> <<FlBase:32>>
+ end,
+ [H1, DigH, MD5, Base | <<0:?RESERVED/unit:8>>].
%% Going through some trouble to avoid creating one single binary for
%% the free lists. If the free lists are huge, binary_to_term and
@@ -1695,8 +1707,8 @@ free_lists_from_file(H, Pos) ->
case catch bin_to_tree([], H, start, FL, -1, []) of
{'EXIT', _} ->
throw({error, {bad_freelists, H#head.filename}});
- Reply ->
- Reply
+ Ftab ->
+ H#head{freelists = Ftab, base = ?BASE}
end.
bin_to_tree(Bin, H, LastPos, Ftab, A0, L) ->
diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl
index bba46e4cb6..e73c087753 100644
--- a/lib/stdlib/src/lists.erl
+++ b/lib/stdlib/src/lists.erl
@@ -628,9 +628,10 @@ keydelete3(_, _, []) -> [].
-spec keyreplace(Key, N, TupleList1, NewTuple) -> TupleList2 when
Key :: term(),
N :: pos_integer(),
- TupleList1 :: [tuple()],
- TupleList2 :: [tuple()],
- NewTuple :: tuple().
+ TupleList1 :: [Tuple],
+ TupleList2 :: [Tuple],
+ NewTuple :: Tuple,
+ Tuple :: tuple().
keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) ->
keyreplace3(K, N, L, New).
@@ -660,9 +661,10 @@ keytake(_K, _N, [], _L) -> false.
-spec keystore(Key, N, TupleList1, NewTuple) -> TupleList2 when
Key :: term(),
N :: pos_integer(),
- TupleList1 :: [tuple()],
- TupleList2 :: [tuple(), ...],
- NewTuple :: tuple().
+ TupleList1 :: [Tuple],
+ TupleList2 :: [Tuple, ...],
+ NewTuple :: Tuple,
+ Tuple :: tuple().
keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) ->
keystore2(K, N, L, New).
@@ -740,8 +742,9 @@ keysort_1(_I, X, _EX, [], R) ->
TupleList1 :: [T1],
TupleList2 :: [T2],
TupleList3 :: [(T1 | T2)],
- T1 :: tuple(),
- T2 :: tuple().
+ T1 :: Tuple,
+ T2 :: Tuple,
+ Tuple :: tuple().
keymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
case L2 of
@@ -842,8 +845,9 @@ ukeysort_1(_I, X, _EX, []) ->
TupleList1 :: [T1],
TupleList2 :: [T2],
TupleList3 :: [(T1 | T2)],
- T1 :: tuple(),
- T2 :: tuple().
+ T1 :: Tuple,
+ T2 :: Tuple,
+ Tuple :: tuple().
ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 ->
case L1 of
@@ -873,8 +877,9 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
-spec keymap(Fun, N, TupleList1) -> TupleList2 when
Fun :: fun((Term1 :: term()) -> Term2 :: term()),
N :: pos_integer(),
- TupleList1 :: [tuple()],
- TupleList2 :: [tuple()].
+ TupleList1 :: [Tuple],
+ TupleList2 :: [Tuple],
+ Tuple :: tuple().
keymap(Fun, Index, [Tup|Tail]) ->
[setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)];
diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl
index dbb524cc74..d7b51a151c 100644
--- a/lib/stdlib/src/random.erl
+++ b/lib/stdlib/src/random.erl
@@ -26,6 +26,10 @@
-export([seed/0, seed/1, seed/3, uniform/0, uniform/1,
uniform_s/1, uniform_s/2, seed0/0]).
+-define(PRIME1, 30269).
+-define(PRIME2, 30307).
+-define(PRIME3, 30323).
+
%%-----------------------------------------------------------------------
%% The type of the state
@@ -44,7 +48,11 @@ seed0() ->
-spec seed() -> ran().
seed() ->
- reseed(seed0()).
+ case seed_put(seed0()) of
+ undefined -> seed0();
+ {_,_,_} = Tuple -> Tuple
+ end.
+
%% seed({A1, A2, A3})
%% Seed random number generation
@@ -66,17 +74,15 @@ seed({A1, A2, A3}) ->
A3 :: integer().
seed(A1, A2, A3) ->
- put(random_seed,
- {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}).
+ seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are
+ (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the
+ (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes.
--spec reseed(ran()) -> ran().
-
-reseed({A1, A2, A3}) ->
- case seed(A1, A2, A3) of
- undefined -> seed0();
- {_,_,_} = Tuple -> Tuple
- end.
+-spec seed_put(ran()) -> 'undefined' | ran().
+
+seed_put(Seed) ->
+ put(random_seed, Seed).
%% uniform()
%% Returns a random float between 0 and 1.
@@ -88,11 +94,11 @@ uniform() ->
undefined -> seed0();
Tuple -> Tuple
end,
- B1 = (A1*171) rem 30269,
- B2 = (A2*172) rem 30307,
- B3 = (A3*170) rem 30323,
+ B1 = (A1*171) rem ?PRIME1,
+ B2 = (A2*172) rem ?PRIME2,
+ B3 = (A3*170) rem ?PRIME3,
put(random_seed, {B1,B2,B3}),
- R = A1/30269 + A2/30307 + A3/30323,
+ R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3,
R - trunc(R).
%% uniform(N) -> I
@@ -116,10 +122,10 @@ uniform(N) when is_integer(N), N >= 1 ->
State1 :: ran().
uniform_s({A1, A2, A3}) ->
- B1 = (A1*171) rem 30269,
- B2 = (A2*172) rem 30307,
- B3 = (A3*170) rem 30323,
- R = A1/30269 + A2/30307 + A3/30323,
+ B1 = (A1*171) rem ?PRIME1,
+ B2 = (A2*172) rem ?PRIME2,
+ B3 = (A3*170) rem ?PRIME3,
+ R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3,
{R - trunc(R), {B1,B2,B3}}.
%% uniform_s(N, State) -> {I, NewState}
diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index b569ed9003..63767aeda6 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -34,6 +34,8 @@
-define(datadir(Conf), ?config(data_dir, Conf)).
-endif.
+-compile(r13). % OTP-9607
+
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
not_run/1, newly_started/1, basic_v8/1, basic_v9/1,
@@ -53,7 +55,7 @@
simultaneous_open/1, insert_new/1, repair_continuation/1,
otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1,
otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1,
- otp_8923/1, otp_9282/1]).
+ otp_8923/1, otp_9282/1, otp_9607/1]).
-export([dets_dirty_loop/0]).
@@ -112,7 +114,7 @@ all() ->
many_clients, otp_4906, otp_5402, simultaneous_open,
insert_new, repair_continuation, otp_5487, otp_6206,
otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898,
- otp_8899, otp_8903, otp_8923, otp_9282]
+ otp_8899, otp_8903, otp_8923, otp_9282, otp_9607]
end.
groups() ->
@@ -554,7 +556,11 @@ dets_dirty_loop() ->
{From, [write, Name, Value]} ->
Ret = dets:insert(Name, Value),
From ! {self(), Ret},
- dets_dirty_loop()
+ dets_dirty_loop();
+ {From, [close, Name]} ->
+ Ret = dets:close(Name),
+ From ! {self(), Ret},
+ dets_dirty_loop()
end.
@@ -1568,8 +1574,10 @@ repair(Config, V) ->
?line FileSize = dets:info(TabRef, memory),
?line ok = dets:close(TabRef),
crash(Fname, FileSize+20),
- ?line {error, {bad_freelists, Fname}} =
+ %% Used to return bad_freelists, but that changed in OTP-9622
+ ?line {ok, TabRef} =
dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ ?line ok = dets:close(TabRef),
?line file:delete(Fname),
%% File not closed, opening with read and read_write access tried.
@@ -3880,10 +3888,91 @@ some_calls(Tab, Config) ->
?line ok = dets:close(T),
file:delete(File).
+otp_9607(doc) ->
+ ["OTP-9607. Test downgrading the slightly changed format."];
+otp_9607(suite) ->
+ [];
+otp_9607(Config) when is_list(Config) ->
+ %% Note: the bug is about almost full tables. The fix of that
+ %% problem is *not* tested here.
+ Version = r13b,
+ case ?t:is_release_available(atom_to_list(Version)) of
+ true ->
+ T = otp_9607,
+ File = filename(T, Config),
+ Key = a,
+ Value = 1,
+ Args = [{file,File}],
+ ?line {ok, T} = dets:open_file(T, Args),
+ ?line ok = dets:insert(T, {Key, Value}),
+ ?line ok = dets:close(T),
+
+ ?line Call = fun(P, A) ->
+ P ! {self(), A},
+ receive
+ {P, Ans} ->
+ Ans
+ after 5000 ->
+ exit(other_process_dead)
+ end
+ end,
+ %% Create a file on the modified format, read the file
+ %% with an emulator that doesn't know about the modified
+ %% format.
+ ?line {ok, Node} = start_node_rel(Version, Version, slave),
+ ?line Pid = rpc:call(Node, erlang, spawn,
+ [?MODULE, dets_dirty_loop, []]),
+ ?line {error,{needs_repair, File}} =
+ Call(Pid, [open, T, Args++[{repair,false}]]),
+ io:format("Expect repair:~n"),
+ ?line {ok, T} = Call(Pid, [open, T, Args]),
+ ?line [{Key,Value}] = Call(Pid, [read, T, Key]),
+ ?line ok = Call(Pid, [close, T]),
+ file:delete(File),
+
+ %% Create a file on the unmodified format. Modify the file
+ %% using an emulator that must not turn the file into the
+ %% modified format. Read the file and make sure it is not
+ %% repaired.
+ ?line {ok, T} = Call(Pid, [open, T, Args]),
+ ?line ok = Call(Pid, [write, T, {Key,Value}]),
+ ?line [{Key,Value}] = Call(Pid, [read, T, Key]),
+ ?line ok = Call(Pid, [close, T]),
+
+ Key2 = b,
+ Value2 = 2,
+
+ ?line {ok, T} = dets:open_file(T, Args),
+ ?line [{Key,Value}] = dets:lookup(T, Key),
+ ?line ok = dets:insert(T, {Key2,Value2}),
+ ?line ok = dets:close(T),
+
+ ?line {ok, T} = Call(Pid, [open, T, Args++[{repair,false}]]),
+ ?line [{Key2,Value2}] = Call(Pid, [read, T, Key2]),
+ ?line ok = Call(Pid, [close, T]),
+
+ ?t:stop_node(Node),
+ file:delete(File),
+ ok;
+ false ->
+ {skipped, "No support for old node"}
+ end.
+
+
+
%%
%% Parts common to several test cases
%%
+start_node_rel(Name, Rel, How) ->
+ Release = [{release, atom_to_list(Rel)}],
+ ?line Pa = filename:dirname(code:which(?MODULE)),
+ ?line test_server:start_node(Name, How,
+ [{args,
+ " -kernel net_setuptime 100 "
+ " -pa " ++ Pa},
+ {erl, Release}]).
+
crash(File, Where) ->
crash(File, Where, 10).