aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/configure.in2
-rw-r--r--erts/doc/src/epmd.xml19
-rw-r--r--erts/doc/src/erl.xml9
-rw-r--r--erts/doc/src/erl_nif.xml13
-rw-r--r--erts/doc/src/init.xml13
-rw-r--r--erts/doc/src/notes.xml33
-rw-r--r--erts/emulator/beam/beam_bif_load.c3
-rw-r--r--erts/emulator/beam/beam_debug.c8
-rw-r--r--erts/emulator/beam/beam_emu.c8
-rw-r--r--erts/emulator/beam/beam_load.c2
-rw-r--r--erts/emulator/beam/bif.c2
-rw-r--r--erts/emulator/beam/break.c11
-rw-r--r--erts/emulator/beam/copy.c2
-rw-r--r--erts/emulator/beam/dist.c6
-rw-r--r--erts/emulator/beam/erl_alloc.c6
-rw-r--r--erts/emulator/beam/erl_alloc_util.c36
-rw-r--r--erts/emulator/beam/erl_bif_info.c4
-rw-r--r--erts/emulator/beam/erl_bits.c6
-rw-r--r--erts/emulator/beam/erl_db.c2
-rw-r--r--erts/emulator/beam/erl_db_tree.c2
-rw-r--r--erts/emulator/beam/erl_db_util.c42
-rw-r--r--erts/emulator/beam/erl_gc.c3
-rw-r--r--erts/emulator/beam/erl_nif.c5
-rw-r--r--erts/emulator/beam/erl_nif.h3
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h21
-rw-r--r--erts/emulator/beam/erl_process.c42
-rw-r--r--erts/emulator/beam/erl_process.h1
-rw-r--r--erts/emulator/beam/erl_process_dump.c4
-rw-r--r--erts/emulator/beam/erl_unicode.c2
-rw-r--r--erts/emulator/beam/global.h2
-rw-r--r--erts/emulator/beam/io.c11
-rw-r--r--erts/emulator/hipe/hipe_debug.c6
-rw-r--r--erts/emulator/sys/common/erl_mseg.c24
-rw-r--r--erts/emulator/test/nif_SUITE.erl10
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c18
-rw-r--r--erts/emulator/test/process_SUITE.erl50
-rw-r--r--erts/epmd/src/epmd.c43
-rw-r--r--erts/epmd/src/epmd_cli.c2
-rw-r--r--erts/epmd/src/epmd_int.h59
-rw-r--r--erts/epmd/src/epmd_srv.c224
-rw-r--r--erts/etc/common/heart.c6
-rw-r--r--erts/etc/unix/to_erl.c8
-rw-r--r--erts/lib_src/common/erl_printf_format.c27
-rw-r--r--lib/common_test/src/ct_framework.erl5
-rw-r--r--lib/compiler/src/beam_bsm.erl6
-rw-r--r--lib/compiler/src/beam_dead.erl44
-rw-r--r--lib/compiler/test/andor_SUITE.erl2
-rw-r--r--lib/compiler/test/apply_SUITE.erl2
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_bincomp_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_bit_binaries_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl24
-rw-r--r--lib/compiler/test/bs_utf_SUITE.erl2
-rw-r--r--lib/compiler/test/compilation_SUITE.erl2
-rw-r--r--lib/compiler/test/compile_SUITE.erl2
-rw-r--r--lib/compiler/test/core_SUITE.erl2
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl2
-rw-r--r--lib/compiler/test/error_SUITE.erl2
-rw-r--r--lib/compiler/test/float_SUITE.erl2
-rw-r--r--lib/compiler/test/fun_SUITE.erl2
-rw-r--r--lib/compiler/test/guard_SUITE.erl2
-rw-r--r--lib/compiler/test/inline_SUITE.erl2
-rw-r--r--lib/compiler/test/lc_SUITE.erl2
-rw-r--r--lib/compiler/test/match_SUITE.erl20
-rw-r--r--lib/compiler/test/misc_SUITE.erl2
-rw-r--r--lib/compiler/test/num_bif_SUITE.erl2
-rw-r--r--lib/compiler/test/pmod_SUITE.erl2
-rw-r--r--lib/compiler/test/receive_SUITE.erl2
-rw-r--r--lib/compiler/test/record_SUITE.erl21
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl2
-rw-r--r--lib/compiler/test/warnings_SUITE.erl2
-rw-r--r--lib/crypto/c_src/crypto.c61
-rw-r--r--lib/crypto/doc/src/crypto.xml42
-rw-r--r--lib/crypto/doc/src/notes.xml17
-rw-r--r--lib/crypto/src/crypto.erl25
-rw-r--r--lib/crypto/test/crypto_SUITE.erl33
-rw-r--r--lib/crypto/vsn.mk2
-rw-r--r--lib/dialyzer/doc/manual.txt33
-rw-r--r--lib/dialyzer/doc/src/dialyzer.xml70
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl25
-rw-r--r--lib/dialyzer/test/small_tests_SUITE.erl38
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs3
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl28
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl11
-rw-r--r--lib/eunit/src/eunit_lib.erl18
-rw-r--r--lib/eunit/src/eunit_surefire.erl4
-rw-r--r--lib/kernel/src/net_kernel.erl2
-rw-r--r--lib/kernel/test/heart_SUITE.erl13
-rw-r--r--lib/mnesia/doc/src/notes.xml30
-rw-r--r--lib/mnesia/src/mnesia.appup.src30
-rw-r--r--lib/mnesia/src/mnesia_controller.erl83
-rw-r--r--lib/mnesia/vsn.mk2
-rw-r--r--lib/os_mon/src/disksup.erl4
-rw-r--r--lib/os_mon/src/memsup.erl10
-rw-r--r--lib/public_key/src/public_key.appup.src20
-rw-r--r--lib/public_key/test/pkits_SUITE.erl1472
-rw-r--r--lib/public_key/vsn.mk2
-rw-r--r--lib/sasl/src/rb.erl4
-rw-r--r--lib/ssh/doc/src/notes.xml13
-rw-r--r--lib/ssh/src/ssh.appup.src26
-rwxr-xr-xlib/ssh/src/ssh_bits.erl56
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl4
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/doc/src/ssl.xml2
-rw-r--r--lib/ssl/src/ssl.appup.src2
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/src/gen.erl9
-rw-r--r--lib/stdlib/src/gen_event.erl3
-rw-r--r--lib/stdlib/src/gen_fsm.erl11
-rw-r--r--lib/stdlib/src/gen_server.erl11
-rw-r--r--lib/stdlib/test/gen_event_SUITE.erl21
-rw-r--r--lib/test_server/src/test_server.erl19
-rw-r--r--lib/tools/src/cover.erl9
114 files changed, 2295 insertions, 943 deletions
diff --git a/erts/configure.in b/erts/configure.in
index 2590357372..31d1d55b8a 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -1793,7 +1793,7 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2])
AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \
pread pwrite writev memmove strerror strerror_r strncasecmp \
- gethrtime localtime_r gmtime_r mmap mremap memcpy mallopt \
+ gethrtime localtime_r gmtime_r inet_pton mmap mremap memcpy mallopt \
sbrk _sbrk __sbrk brk _brk __brk \
flockfile fstat strlcpy strlcat setsid posix2time setlocale nl_langinfo poll])
diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml
index 474230cb38..8c3c1e5237 100644
--- a/erts/doc/src/epmd.xml
+++ b/erts/doc/src/epmd.xml
@@ -116,6 +116,16 @@
<p>These options are available when starting the actual name server. The name server is normally started automatically by the <c>erl</c> command (if not already available), but it can also be started at i.e. system start-up.</p>
<taglist>
+ <tag><c><![CDATA[-address List]]></c></tag>
+ <item>
+ <p>Let this instance of <c>epmd</c> listen only on the
+ comma-separated list of IP addresses and on the loopback address
+ (which is implicitely added to the list if it has not been
+ specified). This can also be set using the
+ <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable, see the
+ section <seealso marker="#environment_variables">Environment
+ variables</seealso> below.</p>
+ </item>
<tag><c><![CDATA[-port No]]></c></tag>
<item>
<p>Let this instance of epmd listen to another TCP port than
@@ -228,6 +238,15 @@
<marker id="environment_variables"></marker>
<title>Environment variables</title>
<taglist>
+ <tag><c><![CDATA[ERL_EPMD_ADDRESS]]></c></tag>
+ <item>
+ <p>This environment variable may be set to a comma-separated
+ list of IP addresses, in which case the <c>epmd</c> daemon
+ will listen only on the specified address(es) and on the
+ loopback address (which is implicitely added to the list if it
+ has not been specified). The default behaviour is to listen on
+ all available IP addresses.</p>
+ </item>
<tag><c><![CDATA[ERL_EPMD_PORT]]></c></tag>
<item>
<p>This environment variable can contain the port number epmd will use.
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index f4c81d9c47..514ee5ffaf 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1004,6 +1004,15 @@
add to the code path.
See <seealso marker="kernel:code">code(3)</seealso>.</p>
</item>
+ <tag><c><![CDATA[ERL_EPMD_ADDRESS]]></c></tag>
+ <item>
+ <p>This environment variable may be set to a comma-separated
+ list of IP addresses, in which case the
+ <seealso marker="epmd">epmd</seealso> daemon
+ will listen only on the specified address(es) and on the
+ loopback address (which is implicitely added to the list if it
+ has not been specified).</p>
+ </item>
<tag><c><![CDATA[ERL_EPMD_PORT]]></c></tag>
<item>
<p>This environment variable can contain the port number to use when
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 4bbd4e2a54..cdce4ec0b8 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -688,6 +688,10 @@ typedef enum {
<fsummary>Determine if a term is an empty list</fsummary>
<desc><p>Return true if <c>term</c> is an empty list.</p></desc>
</func>
+ <marker id="enif_is_exception"/><func><name><ret>int</ret><nametext>enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
+ <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_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>
@@ -738,7 +742,14 @@ typedef enum {
</func>
<func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_badarg(ErlNifEnv* env)</nametext></name>
<fsummary>Make a badarg exception.</fsummary>
- <desc><p>Make a badarg exception to be returned from a NIF.</p></desc>
+ <desc><p>Make a badarg exception to be returned from a NIF, and set
+ an associated exception reason in <c>env</c>. If
+ <c>enif_make_badarg</c> is called, the term it returns <em>must</em>
+ be returned from the function that called it. No other return value
+ is allowed. Also, the term returned from <c>enif_make_badarg</c> may
+ be passed only to
+ <seealso marker="#enif_is_exception">enif_is_exception</seealso> and
+ not to any other NIF API function.</p></desc>
</func>
<func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)</nametext></name>
<fsummary>Make a binary term.</fsummary>
diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml
index 33364c709a..0e828389f6 100644
--- a/erts/doc/src/init.xml
+++ b/erts/doc/src/init.xml
@@ -67,19 +67,6 @@
</desc>
</func>
<func>
- <name>get_args() -> [Arg]</name>
- <fsummary>Get all non-flag command line arguments</fsummary>
- <type>
- <v>Arg = atom()</v>
- </type>
- <desc>
- <p>Returns any plain command line arguments as a list of atoms
- (possibly empty). It is recommended that
- <c>get_plain_arguments/1</c> is used instead, because of
- the limited length of atoms.</p>
- </desc>
- </func>
- <func>
<name>get_argument(Flag) -> {ok, Arg} | error</name>
<fsummary>Get the values associated with a command line user flag</fsummary>
<type>
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index 102fa43c1f..e91839572b 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -30,6 +30,39 @@
</header>
<p>This document describes the changes made to the ERTS application.</p>
+<section><title>Erts 5.8.3.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Ets table type ordered_set could order large integer keys
+ wrongly on pure 64bit platforms. This is now corrected.</p>
+ <p>
+ Own Id: OTP-9181</p>
+ </item>
+ <item>
+ <p>
+ The status of a process was unnecessarily set to waiting
+ before a process was enqueued in a run queue. This bug
+ was harmless up until OTP-R14B01. In OTP-R14B02
+ <c>erlang:hibernate/3</c> was fixed (OTP-9125). After the
+ introduction of OTP-9125, the previously harmless process
+ status bug sometimes caused erroneous badarg exceptions
+ from <c>process_info()</c>.</p>
+ <p>
+ OTP-9125 also introduced a thread unsafe access to the
+ status field of a process which now also have been fixed.</p>
+ <p>
+ *** INCOMPATIBILITY with noxs ***</p>
+ <p>
+ Own Id: OTP-9197</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 5.8.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 6ae9736141..1ca405961f 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -472,9 +472,6 @@ check_process_code(Process* rp, Module* modp)
for (oh = MSO(rp).first; oh; oh = oh->next) {
if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
ErlFunThing* funp = (ErlFunThing*) oh;
- BeamInstr* fun_code;
-
- fun_code = funp->fe->address;
if (INSIDE((BeamInstr *) funp->fe->address)) {
if (done_gc) {
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 8a48049921..fffb172c68 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -291,7 +291,7 @@ dbg_bt(Process* p, Eterm* sp)
if (addr)
erts_fprintf(stderr,
HEXF ": %T:%T/%bpu\n",
- addr, (Eterm) addr[0], (Eterm) addr[1], (Uint) addr[2]);
+ addr, (Eterm) addr[0], (Eterm) addr[1], addr[2]);
}
sp++;
}
@@ -484,7 +484,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
if (f+3 != (BeamInstr *) *ap) {
erts_print(to, to_arg, "f(" HEXF ")", *ap);
} else {
- erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], (Eterm) f[2]);
+ erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]);
}
ap++;
}
@@ -495,7 +495,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
if (f+3 != (BeamInstr *) *ap) {
erts_print(to, to_arg, "p(" HEXF ")", *ap);
} else {
- erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], (Eterm) f[2]);
+ erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]);
}
ap++;
}
@@ -508,7 +508,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
{
Export* ex = (Export *) *ap;
erts_print(to, to_arg,
- "%T:%T/%bpu", (Eterm) ex->code[0], (Eterm) ex->code[1], (Uint) ex->code[2]);
+ "%T:%T/%bpu", (Eterm) ex->code[0], (Eterm) ex->code[1], ex->code[2]);
ap++;
}
break;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 8991f7b198..32ea8588d2 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -3420,7 +3420,8 @@ void process_main(void)
r(0) = c_p->def_arg_reg[0];
x(1) = c_p->def_arg_reg[1];
x(2) = c_p->def_arg_reg[2];
- if (c_p->status == P_WAITING) {
+ if (c_p->flags & F_HIBERNATE_SCHED) {
+ c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
}
Dispatch();
@@ -5225,6 +5226,7 @@ void process_main(void)
OpCase(i_hibernate): {
SWAPOUT;
if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) {
+ c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
} else {
I = handle_error(c_p, I, reg, hibernate_3);
@@ -6277,15 +6279,17 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re
PROCESS_MAIN_CHK_LOCKS(c_p);
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- c_p->status = P_WAITING;
#ifdef ERTS_SMP
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
if (c_p->msg.len > 0)
erts_add_to_runq(c_p);
+ else
#endif
+ c_p->status = P_WAITING;
}
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
c_p->current = bif_export[BIF_hibernate_3]->code;
+ c_p->flags |= F_HIBERNATE_SCHED; /* Needed also when woken! */
return 1;
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index c697b1ef31..57fe25453d 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -1411,7 +1411,6 @@ static int
load_code(LoaderState* stp)
{
int i;
- int tmp;
int ci;
int last_func_start = 0;
char* sign;
@@ -1931,7 +1930,6 @@ load_code(LoaderState* stp)
case 'P': /* Byte offset into tuple or stack */
case 'Q': /* Like 'P', but packable */
VerifyTag(stp, tag, TAG_u);
- tmp = tmp_op->a[arg].val;
code[ci++] = (BeamInstr) ((tmp_op->a[arg].val+1) * sizeof(Eterm));
break;
case 'l': /* Floating point register. */
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index f01580eb2b..6b1ce823cb 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -368,7 +368,6 @@ static int demonitor(Process *c_p, Eterm ref)
ErtsMonitor *mon = NULL; /* The monitor entry to delete */
Process *rp; /* Local target process */
Eterm to = NIL; /* Monitor link traget */
- Eterm ref_p; /* Pid of this end */
DistEntry *dep = NULL; /* Target's distribution entry */
int deref_de = 0;
int res;
@@ -381,7 +380,6 @@ static int demonitor(Process *c_p, Eterm ref)
res = ERTS_DEMONITOR_BADARG;
goto done; /* Cannot be this monitor's ref */
}
- ref_p = c_p->id;
mon = erts_lookup_monitor(c_p->monitors, ref);
if (!mon) {
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index d255cf3558..b8889e6206 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-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
@@ -266,7 +266,7 @@ print_process_info(int to, void *to_arg, Process *p)
}
erts_print(to, to_arg, "Number of heap fragments: %d\n", frags);
}
- erts_print(to, to_arg, "Heap fragment data: %bpu\n", MBUF_SIZE(p));
+ erts_print(to, to_arg, "Heap fragment data: %beu\n", MBUF_SIZE(p));
scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
if (scb) {
@@ -313,12 +313,11 @@ print_process_info(int to, void *to_arg, Process *p)
}
/* print the number of reductions etc */
- erts_print(to, to_arg, "Reductions: %bpu\n", p->reds);
+ erts_print(to, to_arg, "Reductions: %beu\n", p->reds);
- erts_print(to, to_arg, "Stack+heap: %bpu\n", p->heap_sz);
+ erts_print(to, to_arg, "Stack+heap: %beu\n", p->heap_sz);
erts_print(to, to_arg, "OldHeap: %bpu\n",
- (OLD_HEAP(p) == NULL) ? 0 :
- (unsigned)(OLD_HEND(p) - OLD_HEAP(p)) );
+ (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HEAP(p)) );
erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop));
erts_print(to, to_arg, "OldHeap unused: %bpu\n",
(OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) );
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 243e8973cf..90201f3a90 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -477,7 +477,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
if (htop != hbot)
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct() when copying %T:"
- " htop=%p != hbot=%p (sz=%bpu)\n",
+ " htop=%p != hbot=%p (sz=%beu)\n",
org_obj, htop, hbot, org_sz);
#else
if (htop > hbot) {
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 044fd045a6..b1cdd0660a 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -904,7 +904,6 @@ int erts_net_message(Port *prt,
ErtsDistExternal ede;
byte *t;
Sint ctl_len;
- int orig_ctl_len;
Eterm arg;
Eterm from, to;
Eterm watcher, watched;
@@ -985,7 +984,6 @@ int erts_net_message(Port *prt,
PURIFY_MSG("data error");
goto data_error;
}
- orig_ctl_len = ctl_len;
if (ctl_len > DIST_CTL_DEFAULT_SIZE) {
ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm));
@@ -1689,7 +1687,7 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf)
if (size > (Uint) INT_MAX)
erl_exit(ERTS_ABORT_EXIT,
"Absurdly large distribution output data buffer "
- "(%bpu bytes) passed.\n",
+ "(%beu bytes) passed.\n",
size);
prt->caller = NIL;
@@ -1716,7 +1714,7 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
if (size > (Uint) INT_MAX)
erl_exit(ERTS_ABORT_EXIT,
"Absurdly large distribution output data buffer "
- "(%bpu bytes) passed.\n",
+ "(%beu bytes) passed.\n",
size);
iov[0].iov_base = NULL;
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 775f4435a9..673eac7fea 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -1913,7 +1913,7 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
/* Print result... */
erts_print(to, arg, "=memory\n");
for (i = 0; i < length; i++)
- erts_print(to, arg, "%T: %bpu\n", atoms[i], *uintps[i]);
+ erts_print(to, arg, "%T: %beu\n", atoms[i], *uintps[i]);
}
if (proc) {
@@ -2107,11 +2107,11 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
for (i = 0; i < length; i++) {
switch (values[i].arity) {
case 2:
- erts_print(to, arg, "%s: %bpu\n",
+ erts_print(to, arg, "%s: %beu\n",
values[i].name, values[i].ui[0]);
break;
case 3:
- erts_print(to, arg, "%s: %bpu %bpu\n",
+ erts_print(to, arg, "%s: %beu %beu\n",
values[i].name, values[i].ui[0], values[i].ui[1]);
break;
default:
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 1394b7e829..84c72439a3 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -1877,7 +1877,7 @@ sz_info_carriers(Allctr_t *allctr,
cs->blocks.max_ever.size);
erts_print(to,
arg,
- "%scarriers size: %bpu %bpu %bpu\n",
+ "%scarriers size: %beu %bpu %bpu\n",
prefix,
curr_size,
cs->max.size,
@@ -1933,7 +1933,7 @@ info_carriers(Allctr_t *allctr,
cs->blocks.max_ever.size);
erts_print(to,
arg,
- "%scarriers: %bpu %bpu %bpu\n",
+ "%scarriers: %beu %bpu %bpu\n",
prefix,
curr_no,
cs->max.no,
@@ -1952,7 +1952,7 @@ info_carriers(Allctr_t *allctr,
cs->curr_sys_alloc.no);
erts_print(to,
arg,
- "%scarriers size: %bpu %bpu %bpu\n",
+ "%scarriers size: %beu %bpu %bpu\n",
prefix,
curr_size,
cs->max.size,
@@ -2053,15 +2053,15 @@ info_calls(Allctr_t *allctr,
#define PRINT_CC_4(TO, TOA, NAME, CC) \
if ((CC).giga_no == 0) \
- erts_print(TO, TOA, "%s calls: %bpu\n", NAME, CC.no); \
+ erts_print(TO, TOA, "%s calls: %b32u\n", NAME, CC.no); \
else \
- erts_print(TO, TOA, "%s calls: %bpu%09lu\n", NAME, CC.giga_no, CC.no)
+ erts_print(TO, TOA, "%s calls: %b32u%09lu\n", NAME, CC.giga_no, CC.no)
#define PRINT_CC_5(TO, TOA, PRFX, NAME, CC) \
if ((CC).giga_no == 0) \
- erts_print(TO, TOA, "%s%s calls: %bpu\n",PRFX,NAME,CC.no); \
+ erts_print(TO, TOA, "%s%s calls: %b32u\n",PRFX,NAME,CC.no); \
else \
- erts_print(TO, TOA, "%s%s calls: %bpu%09lu\n",PRFX,NAME,CC.giga_no,CC.no)
+ erts_print(TO, TOA, "%s%s calls: %b32u%09lu\n",PRFX,NAME,CC.giga_no,CC.no)
char *prefix = allctr->name_prefix;
int to = *print_to_p;
@@ -2168,21 +2168,21 @@ info_options(Allctr_t *allctr,
"option e: true\n"
"option t: %s\n"
"option ramv: %s\n"
- "option sbct: %bpu\n"
+ "option sbct: %beu\n"
#if HAVE_ERTS_MSEG
"option asbcst: %bpu\n"
"option rsbcst: %bpu\n"
#endif
- "option rsbcmt: %bpu\n"
- "option rmbcmt: %bpu\n"
- "option mmbcs: %bpu\n"
+ "option rsbcmt: %beu\n"
+ "option rmbcmt: %beu\n"
+ "option mmbcs: %beu\n"
#if HAVE_ERTS_MSEG
- "option mmsbc: %bpu\n"
- "option mmmbc: %bpu\n"
+ "option mmsbc: %beu\n"
+ "option mmmbc: %beu\n"
#endif
- "option lmbcs: %bpu\n"
- "option smbcs: %bpu\n"
- "option mbcgs: %bpu\n",
+ "option lmbcs: %beu\n"
+ "option smbcs: %beu\n"
+ "option mbcgs: %beu\n",
topt,
allctr->ramv ? "true" : "false",
allctr->sbc_threshold,
@@ -2292,9 +2292,9 @@ erts_alcu_au_info_options(int *print_to_p, void *print_to_arg,
erts_print(*print_to_p,
print_to_arg,
#if HAVE_ERTS_MSEG
- "option mmc: %bpu\n"
+ "option mmc: %beu\n"
#endif
- "option ycs: %bpu\n",
+ "option ycs: %beu\n",
#if HAVE_ERTS_MSEG
max_mseg_carriers,
#endif
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 71206c48b2..e50fc18e64 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -71,9 +71,9 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE
#endif
#endif
#ifdef ERTS_SMP
- " [smp:%bpu:%bpu]"
+ " [smp:%beu:%beu]"
#endif
- " [rq:%bpu]"
+ " [rq:%beu]"
#ifdef USE_THREADS
" [async-threads:%d]"
#endif
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 6f8a7436d5..0174e5fc43 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -177,7 +177,6 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
byte* LSB;
byte* MSB;
Uint* hp;
- Uint* hp_end;
Uint words_needed;
Uint actual;
Uint v32;
@@ -405,7 +404,6 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
default:
words_needed = 1+WSIZE(bytes);
hp = HeapOnlyAlloc(p, words_needed);
- hp_end = hp + words_needed;
res = bytes_to_big(LSB, bytes, sgn, hp);
if (is_small(res)) {
p->htop = hp;
@@ -425,7 +423,6 @@ Eterm
erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb)
{
ErlSubBin* sb;
- size_t num_bytes; /* Number of bytes in binary. */
if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */
return THE_NON_VALUE;
@@ -435,7 +432,6 @@ erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffe
* From now on, we can't fail.
*/
- num_bytes = NBYTES(num_bits);
sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE);
sb->thing_word = HEADER_SUB_BIN;
@@ -1557,7 +1553,6 @@ Uint32
erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb)
{
Uint bytes;
- Uint bits;
Uint offs;
byte bigbuf[4];
byte* LSB;
@@ -1567,7 +1562,6 @@ erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb)
ASSERT(mb->size - mb->offset >= 32);
bytes = 4;
- bits = 8;
offs = 0;
LSB = bigbuf;
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 61e8a595be..e0a6aa05c6 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -3737,7 +3737,7 @@ static void print_table(int to, void *to_arg, int show, DbTable* tb)
erts_print(to, to_arg, "Objects: %d\n", (int)erts_smp_atomic_read(&tb->common.nitems));
erts_print(to, to_arg, "Words: %bpu\n",
- (Uint) ((erts_smp_atomic_read(&tb->common.memory_size)
+ (UWord) ((erts_smp_atomic_read(&tb->common.memory_size)
+ sizeof(Uint)
- 1)
/ sizeof(Uint)));
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 6cdbec3213..a59c0c258d 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -575,7 +575,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
return DB_ERROR_NONE;
}
-static ERTS_INLINE int cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base,
+static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base,
TreeDbTerm* obj)
{
return cmp_rel(key, key_base,
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 0b63ab9ba0..c3b074f782 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -5046,31 +5046,31 @@ void db_match_dis(Binary *bp)
++t;
n = *t;
++t;
- erts_printf("TryMeElse\t%bpu\n", n);
+ erts_printf("TryMeElse\t%beu\n", n);
break;
case matchArray:
++t;
n = *t;
++t;
- erts_printf("Array\t%bpu\n", n);
+ erts_printf("Array\t%beu\n", n);
break;
case matchArrayBind:
++t;
n = *t;
++t;
- erts_printf("ArrayBind\t%bpu\n", n);
+ erts_printf("ArrayBind\t%beu\n", n);
break;
case matchTuple:
++t;
n = *t;
++t;
- erts_printf("Tuple\t%bpu\n", n);
+ erts_printf("Tuple\t%beu\n", n);
break;
case matchPushT:
++t;
n = *t;
++t;
- erts_printf("PushT\t%bpu\n", n);
+ erts_printf("PushT\t%beu\n", n);
break;
case matchPushL:
++t;
@@ -5084,13 +5084,13 @@ void db_match_dis(Binary *bp)
++t;
n = *t;
++t;
- erts_printf("Bind\t%bpu\n", n);
+ erts_printf("Bind\t%beu\n", n);
break;
case matchCmp:
++t;
n = *t;
++t;
- erts_printf("Cmp\t%bpu\n", n);
+ erts_printf("Cmp\t%beu\n", n);
break;
case matchEqBin:
++t;
@@ -5112,9 +5112,9 @@ void db_match_dis(Binary *bp)
else
erts_printf(", ");
#if defined(ARCH_64) && !HALFWORD_HEAP
- erts_printf("0x%016bpx", rt->data.ui[ri]);
+ erts_printf("0x%016bex", rt->data.ui[ri]);
#else
- erts_printf("0x%08bpx", rt->data.ui[ri]);
+ erts_printf("0x%08bex", rt->data.ui[ri]);
#endif
}
}
@@ -5136,9 +5136,9 @@ void db_match_dis(Binary *bp)
else
erts_printf(", ");
#if defined(ARCH_64) && !HALFWORD_HEAP
- erts_printf("0x%016bpx", *et);
+ erts_printf("0x%016bex", *et);
#else
- erts_printf("0x%08bpx", *et);
+ erts_printf("0x%08bex", *et);
#endif
++et;
}
@@ -5190,31 +5190,31 @@ void db_match_dis(Binary *bp)
++t;
n = *t;
++t;
- erts_printf("MkTuple\t%bpu\n", n);
+ erts_printf("MkTuple\t%beu\n", n);
break;
case matchOr:
++t;
n = *t;
++t;
- erts_printf("Or\t%bpu\n", n);
+ erts_printf("Or\t%beu\n", n);
break;
case matchAnd:
++t;
n = *t;
++t;
- erts_printf("And\t%bpu\n", n);
+ erts_printf("And\t%beu\n", n);
break;
case matchOrElse:
++t;
n = *t;
++t;
- erts_printf("OrElse\t%bpu\n", n);
+ erts_printf("OrElse\t%beu\n", n);
break;
case matchAndAlso:
++t;
n = *t;
++t;
- erts_printf("AndAlso\t%bpu\n", n);
+ erts_printf("AndAlso\t%beu\n", n);
break;
case matchCall0:
++t;
@@ -5244,19 +5244,19 @@ void db_match_dis(Binary *bp)
++t;
n = (Uint) *t;
++t;
- erts_printf("PushV\t%bpu\n", n);
+ erts_printf("PushV\t%beu\n", n);
break;
#if HALFWORD_HEAP
case matchPushVGuard:
n = (Uint) *++t;
++t;
- erts_printf("PushVGuard\t%bpu\n", n);
+ erts_printf("PushVGuard\t%beu\n", n);
break;
#endif
case matchPushVResult:
n = (Uint) *++t;
++t;
- erts_printf("PushVResult\t%bpu\n", n);
+ erts_printf("PushVResult\t%beu\n", n);
break;
case matchTrue:
++t;
@@ -5367,8 +5367,8 @@ void db_match_dis(Binary *bp)
}
erts_printf("}\n");
erts_printf("num_bindings: %d\n", prog->num_bindings);
- erts_printf("heap_size: %bpu\n", prog->heap_size);
- erts_printf("stack_offset: %bpu\n", prog->stack_offset);
+ erts_printf("heap_size: %beu\n", prog->heap_size);
+ erts_printf("stack_offset: %beu\n", prog->stack_offset);
erts_printf("text: 0x%08x\n", (unsigned long) prog->text);
erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset);
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index d9150d86fe..c30d67ac88 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -455,7 +455,6 @@ erts_garbage_collect_hibernate(Process* p)
Eterm* heap;
Eterm* htop;
Rootset rootset;
- int n;
char* src;
Uint src_size;
Uint actual_size;
@@ -486,7 +485,7 @@ erts_garbage_collect_hibernate(Process* p)
sizeof(Eterm)*heap_size);
htop = heap;
- n = setup_rootset(p, p->arg_reg, p->arity, &rootset);
+ (void) setup_rootset(p, p->arg_reg, p->arity, &rootset);
#if HIPE
hipe_empty_nstack(p);
#endif
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 135c6b0ccc..8b48444904 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -430,6 +430,11 @@ int enif_is_list(ErlNifEnv* env, ERL_NIF_TERM term)
return is_list(term) || is_nil(term);
}
+int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)
+{
+ return term == THE_NON_VALUE;
+}
+
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.h b/erts/emulator/beam/erl_nif.h
index 8050b3640a..d028567faf 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -31,9 +31,10 @@
** 1.0: R13B04
** 2.0: R14A
** 2.1: R14B02 "vm_variant"
+** 2.2: R14B03 enif_is_exception
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 1
+#define ERL_NIF_MINOR_VERSION 2
#include <stdlib.h>
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index eca506593d..c991b61abe 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2009-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,6 +21,13 @@
# error This file should not be included directly
#endif
+/*
+** WARNING: add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list
+** to keep compatibility on Windows!!!
+**
+** And don't forget to increase ERL_NIF_MINOR_VERSION in erl_nif.h
+** when adding functions to the API.
+*/
#ifdef ERL_NIF_API_FUNC_DECL
ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*));
ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size));
@@ -128,12 +135,17 @@ ERL_NIF_API_FUNC_DECL(int,enif_get_uint64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNif
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64));
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));
/*
-** Add last to keep compatibility on Windows!!!
+** Add new entries here to keep compatibility on Windows!!!
*/
#endif
+/*
+** Please keep the ERL_NIF_API_FUNC_MACRO list below in the same order
+** as the ERL_NIF_API_FUNC_DECL list above
+*/
#ifdef ERL_NIF_API_FUNC_MACRO
# define enif_priv_data ERL_NIF_API_FUNC_MACRO(enif_priv_data)
# define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc)
@@ -243,6 +255,11 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64));
# define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64)
#endif
+# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception)
+
+/*
+** Add new entries here
+*/
#endif
#ifndef enif_make_list1
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index f8997f3c07..31f23d3978 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -1267,7 +1267,6 @@ ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi)
static void
wake_scheduler(ErtsRunQueue *rq, int incq, int one)
{
- int res;
ErtsSchedulerSleepInfo *ssi;
ErtsSchedulerSleepList *sl;
@@ -1298,7 +1297,6 @@ wake_scheduler(ErtsRunQueue *rq, int incq, int one)
if (ssi->next)
ssi->next->prev = ssi->prev;
- res = sl->list != NULL;
erts_smp_spin_unlock(&sl->lock);
ERTS_THR_MEMORY_BARRIER;
@@ -2857,7 +2855,6 @@ resume_process(Process *p)
return;
switch(p->rstatus) {
case P_RUNABLE:
- *statusp = P_WAITING; /* make erts_add_to_runq work */
erts_add_to_runq(p);
break;
case P_WAITING:
@@ -3668,7 +3665,7 @@ sched_thread_func(void *vesdp)
#ifdef ERTS_ENABLE_LOCK_CHECK
{
char buf[31];
- erts_snprintf(&buf[0], 31, "scheduler %bpu", no);
+ erts_snprintf(&buf[0], 31, "scheduler %beu", no);
erts_lc_set_thread_name(&buf[0]);
}
#endif
@@ -3726,7 +3723,7 @@ sched_thread_func(void *vesdp)
process_main();
/* No schedulers should *ever* terminate */
- erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %bpu terminated\n",
+ erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %beu terminated\n",
((ErtsSchedulerData *) vesdp)->no);
return NULL;
}
@@ -3775,8 +3772,8 @@ erts_start_schedulers(void)
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
ASSERT(actual != wanted_no_schedulers);
erts_dsprintf(dsbufp,
- "Failed to create %bpu scheduler-threads (%s:%d); "
- "only %bpu scheduler-thread%s created.\n",
+ "Failed to create %beu scheduler-threads (%s:%d); "
+ "only %beu scheduler-thread%s created.\n",
wanted_no_schedulers, erl_errno_id(res), res,
actual, actual == 1 ? " was" : "s were");
erts_send_error_to_logger_nogl(dsbufp);
@@ -4653,7 +4650,7 @@ internal_add_to_runq(ErtsRunQueue *runq, Process *p)
if (p->status_flags & ERTS_PROC_SFLG_INRUNQ)
return NULL;
else if (p->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) {
- ASSERT(p->status != P_SUSPENDED);
+ ASSERT(p->rcount == 0);
ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p);
p->status_flags |= ERTS_PROC_SFLG_PENDADD2SCHEDQ;
return NULL;
@@ -4664,9 +4661,8 @@ internal_add_to_runq(ErtsRunQueue *runq, Process *p)
ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p);
#ifndef ERTS_SMP
/* Never schedule a suspended process (ok in smp case) */
- ASSERT(p->status != P_SUSPENDED);
+ ASSERT(p->rcount == 0);
add_runq = runq;
-
#else
ASSERT(!p->bound_runq || p->bound_runq == p->run_queue);
if (p->bound_runq) {
@@ -5166,7 +5162,7 @@ Process *schedule(Process *p, int calls)
handle_pending_suspend(p,
ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
ASSERT(!(p->status_flags & ERTS_PROC_SFLG_PENDADD2SCHEDQ)
- || p->status != P_SUSPENDED);
+ || p->rcount == 0);
}
#endif
erts_smp_runq_lock(rq);
@@ -7611,10 +7607,28 @@ timeout_proc(Process* p)
p->flags |= F_TIMO;
p->flags &= ~F_INSLPQUEUE;
- if (p->status == P_WAITING)
- erts_add_to_runq(p);
- if (p->status == P_SUSPENDED)
+ switch (p->status) {
+ case P_GARBING:
+ switch (p->gcstatus) {
+ case P_SUSPENDED:
+ goto suspended;
+ case P_WAITING:
+ goto waiting;
+ default:
+ break;
+ }
+ break;
+ case P_WAITING:
+ waiting:
+ erts_add_to_runq(p);
+ break;
+ case P_SUSPENDED:
+ suspended:
p->rstatus = P_RUNABLE; /* MUST set resume status to runnable */
+ break;
+ default:
+ break;
+ }
}
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 8f78a7d76e..334ae5573f 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -895,6 +895,7 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
#define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */
#define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */
#define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */
+#define F_HIBERNATE_SCHED (1 << 11) /* Schedule out after hibernate op */
/* process trace_flags */
#define F_SENSITIVE (1 << 0)
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 68fda01597..5410bcd495 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -194,7 +194,7 @@ dump_element(int to, void *to_arg, Eterm x)
} else if (is_pid(x)) {
erts_print(to, to_arg, "P%T", x);
} else if (is_port(x)) {
- erts_print(to, to_arg, "p<%bpu.%bpu>",
+ erts_print(to, to_arg, "p<%beu.%beu>",
port_channel_no(x), port_number(x));
} else if (is_nil(x)) {
erts_putc(to, to_arg, 'N');
@@ -376,7 +376,7 @@ heap_dump(int to, void *to_arg, Eterm x)
erts_print(to, to_arg, "P%T\n", x);
*ptr = OUR_NIL;
} else if (is_external_port_header(hdr)) {
- erts_print(to, to_arg, "p<%bpu.%bpu>\n",
+ erts_print(to, to_arg, "p<%beu.%beu>\n",
port_channel_no(x), port_number(x));
*ptr = OUR_NIL;
} else {
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 545b345a71..dacf228e92 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -902,7 +902,6 @@ static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,int pos,
static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
{
Eterm *real_bin;
- Sint need;
byte* bytes;
Eterm rest_term;
int left, sleft;
@@ -918,7 +917,6 @@ static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
ASSERT(is_binary(BIF_ARG_1));
real_bin = binary_val(BIF_ARG_1);
ASSERT(*real_bin == HEADER_PROC_BIN);
- need = ((ProcBin *) real_bin)->val->orig_size;
pos = (int) binary_size(BIF_ARG_1);
bytes = binary_bytes(BIF_ARG_1);
sleft = left = allowed_iterations(BIF_P);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 432bdd705b..96da894d90 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1828,7 +1828,7 @@ erts_alloc_message_heap(Uint size,
#endif
if (size > (Uint) INT_MAX)
- erl_exit(ERTS_ABORT_EXIT, "HUGE size (%bpu)\n", size);
+ erl_exit(ERTS_ABORT_EXIT, "HUGE size (%beu)\n", size);
if (
#if defined(ERTS_SMP)
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index f21a96c754..f619c6f88b 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-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
@@ -1226,7 +1226,6 @@ void init_io(void)
{
int i;
ErlDrvEntry** dp;
- ErlDrvEntry* drv;
char maxports[21]; /* enough for any 64-bit integer */
size_t maxportssize = sizeof(maxports);
Uint ports_bits = ERTS_PORTS_BITS;
@@ -1309,10 +1308,8 @@ void init_io(void)
init_driver(&fd_driver, &fd_driver_entry, NULL);
init_driver(&vanilla_driver, &vanilla_driver_entry, NULL);
init_driver(&spawn_driver, &spawn_driver_entry, NULL);
- for (dp = driver_tab; *dp != NULL; dp++) {
- drv = *dp;
+ for (dp = driver_tab; *dp != NULL; dp++)
erts_add_driver_entry(*dp, NULL, 1);
- }
erts_smp_tsd_set(driver_list_lock_status_key, NULL);
erts_smp_mtx_unlock(&erts_driver_list_lock);
@@ -2420,7 +2417,7 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len)
if (len > (Uint) INT_MAX)
erl_exit(ERTS_ABORT_EXIT,
- "Absurdly large data buffer (%bpu bytes) passed to"
+ "Absurdly large data buffer (%beu bytes) passed to"
"output callback of %s driver.\n",
len,
p->drv_ptr->name ? p->drv_ptr->name : "unknown");
@@ -3670,7 +3667,7 @@ driver_pdl_inc_refc(ErlDrvPDL pdl)
{
ErlDrvSInt refc = pdl_inctest_refc(pdl);
#ifdef HARDDEBUG
- erts_fprintf(stderr, "driver_pdl_inc_refc(%p) -> %bpd\r\n",
+ erts_fprintf(stderr, "driver_pdl_inc_refc(%p) -> %bed\r\n",
pdl, refc);
#endif
return refc;
diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c
index c7b608aafe..7ca11f8c6c 100644
--- a/erts/emulator/hipe/hipe_debug.c
+++ b/erts/emulator/hipe/hipe_debug.c
@@ -51,7 +51,7 @@ static const char stars[2*sizeof(long)+5] = {
extern Uint beam_apply[];
-static void print_beam_pc(Uint *pc)
+static void print_beam_pc(BeamInstr *pc)
{
if (pc == hipe_beam_pc_return) {
printf("return-to-native");
@@ -60,7 +60,7 @@ static void print_beam_pc(Uint *pc)
} else if (pc == &beam_apply[1]) {
printf("normal-process-exit");
} else {
- Eterm *mfa = find_function_from_pc(pc);
+ BeamInstr *mfa = find_function_from_pc(pc);
if (mfa)
erts_printf("%T:%T/%bpu + 0x%bpx",
mfa[0], mfa[1], mfa[2], pc - &mfa[3]);
@@ -71,7 +71,7 @@ static void print_beam_pc(Uint *pc)
static void catch_slot(Eterm *pos, Eterm val)
{
- Uint *pc = catch_pc(val);
+ BeamInstr *pc = catch_pc(val);
printf(" | 0x%0*lx | 0x%0*lx | CATCH 0x%0*lx (BEAM ",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)val,
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index ceb290b644..ffa3a6328c 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -1092,10 +1092,10 @@ info_options(char *prefix,
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "%samcbf: %bpu\n", prefix, abs_max_cache_bad_fit);
- erts_print(to, arg, "%srmcbf: %bpu\n", prefix, rel_max_cache_bad_fit);
- erts_print(to, arg, "%smcs: %bpu\n", prefix, max_cache_size);
- erts_print(to, arg, "%scci: %bpu\n", prefix, cache_check_interval);
+ erts_print(to, arg, "%samcbf: %beu\n", prefix, abs_max_cache_bad_fit);
+ erts_print(to, arg, "%srmcbf: %beu\n", prefix, rel_max_cache_bad_fit);
+ erts_print(to, arg, "%smcs: %beu\n", prefix, max_cache_size);
+ erts_print(to, arg, "%scci: %beu\n", prefix, cache_check_interval);
}
if (hpp || szp) {
@@ -1131,9 +1131,9 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
#define PRINT_CC(TO, TOA, CC) \
if (calls.CC.giga_no == 0) \
- erts_print(TO, TOA, "mseg_%s calls: %bpu\n", #CC, calls.CC.no); \
+ erts_print(TO, TOA, "mseg_%s calls: %b32u\n", #CC, calls.CC.no); \
else \
- erts_print(TO, TOA, "mseg_%s calls: %bpu%09bpu\n", #CC, \
+ erts_print(TO, TOA, "mseg_%s calls: %b32u%09b32u\n", #CC, \
calls.CC.giga_no, calls.CC.no)
int to = *print_to_p;
@@ -1215,13 +1215,13 @@ info_status(MemKind* mk, int *print_to_p, void *print_to_arg,
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "cached_segments: %bpu\n", mk->cache_size);
- erts_print(to, arg, "cache_hits: %bpu\n", mk->cache_hits);
- erts_print(to, arg, "segments: %bpu %bpu %bpu\n",
+ erts_print(to, arg, "cached_segments: %beu\n", mk->cache_size);
+ erts_print(to, arg, "cache_hits: %beu\n", mk->cache_hits);
+ erts_print(to, arg, "segments: %beu %beu %beu\n",
mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no);
- erts_print(to, arg, "segments_size: %bpu %bpu %bpu\n",
+ erts_print(to, arg, "segments_size: %beu %beu %beu\n",
mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz);
- erts_print(to, arg, "segments_watermark: %bpu\n",
+ erts_print(to, arg, "segments_watermark: %beu\n",
mk->segments.current.watermark);
}
@@ -1507,7 +1507,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
while ((page_size >> page_shift) != 1) {
if ((page_size & (1 << (page_shift - 1))) != 0)
erl_exit(ERTS_ABORT_EXIT,
- "erts_mseg: Unexpected page_size %bpu\n", page_size);
+ "erts_mseg: Unexpected page_size %beu\n", page_size);
page_shift++;
}
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index b79c30d8d9..91d695d979 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -1121,7 +1121,14 @@ 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">>]}),
+ try
+ ?line error = check_is_exception(),
+ ?line throw(expected_badarg)
+ catch
+ error:badarg ->
+ ?line ok
+ end.
get_length(doc) -> ["Test all enif_get_length functions"];
get_length(Config) when is_list(Config) ->
@@ -1245,6 +1252,7 @@ release_resource(_) -> ?nif_stub.
last_resource_dtor_call() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
+check_is_exception() -> ?nif_stub.
length_test(_,_,_,_,_) -> ?nif_stub.
make_atoms() -> ?nif_stub.
make_strings() -> ?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 8489124966..dc047394b5 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -802,6 +802,23 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
}
/*
+ * no arguments
+ *
+ * This function is separate from check_is because it calls enif_make_badarg
+ * and so it must return the badarg exception as its return value. Thus, the
+ * badarg exception indicates success. Failure is indicated by returning an
+ * error atom.
+ */
+static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM error_atom = enif_make_atom(env, "error");
+ ERL_NIF_TERM badarg = enif_make_badarg(env);
+ if (enif_is_exception(env, error_atom)) return error_atom;
+ if (!enif_is_exception(env, badarg)) return error_atom;
+ return badarg;
+}
+
+/*
* argv[0] atom with length of 6
* argv[1] list with length of 6
* argv[2] empty list
@@ -1383,6 +1400,7 @@ static ErlNifFunc nif_funcs[] =
{"last_resource_dtor_call", 0, last_resource_dtor_call},
{"make_new_resource", 2, make_new_resource},
{"check_is", 10, check_is},
+ {"check_is_exception", 0, check_is_exception},
{"length_test", 5, length_test},
{"make_atoms", 0, make_atoms},
{"make_strings", 0, make_strings},
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index a731f09e4c..36bae908aa 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -39,6 +39,7 @@
process_info_other_dist_msg/1,
process_info_2_list/1, process_info_lock_reschedule/1,
process_info_lock_reschedule2/1,
+ process_info_lock_reschedule3/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
process_status_exiting/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
@@ -65,7 +66,8 @@ all() ->
t_process_info, process_info_other_msg,
process_info_other_dist_msg, process_info_2_list,
process_info_lock_reschedule,
- process_info_lock_reschedule2, process_status_exiting,
+ process_info_lock_reschedule2,
+ process_info_lock_reschedule3, process_status_exiting,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -702,6 +704,52 @@ process_info_lock_reschedule2(Config) when is_list(Config) ->
?line unlink(P6), exit(P6, bang),
?line ok.
+many_args(0,_B,_C,_D,_E,_F,_G,_H,_I,_J) ->
+ ok;
+many_args(A,B,C,D,E,F,G,H,I,J) ->
+ many_args(A-1,B,C,D,E,F,G,H,I,J).
+
+do_pi_msg_len(PT, AT) ->
+ lists:map(fun (_) -> ok end, [a,b,c,d]),
+ {message_queue_len, _} = process_info(element(2,PT), element(2,AT)).
+
+process_info_lock_reschedule3(doc) ->
+ [];
+process_info_lock_reschedule3(suite) ->
+ [];
+process_info_lock_reschedule3(Config) when is_list(Config) ->
+ %% We need a process that is running and an item that requires
+ %% process_info to take the main process lock.
+ ?line Target1 = spawn_link(fun tok_loop/0),
+ ?line Name1 = process_info_lock_reschedule_running,
+ ?line register(Name1, Target1),
+ ?line Target2 = spawn_link(fun () -> receive after infinity -> ok end end),
+ ?line Name2 = process_info_lock_reschedule_waiting,
+ ?line register(Name2, Target2),
+ ?line PI = fun(N) ->
+ case N rem 10 of
+ 0 -> erlang:yield();
+ _ -> ok
+ end,
+ ?line do_pi_msg_len({proc, Target1},
+ {arg, message_queue_len})
+ end,
+ ?line many_args(100000,1,2,3,4,5,6,7,8,9),
+ ?line lists:foreach(PI, lists:seq(1,1000000)),
+ %% Make sure Target1 still is willing to "tok loop"
+ ?line case process_info(Target1, status) of
+ {status, OkStatus} when OkStatus == runnable;
+ OkStatus == running;
+ OkStatus == garbage_collecting ->
+ ?line unlink(Target1),
+ ?line unlink(Target2),
+ ?line exit(Target1, bang),
+ ?line exit(Target2, bang),
+ ?line OkStatus;
+ {status, BadStatus} ->
+ ?line ?t:fail(BadStatus)
+ end.
+
process_status_exiting(Config) when is_list(Config) ->
%% Make sure that erts_debug:get_internal_state({process_status,P})
%% returns exiting if it is in status P_EXITING.
diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c
index e94533f0ba..a1f202251c 100644
--- a/erts/epmd/src/epmd.c
+++ b/erts/epmd/src/epmd.c
@@ -33,6 +33,7 @@
static void usage(EpmdVars *);
static void run_daemon(EpmdVars*);
+static char* get_addresses(void);
static int get_port_no(void);
static int check_relaxed(void);
#ifdef __WIN32__
@@ -133,6 +134,7 @@ int main(int argc, char** argv)
{
EpmdVars g_empd_vars;
EpmdVars *g = &g_empd_vars;
+ int i;
#ifdef __WIN32__
WORD wVersionRequested;
WSADATA wsaData;
@@ -158,8 +160,9 @@ int main(int argc, char** argv)
g->argv = NULL;
#endif
- g->port = get_port_no();
- g->debug = 0;
+ g->addresses = get_addresses();
+ g->port = get_port_no();
+ g->debug = 0;
g->silent = 0;
g->is_daemon = 0;
@@ -168,12 +171,14 @@ int main(int argc, char** argv)
g->delay_accept = 0;
g->delay_write = 0;
g->progname = argv[0];
- g->listenfd = -1;
g->conn = NULL;
g->nodes.reg = g->nodes.unreg = g->nodes.unreg_tail = NULL;
g->nodes.unreg_count = 0;
g->active_conn = 0;
+ for (i = 0; i < MAX_LISTEN_SOCKETS; i++)
+ g->listenfd[i] = -1;
+
argc--;
argv++;
while (argc > 0) {
@@ -208,6 +213,11 @@ int main(int argc, char** argv)
else
usage(g);
epmd_cleanup_exit(g,0);
+ } else if (strcmp(argv[0], "-address") == 0) {
+ if (argc == 1)
+ usage(g);
+ g->addresses = argv[1];
+ argv += 2; argc -= 2;
} else if (strcmp(argv[0], "-port") == 0) {
if ((argc == 1) ||
((g->port = atoi(argv[1])) == 0))
@@ -252,13 +262,10 @@ int main(int argc, char** argv)
/*
* max_conn must not be greater than FD_SETSIZE.
* (at least QNX crashes)
- *
- * More correctly, it must be FD_SETSIZE - 1, beacuse the
- * listen FD is stored outside the connection array.
*/
if (g->max_conn > FD_SETSIZE) {
- g->max_conn = FD_SETSIZE - 1;
+ g->max_conn = FD_SETSIZE;
}
if (g->is_daemon) {
@@ -393,11 +400,14 @@ static void run_daemon(EpmdVars *g)
static void usage(EpmdVars *g)
{
- fprintf(stderr, "usage: epmd [-d|-debug] [DbgExtra...] [-port No] [-daemon]\n");
- fprintf(stderr, " [-relaxed_command_check]\n");
+ fprintf(stderr, "usage: epmd [-d|-debug] [DbgExtra...] [-address List]\n");
+ fprintf(stderr, " [-port No] [-daemon] [-relaxed_command_check]\n");
fprintf(stderr, " epmd [-d|-debug] [-port No] [-names|-kill|-stop name]\n\n");
fprintf(stderr, "See the Erlang epmd manual page for info about the usage.\n\n");
fprintf(stderr, "Regular options\n");
+ fprintf(stderr, " -address List\n");
+ fprintf(stderr, " Let epmd listen only on the comma-separated list of IP\n");
+ fprintf(stderr, " addresses (and on the loopback interface).\n");
fprintf(stderr, " -port No\n");
fprintf(stderr, " Let epmd listen to another port than default %d\n",
EPMD_PORT_NO);
@@ -487,8 +497,8 @@ static void dbg_gen_printf(int onsyslog,int perr,int from_level,
(int) strlen(timestr)-1, timestr);
len = strlen(buf);
erts_vsnprintf(buf + len, DEBUG_BUFFER_SIZE - len, format, args);
- if (perr == 1)
- perror(buf);
+ if (perr != 0)
+ fprintf(stderr,"%s: %s\r\n",buf,strerror(perr));
else
fprintf(stderr,"%s\r\n",buf);
}
@@ -499,7 +509,7 @@ void dbg_perror(EpmdVars *g,const char *format,...)
{
va_list args;
va_start(args, format);
- dbg_gen_printf(1,1,0,g,format,args);
+ dbg_gen_printf(1,errno,0,g,format,args);
va_end(args);
}
@@ -555,8 +565,9 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval)
epmd_conn_close(g,&g->conn[i]);
free(g->conn);
}
- if(g->listenfd >= 0)
- close(g->listenfd);
+ for(i=0; i < MAX_LISTEN_SOCKETS; i++)
+ if(g->listenfd[i] >= 0)
+ close(g->listenfd[i]);
free_all_nodes(g);
if(g->argv){
for(i=0; g->argv[i] != NULL; ++i)
@@ -568,6 +579,10 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval)
exit(exitval);
}
+static char* get_addresses(void)
+{
+ return getenv("ERL_EPMD_ADDRESS");
+}
static int get_port_no(void)
{
char* port_str = getenv("ERL_EPMD_PORT");
diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c
index 7c60ba0420..ac55ba6bb6 100644
--- a/erts/epmd/src/epmd_cli.c
+++ b/erts/epmd/src/epmd_cli.c
@@ -137,7 +137,7 @@ static int conn_to_epmd(EpmdVars *g)
{ /* store port number in unsigned short */
unsigned short sport = g->port;
- SET_ADDR_LOOPBACK(address, FAMILY, sport);
+ SET_ADDR(address, EPMD_ADDR_LOOPBACK, sport);
}
if (connect(connect_sock, (struct sockaddr*)&address, sizeof address) < 0)
diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h
index c2558d52a1..2a0de4df9c 100644
--- a/erts/epmd/src/epmd_int.h
+++ b/erts/epmd/src/epmd_int.h
@@ -168,42 +168,40 @@
#if defined(HAVE_IN6) && defined(AF_INET6) && defined(EPMD6)
#define EPMD_SOCKADDR_IN sockaddr_in6
-#define FAMILY AF_INET6
-
-#define SET_ADDR_LOOPBACK(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin6_family = (af); \
- (addr).sin6_flowinfo = 0; \
- (addr).sin6_addr = in6addr_loopback; \
- (addr).sin6_port = htons(port); \
+#define EPMD_IN_ADDR in6_addr
+#define EPMD_S_ADDR s6_addr
+#define EPMD_ADDR_LOOPBACK in6addr_loopback.s6_addr
+#define EPMD_ADDR_ANY in6addr_any.s6_addr
+#define FAMILY AF_INET6
+
+#define SET_ADDR(dst, addr, port) do { \
+ memset((char*)&(dst), 0, sizeof(dst)); \
+ memcpy((char*)&(dst).sin6_addr.s6_addr, (char*)&(addr), 16); \
+ (dst).sin6_family = AF_INET6; \
+ (dst).sin6_flowinfo = 0; \
+ (dst).sin6_port = htons(port); \
} while(0)
-#define SET_ADDR_ANY(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin6_family = (af); \
- (addr).sin6_flowinfo = 0; \
- (addr).sin6_addr = in6addr_any; \
- (addr).sin6_port = htons(port); \
- } while(0)
+#define IS_ADDR_LOOPBACK(addr) \
+ (memcmp((addr).s6_addr, in6addr_loopback.s6_addr, 16) == 0)
#else /* Not IP v6 */
#define EPMD_SOCKADDR_IN sockaddr_in
-#define FAMILY AF_INET
-
-#define SET_ADDR_LOOPBACK(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin_family = (af); \
- (addr).sin_addr.s_addr = htonl(INADDR_LOOPBACK); \
- (addr).sin_port = htons(port); \
+#define EPMD_IN_ADDR in_addr
+#define EPMD_S_ADDR s_addr
+#define EPMD_ADDR_LOOPBACK htonl(INADDR_LOOPBACK)
+#define EPMD_ADDR_ANY htonl(INADDR_ANY)
+#define FAMILY AF_INET
+
+#define SET_ADDR(dst, addr, port) do { \
+ memset((char*)&(dst), 0, sizeof(dst)); \
+ (dst).sin_family = AF_INET; \
+ (dst).sin_addr.s_addr = (addr); \
+ (dst).sin_port = htons(port); \
} while(0)
-#define SET_ADDR_ANY(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin_family = (af); \
- (addr).sin_addr.s_addr = htonl(INADDR_ANY); \
- (addr).sin_port = htons(port); \
- } while(0)
+#define IS_ADDR_LOOPBACK(addr) ((addr).s_addr == htonl(INADDR_LOOPBACK))
#endif /* Not IP v6 */
@@ -231,6 +229,8 @@
/* Maximum length of a node name == atom name */
#define MAXSYMLEN 255
+#define MAX_LISTEN_SOCKETS 16
+
#define INBUF_SIZE 1024
#define OUTBUF_SIZE 1024
@@ -299,7 +299,8 @@ typedef struct {
Connection *conn;
Nodes nodes;
fd_set orig_read_mask;
- int listenfd;
+ int listenfd[MAX_LISTEN_SOCKETS];
+ char *addresses;
char **argv;
} EpmdVars;
diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c
index 3499ab2934..4d9b454f97 100644
--- a/erts/epmd/src/epmd_srv.c
+++ b/erts/epmd/src/epmd_srv.c
@@ -24,6 +24,10 @@
#include "epmd.h" /* Renamed from 'epmd_r4.h' */
#include "epmd_int.h"
+#ifndef INADDR_NONE
+# define INADDR_NONE 0xffffffff
+#endif
+
/*
*
* This server is a local name server for Erlang nodes. Erlang nodes can
@@ -79,91 +83,157 @@ static void print_names(EpmdVars*);
void run(EpmdVars *g)
{
- int listensock;
+ struct EPMD_SOCKADDR_IN iserv_addr[MAX_LISTEN_SOCKETS];
+ int listensock[MAX_LISTEN_SOCKETS];
+ int num_sockets;
int i;
int opt;
- struct EPMD_SOCKADDR_IN iserv_addr;
+ unsigned short sport = g->port;
node_init(g);
g->conn = conn_init(g);
dbg_printf(g,2,"try to initiate listening port %d", g->port);
-
- if ((listensock = socket(FAMILY,SOCK_STREAM,0)) < 0) {
- dbg_perror(g,"error opening stream socket");
- epmd_cleanup_exit(g,1);
- }
- g->listenfd = listensock;
+
+ if (g->addresses != NULL)
+ {
+ char *tmp;
+ char *token;
+ int loopback_ok = 0;
+
+ if ((tmp = (char *)malloc(strlen(g->addresses) + 1)) == NULL)
+ {
+ dbg_perror(g,"cannot allocate memory");
+ epmd_cleanup_exit(g,1);
+ }
+ strcpy(tmp,g->addresses);
+
+ for(token = strtok(tmp,", "), num_sockets = 0;
+ token != NULL;
+ token = strtok(NULL,", "), num_sockets++)
+ {
+ struct EPMD_IN_ADDR addr;
+#ifdef HAVE_INET_PTON
+ int ret;
+
+ if ((ret = inet_pton(FAMILY,token,&addr)) == -1)
+ {
+ dbg_perror(g,"cannot convert IP address to network format");
+ epmd_cleanup_exit(g,1);
+ }
+ else if (ret == 0)
+#elif !defined(EPMD6)
+ if ((addr.EPMD_S_ADDR = inet_addr(token)) == INADDR_NONE)
+#endif
+ {
+ dbg_tty_printf(g,0,"cannot parse IP address \"%s\"",token);
+ epmd_cleanup_exit(g,1);
+ }
+
+ if (IS_ADDR_LOOPBACK(addr))
+ loopback_ok = 1;
+
+ if (num_sockets - loopback_ok == MAX_LISTEN_SOCKETS - 1)
+ {
+ dbg_tty_printf(g,0,"cannot listen on more than %d IP addresses",
+ MAX_LISTEN_SOCKETS);
+ epmd_cleanup_exit(g,1);
+ }
+
+ SET_ADDR(iserv_addr[num_sockets],addr.EPMD_S_ADDR,sport);
+ }
+
+ free(tmp);
+
+ if (!loopback_ok)
+ {
+ SET_ADDR(iserv_addr[num_sockets],EPMD_ADDR_LOOPBACK,sport);
+ num_sockets++;
+ }
+ }
+ else
+ {
+ SET_ADDR(iserv_addr[0],EPMD_ADDR_ANY,sport);
+ num_sockets = 1;
+ }
+
+#if !defined(__WIN32__)
+ /* We ignore the SIGPIPE signal that is raised when we call write
+ twice on a socket closed by the other end. */
+ signal(SIGPIPE, SIG_IGN);
+#endif
/*
* Initialize number of active file descriptors.
* Stdin, stdout, and stderr are still open.
- * One for the listen socket.
*/
- g->active_conn = 3+1;
+ g->active_conn = 3 + num_sockets;
+ g->max_conn -= num_sockets;
+
+ FD_ZERO(&g->orig_read_mask);
+
+ for (i = 0; i < num_sockets; i++)
+ {
+ if ((listensock[i] = socket(FAMILY,SOCK_STREAM,0)) < 0)
+ {
+ dbg_perror(g,"error opening stream socket");
+ epmd_cleanup_exit(g,1);
+ }
+ g->listenfd[i] = listensock[i];
- /*
- * Note that we must not enable the SO_REUSEADDR on Windows,
- * because addresses will be reused even if they are still in use.
- */
+ /*
+ * Note that we must not enable the SO_REUSEADDR on Windows,
+ * because addresses will be reused even if they are still in use.
+ */
#if !defined(__WIN32__)
- /* We ignore the SIGPIPE signal that is raised when we call write
- twice on a socket closed by the other end. */
- signal(SIGPIPE, SIG_IGN);
-
- opt = 1; /* Set this option */
- if (setsockopt(listensock,SOL_SOCKET,SO_REUSEADDR,(char* ) &opt,
- sizeof(opt)) <0) {
- dbg_perror(g,"can't set sockopt");
- epmd_cleanup_exit(g,1);
- }
+ opt = 1;
+ if (setsockopt(listensock[i],SOL_SOCKET,SO_REUSEADDR,(char* ) &opt,
+ sizeof(opt)) <0)
+ {
+ dbg_perror(g,"can't set sockopt");
+ epmd_cleanup_exit(g,1);
+ }
#endif
- /* In rare cases select returns because there is someone
- to accept but the request is withdrawn before the
- accept function is called. We set the listen socket
- to be non blocking to prevent us from being hanging
- in accept() waiting for the next request. */
+ /* In rare cases select returns because there is someone
+ to accept but the request is withdrawn before the
+ accept function is called. We set the listen socket
+ to be non blocking to prevent us from being hanging
+ in accept() waiting for the next request. */
#if (defined(__WIN32__) || defined(NO_FCNTL))
- opt = 1;
- if (ioctl(listensock, FIONBIO, &opt) != 0) /* Gives warning in VxWorks */
+ opt = 1;
+ /* Gives warning in VxWorks */
+ if (ioctl(listensock[i], FIONBIO, &opt) != 0)
#else
- opt = fcntl(listensock, F_GETFL, 0);
- if (fcntl(listensock, F_SETFL, opt | O_NONBLOCK) == -1)
+ opt = fcntl(listensock[i], F_GETFL, 0);
+ if (fcntl(listensock[i], F_SETFL, opt | O_NONBLOCK) == -1)
#endif /* __WIN32__ || VXWORKS */
- dbg_perror(g,"failed to set non-blocking mode of listening socket %d",
- listensock);
+ dbg_perror(g,"failed to set non-blocking mode of listening socket %d",
+ listensock[i]);
- { /* store port number in unsigned short */
- unsigned short sport = g->port;
- SET_ADDR_ANY(iserv_addr, FAMILY, sport);
- }
-
- if(bind(listensock,(struct sockaddr*) &iserv_addr, sizeof(iserv_addr)) < 0 )
- {
- if (errno == EADDRINUSE)
+ if (bind(listensock[i], (struct sockaddr*) &iserv_addr[i],
+ sizeof(iserv_addr[i])) < 0)
{
- dbg_tty_printf(g,1,"there is already a epmd running at port %d",
- g->port);
- epmd_cleanup_exit(g,0);
- }
- else
- {
- dbg_perror(g,"failed to bind socket");
- epmd_cleanup_exit(g,1);
+ if (errno == EADDRINUSE)
+ {
+ dbg_tty_printf(g,1,"there is already a epmd running at port %d",
+ g->port);
+ epmd_cleanup_exit(g,0);
+ }
+ else
+ {
+ dbg_perror(g,"failed to bind socket");
+ epmd_cleanup_exit(g,1);
+ }
}
- }
-
- dbg_printf(g,2,"starting");
- if(listen(listensock, SOMAXCONN) < 0) {
- dbg_perror(g,"failed to listen on socket");
- epmd_cleanup_exit(g,1);
- }
-
- FD_ZERO(&g->orig_read_mask);
- FD_SET(listensock,&g->orig_read_mask);
+ if(listen(listensock[i], SOMAXCONN) < 0) {
+ dbg_perror(g,"failed to listen on socket");
+ epmd_cleanup_exit(g,1);
+ }
+ FD_SET(listensock[i],&g->orig_read_mask);
+ }
dbg_tty_printf(g,2,"entering the main select() loop");
@@ -200,17 +270,18 @@ void run(EpmdVars *g)
sleep(g->delay_accept);
}
- if (FD_ISSET(listensock,&read_mask)) {
- if (do_accept(g, listensock) && g->active_conn < g->max_conn) {
- /*
- * The accept() succeeded, and we have at least one file
- * descriptor still free, which means that another accept()
- * could succeed. Go do do another select(), in case there
- * are more incoming connections waiting to be accepted.
- */
- goto select_again;
+ for (i = 0; i < num_sockets; i++)
+ if (FD_ISSET(listensock[i],&read_mask)) {
+ if (do_accept(g, listensock[i]) && g->active_conn < g->max_conn) {
+ /*
+ * The accept() succeeded, and we have at least one file
+ * descriptor still free, which means that another accept()
+ * could succeed. Go do do another select(), in case there
+ * are more incoming connections waiting to be accepted.
+ */
+ goto select_again;
+ }
}
- }
/* Check all open streams marked by select for data or a
close. We also close all open sockets except ALIVE
@@ -738,6 +809,7 @@ static int conn_open(EpmdVars *g,int fd)
for (i = 0; i < g->max_conn; i++) {
if (g->conn[i].open == EPMD_FALSE) {
struct sockaddr_in si;
+ struct sockaddr_in di;
#ifdef HAVE_SOCKLEN_T
socklen_t st;
#else
@@ -758,12 +830,16 @@ static int conn_open(EpmdVars *g,int fd)
/* Determine if connection is from localhost */
if (getpeername(s->fd,(struct sockaddr*) &si,&st) ||
st < sizeof(si)) {
- /* Failure to get peername is regarder as non local host */
+ /* Failure to get peername is regarded as non local host */
s->local_peer = EPMD_FALSE;
} else {
+ /* Only 127.x.x.x and connections from the host's IP address
+ allowed, no false positives */
s->local_peer =
- ((((unsigned) ntohl(si.sin_addr.s_addr)) & 0xFF000000U) ==
- 0x7F000000U); /* Only 127.x.x.x allowed, no false positives */
+ (((((unsigned) ntohl(si.sin_addr.s_addr)) & 0xFF000000U) ==
+ 0x7F000000U) ||
+ (getsockname(s->fd,(struct sockaddr*) &di,&st) ?
+ EPMD_FALSE : si.sin_addr.s_addr == di.sin_addr.s_addr));
}
dbg_tty_printf(g,2,(s->local_peer) ? "Local peer connected" :
"Non-local peer connected");
diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c
index 778b3569c7..7a5746e630 100644
--- a/erts/etc/common/heart.c
+++ b/erts/etc/common/heart.c
@@ -727,16 +727,16 @@ static int
heart_cmd_reply(int fd, char *s)
{
struct msg m;
- int len = strlen(s) + 1; /* Include \0 */
+ int len = strlen(s);
/* if s >= MSG_BODY_SIZE, return a write
* failure immediately.
*/
- if (len > sizeof(m.fill))
+ if (len >= sizeof(m.fill))
return -1;
m.op = HEART_CMD;
- m.len = htons(len + 2); /* Include Op */
+ m.len = htons(len + 1); /* Include Op */
strcpy((char*)m.fill, s);
return write_message(fd, &m);
diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c
index 886b301997..b7c3c956c6 100644
--- a/erts/etc/unix/to_erl.c
+++ b/erts/etc/unix/to_erl.c
@@ -125,7 +125,7 @@ static void usage(char *pname)
int main(int argc, char **argv)
{
char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX];
- int i, len, wfd, rfd, result = 0;
+ int i, len, wfd, rfd;
fd_set readfds;
char buf[BUFSIZ];
char pipename[FILENAME_MAX];
@@ -367,7 +367,6 @@ int main(int argc, char **argv)
}
else {
fprintf(stderr, "Error in select.\n");
- result = -1;
break;
}
}
@@ -398,7 +397,6 @@ int main(int argc, char **argv)
close(wfd);
if (len < 0) {
fprintf(stderr, "Error in reading from stdin.\n");
- result = -1;
} else {
fprintf(stderr, "[EOF]\n\r");
}
@@ -420,7 +418,6 @@ int main(int argc, char **argv)
fprintf(stderr, "Error in writing to FIFO.\n");
close(rfd);
close(wfd);
- result = -1;
break;
}
STATUS("\" OK\r\n");
@@ -447,7 +444,6 @@ int main(int argc, char **argv)
close(wfd);
if (len < 0) {
fprintf(stderr, "Error in reading from FIFO.\n");
- result = -1;
} else
fprintf(stderr, "[End]\n\r");
break;
@@ -456,7 +452,6 @@ int main(int argc, char **argv)
if ((len=version_handshake(buf,len,wfd)) < 0) {
close(rfd);
close(wfd);
- result = -1;
break;
}
if (protocol_ver >= 1) {
@@ -475,7 +470,6 @@ int main(int argc, char **argv)
fprintf(stderr, "Error in writing to terminal.\n");
close(rfd);
close(wfd);
- result = -1;
break;
}
STATUS("\" OK\r\n");
diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c
index bd3d38e649..968d563325 100644
--- a/erts/lib_src/common/erl_printf_format.c
+++ b/erts/lib_src/common/erl_printf_format.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2005-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
@@ -27,7 +27,7 @@
* length: hh | h | l | ll | L | j | t | b<sz>
* conversion: d,i | o,u,x,X | e,E | f,F | g,G | a,A | c | s | T |
* p | n | %
- * sz: 8 | 16 | 32 | 64 | p
+ * sz: 8 | 16 | 32 | 64 | p | e
*/
/* Without this, variable argument lists break on VxWorks */
@@ -76,6 +76,18 @@
#endif
#endif
+#ifndef ERTS_SIZEOF_ETERM
+# ifdef HALFWORD_HEAP_EMULATOR
+# if SIZEOF_VOID_P == 8
+# define ERTS_SIZEOF_ETERM 4
+# else
+# error "HALFWORD_HEAP_EMULATOR only allowed on 64-bit architecture"
+# endif
+# else
+# define ERTS_SIZEOF_ETERM SIZEOF_VOID_P
+# endif
+#endif
+
#if defined(__GNUC__)
# undef inline
# define inline __inline__
@@ -520,6 +532,17 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
#error No integer datatype with the same size as 'void *' found
#endif
}
+ else if (*ptr == 'e') {
+ ptr++;
+#if SIZEOF_INT == ERTS_SIZEOF_ETERM
+#elif SIZEOF_LONG == ERTS_SIZEOF_ETERM
+ fmt |= FMTL_l;
+#elif SIZEOF_LONG_LONG == ERTS_SIZEOF_ETERM
+ fmt |= FMTL_ll;
+#else
+#error No integer datatype with the same size as Eterm found
+#endif
+ }
else {
int bits = 0;
while(isdigit((int) *ptr))
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 38a2aa53ac..3d4f674160 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -24,7 +24,7 @@
-module(ct_framework).
--export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]).
+-export([init_tc/3, end_tc/3, end_tc/4, get_suite/2, report/2, warn/1]).
-export([error_notification/4]).
-export([overview_html_header/1]).
@@ -434,6 +434,9 @@ try_set_default(Name,Key,Info,Where) ->
%%%
%%% @doc Test server framework callback, called by the test_server
%%% when a test case is finished.
+end_tc(Mod, Fun, Args) ->
+ %% Have to keep end_tc/3 for backwards compatabilty issues
+ end_tc(Mod, Fun, Args, '$end_tc_dummy').
end_tc(?MODULE,error_in_suite,_, _) -> % bad start!
ok;
end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) ->
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index 2a36fda1ea..5cc8252b99 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -651,10 +651,8 @@ add_warning(Term, Anno, Ws) ->
warning_translate_label(Term, D) when is_tuple(Term) ->
case element(1, Term) of
{label,F} ->
- case gb_trees:lookup(F, D) of
- none -> Term;
- {value,FA} -> setelement(1, Term, FA)
- end;
+ FA = gb_trees:get(F, D),
+ setelement(1, Term, FA);
_ -> Term
end;
warning_translate_label(Term, _) -> Term.
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index bb93110176..8e96569414 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -162,14 +162,11 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% We must split the basic block when we encounter instructions with labels,
%% such as catches and BIFs. All labels must be visible outside the blocks.
-%% Also remove empty blocks.
split_blocks({function,Name,Arity,CLabel,Is0}) ->
Is = split_blocks(Is0, []),
{function,Name,Arity,CLabel,Is}.
-split_blocks([{block,[]}|Is], Acc) ->
- split_blocks(Is, Acc);
split_blocks([{block,Bl}|Is], Acc0) ->
Acc = split_block(Bl, [], Acc0),
split_blocks(Is, Acc);
@@ -246,30 +243,24 @@ forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) ->
D = update_value_dict(List, Reg, D0),
forward(Is, D, Lc, [I|Acc]);
forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) ->
+ %% Assumption: The target labels in a select_val/3 instruction
+ %% cannot be reached in any other way than through the select_val/3
+ %% instruction (i.e. there can be no fallthrough to such label and
+ %% it cannot be referenced by, for example, a jump/1 instruction).
Block = case gb_trees:lookup({Lbl,Dst}, D) of
- {value,Lit} ->
- %% The move instruction seems to be redundant, but also make
- %% sure that the instruction preceeding the label
- %% cannot fall through to the move instruction.
- case is_unreachable_after(Acc) of
- false -> Blk; %Must keep move instruction.
- true -> {block,BlkIs} %Safe to remove move instruction.
- end;
- _ -> Blk %Keep move instruction.
+ {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction.
+ _ -> Blk %Must keep move instruction.
end,
forward([Block|Is], D, Lc, [LblI|Acc]);
forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) ->
+ %% Assumption: The target labels in a select_val/3 instruction
+ %% cannot be reached in any other way than through the select_val/3
+ %% instruction (i.e. there can be no fallthrough to such label and
+ %% it cannot be referenced by, for example, a jump/1 instruction).
Is = case gb_trees:lookup({Lbl,Dst}, D) of
- {value,Lit} ->
- %% The move instruction seems to be redundant, but also make
- %% sure that the instruction preceeding the label
- %% cannot fall through to the move instruction.
- case is_unreachable_after(Acc) of
- false -> Is0; %Must keep move instruction.
- true -> Is1 %Safe to remove move instruction.
- end;
- _ -> Is0 %Keep move instruction.
- end,
+ {value,Lit} -> Is1; %Safe to remove move instruction.
+ _ -> Is0 %Keep move instruction.
+ end,
forward(Is, D, Lc, [LblI|Acc]);
forward([{test,is_eq_exact,_,[Dst,Src]}=I,
{block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) ->
@@ -299,16 +290,12 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) ->
Key = {Lbl,Reg},
D = case gb_trees:lookup(Key, D0) of
none -> gb_trees:insert(Key, Lit, D0); %New.
- {value,Lit} -> D0; %Already correct.
{value,inconsistent} -> D0; %Inconsistent.
{value,_} -> gb_trees:update(Key, inconsistent, D0)
end,
update_value_dict(T, Reg, D);
update_value_dict([], _, D) -> D.
-is_unreachable_after([I|_]) ->
- beam_jump:is_unreachable_after(I).
-
%%%
%%% Scan instructions in reverse execution order and remove dead code.
%%%
@@ -602,16 +589,11 @@ count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) ->
count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) ->
%% The save point we are looking for - we are done.
Bits;
-count_bits_matched([{bs_save2,_,_}|Is], SavePoint, Bits) ->
- %% Another save point - keep counting.
- count_bits_matched(Is, SavePoint, Bits);
count_bits_matched([_|_], _, Bits) -> Bits.
shortcut_bs_pos_used(To, Reg, D) ->
shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D).
-shortcut_bs_pos_used_1([{bs_restore2,Reg,_}|_], Reg, _) ->
- false;
shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) ->
false;
shortcut_bs_pos_used_1(Is, Reg, D) ->
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index cab22e03d0..f7388f1614 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -28,7 +28,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(andor_SUITE),
+ test_lib:recompile(?MODULE),
[t_case, t_and_or, t_andalso, t_orelse, inside, overlap,
combined, in_case, before_and_inside_if].
diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl
index c517c4465e..25f8a8dfb5 100644
--- a/lib/compiler/test/apply_SUITE.erl
+++ b/lib/compiler/test/apply_SUITE.erl
@@ -28,7 +28,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(apply_SUITE),
+ test_lib:recompile(?MODULE),
[mfa, fun_apply].
groups() ->
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index fc88ebeb41..556dc54a8f 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -46,7 +46,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(beam_validator_SUITE),
+ test_lib:recompile(?MODULE),
[beam_files, compiler_bug, stupid_but_valid, xrange,
yrange, stack, call_last, merge_undefined, uninit,
unsafe_catch, dead_code, mult_labels,
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index 30c04f80cf..d39e340429 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -32,7 +32,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_bincomp_SUITE),
+ test_lib:recompile(?MODULE),
[byte_aligned, bit_aligned, extended_byte_aligned,
extended_bit_aligned, mixed, filters, trim_coverage,
nomatch, sizes, tail].
diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl
index 8be0c4196a..30276f1259 100644
--- a/lib/compiler/test/bs_bit_binaries_SUITE.erl
+++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl
@@ -33,7 +33,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_bit_binaries_SUITE),
+ test_lib:recompile(?MODULE),
[misc, horrid_match, test_bitstr, test_bit_size,
asymmetric_tests, big_asymmetric_tests,
binary_to_and_from_list, big_binary_to_and_from_list,
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index c430b12b70..31c7890f26 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -35,7 +35,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_construct_SUITE),
+ test_lib:recompile(?MODULE),
[two, test1, fail, float_bin, in_guard, in_catch,
nasty_literals, side_effect, opt, otp_7556, float_arith,
otp_8054].
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 9184e14cb2..6a795f6634 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -35,7 +35,7 @@
match_string/1,zero_width/1,bad_size/1,haystack/1,
cover_beam_bool/1]).
--export([coverage_id/1]).
+-export([coverage_id/1,coverage_external_ignore/2]).
-include_lib("test_server/include/test_server.hrl").
@@ -43,7 +43,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_match_SUITE),
+ test_lib:recompile(?MODULE),
[fun_shadow, int_float, otp_5269, null_fields, wiger,
bin_tail, save_restore, shadowed_size_var,
partitioned_bs_match, function_clause, unit,
@@ -585,13 +585,17 @@ coverage(Config) when is_list(Config) ->
A+B
end, 0, [a,b,c])),
+ ?line {<<42.0:64/float>>,float} = coverage_build(<<>>, <<42>>, float),
?line {<<>>,not_a_tuple} = coverage_build(<<>>, <<>>, not_a_tuple),
?line {<<16#76,"abc",16#A9,"abc">>,{x,42,43}} =
coverage_build(<<>>, <<16#7,16#A>>, {x,y,z}),
+ ?line [<<2>>,<<1>>] = coverage_bc(<<1,2>>, []),
+
?line {x,<<"abc">>,z} = coverage_setelement(<<2,"abc">>, {x,y,z}),
?line [42] = coverage_apply(<<42>>, [coverage_id]),
+ ?line 42 = coverage_external(<<42>>),
?line do_coverage_bin_to_term_list([]),
?line do_coverage_bin_to_term_list([lists:seq(0, 10),{a,b,c},<<23:42>>]),
@@ -608,6 +612,10 @@ coverage_fold(Fun, Acc, <<H,T/binary>>) ->
coverage_fold(Fun, Fun(IdFun(H), IdFun(Acc)), T);
coverage_fold(Fun, Acc, <<>>) when is_function(Fun, 2) -> Acc.
+coverage_build(Acc0, <<H,T/binary>>, float) ->
+ Float = id(<<H:64/float>>),
+ Acc = <<Acc0/binary,Float/binary>>,
+ coverage_build(Acc, T, float);
coverage_build(Acc0, <<H,T/binary>>, Tuple0) ->
Str = id(<<H:(id(4)),(H-1):4,"abc">>),
Acc = id(<<Acc0/bitstring,Str/bitstring>>),
@@ -618,6 +626,11 @@ coverage_build(Acc0, <<H,T/binary>>, Tuple0) ->
end;
coverage_build(Acc, <<>>, Tuple) -> {Acc,Tuple}.
+coverage_bc(<<H,T/binary>>, Acc) ->
+ B = << <<C:8>> || C <- [H] >>,
+ coverage_bc(T, [B|Acc]);
+coverage_bc(<<>>, Acc) -> Acc.
+
coverage_setelement(<<H,T1/binary>>, Tuple) when element(1, Tuple) =:= x ->
setelement(H, Tuple, T1).
@@ -625,6 +638,13 @@ coverage_apply(<<H,T/binary>>, [F|Fs]) ->
[?MODULE:F(H)|coverage_apply(T, Fs)];
coverage_apply(<<>>, []) -> [].
+coverage_external(<<H,T/binary>>) ->
+ ?MODULE:coverage_external_ignore(T, T),
+ H.
+
+coverage_external_ignore(_, _) ->
+ ok.
+
coverage_id(I) -> id(I).
do_coverage_bin_to_term_list(L) ->
diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl
index d37943ce3a..f30a4d3fef 100644
--- a/lib/compiler/test/bs_utf_SUITE.erl
+++ b/lib/compiler/test/bs_utf_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_utf_SUITE),
+ test_lib:recompile(?MODULE),
[utf8_roundtrip, unused_utf_char, utf16_roundtrip,
utf32_roundtrip, guard, extreme_tripping, literals,
coverage].
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index ba225b66d0..1343fbd1c9 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -27,7 +27,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(compilation_SUITE),
+ test_lib:recompile(?MODULE),
[self_compile_old_inliner, self_compile, compiler_1,
compiler_3, compiler_5, beam_compiler_1,
beam_compiler_2, beam_compiler_3, beam_compiler_4,
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 037c078fd0..b3e5376ffd 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
-spec all() -> all_return_type().
all() ->
- test_lib:recompile(compile_SUITE),
+ test_lib:recompile(?MODULE),
[app_test, file_1, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, package_forms, encrypted_abstr,
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 21a5f65dee..26173c62b8 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -40,7 +40,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(core_SUITE),
+ test_lib:recompile(?MODULE),
[dehydrated_itracer, nested_tries].
groups() ->
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 710751b09d..ac14d36e82 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(core_fold_SUITE),
+ test_lib:recompile(?MODULE),
[t_element, setelement, t_length, append, t_apply, bifs,
eq, nested_call_in_case, coverage].
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index c9823665b4..6e0aadf007 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -27,7 +27,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(error_SUITE),
+ test_lib:recompile(?MODULE),
[head_mismatch_line, warnings_as_errors, bif_clashes].
groups() ->
diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl
index 6738265776..afc04fd440 100644
--- a/lib/compiler/test/float_SUITE.erl
+++ b/lib/compiler/test/float_SUITE.erl
@@ -26,7 +26,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(float_SUITE),
+ test_lib:recompile(?MODULE),
[pending, bif_calls, math_functions,
mixed_float_and_int].
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index aa9be83c82..368a5815bf 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -27,7 +27,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(fun_SUITE),
+ test_lib:recompile(?MODULE),
[test1, overwritten_fun, otp_7202, bif_fun].
groups() ->
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 482564a32b..0e69efba6b 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -37,7 +37,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(guard_SUITE),
+ test_lib:recompile(?MODULE),
[misc, const_cond, basic_not, complex_not, nested_nots,
semicolon, complex_semicolon, comma, or_guard,
more_or_guards, complex_or_guards, and_guard, xor_guard,
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index 7b9600c2f6..af2b8ec92a 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -31,7 +31,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(inline_SUITE),
+ test_lib:recompile(?MODULE),
[attribute, bsdecode, bsdes, barnes2, decode1, smith,
itracer, pseudoknot, lists, really_inlined, otp_7223,
coverage].
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index bcdcf2fd9f..c8908858ba 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(lc_SUITE),
+ test_lib:recompile(?MODULE),
[basic, deeply_nested, no_generator, empty_generator].
groups() ->
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 04879300d1..9406d7de8f 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -22,16 +22,16 @@
init_per_group/2,end_per_group/2,
pmatch/1,mixed/1,aliases/1,match_in_call/1,
untuplify/1,shortcut_boolean/1,letify_guard/1,
- selectify/1,underscore/1]).
+ selectify/1,underscore/1,coverage/1]).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(match_SUITE),
+ test_lib:recompile(?MODULE),
[pmatch, mixed, aliases, match_in_call, untuplify,
- shortcut_boolean, letify_guard, selectify, underscore].
+ shortcut_boolean, letify_guard, selectify, underscore, coverage].
groups() ->
[].
@@ -398,4 +398,18 @@ underscore(Config) when is_list(Config) ->
_ = is_list(Config),
ok.
+coverage(Config) when is_list(Config) ->
+ %% Cover beam_dead.
+ ok = coverage_1(x, a),
+ ok = coverage_1(x, b).
+
+coverage_1(B, Tag) ->
+ case Tag of
+ a -> coverage_2(1, a, B);
+ b -> coverage_2(2, b, B)
+ end.
+
+coverage_2(1, a, x) -> ok;
+coverage_2(2, b, x) -> ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index f1f9b17084..c941a80e61 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -56,7 +56,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
-spec all() -> misc_SUITE_test_cases().
all() ->
- test_lib:recompile(misc_SUITE),
+ test_lib:recompile(?MODULE),
[tobias, empty_string, md5, silly_coverage,
confused_literals, integer_encoding, override_bif].
diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl
index 0a4750dc08..3479cf5425 100644
--- a/lib/compiler/test/num_bif_SUITE.erl
+++ b/lib/compiler/test/num_bif_SUITE.erl
@@ -40,7 +40,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(num_bif_SUITE),
+ test_lib:recompile(?MODULE),
[t_abs, t_float, t_float_to_list, t_integer_to_list,
{group, t_list_to_float}, t_list_to_integer, t_round,
t_trunc].
diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl
index 4c68d777ca..9a317b5762 100644
--- a/lib/compiler/test/pmod_SUITE.erl
+++ b/lib/compiler/test/pmod_SUITE.erl
@@ -28,7 +28,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(pmod_SUITE),
+ test_lib:recompile(?MODULE),
[basic, otp_8447].
groups() ->
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 75e8045693..2a67615e5e 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -39,7 +39,7 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(receive_SUITE),
+ test_lib:recompile(?MODULE),
[recv, coverage, otp_7980, ref_opt, export].
groups() ->
diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl
index 65b96590ed..363422ec7e 100644
--- a/lib/compiler/test/record_SUITE.erl
+++ b/lib/compiler/test/record_SUITE.erl
@@ -26,7 +26,8 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1,
- guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, nested_access/1]).
+ guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1,
+ nested_access/1,coverage/1]).
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(test_server:minutes(2)),
@@ -40,10 +41,10 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(record_SUITE),
+ test_lib:recompile(?MODULE),
[errors, record_test_2, record_test_3,
record_access_in_guards, guard_opt, eval_once, foobar,
- missing_test_heap, nested_access].
+ missing_test_heap, nested_access, coverage].
groups() ->
[].
@@ -568,4 +569,18 @@ nested_access(Config) when is_list(Config) ->
?line N2a = N2b,
ok.
+-record(rr, {a,b,c}).
+
+coverage(Config) when is_list(Config) ->
+ %% There should only remain one record test in the code below.
+ R0 = id(#rr{a=1,b=2,c=3}),
+ B = R0#rr.b, %Test the record here.
+ R = R0#rr{c=42}, %No need to test here.
+ if
+ B > R#rr.a -> %No need to test here.
+ ok
+ end,
+ #rr{a=1,b=2,c=42} = id(R), %Test for correctness.
+ ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index 92a79d3cba..c6e0f8d85d 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -31,7 +31,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(trycatch_SUITE),
+ test_lib:recompile(?MODULE),
[basic, lean_throw, try_of, try_after, catch_oops,
after_oops, eclectic, rethrow, nested_of, nested_catch,
nested_after, nested_horrid, last_call_optimization,
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index dd18a6e1a3..f6a572abfa 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -54,7 +54,7 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(warnings_SUITE),
+ test_lib:recompile(?MODULE),
[pattern, pattern2, pattern3, pattern4, guard,
bad_arith, bool_cases, bad_apply, files, effect,
bin_opt_info, bin_construction].
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index b8786f6f94..3ebf62d87c 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -134,7 +134,9 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T
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 rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -204,7 +206,9 @@ static ErlNifFunc nif_funcs[] = {
{"aes_ctr_encrypt", 3, aes_ctr_encrypt},
{"aes_ctr_decrypt", 3, aes_ctr_encrypt},
{"rand_bytes", 1, rand_bytes_1},
+ {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif},
{"rand_bytes", 3, rand_bytes_3},
+ {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif},
{"rand_uniform_nif", 2, rand_uniform_nif},
{"mod_exp_nif", 3, mod_exp_nif},
{"dss_verify", 4, dss_verify},
@@ -704,6 +708,22 @@ static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes);
return ret;
}
+static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Bytes) */
+ unsigned bytes;
+ unsigned char* data;
+ ERL_NIF_TERM ret;
+ if (!enif_get_uint(env, argv[0], &bytes)) {
+ return enif_make_badarg(env);
+ }
+ data = enif_make_new_binary(env, bytes, &ret);
+ if ( RAND_bytes(data, bytes) != 1) {
+ return atom_false;
+ }
+ ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes);
+ return ret;
+}
+
static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Bytes, TopMask, BottomMask) */
unsigned bytes;
@@ -724,6 +744,47 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
}
return ret;
}
+static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Bytes, TopMask, BottomMask) */
+ unsigned bits;
+ BIGNUM *bn_rand;
+ int top, bottom;
+ unsigned char* data;
+ unsigned dlen;
+ ERL_NIF_TERM ret;
+ if (!enif_get_uint(env, argv[0], &bits)
+ || !enif_get_int(env, argv[1], &top)
+ || !enif_get_int(env, argv[2], &bottom)) {
+ return enif_make_badarg(env);
+ }
+ if (! (top == -1 || top == 0 || top == 1) ) {
+ return enif_make_badarg(env);
+ }
+ if (! (bottom == 0 || bottom == 1) ) {
+ return enif_make_badarg(env);
+ }
+
+ bn_rand = BN_new();
+ if (! bn_rand ) {
+ return enif_make_badarg(env);
+ }
+
+ /* Get a (bits) bit random number */
+ if (!BN_rand(bn_rand, bits, top, bottom)) {
+ ret = atom_false;
+ }
+ else {
+ /* Copy the bignum into an erlang mpint binary. */
+ dlen = BN_num_bytes(bn_rand);
+ data = enif_make_new_binary(env, dlen+4, &ret);
+ put_int32(data, dlen);
+ BN_bn2bin(bn_rand, data+4);
+ ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen);
+ }
+ BN_free(bn_rand);
+
+ return ret;
+}
static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp)
{
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index dfafe67348..1ccea6df79 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1999</year><year>2010</year>
+ <year>1999</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -619,6 +619,21 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</desc>
</func>
<func>
+ <name>strong_rand_bytes(N) -> binary()</name>
+ <fsummary>Generate a binary of random bytes</fsummary>
+ <type>
+ <v>N = integer()</v>
+ </type>
+ <desc>
+ <p>Generates N bytes randomly uniform 0..255, and returns the
+ result in a binary. Uses a cryptographically secure prng seeded and
+ periodically mixed with operating system provided entropy. By default
+ this is the <c>RAND_bytes</c> method from OpenSSL.</p>
+ <p>May throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".</p>
+ </desc>
+ </func>
+ <func>
<name>rand_uniform(Lo, Hi) -> N</name>
<fsummary>Generate a random number</fsummary>
<type>
@@ -633,6 +648,31 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</desc>
</func>
<func>
+ <name>strong_rand_mpint(N, Top, Bottom) -> Mpint</name>
+ <fsummary>Generate an N bit random number</fsummary>
+ <type>
+ <v>N = non_neg_integer()</v>
+ <v>Top = -1 | 0 | 1</v>
+ <v>Bottom = 0 | 1</v>
+ <v>Mpint = binary()</v>
+ </type>
+ <desc>
+ <p>Generate an N bit random number using OpenSSL's
+ cryptographically strong pseudo random number generator
+ <c>BN_rand</c>.</p>
+ <p>The parameter <c>Top</c> places constraints on the most
+ significant bits of the generated number. If <c>Top</c> is 1, then the
+ two most significant bits will be set to 1, if <c>Top</c> is 0, the
+ most significant bit will be 1, and if <c>Top</c> is -1 then no
+ constraints are applied and thus the generated number may be less than
+ N bits long.</p>
+ <p>If <c>Bottom</c> is 1, then the generated number is
+ constrained to be odd.</p>
+ <p>May throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".</p>
+ </desc>
+ </func>
+ <func>
<name>mod_exp(N, P, M) -> Result</name>
<fsummary>Perform N ^ P mod M</fsummary>
<type>
diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml
index 5e9bda3920..ab1ffa9e5c 100644
--- a/lib/crypto/doc/src/notes.xml
+++ b/lib/crypto/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1999</year><year>2010</year>
+ <year>1999</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -30,6 +30,21 @@
</header>
<p>This document describes the changes made to the Crypto application.</p>
+<section><title>Crypto 2.0.2.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Strengthened random number generation. (Thanks to Geoff Cant)</p>
+ <p>
+ Own Id: OTP-9225</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Crypto 2.0.2.1</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index d6e2e033c0..cc7b3acc9c 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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
@@ -46,6 +46,7 @@
-export([rsa_private_encrypt/3, rsa_public_decrypt/3]).
-export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]).
-export([rand_bytes/1, rand_bytes/3, rand_uniform/2]).
+-export([strong_rand_bytes/1, strong_rand_mpint/3]).
-export([mod_exp/3, mpint/1, erlint/1]).
%% -export([idea_cbc_encrypt/3, idea_cbc_decrypt/3]).
-export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]).
@@ -68,6 +69,8 @@
des_ede3_cbc_encrypt, des_ede3_cbc_decrypt,
aes_cfb_128_encrypt, aes_cfb_128_decrypt,
rand_bytes,
+ strong_rand_bytes,
+ strong_rand_mpint,
rand_uniform,
mod_exp,
dss_verify,dss_sign,
@@ -361,12 +364,32 @@ aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
%% RAND - pseudo random numbers using RN_ functions in crypto lib
%%
-spec rand_bytes(non_neg_integer()) -> binary().
+-spec strong_rand_bytes(non_neg_integer()) -> binary().
-spec rand_uniform(crypto_integer(), crypto_integer()) ->
crypto_integer().
+-spec strong_rand_mpint(Bits::non_neg_integer(),
+ Top::-1..1,
+ Bottom::0..1) -> binary().
rand_bytes(_Bytes) -> ?nif_stub.
+
+strong_rand_bytes(Bytes) ->
+ case strong_rand_bytes_nif(Bytes) of
+ false -> erlang:error(low_entropy);
+ Bin -> Bin
+ end.
+strong_rand_bytes_nif(_Bytes) -> ?nif_stub.
+
rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub.
+strong_rand_mpint(Bits, Top, Bottom) ->
+ case strong_rand_mpint_nif(Bits,Top,Bottom) of
+ false -> erlang:error(low_entropy);
+ Bin -> Bin
+ end.
+strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub.
+
+
rand_uniform(From,To) when is_binary(From), is_binary(To) ->
case rand_uniform_nif(From,To) of
<<Len:32/integer, MSB, Rest/binary>> when MSB > 127 ->
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index fe8f8e69a0..854a8b4485 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -46,6 +46,7 @@
aes_ctr/1,
mod_exp_test/1,
rand_uniform_test/1,
+ strong_rand_test/1,
rsa_verify_test/1,
dsa_verify_test/1,
rsa_sign_test/1,
@@ -68,7 +69,8 @@ all() ->
md5_mac_io, sha, sha_update,
%% sha256, sha256_update, sha512,sha512_update,
des_cbc, aes_cfb, aes_cbc,
- aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, rand_uniform_test,
+ aes_cbc_iter, aes_ctr, des_cbc_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,
rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64,
@@ -710,6 +712,33 @@ rand_uniform_aux_test(N) ->
%%
%%
+strong_rand_test(doc) ->
+ "strong_rand_mpint and strong_random_bytes testing";
+strong_rand_test(suite) ->
+ [];
+strong_rand_test(Config) when is_list(Config) ->
+ strong_rand_aux_test(180),
+ ?line 10 = byte_size(crypto:strong_rand_bytes(10)).
+
+strong_rand_aux_test(0) ->
+ ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>),
+ ok;
+strong_rand_aux_test(1) ->
+ ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1),
+ ?line strong_rand_aux_test(0);
+strong_rand_aux_test(N) ->
+ ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N),
+ ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N),
+ ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1),
+ ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11),
+ ?line strong_rand_aux_test(N-1).
+
+sru_length(Mpint) ->
+ I = crypto:erlint(Mpint),
+ length(erlang:integer_to_list(I, 2)).
+
+%%
+%%
%%
%%
rsa_verify_test(doc) ->
@@ -1097,7 +1126,7 @@ worker_loop(0, _) ->
ok;
worker_loop(N, Config) ->
Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc,
- aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test,
+ aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test,
rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test },
F = element(random:uniform(size(Funcs)),Funcs),
diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk
index e2d6fd0b37..740c68d8fa 100644
--- a/lib/crypto/vsn.mk
+++ b/lib/crypto/vsn.mk
@@ -1 +1 @@
-CRYPTO_VSN = 2.0.2.1
+CRYPTO_VSN = 2.0.2.2
diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt
index 1d7a1a6222..d519ac960b 100644
--- a/lib/dialyzer/doc/manual.txt
+++ b/lib/dialyzer/doc/manual.txt
@@ -37,7 +37,7 @@ The parameters are:
The analysis starts from .beam bytecode files.
The files must be compiled with +debug_info.
- Source code:
- The analysis starts from .erl files.
+ The analysis starts from .erl files.
Controlling the discrepancies reported by the Dialyzer
======================================================
@@ -131,7 +131,7 @@ Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose]
[--check_plt] [--no_check_plt] [--plt_info] [--get_warnings]
[--no_native] [--fullpath]
-Options:
+Options:
files_or_dirs (for backwards compatibility also as: -c files_or_dirs)
Use Dialyzer from the command line to detect defects in the
specified files or directories containing .erl or .beam files,
@@ -169,7 +169,7 @@ Options:
--output_plt file
Store the plt at the specified file after building it.
--plt plt
- Use the specified plt as the initial plt (if the plt was built
+ Use the specified plt as the initial plt (if the plt was built
during setup the files will be checked for consistency).
--plts plt*
Merge the specified plts to create the initial plt -- requires
@@ -204,8 +204,8 @@ Options:
--add_to_plt
The plt is extended to also include the files specified with -c and -r.
Use --plt to specify which plt to start from, and --output_plt to
- specify where to put the plt. Note that the analysis might include
- files from the plt if they depend on the new files.
+ specify where to put the plt. Note that the analysis might include
+ files from the plt if they depend on the new files.
This option only works with beam files.
--remove_from_plt
The information from the files specified with -c and -r is removed
@@ -269,13 +269,13 @@ Warning options:
Include warnings about behaviour callbacks which drift from the published
recommended interfaces.
-Wunderspecs ***
- Warn about underspecified functions
+ Warn about underspecified functions
(those whose -spec is strictly more allowing than the success typing).
The following options are also available but their use is not recommended:
(they are mostly for Dialyzer developers and internal debugging)
-Woverspecs ***
- Warn about overspecified functions
+ Warn about overspecified functions
(those whose -spec is strictly less allowing than the success typing).
-Wspecdiffs ***
Warn when the -spec is different than the success typing.
@@ -306,8 +306,8 @@ dialyzer:run(OptList) -> Warnings
Warnings :: [{tag(), id(), msg()}]
tag() :: 'warn_return_no_exit' | 'warn_return_only_exit' | 'warn_not_called'
| 'warn_non_proper_list' | 'warn_fun_app' | 'warn_matching'
- | 'warn_failing_call' | 'warn_contract_types'
- | 'warn_contract_syntax' | 'warn_contract_not_equal'
+ | 'warn_failing_call' | 'warn_contract_types'
+ | 'warn_contract_syntax' | 'warn_contract_not_equal'
| 'warn_contract_subtype' | 'warn_contract_supertype'
id() :: {File :: string(), Line :: integer()}
msg() :: Undefined
@@ -319,24 +319,31 @@ Option :: {files, [Filename :: string()]}
| {from, src_code | byte_code} %% Defaults to byte_code
| {init_plt, FileName :: string()} %% If changed from default
| {plts, [FileName :: string()]} %% If changed from default
- | {include_dirs, [DirName :: string()]}
+ | {include_dirs, [DirName :: string()]}
| {output_file, FileName :: string()}
| {output_plt, FileName :: string()}
| {analysis_type, 'succ_typings' | 'plt_add' |
'plt_build' | 'plt_check' | 'plt_remove'}
| {warnings, [WarnOpts]}
+ | {get_warnings, bool()}
WarnOpts :: no_return
| no_unused
| no_improper_lists
| no_fun_app
| no_match
+ | no_opaque
| no_fail_call
- | unmatched_returns
| error_handling
+ | race_conditions
+ | behaviours
+ | unmatched_returns
+ | overspecs
+ | underspecs
+ | specdiffs
dialyzer:format_warning({tag(), id(), msg()}) -> string()
-
+
Returns a string representation of the warnings as returned by dialyzer:run/1.
dialyzer:plt_info(string()) -> {'ok', [{atom(), any()}]} | {'error', atom()}
@@ -392,7 +399,7 @@ files that depend on these files. Note that this consistency check
will be performed automatically the next time you run Dialyzer with
this plt. The --check_plt option is merely for doing so without doing
any other analysis.
-
+
-----------------------------------------------
--
-- Feedback & bug reports
diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml
index b6547b11e1..4080dfdf77 100644
--- a/lib/dialyzer/doc/src/dialyzer.xml
+++ b/lib/dialyzer/doc/src/dialyzer.xml
@@ -241,7 +241,7 @@
<item>Include warnings about behaviour callbacks which drift from the
published recommended interfaces.</item>
<tag><c><![CDATA[-Wunderspecs]]></c>***</tag>
- <item>Warn about underspecified functions
+ <item>Warn about underspecified functions
(the -spec is strictly more allowing than the success typing).</item>
</taglist>
<p>The following options are also available but their use is not
@@ -249,7 +249,7 @@
debugging)</p>
<taglist>
<tag><c><![CDATA[-Woverspecs]]></c>***</tag>
- <item>Warn about overspecified functions
+ <item>Warn about overspecified functions
(the -spec is strictly less allowing than the success typing).</item>
<tag><c><![CDATA[-Wspecdiffs]]></c>***</tag>
<item>Warn when the -spec is different than the success typing.</item>
@@ -278,34 +278,34 @@
<desc>
<p>Dialyzer GUI version.</p>
<code type="none"><![CDATA[
-OptList : [Option]
-Option : {files, [Filename : string()]}
- | {files_rec, [DirName : string()]}
- | {defines, [{Macro: atom(), Value : term()}]}
- | {from, src_code | byte_code} %% Defaults to byte_code
- | {init_plt, FileName : string()} %% If changed from default
- | {plts, [FileName :: string()]} %% If changed from default
- | {include_dirs, [DirName : string()]}
- | {output_file, FileName : string()}
- | {output_plt, FileName :: string()}
- | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'}
- | {warnings, [WarnOpts]}
- | {get_warnings, bool()}
+OptList :: [Option]
+Option :: {files, [Filename :: string()]}
+ | {files_rec, [DirName :: string()]}
+ | {defines, [{Macro: atom(), Value : term()}]}
+ | {from, src_code | byte_code} %% Defaults to byte_code
+ | {init_plt, FileName :: string()} %% If changed from default
+ | {plts, [FileName :: string()]} %% If changed from default
+ | {include_dirs, [DirName :: string()]}
+ | {output_file, FileName :: string()}
+ | {output_plt, FileName :: string()}
+ | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'}
+ | {warnings, [WarnOpts]}
+ | {get_warnings, bool()}
-WarnOpts : no_return
- | no_unused
- | no_improper_lists
- | no_fun_app
- | no_match
- | no_opaque
- | no_fail_call
- | error_handling
- | race_conditions
- | behaviours
- | unmatched_returns
- | overspecs
- | underspecs
- | specdiffs
+WarnOpts :: no_return
+ | no_unused
+ | no_improper_lists
+ | no_fun_app
+ | no_match
+ | no_opaque
+ | no_fail_call
+ | error_handling
+ | race_conditions
+ | behaviours
+ | unmatched_returns
+ | overspecs
+ | underspecs
+ | specdiffs
]]></code>
</desc>
</func>
@@ -320,12 +320,12 @@ WarnOpts : no_return
<p>Dialyzer command line version.</p>
<code type="none"><![CDATA[
Warnings :: [{Tag, Id, Msg}]
-Tag : 'warn_return_no_exit' | 'warn_return_only_exit'
- | 'warn_not_called' | 'warn_non_proper_list'
- | 'warn_fun_app' | 'warn_matching'
- | 'warn_failing_call' | 'warn_contract_types'
- | 'warn_contract_syntax' | 'warn_contract_not_equal'
- | 'warn_contract_subtype' | 'warn_contract_supertype'
+Tag :: 'warn_return_no_exit' | 'warn_return_only_exit'
+ | 'warn_not_called' | 'warn_non_proper_list'
+ | 'warn_fun_app' | 'warn_matching'
+ | 'warn_failing_call' | 'warn_contract_types'
+ | 'warn_contract_syntax' | 'warn_contract_not_equal'
+ | 'warn_contract_subtype' | 'warn_contract_supertype'
Id = {File :: string(), Line :: integer()}
Msg = msg() -- Undefined
]]></code>
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index 24d6013692..b8da57d3f9 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -155,19 +155,24 @@ postprocess_dataflow_warns(RawWarnings, State, WarnAcc) ->
postprocess_dataflow_warns([], _State, WAcc, Acc) ->
{WAcc, lists:reverse(Acc)};
-postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {File, CallL}, Msg}|Rest],
+postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest],
#st{codeserver = Codeserver} = State, WAcc, Acc) ->
{contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg,
- {ok, {{File, _ContrL} = FileLine, _C}} =
+ {ok, {{ContrF, _ContrL} = FileLine, _C}} =
dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver),
- NewMsg =
- {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]},
- W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg},
- Filter =
- fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false;
- (_) -> true
- end,
- postprocess_dataflow_warns(Rest, State, lists:filter(Filter, WAcc), [W|Acc]);
+ case CallF =:= ContrF of
+ true ->
+ NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]},
+ W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg},
+ Filter =
+ fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false;
+ (_) -> true
+ end,
+ FilterWAcc = lists:filter(Filter, WAcc),
+ postprocess_dataflow_warns(Rest, State, FilterWAcc, [W|Acc]);
+ false ->
+ postprocess_dataflow_warns(Rest, State, WAcc, Acc)
+ end;
postprocess_dataflow_warns([W|Rest], State, Wacc, Acc) ->
postprocess_dataflow_warns(Rest, State, Wacc, [W|Acc]).
diff --git a/lib/dialyzer/test/small_tests_SUITE.erl b/lib/dialyzer/test/small_tests_SUITE.erl
index 21a2c76160..dbcc044eea 100644
--- a/lib/dialyzer/test/small_tests_SUITE.erl
+++ b/lib/dialyzer/test/small_tests_SUITE.erl
@@ -18,18 +18,18 @@
contract5/1, disj_norm_form/1, eqeq/1, ets_select/1,
exhaust_case/1, failing_guard1/1, flatten/1, fun_app/1,
fun_ref_match/1, fun_ref_record/1, gencall/1, gs_make/1,
- inf_loop2/1, letrec1/1, list_match/1, lzip/1, make_tuple/1,
- minus_minus/1, mod_info/1, my_filter/1, my_sofs/1, no_match/1,
- no_unused_fun/1, no_unused_fun2/1, non_existing/1,
- not_guard_crash/1, or_bug/1, orelsebug/1, orelsebug2/1,
- overloaded1/1, port_info_test/1, process_info_test/1, pubsub/1,
- receive1/1, record_construct/1, record_pat/1,
- record_send_test/1, record_test/1, recursive_types1/1,
- recursive_types2/1, recursive_types3/1, recursive_types4/1,
- recursive_types5/1, recursive_types6/1, recursive_types7/1,
- refine_bug1/1, toth/1, trec/1, try1/1, tuple1/1,
- unsafe_beamcode_bug/1, unused_cases/1, unused_clauses/1,
- zero_tuple/1]).
+ inf_loop2/1, invalid_specs/1, letrec1/1, list_match/1, lzip/1,
+ make_tuple/1, minus_minus/1, mod_info/1, my_filter/1,
+ my_sofs/1, no_match/1, no_unused_fun/1, no_unused_fun2/1,
+ non_existing/1, not_guard_crash/1, or_bug/1, orelsebug/1,
+ orelsebug2/1, overloaded1/1, port_info_test/1,
+ process_info_test/1, pubsub/1, receive1/1, record_construct/1,
+ record_pat/1, record_send_test/1, record_test/1,
+ recursive_types1/1, recursive_types2/1, recursive_types3/1,
+ recursive_types4/1, recursive_types5/1, recursive_types6/1,
+ recursive_types7/1, refine_bug1/1, toth/1, trec/1, try1/1,
+ tuple1/1, unsafe_beamcode_bug/1, unused_cases/1,
+ unused_clauses/1, zero_tuple/1]).
suite() ->
[{timetrap, {minutes, 1}}].
@@ -51,10 +51,10 @@ all() ->
atom_guard,atom_widen,bs_fail_constr,bs_utf8,cerl_hipeify,comm_layer,
compare1,confusing_warning,contract2,contract3,contract5,disj_norm_form,
eqeq,ets_select,exhaust_case,failing_guard1,flatten,fun_app,fun_ref_match,
- fun_ref_record,gencall,gs_make,inf_loop2,letrec1,list_match,lzip,
- make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match,no_unused_fun,
- no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug,orelsebug2,
- overloaded1,port_info_test,process_info_test,pubsub,receive1,
+ fun_ref_record,gencall,gs_make,inf_loop2,invalid_specs,letrec1,list_match,
+ lzip,make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match,
+ no_unused_fun,no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug,
+ orelsebug2,overloaded1,port_info_test,process_info_test,pubsub,receive1,
record_construct,record_pat,record_send_test,record_test,recursive_types1,
recursive_types2,recursive_types3,recursive_types4,recursive_types5,
recursive_types6,recursive_types7,refine_bug1,toth,trec,try1,tuple1,
@@ -235,6 +235,12 @@ inf_loop2(Config) ->
Error -> ct:fail(Error)
end.
+invalid_specs(Config) ->
+ case dialyze(Config, invalid_specs) of
+ 'same' -> 'same';
+ Error -> ct:fail(Error)
+ end.
+
letrec1(Config) ->
case dialyze(Config, letrec1) of
'same' -> 'same';
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs
new file mode 100644
index 0000000000..c95c0ff1f8
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs
@@ -0,0 +1,3 @@
+
+invalid_spec1.erl:5: Invalid type specification for function invalid_spec1:get_plan_dirty/1. The success typing is ([string()]) -> {maybe_improper_list(),[atom()]}
+invalid_spec2.erl:5: Function foo/0 has no local return
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl
new file mode 100644
index 0000000000..06ab2f9a22
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl
@@ -0,0 +1,28 @@
+-module(invalid_spec1).
+
+-export([get_plan_dirty/1]).
+
+-spec get_plan_dirty([string()]) -> {{atom(), any()}, [atom()]}.
+
+get_plan_dirty(ClassL) ->
+ get_plan_dirty(ClassL, [], []).
+
+get_plan_dirty([], Res, FoundClassList) ->
+ {Res,FoundClassList};
+get_plan_dirty([Class|ClassL], Res, FoundClassList) ->
+ ClassPlan = list_to_atom(Class ++ "_plan"),
+ case catch mnesia:dirty_all_keys(ClassPlan) of
+ {'EXIT',_} ->
+ get_plan_dirty(ClassL, Res, FoundClassList);
+ [] ->
+ get_plan_dirty(ClassL, Res, FoundClassList);
+ KeyL ->
+ ClassAtom = list_to_atom(Class),
+ Res2 =
+ lists:foldl(fun(Key, Acc) ->
+ [{ClassAtom,Key}|Acc]
+ end,
+ Res,
+ KeyL),
+ get_plan_dirty(ClassL, Res2, [ClassAtom|FoundClassList])
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl
new file mode 100644
index 0000000000..e49f73d014
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl
@@ -0,0 +1,11 @@
+-module(invalid_spec2).
+
+-export([foo/0]).
+
+foo() ->
+ case
+ invalid_spec1:get_plan_dirty(mnesia:dirty_all_keys(cmClassInfo))
+ of
+ {[],[]} -> foo;
+ { _, _} -> bar
+ end.
diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl
index 4751f1094a..45d2387e7b 100644
--- a/lib/eunit/src/eunit_lib.erl
+++ b/lib/eunit/src/eunit_lib.erl
@@ -33,7 +33,7 @@
-export([dlist_next/1, uniq/1, fun_parent/1, is_string/1, command/1,
command/2, command/3, trie_new/0, trie_store/2, trie_match/2,
split_node/1, consult_file/1, list_dir/1, format_exit_term/1,
- format_exception/1, format_error/1]).
+ format_exception/1, format_exception/2, format_error/1]).
%% Type definitions for describing exceptions
@@ -55,21 +55,23 @@
%% ---------------------------------------------------------------------
%% Formatting of error descriptors
+format_exception(Exception) ->
+ format_exception(Exception, 20).
-format_exception({Class,Term,Trace})
+format_exception({Class,Term,Trace}, Depth)
when is_atom(Class), is_list(Trace) ->
case is_stacktrace(Trace) of
true ->
io_lib:format("~w:~P\n~s",
- [Class, Term, 20, format_stacktrace(Trace)]);
+ [Class, Term, Depth, format_stacktrace(Trace)]);
false ->
- format_term(Term)
+ format_term(Term, Depth)
end;
-format_exception(Term) ->
- format_term(Term).
+format_exception(Term, Depth) ->
+ format_term(Term, Depth).
-format_term(Term) ->
- io_lib:format("~P\n", [Term, 15]).
+format_term(Term, Depth) ->
+ io_lib:format("~P\n", [Term, Depth]).
format_exit_term(Term) ->
{Reason, Trace} = analyze_exit_term(Term),
diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl
index eb994a990a..f289cd724a 100644
--- a/lib/eunit/src/eunit_surefire.erl
+++ b/lib/eunit/src/eunit_surefire.erl
@@ -323,7 +323,7 @@ write_testcase(
format_testcase_result(ok) -> [<<>>];
format_testcase_result({failed, {error, {Type, _}, _} = Exception}) when is_atom(Type) ->
[?INDENT, ?INDENT, <<"<failure type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE,
- <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
+ <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)),
?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
format_testcase_result({failed, Term}) ->
[?INDENT, ?INDENT, <<"<failure type=\"unknown\">">>, ?NEWLINE,
@@ -331,7 +331,7 @@ format_testcase_result({failed, Term}) ->
?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) ->
[?INDENT, ?INDENT, <<"<error type=\"">>, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE,
- <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
+ <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)),
?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE];
format_testcase_result({aborted, Term}) ->
[?INDENT, ?INDENT, <<"<error type=\"unknown\">">>, ?NEWLINE,
diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl
index 49a02359b0..5228d4fe01 100644
--- a/lib/kernel/src/net_kernel.erl
+++ b/lib/kernel/src/net_kernel.erl
@@ -1249,7 +1249,7 @@ protocol_childspecs([H|T]) ->
epmd_module() ->
case init:get_argument(epmd_module) of
{ok,[[Module]]} ->
- Module;
+ list_to_atom(Module);
_ ->
erl_epmd
end.
diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl
index 043c753cf8..233e438dc9 100644
--- a/lib/kernel/test/heart_SUITE.erl
+++ b/lib/kernel/test/heart_SUITE.erl
@@ -22,7 +22,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2, start/1, restart/1,
- reboot/1, set_cmd/1, clear_cmd/1,
+ reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1,
dont_drop/1, kill_pid/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -58,7 +58,7 @@ end_per_testcase(_Func, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [start, restart, reboot, set_cmd, clear_cmd, kill_pid].
+ [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid].
groups() ->
[].
@@ -246,6 +246,15 @@ clear_cmd(Config) when is_list(Config) ->
end,
ok.
+get_cmd(suite) -> [];
+get_cmd(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_check(slave, heart_test),
+ Cmd = "test",
+ ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]),
+ ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []),
+ stop_node(Node),
+ ok.
+
dont_drop(suite) ->
%%% Removed as it may crash epmd/distribution in colourful
%%% ways. While we ARE finding out WHY, it would
diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml
index ccf70b8373..19574a1434 100644
--- a/lib/mnesia/doc/src/notes.xml
+++ b/lib/mnesia/doc/src/notes.xml
@@ -38,7 +38,35 @@
thus constitutes one section in this document. The title of each
section is the version number of Mnesia.</p>
- <section><title>Mnesia 4.4.17</title>
+ <section><title>Mnesia 4.4.18</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Call chmod without the "-f" flag</p>
+ <p>
+ "-f" is a non-standard chmod option which at least SGI
+ IRIX and HP UX do not support. As the only effect of the
+ "-f" flag is to suppress warning messages, it can be
+ safely omitted. (Thanks to Holger Wei�)</p>
+ <p>
+ Own Id: OTP-9170</p>
+ </item>
+ <item>
+ <p>
+ Mnesia sometimes failed to update meta-information in
+ large systems, which could cause table content to be
+ inconsistent between nodes.</p>
+ <p>
+ Own Id: OTP-9186 Aux Id: seq11728 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Mnesia 4.4.17</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/mnesia/src/mnesia.appup.src b/lib/mnesia/src/mnesia.appup.src
index 0eff761b61..7bad6c4ea6 100644
--- a/lib/mnesia/src/mnesia.appup.src
+++ b/lib/mnesia/src/mnesia.appup.src
@@ -1,25 +1,33 @@
%% -*- erlang -*-
{"%VSN%",
[
- {"4.4.16",[
- {update, mnesia_frag, soft, soft_purge, soft_purge, []},
- {update, mnesia_schema, soft, soft_purge, soft_purge, []}
+ {"4.4.17",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []}
]},
- {"4.4.15",[
- {update, mnesia_frag, soft, soft_purge, soft_purge, []},
- {update, mnesia, soft, soft_purge, soft_purge, []},
- {update, mnesia_dumper, soft, soft_purge, soft_purge, []}
- ]}
- ],
- [
{"4.4.16",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
{update, mnesia_frag, soft, soft_purge, soft_purge, []},
{update, mnesia_schema, soft, soft_purge, soft_purge, []}
]},
{"4.4.15",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
{update, mnesia_frag, soft, soft_purge, soft_purge, []},
{update, mnesia, soft, soft_purge, soft_purge, []},
{update, mnesia_dumper, soft, soft_purge, soft_purge, []}
]}
- ]
+ ],
+ {"4.4.17",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []}
+ ]},
+ {"4.4.16",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
+ {update, mnesia_frag, soft, soft_purge, soft_purge, []},
+ {update, mnesia_schema, soft, soft_purge, soft_purge, []}
+ ]},
+ {"4.4.15",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
+ {update, mnesia_frag, soft, soft_purge, soft_purge, []},
+ {update, mnesia, soft, soft_purge, soft_purge, []},
+ {update, mnesia_dumper, soft, soft_purge, soft_purge, []}
+ ]}
}.
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index 021be8af2a..0254769758 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-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
@@ -457,7 +457,7 @@ connect_nodes2(Father, Ns, UserFun) ->
New1 = mnesia_lib:intersect(Ns, Connected),
New = New1 -- Current,
process_flag(trap_exit, true),
- Res = try_merge_schema(New, UserFun),
+ Res = try_merge_schema(New, [], UserFun),
Msg = {schema_is_merged, [], late_merge, []},
multicall([node()|Ns], Msg),
After = val({current, db_nodes}),
@@ -471,7 +471,7 @@ connect_nodes2(Father, Ns, UserFun) ->
merge_schema() ->
AllNodes = mnesia_lib:all_nodes(),
- case try_merge_schema(AllNodes, fun default_merge/1) of
+ case try_merge_schema(AllNodes, [node()], fun default_merge/1) of
ok ->
schema_is_merged();
{aborted, {throw, Str}} when is_list(Str) ->
@@ -483,11 +483,17 @@ merge_schema() ->
default_merge(F) ->
F([]).
-try_merge_schema(Nodes, UserFun) ->
+try_merge_schema(Nodes, Told0, UserFun) ->
case mnesia_schema:merge_schema(UserFun) of
{atomic, not_merged} ->
%% No more nodes that we need to merge the schema with
- ok;
+ %% Ensure we have told everybody that we are running
+ case val({current,db_nodes}) -- mnesia_lib:uniq(Told0) of
+ [] -> ok;
+ Tell ->
+ im_running(Tell, [node()]),
+ ok
+ end;
{atomic, {merged, OldFriends, NewFriends}} ->
%% Check if new nodes has been added to the schema
Diff = mnesia_lib:all_nodes() -- [node() | Nodes],
@@ -496,12 +502,18 @@ try_merge_schema(Nodes, UserFun) ->
%% Tell everybody to adopt orphan tables
im_running(OldFriends, NewFriends),
im_running(NewFriends, OldFriends),
-
- try_merge_schema(Nodes, UserFun);
+ Told = case lists:member(node(), NewFriends) of
+ true -> Told0 ++ OldFriends;
+ false -> Told0 ++ NewFriends
+ end,
+ try_merge_schema(Nodes, Told, UserFun);
{atomic, {"Cannot get cstructs", Node, Reason}} ->
dbg_out("Cannot get cstructs, Node ~p ~p~n", [Node, Reason]),
- timer:sleep(1000), % Avoid a endless loop look alike
- try_merge_schema(Nodes, UserFun);
+ timer:sleep(300), % Avoid a endless loop look alike
+ try_merge_schema(Nodes, Told0, UserFun);
+ {aborted, {shutdown, _}} -> %% One of the nodes is going down
+ timer:sleep(300), % Avoid a endless loop look alike
+ try_merge_schema(Nodes, Told0, UserFun);
Other ->
Other
end.
@@ -915,6 +927,7 @@ handle_cast(unblock_controller, State) ->
handle_cast({mnesia_down, Node}, State) ->
maybe_log_mnesia_down(Node),
mnesia_lib:del({current, db_nodes}, Node),
+ mnesia_lib:unset({node_up, Node}),
mnesia_checkpoint:tm_mnesia_down(Node),
Alltabs = val({schema, tables}),
reconfigure_tables(Node, Alltabs),
@@ -977,11 +990,12 @@ handle_cast(Msg, State) when State#state.schema_is_merged /= true ->
%% This must be done after schema_is_merged otherwise adopt_orphan
%% might trigger a table load from wrong nodes as a result of that we don't
%% know which tables we can load safly first.
-handle_cast({im_running, _Node, NewFriends}, State) ->
+handle_cast({im_running, Node, NewFriends}, State) ->
LocalTabs = mnesia_lib:local_active_tables() -- [schema],
RemoveLocalOnly = fun(Tab) -> not val({Tab, local_content}) end,
Tabs = lists:filter(RemoveLocalOnly, LocalTabs),
- Ns = mnesia_lib:intersect(NewFriends, val({current, db_nodes})),
+ Nodes = mnesia_lib:union([Node],val({current, db_nodes})),
+ Ns = mnesia_lib:intersect(NewFriends, Nodes),
abcast(Ns, {adopt_orphans, node(), Tabs}),
noreply(State);
@@ -1042,30 +1056,33 @@ handle_cast({master_nodes_updated, Tab, Masters}, State) ->
end;
handle_cast({adopt_orphans, Node, Tabs}, State) ->
-
State2 = node_has_tabs(Tabs, Node, State),
- %% Register the other node as up and running
- mnesia_recover:log_mnesia_up(Node),
- verbose("Logging mnesia_up ~w~n",[Node]),
- mnesia_lib:report_system_event({mnesia_up, Node}),
-
- %% Load orphan tables
- LocalTabs = val({schema, local_tables}) -- [schema],
- Nodes = val({current, db_nodes}),
- {LocalOrphans, RemoteMasters} =
- orphan_tables(LocalTabs, Node, Nodes, [], []),
- Reason = {adopt_orphan, node()},
- mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason),
-
- Fun =
- fun(N) ->
- RemoteOrphans =
- [Tab || {Tab, Ns} <- RemoteMasters,
- lists:member(N, Ns)],
- mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason)
- end,
- lists:foreach(Fun, Nodes),
+ case ?catch_val({node_up,Node}) of
+ true -> ignore;
+ _ ->
+ %% Register the other node as up and running
+ set({node_up, Node}, true),
+ mnesia_recover:log_mnesia_up(Node),
+ verbose("Logging mnesia_up ~w~n",[Node]),
+ mnesia_lib:report_system_event({mnesia_up, Node}),
+ %% Load orphan tables
+ LocalTabs = val({schema, local_tables}) -- [schema],
+ Nodes = val({current, db_nodes}),
+ {LocalOrphans, RemoteMasters} =
+ orphan_tables(LocalTabs, Node, Nodes, [], []),
+ Reason = {adopt_orphan, node()},
+ mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason),
+
+ Fun =
+ fun(N) ->
+ RemoteOrphans =
+ [Tab || {Tab, Ns} <- RemoteMasters,
+ lists:member(N, Ns)],
+ mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason)
+ end,
+ lists:foreach(Fun, Nodes)
+ end,
noreply(State2);
handle_cast(Msg, State) ->
diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk
index 5247657b68..38e1a94545 100644
--- a/lib/mnesia/vsn.mk
+++ b/lib/mnesia/vsn.mk
@@ -1 +1 @@
-MNESIA_VSN = 4.4.17
+MNESIA_VSN = 4.4.18
diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl
index 3340f7ee72..3ee1df759f 100644
--- a/lib/os_mon/src/disksup.erl
+++ b/lib/os_mon/src/disksup.erl
@@ -103,6 +103,7 @@ init([]) ->
Flavor==darwin;
Flavor==linux;
Flavor==openbsd;
+ Flavor==netbsd;
Flavor==irix64;
Flavor==irix ->
start_portprogram();
@@ -267,6 +268,9 @@ check_disk_space({unix, freebsd}, Port, Threshold) ->
check_disk_space({unix, openbsd}, Port, Threshold) ->
Result = my_cmd("/bin/df -k -t ffs", Port),
check_disks_solaris(skip_to_eol(Result), Threshold);
+check_disk_space({unix, netbsd}, Port, Threshold) ->
+ Result = my_cmd("/bin/df -k -t ffs", Port),
+ check_disks_solaris(skip_to_eol(Result), Threshold);
check_disk_space({unix, sunos4}, Port, Threshold) ->
Result = my_cmd("df", Port),
check_disks_solaris(skip_to_eol(Result), Threshold);
diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl
index 822e1f939c..cc4941ee7d 100644
--- a/lib/os_mon/src/memsup.erl
+++ b/lib/os_mon/src/memsup.erl
@@ -176,9 +176,11 @@ init([]) ->
PortMode = case OS of
{unix, darwin} -> false;
{unix, freebsd} -> false;
+ {unix, dragonfly} -> false;
% Linux supports this.
{unix, linux} -> true;
{unix, openbsd} -> true;
+ {unix, netbsd} -> true;
{unix, irix64} -> true;
{unix, irix} -> true;
{unix, sunos} -> true;
@@ -610,8 +612,10 @@ code_change(Vsn, PrevState, "1.8") ->
PortMode = case OS of
{unix, darwin} -> false;
{unix, freebsd} -> false;
+ {unix, dragonfly} -> false;
{unix, linux} -> false;
{unix, openbsd} -> true;
+ {unix, netbsd} -> true;
{unix, sunos} -> true;
{win32, _OSname} -> false;
vxworks -> true
@@ -687,6 +691,7 @@ get_os_wordsize({unix, linux}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, darwin}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, netbsd}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, freebsd}) -> get_os_wordsize_with_uname();
+get_os_wordsize({unix, dragonfly}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, openbsd}) -> get_os_wordsize_with_uname();
get_os_wordsize(_) -> unsupported_os.
@@ -736,7 +741,7 @@ get_memory_usage({unix,darwin}) ->
%% FreeBSD: Look in /usr/include/sys/vmmeter.h for the format of struct
%% vmmeter
-get_memory_usage({unix,freebsd}) ->
+get_memory_usage({unix,OSname}) when OSname == freebsd; OSname == dragonfly ->
PageSize = freebsd_sysctl("vm.stats.vm.v_page_size"),
PageCount = freebsd_sysctl("vm.stats.vm.v_page_count"),
FreeCount = freebsd_sysctl("vm.stats.vm.v_free_count"),
@@ -779,6 +784,9 @@ get_ext_memory_usage(OS, {Alloc, Total}) ->
{unix, freebsd} ->
[{total_memory, Total}, {free_memory, Total-Alloc},
{system_total_memory, Total}];
+ {unix, dragonfly} ->
+ [{total_memory, Total}, {free_memory, Total-Alloc},
+ {system_total_memory, Total}];
{unix, darwin} ->
[{total_memory, Total}, {free_memory, Total-Alloc},
{system_total_memory, Total}];
diff --git a/lib/public_key/src/public_key.appup.src b/lib/public_key/src/public_key.appup.src
index c65ac7bc99..4986801dad 100644
--- a/lib/public_key/src/public_key.appup.src
+++ b/lib/public_key/src/public_key.appup.src
@@ -1,6 +1,16 @@
%% -*- erlang -*-
{"%VSN%",
[
+ {"0.11",
+ [
+ {update, public_key, soft, soft_purge, soft_purge, []},
+ {update, pubkey_pem, soft, soft_purge, soft_purge, []},
+ {add_module, pubkey_ssh, soft, soft_purge, soft_purge},
+ {update, pubkey_cert, soft, soft_purge, soft_purge, []},
+ {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}
+ ]
+ },
+
{"0.10",
[
{update, public_key, soft, soft_purge, soft_purge, []},
@@ -25,6 +35,16 @@
}
],
[
+ {"0.11",
+ [
+ {update, public_key, soft, soft_purge, soft_purge, []},
+ {update, pubkey_pem, soft, soft_purge, soft_purge, []},
+ {delete_module, pubkey_ssh, soft, soft_purge, soft_purge},
+ {update, pubkey_cert, soft, soft_purge, soft_purge, []},
+ {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}
+ ]
+ },
+
{"0.10",
[
{update, public_key, soft, soft_purge, soft_purge, []},
diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl
index 660af4e8ab..a325a975e9 100644
--- a/lib/public_key/test/pkits_SUITE.erl
+++ b/lib/public_key/test/pkits_SUITE.erl
@@ -26,7 +26,6 @@
-compile(export_all).
-include_lib("public_key/include/public_key.hrl").
-%%-include("public_key.hrl").
-define(error(Format,Args), error(Format,Args,?FILE,?LINE)).
-define(warning(Format,Args), warning(Format,Args,?FILE,?LINE)).
@@ -42,18 +41,65 @@
-define(NIST5, "2.16.840.1.101.3.2.1.48.5").
-define(NIST6, "2.16.840.1.101.3.2.1.48.6").
+-record(verify_state, {
+ certs_db,
+ crl_info,
+ revoke_state}).
%%
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
all() ->
- [signature_verification, validity_periods,
- verifying_name_chaining,
- verifying_paths_with_self_issued_certificates,
- verifying_basic_constraints, key_usage,
- name_constraints, private_certificate_extensions].
+ [{group, signature_verification},
+ {group, validity_periods},
+ {group, verifying_name_chaining},
+ {group, verifying_paths_with_self_issued_certificates},
+ %%{group, basic_certificate_revocation_tests},
+ %%{group, delta_crls},
+ %%{group, distribution_points},
+ {group, verifying_basic_constraints},
+ {group, key_usage},
+ {group, name_constraints},
+ {group, private_certificate_extensions}].
groups() ->
- [].
+ [{signature_verification, [], [valid_rsa_signature,
+ invalid_rsa_signature, valid_dsa_signature,
+ invalid_dsa_signature]},
+ {validity_periods, [],
+ [not_before_invalid, not_before_valid, not_after_invalid, not_after_valid]},
+ {verifying_name_chaining, [],
+ [invalid_name_chain, whitespace_name_chain, capitalization_name_chain,
+ uid_name_chain, attrib_name_chain, string_name_chain]},
+ {verifying_paths_with_self_issued_certificates, [],
+ [basic_valid, basic_invalid, crl_signing_valid, crl_signing_invalid]},
+ %% {basic_certificate_revocation_tests, [],
+ %% [missing_CRL, revoked_CA, revoked_peer, invalid_CRL_signature,
+ %% invalid_CRL_issuer, invalid_CRL, valid_CRL,
+ %% unknown_CRL_extension, old_CRL, fresh_CRL, valid_serial,
+ %% invalid_serial, valid_seperate_keys, invalid_separate_keys]},
+ %% {delta_crls, [], [delta_without_crl, valid_delta_crls, invalid_delta_crls]},
+ %% {distribution_points, [], [valid_distribution_points,
+ %% valid_distribution_points_no_issuing_distribution_point,
+ %% invalid_distribution_points, valid_only_contains,
+ %% invalid_only_contains, valid_only_some_reasons,
+ %% invalid_only_some_reasons, valid_indirect_crl,
+ %% invalid_indirect_crl, valid_crl_issuer, invalid_crl_issuer]},
+ {verifying_basic_constraints,[],
+ [missing_basic_constraints, valid_basic_constraint, invalid_path_constraints,
+ valid_path_constraints]},
+ {key_usage, [],
+ [invalid_key_usage, valid_key_usage]},
+ {name_constraints, [],
+ [valid_DN_name_constraints, invalid_DN_name_constraints,
+ valid_rfc822_name_constraints,
+ invalid_rfc822_name_constraints, valid_DN_and_rfc822_name_constraints,
+ invalid_DN_and_rfc822_name_constraints, valid_dns_name_constraints,
+ invalid_dns_name_constraints, valid_uri_name_constraints,
+ invalid_uri_name_constraints]},
+ {private_certificate_extensions, [],
+ [unknown_critical_extension, unknown_not_critical_extension]}
+ ].
init_per_group(_GroupName, Config) ->
Config.
@@ -61,112 +107,706 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+init_per_testcase(_Func, Config) ->
+ Datadir = proplists:get_value(data_dir, Config),
+ put(datadir, Datadir),
+ Config.
+
+end_per_testcase(_Func, Config) ->
+ Config.
+
+init_per_suite(Config) ->
+ {skip, "PKIX Conformance test certificates expired 14 of April 2011,"
+ " new conformance test suite uses new format so skip until PKCS-12 support is implemented"}.
+ %% try crypto:start() of
+ %% ok ->
+ %% Config
+ %% catch _:_ ->
+ %% {skip, "Crypto did not start"}
+ %% end.
+
+end_per_suite(_Config) ->
+ application:stop(crypto).
+
+%%-----------------------------------------------------------------------------
+valid_rsa_signature(doc) ->
+ ["Test rsa signatur verification"];
+valid_rsa_signature(suite) ->
+ [];
+valid_rsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.1", "Valid Signatures Test1", ok}]).
+
+invalid_rsa_signature(doc) ->
+ ["Test rsa signatur verification"];
+invalid_rsa_signature(suite) ->
+ [];
+invalid_rsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}},
+ { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}]).
+
+valid_dsa_signature(doc) ->
+ ["Test dsa signatur verification"];
+valid_dsa_signature(suite) ->
+ [];
+valid_dsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.4", "Valid DSA Signatures Test4", ok},
+ { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}]).
+
+invalid_dsa_signature(doc) ->
+ ["Test dsa signatur verification"];
+invalid_dsa_signature(suite) ->
+ [];
+invalid_dsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.6", "Invalid DSA Signature Test6",{bad_cert,invalid_signature}}]).
+%%-----------------------------------------------------------------------------
+not_before_invalid(doc) ->
+ [""];
+not_before_invalid(suite) ->
+ [];
+not_before_invalid(Config) when is_list(Config) ->
+ run([{ "4.2.1", "Invalid CA notBefore Date Test1",{bad_cert, cert_expired}},
+ { "4.2.2", "Invalid EE notBefore Date Test2",{bad_cert, cert_expired}}]).
+
+not_before_valid(doc) ->
+ [""];
+not_before_valid(suite) ->
+ [];
+not_before_valid(Config) when is_list(Config) ->
+ run([{ "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok},
+ { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}]).
+
+not_after_invalid(doc) ->
+ [""];
+not_after_invalid(suite) ->
+ [];
+not_after_invalid(Config) when is_list(Config) ->
+ run([{ "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}},
+ { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}},
+ { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7",{bad_cert, cert_expired}}]).
+
+not_after_valid(doc) ->
+ [""];
+not_after_valid(suite) ->
+ [];
+not_after_valid(Config) when is_list(Config) ->
+ run([{ "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]).
+%%-----------------------------------------------------------------------------
+invalid_name_chain(doc) ->
+ [""];
+invalid_name_chain(suite) ->
+ [];
+invalid_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}},
+ { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}]).
+
+whitespace_name_chain(doc) ->
+ [""];
+whitespace_name_chain(suite) ->
+ [];
+whitespace_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.3", "Valid Name Chaining Whitespace Test3", ok},
+ { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}]).
+
+capitalization_name_chain(doc) ->
+ [""];
+capitalization_name_chain(suite) ->
+ [];
+capitalization_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.5", "Valid Name Chaining Capitalization Test5",ok}]).
+
+uid_name_chain(doc) ->
+ [""];
+uid_name_chain(suite) ->
+ [];
+uid_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.6", "Valid Name Chaining UIDs Test6",ok}]).
+
+attrib_name_chain(doc) ->
+ [""];
+attrib_name_chain(suite) ->
+ [];
+attrib_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok},
+ { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}]).
+
+string_name_chain(doc) ->
+ [""];
+string_name_chain(suite) ->
+ [];
+string_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.9", "Valid UTF8String Encoded Names Test9", ok},
+ { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok},
+ { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]).
+
+%%-----------------------------------------------------------------------------
+
+basic_valid(doc) ->
+ [""];
+basic_valid(suite) ->
+ [];
+basic_valid(Config) when is_list(Config) ->
+ run([{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok},
+ { "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok},
+ { "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok}
+ ]).
+
+basic_invalid(doc) ->
+ [""];
+basic_invalid(suite) ->
+ [];
+basic_invalid(Config) when is_list(Config) ->
+ run([{"4.5.2", "Invalid Basic Self-Issued Old With New Test2",
+ {bad_cert, {revoked, keyCompromise}}},
+ {"4.5.5", "Invalid Basic Self-Issued New With Old Test5",
+ {bad_cert, {revoked, keyCompromise}}}
+ ]).
+
+crl_signing_valid(doc) ->
+ [""];
+crl_signing_valid(suite) ->
+ [];
+crl_signing_valid(Config) when is_list(Config) ->
+ run([{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}]).
+
+crl_signing_invalid(doc) ->
+ [""];
+crl_signing_invalid(suite) ->
+ [];
+crl_signing_invalid(Config) when is_list(Config) ->
+ run([{ "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8",
+ {bad_cert, invalid_key_usage}}
+ ]).
+
+%%-----------------------------------------------------------------------------
+missing_CRL(doc) ->
+ [""];
+missing_CRL(suite) ->
+ [];
+missing_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.1", "Missing CRL Test1",{bad_cert,
+ revocation_status_undetermined}}]).
+
+revoked_CA(doc) ->
+ [""];
+revoked_CA(suite) ->
+ [];
+revoked_CA(Config) when is_list(Config) ->
+ run([{ "4.4.2", "Invalid Revoked CA Test2", {bad_cert,
+ {revoked, keyCompromise}}}]).
+
+revoked_peer(doc) ->
+ [""];
+revoked_peer(suite) ->
+ [];
+revoked_peer(Config) when is_list(Config) ->
+ run([{ "4.4.3", "Invalid Revoked EE Test3", {bad_cert,
+ {revoked, keyCompromise}}}]).
+
+invalid_CRL_signature(doc) ->
+ [""];
+invalid_CRL_signature(suite) ->
+ [];
+invalid_CRL_signature(Config) when is_list(Config) ->
+ run([{ "4.4.4", "Invalid Bad CRL Signature Test4",
+ {bad_cert, revocation_status_undetermined}}]).
+
+invalid_CRL_issuer(doc) ->
+ [""];
+invalid_CRL_issuer(suite) ->
+ [];
+invalid_CRL_issuer(Config) when is_list(Config) ->
+ run({ "4.4.5", "Invalid Bad CRL Issuer Name Test5",
+ {bad_cert, revocation_status_undetermined}}).
+
+invalid_CRL(doc) ->
+ [""];
+invalid_CRL(suite) ->
+ [];
+invalid_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.6", "Invalid Wrong CRL Test6",
+ {bad_cert, revocation_status_undetermined}}]).
+
+valid_CRL(doc) ->
+ [""];
+valid_CRL(suite) ->
+ [];
+valid_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.7", "Valid Two CRLs Test7", ok}]).
+
+unknown_CRL_extension(doc) ->
+ [""];
+unknown_CRL_extension(suite) ->
+ [];
+unknown_CRL_extension(Config) when is_list(Config) ->
+ run([{ "4.4.8", "Invalid Unknown CRL Entry Extension Test8",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.9", "Invalid Unknown CRL Extension Test9",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.10", "Invalid Unknown CRL Extension Test10",
+ {bad_cert, revocation_status_undetermined}}]).
+
+old_CRL(doc) ->
+ [""];
+old_CRL(suite) ->
+ [];
+old_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.11", "Invalid Old CRL nextUpdate Test11",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12",
+ {bad_cert, revocation_status_undetermined}}]).
+
+fresh_CRL(doc) ->
+ [""];
+fresh_CRL(suite) ->
+ [];
+fresh_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}]).
+
+valid_serial(doc) ->
+ [""];
+valid_serial(suite) ->
+ [];
+valid_serial(Config) when is_list(Config) ->
+ run([
+ { "4.4.14", "Valid Negative Serial Number Test14",ok},
+ { "4.4.16", "Valid Long Serial Number Test16", ok},
+ { "4.4.17", "Valid Long Serial Number Test17", ok}
+ ]).
+
+invalid_serial(doc) ->
+ [""];
+invalid_serial(suite) ->
+ [];
+invalid_serial(Config) when is_list(Config) ->
+ run([{ "4.4.15", "Invalid Negative Serial Number Test15",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.18", "Invalid Long Serial Number Test18",
+ {bad_cert, {revoked, keyCompromise}}}]).
+
+valid_seperate_keys(doc) ->
+ [""];
+valid_seperate_keys(suite) ->
+ [];
+valid_seperate_keys(Config) when is_list(Config) ->
+ run([{ "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}]).
+
+invalid_separate_keys(doc) ->
+ [""];
+invalid_separate_keys(suite) ->
+ [];
+invalid_separate_keys(Config) when is_list(Config) ->
+ run([{ "4.4.20", "Invalid Separate Certificate and CRL Keys Test20",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+%%-----------------------------------------------------------------------------
+missing_basic_constraints(doc) ->
+ [""];
+missing_basic_constraints(suite) ->
+ [];
+missing_basic_constraints(Config) when is_list(Config) ->
+ run([{ "4.6.1", "Invalid Missing basicConstraints Test1",
+ {bad_cert, missing_basic_constraint}},
+ { "4.6.2", "Invalid cA False Test2",
+ {bad_cert, missing_basic_constraint}},
+ { "4.6.3", "Invalid cA False Test3",
+ {bad_cert, missing_basic_constraint}}]).
+
+valid_basic_constraint(doc) ->
+ [""];
+valid_basic_constraint(suite) ->
+ [];
+valid_basic_constraint(Config) when is_list(Config) ->
+ run([{"4.6.4", "Valid basicConstraints Not Critical Test4", ok}]).
+
+invalid_path_constraints(doc) ->
+ [""];
+invalid_path_constraints(suite) ->
+ [];
+invalid_path_constraints(Config) when is_list(Config) ->
+ run([{ "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}},
+ { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}},
+ { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}},
+ { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}},
+ { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}},
+ { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}},
+ { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16",
+ {bad_cert, max_path_length_reached}}]).
-signature_verification(doc) -> [""];
-signature_verification(suite) -> [];
-signature_verification(Config) when is_list(Config) ->
- run(signature_verification()).
-validity_periods(doc) -> [""];
-validity_periods(suite) -> [];
-validity_periods(Config) when is_list(Config) ->
- run(validity_periods()).
-verifying_name_chaining(doc) -> [""];
-verifying_name_chaining(suite) -> [];
-verifying_name_chaining(Config) when is_list(Config) ->
- run(verifying_name_chaining()).
-basic_certificate_revocation_tests(doc) -> [""];
-basic_certificate_revocation_tests(suite) -> [];
-basic_certificate_revocation_tests(Config) when is_list(Config) ->
- run(basic_certificate_revocation_tests()).
-verifying_paths_with_self_issued_certificates(doc) -> [""];
-verifying_paths_with_self_issued_certificates(suite) -> [];
-verifying_paths_with_self_issued_certificates(Config) when is_list(Config) ->
- run(verifying_paths_with_self_issued_certificates()).
-verifying_basic_constraints(doc) -> [""];
-verifying_basic_constraints(suite) -> [];
-verifying_basic_constraints(Config) when is_list(Config) ->
- run(verifying_basic_constraints()).
-key_usage(doc) -> [""];
-key_usage(suite) -> [];
-key_usage(Config) when is_list(Config) ->
- run(key_usage()).
+valid_path_constraints(doc) ->
+ [""];
+valid_path_constraints(suite) ->
+ [];
+valid_path_constraints(Config) when is_list(Config) ->
+ run([{ "4.6.7", "Valid pathLenConstraint Test7", ok},
+ { "4.6.8", "Valid pathLenConstraint Test8", ok},
+ { "4.6.13", "Valid pathLenConstraint Test13", ok},
+ { "4.6.14", "Valid pathLenConstraint Test14", ok},
+ { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok},
+ { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]).
+
+%%-----------------------------------------------------------------------------
+invalid_key_usage(doc) ->
+ [""];
+invalid_key_usage(suite) ->
+ [];
+invalid_key_usage(Config) when is_list(Config) ->
+ run([{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1",
+ {bad_cert,invalid_key_usage} },
+ { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2",
+ {bad_cert,invalid_key_usage}},
+ { "4.7.4", "Invalid keyUsage Critical cRLSign False Test4",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+
+valid_key_usage(doc) ->
+ [""];
+valid_key_usage(suite) ->
+ [];
+valid_key_usage(Config) when is_list(Config) ->
+ run([{ "4.7.3", "Valid keyUsage Not Critical Test3", ok}]).
+
+%%-----------------------------------------------------------------------------
certificate_policies(doc) -> [""];
certificate_policies(suite) -> [];
certificate_policies(Config) when is_list(Config) ->
run(certificate_policies()).
+%%-----------------------------------------------------------------------------
require_explicit_policy(doc) -> [""];
require_explicit_policy(suite) -> [];
require_explicit_policy(Config) when is_list(Config) ->
run(require_explicit_policy()).
+%%-----------------------------------------------------------------------------
policy_mappings(doc) -> [""];
policy_mappings(suite) -> [];
policy_mappings(Config) when is_list(Config) ->
run(policy_mappings()).
+%%-----------------------------------------------------------------------------
inhibit_policy_mapping(doc) -> [""];
inhibit_policy_mapping(suite) -> [];
inhibit_policy_mapping(Config) when is_list(Config) ->
run(inhibit_policy_mapping()).
+%%-----------------------------------------------------------------------------
inhibit_any_policy(doc) -> [""];
inhibit_any_policy(suite) -> [];
inhibit_any_policy(Config) when is_list(Config) ->
run(inhibit_any_policy()).
-name_constraints(doc) -> [""];
-name_constraints(suite) -> [];
-name_constraints(Config) when is_list(Config) ->
- run(name_constraints()).
-distribution_points(doc) -> [""];
-distribution_points(suite) -> [];
-distribution_points(Config) when is_list(Config) ->
- run(distribution_points()).
-delta_crls(doc) -> [""];
-delta_crls(suite) -> [];
-delta_crls(Config) when is_list(Config) ->
- run(delta_crls()).
-private_certificate_extensions(doc) -> [""];
-private_certificate_extensions(suite) -> [];
-private_certificate_extensions(Config) when is_list(Config) ->
- run(private_certificate_extensions()).
-
-run() ->
- Tests =
- [signature_verification(),
- validity_periods(),
- verifying_name_chaining(),
- %%basic_certificate_revocation_tests(),
- verifying_paths_with_self_issued_certificates(),
- verifying_basic_constraints(),
- key_usage(),
- %%certificate_policies(),
- %%require_explicit_policy(),
- %%policy_mappings(),
- %%inhibit_policy_mapping(),
- %%inhibit_any_policy(),
- name_constraints(),
- %distribution_points(),
- %delta_crls(),
- private_certificate_extensions()
- ],
- run(lists:append(Tests)).
+%%-----------------------------------------------------------------------------
+
+valid_DN_name_constraints(doc) ->
+ [""];
+valid_DN_name_constraints(suite) ->
+ [];
+valid_DN_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.1", "Valid DN nameConstraints Test1", ok},
+ { "4.13.4", "Valid DN nameConstraints Test4", ok},
+ { "4.13.5", "Valid DN nameConstraints Test5", ok},
+ { "4.13.6", "Valid DN nameConstraints Test6", ok},
+ { "4.13.11", "Valid DN nameConstraints Test11", ok},
+ { "4.13.14", "Valid DN nameConstraints Test14", ok},
+ { "4.13.18", "Valid DN nameConstraints Test18", ok},
+ { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}]).
+
+invalid_DN_name_constraints(doc) ->
+ [""];
+invalid_DN_name_constraints(suite) ->
+ [];
+invalid_DN_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}},
+ { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}},
+ { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}},
+ { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}},
+ { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}},
+ { "4.13.10", "Invalid DN nameConstraints Test10",{bad_cert, name_not_permitted}},
+ { "4.13.12", "Invalid DN nameConstraints Test12",{bad_cert, name_not_permitted}},
+ { "4.13.13", "Invalid DN nameConstraints Test13",{bad_cert, name_not_permitted}},
+ { "4.13.15", "Invalid DN nameConstraints Test15",{bad_cert, name_not_permitted}},
+ { "4.13.16", "Invalid DN nameConstraints Test16",{bad_cert, name_not_permitted}},
+ { "4.13.17", "Invalid DN nameConstraints Test17",{bad_cert, name_not_permitted}},
+ { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20",
+ {bad_cert, name_not_permitted}}]).
+
+valid_rfc822_name_constraints(doc) ->
+ [""];
+valid_rfc822_name_constraints(suite) ->
+ [];
+valid_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.21", "Valid RFC822 nameConstraints Test21", ok},
+ { "4.13.23", "Valid RFC822 nameConstraints Test23", ok},
+ { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}]).
+
+
+invalid_rfc822_name_constraints(doc) ->
+ [""];
+invalid_rfc822_name_constraints(suite) ->
+ [];
+invalid_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.22", "Invalid RFC822 nameConstraints Test22",
+ {bad_cert, name_not_permitted}},
+ { "4.13.24", "Invalid RFC822 nameConstraints Test24",
+ {bad_cert, name_not_permitted}},
+ { "4.13.26", "Invalid RFC822 nameConstraints Test26",
+ {bad_cert, name_not_permitted}}]).
+
+valid_DN_and_rfc822_name_constraints(doc) ->
+ [""];
+valid_DN_and_rfc822_name_constraints(suite) ->
+ [];
+valid_DN_and_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}]).
+
+invalid_DN_and_rfc822_name_constraints(doc) ->
+ [""];
+invalid_DN_and_rfc822_name_constraints(suite) ->
+ [];
+invalid_DN_and_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.28", "Invalid DN and RFC822 nameConstraints Test28",
+ {bad_cert, name_not_permitted}},
+ { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29",
+ {bad_cert, name_not_permitted}}]).
+
+valid_dns_name_constraints(doc) ->
+ [""];
+valid_dns_name_constraints(suite) ->
+ [];
+valid_dns_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.30", "Valid DNS nameConstraints Test30", ok},
+ { "4.13.32", "Valid DNS nameConstraints Test32", ok}]).
+
+invalid_dns_name_constraints(doc) ->
+ [""];
+invalid_dns_name_constraints(suite) ->
+ [];
+invalid_dns_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted}},
+ { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}},
+ { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted}}]).
+
+valid_uri_name_constraints(doc) ->
+ [""];
+valid_uri_name_constraints(suite) ->
+ [];
+valid_uri_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.34", "Valid URI nameConstraints Test34", ok},
+ { "4.13.36", "Valid URI nameConstraints Test36", ok}]).
+
+invalid_uri_name_constraints(doc) ->
+ [""];
+invalid_uri_name_constraints(suite) ->
+ [];
+invalid_uri_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.35", "Invalid URI nameConstraints Test35",{bad_cert, name_not_permitted}},
+ { "4.13.37", "Invalid URI nameConstraints Test37",{bad_cert, name_not_permitted}}]).
+
+%%-----------------------------------------------------------------------------
+delta_without_crl(doc) ->
+ [""];
+delta_without_crl(suite) ->
+ [];
+delta_without_crl(Config) when is_list(Config) ->
+ run([{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1",{bad_cert,
+ revocation_status_undetermined}},
+ {"4.15.10", "Invalid delta-CRL Test10", {bad_cert,
+ revocation_status_undetermined}}]).
+
+valid_delta_crls(doc) ->
+ [""];
+valid_delta_crls(suite) ->
+ [];
+valid_delta_crls(Config) when is_list(Config) ->
+ run([{ "4.15.2", "Valid delta-CRL Test2", ok},
+ { "4.15.5", "Valid delta-CRL Test5", ok},
+ { "4.15.7", "Valid delta-CRL Test7", ok},
+ { "4.15.8", "Valid delta-CRL Test8", ok}
+ ]).
+
+invalid_delta_crls(doc) ->
+ [""];
+invalid_delta_crls(suite) ->
+ [];
+invalid_delta_crls(Config) when is_list(Config) ->
+ run([{ "4.15.3", "Invalid delta-CRL Test3", {bad_cert,{revoked, keyCompromise}}},
+ { "4.15.4", "Invalid delta-CRL Test4", {bad_cert,{revoked, keyCompromise}}},
+ { "4.15.6", "Invalid delta-CRL Test6", {bad_cert,{revoked, keyCompromise}}},
+ { "4.15.9", "Invalid delta-CRL Test9", {bad_cert,{revoked, keyCompromise}}}]).
+
+%%-----------------------------------------------------------------------------
+
+valid_distribution_points(doc) ->
+ [""];
+valid_distribution_points(suite) ->
+ [];
+valid_distribution_points(Config) when is_list(Config) ->
+ run([{ "4.14.1", "Valid distributionPoint Test1", ok},
+ { "4.14.4", "Valid distributionPoint Test4", ok},
+ { "4.14.5", "Valid distributionPoint Test5", ok},
+ { "4.14.7", "Valid distributionPoint Test7", ok}
+ ]).
+
+valid_distribution_points_no_issuing_distribution_point(doc) ->
+ [""];
+valid_distribution_points_no_issuing_distribution_point(suite) ->
+ [];
+valid_distribution_points_no_issuing_distribution_point(Config) when is_list(Config) ->
+ run([{ "4.14.10", "Valid No issuingDistributionPoint Test10", ok}
+ ]).
+
+invalid_distribution_points(doc) ->
+ [""];
+invalid_distribution_points(suite) ->
+ [];
+invalid_distribution_points(Config) when is_list(Config) ->
+ run([{ "4.14.2", "Invalid distributionPoint Test2", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.3", "Invalid distributionPoint Test3", {bad_cert,
+ revocation_status_undetermined}},
+ { "4.14.6", "Invalid distributionPoint Test6", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.8", "Invalid distributionPoint Test8", {bad_cert,
+ revocation_status_undetermined}},
+ { "4.14.9", "Invalid distributionPoint Test9", {bad_cert,
+ revocation_status_undetermined}}
+ ]).
+
+valid_only_contains(doc) ->
+ [""];
+valid_only_contains(suite) ->
+ [];
+valid_only_contains(Config) when is_list(Config) ->
+ run([{ "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}]).
+
+invalid_only_contains(doc) ->
+ [""];
+invalid_only_contains(suite) ->
+ [];
+invalid_only_contains(Config) when is_list(Config) ->
+ run([{ "4.14.11", "Invalid onlyContainsUserCerts CRL Test11",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.14.12", "Invalid onlyContainsCACerts CRL Test12",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.14.14", "Invalid onlyContainsAttributeCerts Test14",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+
+valid_only_some_reasons(doc) ->
+ [""];
+valid_only_some_reasons(suite) ->
+ [];
+valid_only_some_reasons(Config) when is_list(Config) ->
+ run([{ "4.14.18", "Valid onlySomeReasons Test18", ok},
+ { "4.14.19", "Valid onlySomeReasons Test19", ok}
+ ]).
+
+invalid_only_some_reasons(doc) ->
+ [""];
+invalid_only_some_reasons(suite) ->
+ [];
+invalid_only_some_reasons(Config) when is_list(Config) ->
+ run([{ "4.14.15", "Invalid onlySomeReasons Test15",
+ {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.16", "Invalid onlySomeReasons Test16",
+ {bad_cert,{revoked, certificateHold}}},
+ { "4.14.17", "Invalid onlySomeReasons Test17",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.14.20", "Invalid onlySomeReasons Test20",
+ {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.21", "Invalid onlySomeReasons Test21",
+ {bad_cert,{revoked, affiliationChanged}}}
+ ]).
+
+valid_indirect_crl(doc) ->
+ [""];
+valid_indirect_crl(suite) ->
+ [];
+valid_indirect_crl(Config) when is_list(Config) ->
+ run([{ "4.14.22", "Valid IDP with indirectCRL Test22", ok},
+ { "4.14.24", "Valid IDP with indirectCRL Test24", ok},
+ { "4.14.25", "Valid IDP with indirectCRL Test25", ok}
+ ]).
+
+invalid_indirect_crl(doc) ->
+ [""];
+invalid_indirect_crl(suite) ->
+ [];
+invalid_indirect_crl(Config) when is_list(Config) ->
+ run([{ "4.14.23", "Invalid IDP with indirectCRL Test23",
+ {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.26", "Invalid IDP with indirectCRL Test26",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+
+valid_crl_issuer(doc) ->
+ [""];
+valid_crl_issuer(suite) ->
+ [];
+valid_crl_issuer(Config) when is_list(Config) ->
+ run([{ "4.14.28", "Valid cRLIssuer Test28", ok}%%,
+ %%{ "4.14.29", "Valid cRLIssuer Test29", ok},
+ %%{ "4.14.33", "Valid cRLIssuer Test33", ok}
+ ]).
+
+invalid_crl_issuer(doc) ->
+ [""];
+invalid_crl_issuer(suite) ->
+ [];
+invalid_crl_issuer(Config) when is_list(Config) ->
+ run([
+ { "4.14.27", "Invalid cRLIssuer Test27", {bad_cert, revocation_status_undetermined}},
+ { "4.14.31", "Invalid cRLIssuer Test31", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.32", "Invalid cRLIssuer Test32", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.34", "Invalid cRLIssuer Test34", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.35", "Invalid cRLIssuer Test35", {bad_cert, revocation_status_undetermined}}
+ ]).
+
+
+%%distribution_points() ->
+ %%{ "4.14", "Distribution Points" },
+%% [
+ %% Although this test is valid it has a circular dependency. As a result
+ %% an attempt is made to reursively checks a CRL path and rejected due to
+ %% a CRL path validation error. PKITS notes suggest this test does not
+ %% need to be run due to this issue.
+%% { "4.14.30", "Valid cRLIssuer Test30", 54 }].
+
+
+%%-----------------------------------------------------------------------------
+
+unknown_critical_extension(doc) ->
+ [""];
+unknown_critical_extension(suite) ->
+ [];
+unknown_critical_extension(Config) when is_list(Config) ->
+ run([{ "4.16.2", "Invalid Unknown Critical Certificate Extension Test2",
+ {bad_cert,unknown_critical_extension}}]).
+
+unknown_not_critical_extension(doc) ->
+ [""];
+unknown_not_critical_extension(suite) ->
+ [];
+unknown_not_critical_extension(Config) when is_list(Config) ->
+ run([{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}]).
+
+%%-----------------------------------------------------------------------------
run(Tests) ->
File = file(?CERTS,"TrustAnchorRootCertificate.crt"),
{ok, TA} = file:read_file(File),
run(Tests, TA).
run({Chap, Test, Result}, TA) ->
- CertChain = sort_chain(read_certs(Test),TA, [], false),
- try public_key:pkix_path_validation(TA, CertChain, []) of
- {Result, _} -> ok;
+ CertChain = sort_chain(read_certs(Test),TA, [], false, Chap),
+ Options = path_validation_options(TA, Chap,Test),
+ try public_key:pkix_path_validation(TA, CertChain, Options) of
+ {Result, _} -> ok;
{error,Result} when Result =/= ok ->
ok;
- {error,Error} when is_integer(Result) ->
- ?warning(" ~p~n Got ~p expected ~p~n",[Test, Error, Result]);
- {error,Error} when Result =/= ok ->
- ?error(" minor ~p~n Got ~p expected ~p~n",[Test, Error, Result]);
{error, Error} ->
?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, Error]),
fail;
- {ok, _} when Result =/= ok ->
+ {ok, _OK} when Result =/= ok ->
?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, ok]),
fail
catch Type:Reason ->
@@ -181,14 +821,318 @@ run([Test|Rest],TA) ->
run(Rest,TA);
run([],_) -> ok.
+path_validation_options(TA, Chap, Test) ->
+ case needs_crl_options(Chap) of
+ true ->
+ crl_options(TA, Test);
+ false ->
+ Fun =
+ fun(_,{bad_cert, _} = Reason, _) ->
+ {fail, Reason};
+ (_,{extension, _}, UserState) ->
+ {unknown, UserState};
+ (_, Valid, UserState) when Valid == valid;
+ Valid == valid_peer ->
+ {valid, UserState}
+ end,
+ [{verify_fun, {Fun, []}}]
+ end.
+
+needs_crl_options("4.4" ++ _) ->
+ true;
+needs_crl_options("4.5" ++ _) ->
+ true;
+needs_crl_options("4.7.4" ++ _) ->
+ true;
+needs_crl_options("4.7.5" ++ _) ->
+ true;
+needs_crl_options("4.14" ++ _) ->
+ true;
+needs_crl_options("4.15" ++ _) ->
+ true;
+needs_crl_options(_) ->
+ false.
+
+crl_options(TA, Test) ->
+ case read_crls(Test) of
+ [] ->
+ [];
+ CRLs ->
+ Fun =
+ fun(_,{bad_cert, _} = Reason, _) ->
+ {fail, Reason};
+ (_,{extension,
+ #'Extension'{extnID = ?'id-ce-cRLDistributionPoints',
+ extnValue = Value}}, UserState0) ->
+ UserState = update_crls(Value, UserState0),
+ {valid, UserState};
+ (_,{extension, _}, UserState) ->
+ {unknown, UserState};
+ (OtpCert, Valid, UserState) when Valid == valid;
+ Valid == valid_peer ->
+ {ErlCerts, CRLs} = UserState#verify_state.crl_info,
+ CRLInfo0 =
+ crl_info(OtpCert,
+ ErlCerts,[{DerCRL, public_key:der_decode('CertificateList',
+ DerCRL)} || DerCRL <- CRLs],
+ []),
+ CRLInfo = lists:reverse(CRLInfo0),
+ Certs = UserState#verify_state.certs_db,
+ Fun = fun(DP, CRLtoValidate, Id, CertsDb) ->
+ trusted_cert_and_path(DP, CRLtoValidate, Id, CertsDb)
+ end,
+ Ignore = ignore_sign_test_when_building_path(Test),
+ case public_key:pkix_crls_validate(OtpCert, CRLInfo,
+ [{issuer_fun,{Fun, {Ignore, Certs}}}]) of
+ valid ->
+ {valid, UserState};
+ Reason ->
+ {fail, Reason}
+ end
+ end,
+
+ Certs = read_certs(Test),
+ ErlCerts = [public_key:pkix_decode_cert(Cert, otp) || Cert <- Certs],
+
+ [{verify_fun, {Fun, #verify_state{certs_db = [TA| Certs],
+ crl_info = {ErlCerts, CRLs}}}}]
+ end.
+
+crl_info(_, _, [], Acc) ->
+ Acc;
+crl_info(OtpCert, Certs, [{_, #'CertificateList'{tbsCertList =
+ #'TBSCertList'{issuer = Issuer,
+ crlExtensions = CRLExtensions}}}
+ = CRL | Rest], Acc) ->
+ OtpTBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ Extensions = OtpTBSCert#'OTPTBSCertificate'.extensions,
+ ExtList = pubkey_cert:extensions_list(CRLExtensions),
+ DPs = case pubkey_cert:select_extension(?'id-ce-cRLDistributionPoints', Extensions) of
+ #'Extension'{extnValue = Value} ->
+ lists:map(fun(Point) -> pubkey_cert_records:transform(Point, decode) end, Value);
+ _ ->
+ case same_issuer(OtpCert, Issuer) of
+ true ->
+ [make_dp(ExtList, asn1_NOVALUE, Issuer)];
+ false ->
+ [make_dp(ExtList, Issuer, ignore)]
+ end
+ end,
+ DPsCRLs = lists:map(fun(DP) -> {DP, CRL} end, DPs),
+ crl_info(OtpCert, Certs, Rest, DPsCRLs ++ Acc).
+
+ignore_sign_test_when_building_path("Invalid Bad CRL Signature Test4") ->
+ true;
+ignore_sign_test_when_building_path(_) ->
+ false.
+
+same_issuer(OTPCert, Issuer) ->
+ DecIssuer = pubkey_cert_records:transform(Issuer, decode),
+ OTPTBSCert = OTPCert#'OTPCertificate'.tbsCertificate,
+ CertIssuer = OTPTBSCert#'OTPTBSCertificate'.issuer,
+ pubkey_cert:is_issuer(DecIssuer, CertIssuer).
+
+make_dp(Extensions, Issuer0, DpInfo) ->
+ {Issuer, Point} = mk_issuer_dp(Issuer0, DpInfo),
+ case pubkey_cert:select_extension('id-ce-cRLReason', Extensions) of
+ #'Extension'{extnValue = Reasons} ->
+ #'DistributionPoint'{cRLIssuer = Issuer,
+ reasons = Reasons,
+ distributionPoint = Point};
+ _ ->
+ #'DistributionPoint'{cRLIssuer = Issuer,
+ reasons = [unspecified, keyCompromise,
+ cACompromise, affiliationChanged, superseded,
+ cessationOfOperation, certificateHold,
+ removeFromCRL, privilegeWithdrawn, aACompromise],
+ distributionPoint = Point}
+ end.
+
+mk_issuer_dp(asn1_NOVALUE, Issuer) ->
+ {asn1_NOVALUE, {fullName, [{directoryName, Issuer}]}};
+mk_issuer_dp(Issuer, _) ->
+ {[{directoryName, Issuer}], asn1_NOVALUE}.
+
+update_crls(_, State) ->
+ State.
+
+trusted_cert_and_path(DP, CRL, Id, {Ignore, CertsList}) ->
+ case crl_issuer(crl_issuer_name(DP), CRL, Id, CertsList, CertsList, Ignore) of
+ {ok, IssuerCert, DerIssuerCert} ->
+ Certs = [{public_key:pkix_decode_cert(Cert, otp), Cert} || Cert <- CertsList],
+ CertChain = build_chain(Certs, Certs, IssuerCert, Ignore, [DerIssuerCert]),
+ {ok, public_key:pkix_decode_cert(hd(CertChain), otp), CertChain};
+ Other ->
+ Other
+ end.
+
+crl_issuer_name(#'DistributionPoint'{cRLIssuer = asn1_NOVALUE}) ->
+ undefined;
+crl_issuer_name(#'DistributionPoint'{cRLIssuer = [{directoryName, Issuer}]}) ->
+ pubkey_cert_records:transform(Issuer, decode).
+
+build_chain([],_, _, _,Acc) ->
+ Acc;
+
+build_chain([{First, DerFirst}|Certs], All, Cert, Ignore, Acc) ->
+ case public_key:pkix_is_self_signed(Cert) andalso is_test_root(Cert) of
+ true ->
+ Acc;
+ false ->
+ case public_key:pkix_is_issuer(Cert, First)
+ %%andalso check_extension_cert_signer(First)
+ andalso is_signer(First, Cert, Ignore)
+ of
+ true ->
+ build_chain(All, All, First, Ignore, [DerFirst | Acc]);
+ false ->
+ build_chain(Certs, All, Cert, Ignore, Acc)
+ end
+ end.
+
+is_signer(_,_, true) ->
+ true;
+is_signer(Signer, #'OTPCertificate'{} = Cert,_) ->
+ TBSCert = Signer#'OTPCertificate'.tbsCertificate,
+ PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
+ PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey,
+ AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm,
+ PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters,
+ try pubkey_cert:validate_signature(Cert, public_key:pkix_encode('OTPCertificate',
+ Cert, otp),
+ PublicKey, PublicKeyParams, true, ?DEFAULT_VERIFYFUN) of
+ true ->
+ true
+ catch
+ _:_ ->
+ false
+ end;
+is_signer(Signer, #'CertificateList'{} = CRL, _) ->
+ TBSCert = Signer#'OTPCertificate'.tbsCertificate,
+ PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
+ PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey,
+ AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm,
+ PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters,
+ pubkey_crl:verify_crl_signature(CRL, public_key:pkix_encode('CertificateList',
+ CRL, plain),
+ PublicKey, PublicKeyParams).
+
+is_test_root(OtpCert) ->
+ TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ {rdnSequence, AtterList} = TBSCert#'OTPTBSCertificate'.issuer,
+ lists:member([{'AttributeTypeAndValue',{2,5,4,3},{printableString,"Trust Anchor"}}],
+ AtterList).
+
+check_extension_cert_signer(OtpCert) ->
+ TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ Extensions = TBSCert#'OTPTBSCertificate'.extensions,
+ case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of
+ #'Extension'{extnValue = KeyUse} ->
+ lists:member(keyCertSign, KeyUse);
+ _ ->
+ true
+ end.
+
+check_extension_crl_signer(OtpCert) ->
+ TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ Extensions = TBSCert#'OTPTBSCertificate'.extensions,
+ case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of
+ #'Extension'{extnValue = KeyUse} ->
+ lists:member(cRLSign, KeyUse);
+ _ ->
+ true
+ end.
+
+crl_issuer(undefined, CRL, issuer_not_found, _, CertsList, Ignore) ->
+ crl_issuer(CRL, CertsList, Ignore);
+
+crl_issuer(IssuerName, CRL, issuer_not_found, CertsList, CertsList, Ignore) ->
+ crl_issuer(IssuerName, CRL, IssuerName, CertsList, CertsList, Ignore);
+
+crl_issuer(undefined, CRL, Id, [Cert | Rest], All, false) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate,
+ SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber,
+ Issuer = public_key:pkix_normalize_name(
+ TBSCertificate#'OTPTBSCertificate'.subject),
+ Bool = is_signer(ErlCert, CRL, false),
+ case {SerialNumber, Issuer} of
+ Id when Bool == true ->
+ {ok, ErlCert, Cert};
+ _ ->
+ crl_issuer(undefined, CRL, Id, Rest, All, false)
+ end;
+
+crl_issuer(IssuerName, CRL, Id, [Cert | Rest], All, false) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate,
+ SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber,
+ %%Issuer = public_key:pkix_normalize_name(
+ %% TBSCertificate#'OTPTBSCertificate'.subject),
+ Bool = is_signer(ErlCert, CRL, false),
+ case {SerialNumber, IssuerName} of
+ Id when Bool == true ->
+ {ok, ErlCert, Cert};
+ {_, IssuerName} when Bool == true ->
+ {ok, ErlCert, Cert};
+ _ ->
+ crl_issuer(IssuerName, CRL, Id, Rest, All, false)
+ end;
+
+crl_issuer(undefined, CRL, _, [], CertsList, Ignore) ->
+ crl_issuer(CRL, CertsList, Ignore);
+crl_issuer(CRLName, CRL, _, [], CertsList, Ignore) ->
+ crl_issuer(CRLName, CRL, CertsList, Ignore).
+
+
+crl_issuer(_, [],_) ->
+ {error, issuer_not_found};
+crl_issuer(CRL, [Cert | Rest], Ignore) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ case public_key:pkix_is_issuer(CRL, ErlCert) andalso
+ check_extension_crl_signer(ErlCert) andalso
+ is_signer(ErlCert, CRL, Ignore)
+ of
+ true ->
+ {ok, ErlCert,Cert};
+ false ->
+ crl_issuer(CRL, Rest, Ignore)
+ end.
+
+crl_issuer(_,_, [],_) ->
+ {error, issuer_not_found};
+crl_issuer(IssuerName, CRL, [Cert | Rest], Ignore) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate,
+ Issuer = public_key:pkix_normalize_name(
+ TBSCertificate#'OTPTBSCertificate'.subject),
+
+ case
+ public_key:pkix_is_issuer(CRL, ErlCert) andalso
+ check_extension_crl_signer(ErlCert) andalso
+ is_signer(ErlCert, CRL, Ignore)
+ of
+ true ->
+ case pubkey_cert:is_issuer(Issuer, IssuerName) of
+ true ->
+ {ok, ErlCert,Cert};
+ false ->
+ crl_issuer(IssuerName, CRL, Rest, Ignore)
+ end;
+ false ->
+ crl_issuer(IssuerName, CRL, Rest, Ignore)
+ end.
read_certs(Test) ->
File = test_file(Test),
- %% io:format("Read ~p ",[File]),
Ders = erl_make_certs:pem_to_der(File),
- %% io:format("Ders ~p ~n",[length(Ders)]),
[Cert || {'Certificate', Cert, not_encrypted} <- Ders].
+read_crls(Test) ->
+ File = test_file(Test),
+ Ders = erl_make_certs:pem_to_der(File),
+ [CRL || {'CertificateList', CRL, not_encrypted} <- Ders].
+
test_file(Test) ->
file(?CONV, lists:append(string:tokens(Test, " -")) ++ ".pem").
@@ -206,118 +1150,89 @@ file(Sub,File) ->
end,
AbsFile.
-sort_chain([First|Certs], TA, Try, Found) ->
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.3"->
+ [CA, Entity, Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Self, Entity];
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.4";
+ Chap == "4.5.5" ->
+ [CA, Entity, _Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.24";
+ Chap == "4.14.25";
+ Chap == "4.14.26";
+ Chap == "4.14.27";
+ Chap == "4.14.31";
+ Chap == "4.14.32";
+ Chap == "4.14.33" ->
+ [_OtherCA, Entity, CA] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.28";
+ Chap == "4.14.29" ->
+ [CA, _OtherCA, Entity] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.33" ->
+ [Entity, CA, _OtherCA] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+
+sort_chain(Certs, TA, Acc, Bool, Chap) ->
+ do_sort_chain(Certs, TA, Acc, Bool, Chap).
+
+do_sort_chain([First], TA, Try, Found, Chap) when Chap == "4.5.6";
+ Chap == "4.5.7";
+ Chap == "4.4.19";
+ Chap == "4.4.20";
+ Chap == "4.4.21"->
case public_key:pkix_is_issuer(First,TA) of
true ->
- [First|sort_chain(Certs,First,Try,true)];
+ [First|do_sort_chain([],First,Try,true, Chap)];
false ->
- sort_chain(Certs,TA,[First|Try],Found)
+ do_sort_chain([],TA,[First|Try],Found, Chap)
end;
-sort_chain([], _, [],_) -> [];
-sort_chain([], Valid, Check, true) ->
- sort_chain(lists:reverse(Check), Valid, [], false);
-sort_chain([], _Valid, Check, false) ->
+do_sort_chain([First|Certs], TA, Try, Found, Chap) when Chap == "4.5.6";
+ Chap == "4.5.7";
+ Chap == "4.4.19";
+ Chap == "4.4.20";
+ Chap == "4.4.21"->
+%% case check_extension_cert_signer(public_key:pkix_decode_cert(First, otp)) of
+%% true ->
+ case public_key:pkix_is_issuer(First,TA) of
+ true ->
+ [First|do_sort_chain(Certs,First,Try,true, Chap)];
+ false ->
+ do_sort_chain(Certs,TA,[First|Try],Found, Chap)
+ end;
+%% false ->
+%% do_sort_chain(Certs, TA, Try, Found, Chap)
+%% end;
+
+do_sort_chain([First|Certs], TA, Try, Found, Chap) ->
+ case public_key:pkix_is_issuer(First,TA) of
+ true ->
+ [First|do_sort_chain(Certs,First,Try,true, Chap)];
+ false ->
+ do_sort_chain(Certs,TA,[First|Try],Found, Chap)
+ end;
+
+do_sort_chain([], _, [],_, _) -> [];
+do_sort_chain([], Valid, Check, true, Chap) ->
+ do_sort_chain(lists:reverse(Check), Valid, [], false, Chap);
+do_sort_chain([], _Valid, Check, false, _) ->
Check.
-signature_verification() ->
- %% "4.1", "Signature Verification" ,
- [{ "4.1.1", "Valid Signatures Test1", ok},
- { "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}},
- { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}},
- { "4.1.4", "Valid DSA Signatures Test4", ok},
- { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok},
- { "4.1.6", "Invalid DSA Signature Test6", {bad_cert,invalid_signature}}].
-validity_periods() ->
- %% { "4.2", "Validity Periods" },
- [{ "4.2.1", "Invalid CA notBefore Date Test1", {bad_cert, cert_expired}},
- { "4.2.2", "Invalid EE notBefore Date Test2", {bad_cert, cert_expired}},
- { "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok},
- { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok},
- { "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}},
- { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}},
- { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7", {bad_cert, cert_expired}},
- { "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}].
-verifying_name_chaining() ->
- %%{ "4.3", "Verifying Name Chaining" },
- [{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}},
- { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}},
- { "4.3.3", "Valid Name Chaining Whitespace Test3", ok},
- { "4.3.4", "Valid Name Chaining Whitespace Test4", ok},
- { "4.3.5", "Valid Name Chaining Capitalization Test5", ok},
- { "4.3.6", "Valid Name Chaining UIDs Test6", ok},
- { "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok},
- { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok},
- { "4.3.9", "Valid UTF8String Encoded Names Test9", ok},
- { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok},
- { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}].
-basic_certificate_revocation_tests() ->
- %%{ "4.4", "Basic Certificate Revocation Tests" },
- [{ "4.4.1", "Missing CRL Test1", 3 },
- { "4.4.2", "Invalid Revoked CA Test2", 23 },
- { "4.4.3", "Invalid Revoked EE Test3", 23 },
- { "4.4.4", "Invalid Bad CRL Signature Test4", 8 },
- { "4.4.5", "Invalid Bad CRL Issuer Name Test5", 3 },
- { "4.4.6", "Invalid Wrong CRL Test6", 3 },
- { "4.4.7", "Valid Two CRLs Test7", ok},
-
- %% The test document suggests these should return certificate revoked...
- %% Subsquent discussion has concluded they should not due to unhandle
- %% critical CRL extensions.
- { "4.4.8", "Invalid Unknown CRL Entry Extension Test8", 36 },
- { "4.4.9", "Invalid Unknown CRL Extension Test9", 36 },
-
- { "4.4.10", "Invalid Unknown CRL Extension Test10", 36 },
- { "4.4.11", "Invalid Old CRL nextUpdate Test11", 12 },
- { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", 12 },
- { "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok},
- { "4.4.14", "Valid Negative Serial Number Test14", ok},
- { "4.4.15", "Invalid Negative Serial Number Test15", 23 },
- { "4.4.16", "Valid Long Serial Number Test16", ok},
- { "4.4.17", "Valid Long Serial Number Test17", ok},
- { "4.4.18", "Invalid Long Serial Number Test18", 23 },
- { "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok},
- { "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", 23 },
-
- %% CRL path is revoked so get a CRL path validation error
- { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", 54 }].
-verifying_paths_with_self_issued_certificates() ->
- %%{ "4.5", "Verifying Paths with Self-Issued Certificates" },
- [{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok},
- %%{ "4.5.2", "Invalid Basic Self-Issued Old With New Test2", 23 },
- %%{ "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok},
- %%{ "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok},
- { "4.5.5", "Invalid Basic Self-Issued New With Old Test5", 23 },
- %%{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok},
- { "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", 23 },
- { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", {bad_cert,invalid_key_usage} }].
-verifying_basic_constraints() ->
- [%%{ "4.6", "Verifying Basic Constraints" },
- { "4.6.1", "Invalid Missing basicConstraints Test1",
- {bad_cert, missing_basic_constraint} },
- { "4.6.2", "Invalid cA False Test2", {bad_cert, missing_basic_constraint}},
- { "4.6.3", "Invalid cA False Test3", {bad_cert, missing_basic_constraint}},
- { "4.6.4", "Valid basicConstraints Not Critical Test4", ok},
- { "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}},
- { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}},
- { "4.6.7", "Valid pathLenConstraint Test7", ok},
- { "4.6.8", "Valid pathLenConstraint Test8", ok},
- { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}},
- { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}},
- { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}},
- { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}},
- { "4.6.13", "Valid pathLenConstraint Test13", ok},
- { "4.6.14", "Valid pathLenConstraint Test14", ok},
- { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok},
- { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", {bad_cert, max_path_length_reached}},
- { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}].
-key_usage() ->
- %%{ "4.7", "Key Usage" },
- [{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", {bad_cert,invalid_key_usage} },
- { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", {bad_cert,invalid_key_usage} },
- { "4.7.3", "Valid keyUsage Not Critical Test3", ok}
- %%,{ "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", 35 }
- %%,{ "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", 35 }
- ].
+error(Format, Args, File0, Line) ->
+ File = filename:basename(File0),
+ Pid = group_leader(),
+ Pid ! {failed, File, Line},
+ io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]).
+
+warning(Format, Args, File0, Line) ->
+ File = filename:basename(File0),
+ io:format("~s(~p): Warning "++Format, [File,Line|Args]).
%% Certificate policy tests need special handling. They can have several
%% sub tests and we need to check the outputs are correct.
@@ -425,182 +1340,3 @@ inhibit_any_policy() ->
{"4.12.8", "Invalid Self-Issued inhibitAnyPolicy Test8", 43 },
{"4.12.9", "Valid Self-Issued inhibitAnyPolicy Test9", ok},
{"4.12.10", "Invalid Self-Issued inhibitAnyPolicy Test10", 43 }].
-
-name_constraints() ->
- %%{ "4.13", "Name Constraints" },
- [{ "4.13.1", "Valid DN nameConstraints Test1", ok},
- { "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}},
- { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}},
- { "4.13.4", "Valid DN nameConstraints Test4", ok},
- { "4.13.5", "Valid DN nameConstraints Test5", ok},
- { "4.13.6", "Valid DN nameConstraints Test6", ok},
- { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}},
- { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}},
- { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}},
- { "4.13.10", "Invalid DN nameConstraints Test10", {bad_cert, name_not_permitted}},
- { "4.13.11", "Valid DN nameConstraints Test11", ok},
- { "4.13.12", "Invalid DN nameConstraints Test12", {bad_cert, name_not_permitted}},
- { "4.13.13", "Invalid DN nameConstraints Test13", {bad_cert, name_not_permitted}},
- { "4.13.14", "Valid DN nameConstraints Test14", ok},
- { "4.13.15", "Invalid DN nameConstraints Test15", {bad_cert, name_not_permitted}},
- { "4.13.16", "Invalid DN nameConstraints Test16", {bad_cert, name_not_permitted}},
- { "4.13.17", "Invalid DN nameConstraints Test17", {bad_cert, name_not_permitted}},
- { "4.13.18", "Valid DN nameConstraints Test18", ok},
- { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok},
- { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", {bad_cert, name_not_permitted} },
- { "4.13.21", "Valid RFC822 nameConstraints Test21", ok},
- { "4.13.22", "Invalid RFC822 nameConstraints Test22", {bad_cert, name_not_permitted} },
- { "4.13.23", "Valid RFC822 nameConstraints Test23", ok},
- { "4.13.24", "Invalid RFC822 nameConstraints Test24", {bad_cert, name_not_permitted} },
- { "4.13.25", "Valid RFC822 nameConstraints Test25", ok},
- { "4.13.26", "Invalid RFC822 nameConstraints Test26", {bad_cert, name_not_permitted}},
- { "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok},
- { "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", {bad_cert, name_not_permitted} },
- { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", {bad_cert, name_not_permitted} },
- { "4.13.30", "Valid DNS nameConstraints Test30", ok},
- { "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted} },
- { "4.13.32", "Valid DNS nameConstraints Test32", ok},
- { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}},
- { "4.13.34", "Valid URI nameConstraints Test34", ok},
- { "4.13.35", "Invalid URI nameConstraints Test35", {bad_cert, name_not_permitted} },
- { "4.13.36", "Valid URI nameConstraints Test36", ok},
- { "4.13.37", "Invalid URI nameConstraints Test37", {bad_cert, name_not_permitted}},
- { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted} }].
-distribution_points() ->
- %%{ "4.14", "Distribution Points" },
- [{ "4.14.1", "Valid distributionPoint Test1", ok},
- { "4.14.2", "Invalid distributionPoint Test2", 23 },
- { "4.14.3", "Invalid distributionPoint Test3", 44 },
- { "4.14.4", "Valid distributionPoint Test4", ok},
- { "4.14.5", "Valid distributionPoint Test5", ok},
- { "4.14.6", "Invalid distributionPoint Test6", 23 },
- { "4.14.7", "Valid distributionPoint Test7", ok},
- { "4.14.8", "Invalid distributionPoint Test8", 44 },
- { "4.14.9", "Invalid distributionPoint Test9", 44 },
- { "4.14.10", "Valid No issuingDistributionPoint Test10", ok},
- { "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", 44 },
- { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", 44 },
- { "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok},
- { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", 44 },
- { "4.14.15", "Invalid onlySomeReasons Test15", 23 },
- { "4.14.16", "Invalid onlySomeReasons Test16", 23 },
- { "4.14.17", "Invalid onlySomeReasons Test17", 3 },
- { "4.14.18", "Valid onlySomeReasons Test18", ok},
- { "4.14.19", "Valid onlySomeReasons Test19", ok},
- { "4.14.20", "Invalid onlySomeReasons Test20", 23 },
- { "4.14.21", "Invalid onlySomeReasons Test21", 23 },
- { "4.14.22", "Valid IDP with indirectCRL Test22", ok},
- { "4.14.23", "Invalid IDP with indirectCRL Test23", 23 },
- { "4.14.24", "Valid IDP with indirectCRL Test24", ok},
- { "4.14.25", "Valid IDP with indirectCRL Test25", ok},
- { "4.14.26", "Invalid IDP with indirectCRL Test26", 44 },
- { "4.14.27", "Invalid cRLIssuer Test27", 3 },
- { "4.14.28", "Valid cRLIssuer Test28", ok},
- { "4.14.29", "Valid cRLIssuer Test29", ok},
-
- %% Although this test is valid it has a circular dependency. As a result
- %% an attempt is made to reursively checks a CRL path and rejected due to
- %% a CRL path validation error. PKITS notes suggest this test does not
- %% need to be run due to this issue.
- { "4.14.30", "Valid cRLIssuer Test30", 54 },
- { "4.14.31", "Invalid cRLIssuer Test31", 23 },
- { "4.14.32", "Invalid cRLIssuer Test32", 23 },
- { "4.14.33", "Valid cRLIssuer Test33", ok},
- { "4.14.34", "Invalid cRLIssuer Test34", 23 },
- { "4.14.35", "Invalid cRLIssuer Test35", 44 }].
-delta_crls() ->
- %%{ "4.15", "Delta-CRLs" },
- [{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1", 3 },
- { "4.15.2", "Valid delta-CRL Test2", ok},
- { "4.15.3", "Invalid delta-CRL Test3", 23 },
- { "4.15.4", "Invalid delta-CRL Test4", 23 },
- { "4.15.5", "Valid delta-CRL Test5", ok},
- { "4.15.6", "Invalid delta-CRL Test6", 23 },
- { "4.15.7", "Valid delta-CRL Test7", ok},
- { "4.15.8", "Valid delta-CRL Test8", ok},
- { "4.15.9", "Invalid delta-CRL Test9", 23 },
- { "4.15.10", "Invalid delta-CRL Test10", 12 }].
-private_certificate_extensions() ->
- %%{ "4.16", "Private Certificate Extensions" },
- [{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok},
- { "4.16.2", "Invalid Unknown Critical Certificate Extension Test2",
- {bad_cert,unknown_critical_extension}}].
-
-
-convert() ->
- Tests = [signature_verification(),
- validity_periods(),
- verifying_name_chaining(),
- basic_certificate_revocation_tests(),
- verifying_paths_with_self_issued_certificates(),
- verifying_basic_constraints(),
- key_usage(),
- certificate_policies(),
- require_explicit_policy(),
- policy_mappings(),
- inhibit_policy_mapping(),
- inhibit_any_policy(),
- name_constraints(),
- distribution_points(),
- delta_crls(),
- private_certificate_extensions()],
- [convert(Test) || Test <- lists:flatten(Tests)].
-
-convert({_,Test,_}) ->
- convert1(Test);
-convert({_,Test,_,_,_,_,_}) ->
- convert1(Test).
-
-convert1(Test) ->
- FName = lists:append(string:tokens(Test, " -")),
- File = filename:join(?MIME, "Signed" ++ FName ++ ".eml"),
- io:format("Convert ~p~n",[File]),
- {ok, Mail} = file:read_file(File),
- Base64 = skip_lines(Mail),
- %%io:format("~s",[Base64]),
- Tmp = base64:mime_decode(Base64),
- file:write_file("pkits/smime-pem/tmp-pkcs7.der", Tmp),
- Cmd = "openssl pkcs7 -inform der -in pkits/smime-pem/tmp-pkcs7.der"
- " -print_certs -out pkits/smime-pem/" ++ FName ++ ".pem",
- case os:cmd(Cmd) of
- "" -> ok;
- Err ->
- io:format("~s",[Err]),
- erlang:error(bad_cmd)
- end.
-
-skip_lines(<<"\r\n\r\n", Rest/binary>>) -> Rest;
-skip_lines(<<"\n\n", Rest/binary>>) -> Rest;
-skip_lines(<<_:8, Rest/binary>>) ->
- skip_lines(Rest).
-
-init_per_testcase(_Func, Config) ->
- Datadir = proplists:get_value(data_dir, Config),
- put(datadir, Datadir),
- Config.
-
-end_per_testcase(_Func, Config) ->
- %% Nodes = select_nodes(all, Config, ?FILE, ?LINE),
- %% rpc:multicall(Nodes, mnesia, lkill, []),
- Config.
-
-init_per_suite(Config) ->
- try crypto:start() of
- ok ->
- Config
- catch _:_ ->
- {skip, "Crypto did not start"}
- end.
-
-end_per_suite(_Config) ->
- application:stop(crypto).
-
-error(Format, Args, File0, Line) ->
- File = filename:basename(File0),
- Pid = group_leader(),
- Pid ! {failed, File, Line},
- io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]).
-
-warning(Format, Args, File0, Line) ->
- File = filename:basename(File0),
- io:format("~s(~p): Warning "++Format, [File,Line|Args]).
diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk
index c99fd6fee1..3c6b012152 100644
--- a/lib/public_key/vsn.mk
+++ b/lib/public_key/vsn.mk
@@ -1 +1 @@
-PUBLIC_KEY_VSN = 0.11
+PUBLIC_KEY_VSN = 0.12
diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl
index 38e486b7a7..13753565d8 100644
--- a/lib/sasl/src/rb.erl
+++ b/lib/sasl/src/rb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-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
@@ -169,7 +169,7 @@ print_filters() ->
print_dates() ->
io:format(" - {StartDate, EndDate}~n"),
- io:format(" StartDate = EndDate = {{Y-M-D},{H,M,S}} ~n"),
+ io:format(" StartDate = EndDate = {{Y,M,D},{H,M,S}} ~n"),
io:format(" prints the reports with date between StartDate and EndDate~n"),
io:format(" - {StartDate, from}~n"),
io:format(" prints the reports with date greater than StartDate~n"),
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index af667b1a71..224b9d4af7 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -29,6 +29,19 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 2.0.5</title>
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Strengthened random number generation. (Thanks to Geoff Cant)</p>
+ <p>
+ Own Id: OTP-9225</p>
+ </item>
+ </list>
+ </section>
+</section>
+
<section><title>Ssh 2.0.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src
index 501da8ceb9..9be8c3c7d5 100644
--- a/lib/ssh/src/ssh.appup.src
+++ b/lib/ssh/src/ssh.appup.src
@@ -19,34 +19,44 @@
{"%VSN%",
[
- {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []},
+ {"2.0.4", [{load_module, ssh_bits, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []}]},
+ {"2.0.3", [{load_module, ssh_bits, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_file, soft_purge, soft_purge, []},
{load_module, ssh, soft_purge, soft_purge, []},
{load_module, ssh_rsa, soft_purge, soft_purge, []},
{load_module, ssh_acceptor, soft_purge, soft_purge, []},
{load_module, ssh_transport, soft_purge, soft_purge, []},
{load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []},
+ {"2.0.2", [{load_module, ssh_bits, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_file, soft_purge, soft_purge, []},
{load_module, ssh, soft_purge, soft_purge, []},
{load_module, ssh_rsa, soft_purge, soft_purge, []},
{load_module, ssh_acceptor, soft_purge, soft_purge, []},
{load_module, ssh_transport, soft_purge, soft_purge, []},
- {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.1", [{restart_application, ssh}]}
+ {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}
],
[
- {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []},
+ {"2.0.4", [{load_module, ssh_bits, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []}]},
+ {"2.0.3", [{load_module, ssh_bits, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_file, soft_purge, soft_purge, []},
{load_module, ssh, soft_purge, soft_purge, []},
{load_module, ssh_rsa, soft_purge, soft_purge, []},
{load_module, ssh_acceptor, soft_purge, soft_purge, []},
{load_module, ssh_transport, soft_purge, soft_purge, []},
{load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []},
+ {"2.0.2", [{load_module, ssh_bits, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_file, soft_purge, soft_purge, []},
{load_module, ssh, soft_purge, soft_purge, []},
{load_module, ssh_rsa, soft_purge, soft_purge, []},
{load_module, ssh_acceptor, soft_purge, soft_purge, []},
{load_module, ssh_transport, soft_purge, soft_purge, []},
- {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.1", [{restart_application, ssh}]}
+ {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}
]
}.
diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl
index 399581a0fd..3f0a06575c 100755
--- a/lib/ssh/src/ssh_bits.erl
+++ b/lib/ssh/src/ssh_bits.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2005-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
@@ -34,7 +34,7 @@
%% integer utils
-export([isize/1]).
-export([irandom/1, irandom/3]).
--export([random/1, random/3]).
+-export([random/1]).
-export([xor_bits/2, fill_bits/2]).
-export([i2bin/2, bin2i/1]).
@@ -401,9 +401,6 @@ xor_bits(XBits, YBits) ->
irandom(Bits) ->
irandom(Bits, 1, 0).
-%% irandom_odd(Bits) ->
-%% irandom(Bits, 1, 1).
-
%%
%% irandom(N, Top, Bottom)
%%
@@ -414,57 +411,16 @@ irandom(Bits) ->
%% Bot = 0 - do not set the least signifcant bit
%% Bot = 1 - set the least signifcant bit (i.e always odd)
%%
-irandom(0, _Top, _Bottom) ->
- 0;
-irandom(Bits, Top, Bottom) ->
- Bytes = (Bits+7) div 8,
- Skip = (8-(Bits rem 8)) rem 8,
- TMask = case Top of
- 0 -> 0;
- 1 -> 16#80;
- 2 -> 16#c0
- end,
- BMask = case Bottom of
- 0 -> 0;
- 1 -> (1 bsl Skip)
- end,
- <<X:Bits/big-unsigned-integer, _:Skip>> = random(Bytes, TMask, BMask),
- X.
+irandom(Bits, Top, Bottom) when is_integer(Top),
+ 0 =< Top, Top =< 2 ->
+ crypto:erlint(crypto:strong_rand_mpint(Bits, Top - 1, Bottom)).
%%
%% random/1
%% Generate N random bytes
%%
random(N) ->
- random(N, 0, 0).
-
-random(N, TMask, BMask) ->
- list_to_binary(rnd(N, TMask, BMask)).
-
-%% random/3
-%% random(Bytes, TopMask, BotMask)
-%% where
-%% Bytes is the number of bytes to generate
-%% TopMask is bitwised or'ed to the first byte
-%% BotMask is bitwised or'ed to the last byte
-%%
-rnd(0, _TMask, _BMask) ->
- [];
-rnd(1, TMask, BMask) ->
- [(rand8() bor TMask) bor BMask];
-rnd(N, TMask, BMask) ->
- [(rand8() bor TMask) | rnd_n(N-1, BMask)].
-
-rnd_n(1, BMask) ->
- [rand8() bor BMask];
-rnd_n(I, BMask) ->
- [rand8() | rnd_n(I-1, BMask)].
-
-rand8() ->
- (rand32() bsr 8) band 16#ff.
-
-rand32() ->
- random:uniform(16#100000000) -1.
+ crypto:strong_rand_bytes(N).
%%
%% Base 64 encode/decode
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 0ba11b0a26..2d82e6d77d 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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
@@ -106,8 +106,6 @@ peer_address(ConnectionHandler) ->
%% initialize.
%%--------------------------------------------------------------------
init([Role, Manager, Socket, SshOpts]) ->
- {A,B,C} = erlang:now(),
- random:seed(A, B, C),
{NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts),
ssh_bits:install_messages(ssh_transport:transport_messages(NumVsn)),
{Protocol, Callback, CloseTag} =
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 51f9f47446..8c9f671fd5 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 2.0.4
+SSH_VSN = 2.0.5
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index cd5c9281cd..60ea4d547f 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -266,7 +266,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
<p>Possible path validation errors: </p>
-<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p>
+<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p>
</item>
<tag>{hibernate_after, integer()|undefined}</tag>
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index d3e426f254..a0ecb4ac6f 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,6 +1,7 @@
%% -*- erlang -*-
{"%VSN%",
[
+ {"4.1.4", [{restart_application, ssl}]},
{"4.1.3", [{restart_application, ssl}]},
{"4.1.2", [{restart_application, ssl}]},
{"4.1.1", [{restart_application, ssl}]},
@@ -8,6 +9,7 @@
{"4.0.1", [{restart_application, ssl}]}
],
[
+ {"4.1.4", [{restart_application, ssl}]},
{"4.1.3", [{restart_application, ssl}]},
{"4.1.2", [{restart_application, ssl}]},
{"4.1.1", [{restart_application, ssl}]},
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index 2f1edfa186..0e80e42637 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 4.1.4
+SSL_VSN = 4.1.5
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 43df6f621d..574146b1cd 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -29,6 +29,8 @@
-export([init_it/6, init_it/7]).
+-export([format_status_header/2]).
+
-define(default_timeout, 5000).
%%-----------------------------------------------------------------
@@ -315,3 +317,10 @@ debug_options(Opts) ->
{ok, Options} -> sys:debug_options(Options);
_ -> []
end.
+
+format_status_header(TagLine, Pid) when is_pid(Pid) ->
+ lists:concat([TagLine, " ", pid_to_list(Pid)]);
+format_status_header(TagLine, RegName) when is_atom(RegName) ->
+ lists:concat([TagLine, " ", RegName]);
+format_status_header(TagLine, Name) ->
+ {TagLine, Name}.
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index b1e9e3a02f..b00910771f 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -724,7 +724,8 @@ get_modules(MSL) ->
%%-----------------------------------------------------------------
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData,
- Header = lists:concat(["Status for event handler ", ServerName]),
+ Header = gen:format_status_header("Status for event handler",
+ ServerName),
FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of
true ->
Args = [PDict, State],
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 7d9960b912..f2f1365d3d 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -614,15 +614,8 @@ get_msg(Msg) -> Msg.
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] =
StatusData,
- StatusHdr = "Status for state machine",
- Header = if
- is_pid(Name) ->
- lists:concat([StatusHdr, " ", pid_to_list(Name)]);
- is_atom(Name); is_list(Name) ->
- lists:concat([StatusHdr, " ", Name]);
- true ->
- {StatusHdr, Name}
- end,
+ Header = gen:format_status_header("Status for state machine",
+ Name),
Log = sys:get_debug(log, Debug, []),
DefaultStatus = [{data, [{"StateData", StateData}]}],
Specfic =
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index ac81df9cab..09d94a9c40 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -840,15 +840,8 @@ name_to_pid(Name) ->
%%-----------------------------------------------------------------
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData,
- StatusHdr = "Status for generic server",
- Header = if
- is_pid(Name) ->
- lists:concat([StatusHdr, " ", pid_to_list(Name)]);
- is_atom(Name); is_list(Name) ->
- lists:concat([StatusHdr, " ", Name]);
- true ->
- {StatusHdr, Name}
- end,
+ Header = gen:format_status_header("Status for generic server",
+ Name),
Log = sys:get_debug(log, Debug, []),
DefaultStatus = [{data, [{"State", State}]}],
Specfic =
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index 9e3e717e7d..b3a7edc140 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -25,13 +25,14 @@
-export([start/1, add_handler/1, add_sup_handler/1,
delete_handler/1, swap_handler/1, swap_sup_handler/1,
notify/1, sync_notify/1, call/1, info/1, hibernate/1,
- call_format_status/1, error_format_status/1]).
+ call_format_status/1, call_format_status_anon/1,
+ error_format_status/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[start, {group, test_all}, hibernate,
- call_format_status, error_format_status].
+ call_format_status, call_format_status_anon, error_format_status].
groups() ->
[{test_all, [],
@@ -888,6 +889,22 @@ call_format_status(Config) when is_list(Config) ->
?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2,
ok.
+call_format_status_anon(suite) ->
+ [];
+call_format_status_anon(doc) ->
+ ["Test that sys:get_status/1,2 calls format_status/2 for anonymous gen_event processes"];
+call_format_status_anon(Config) when is_list(Config) ->
+ ?line {ok, Pid} = gen_event:start(),
+ %% The 'Name' of the gen_event process will be a pid() here, so
+ %% the next line will crash if format_status can't string-ify pids.
+ ?line Status1 = sys:get_status(Pid),
+ ?line ok = gen_event:stop(Pid),
+ Header = "Status for event handler " ++ pid_to_list(Pid),
+ ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1,
+ ?line Header = proplists:get_value(header, Data1),
+ ok.
+
+
error_format_status(suite) ->
[];
error_format_status(doc) ->
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 7f0011bd68..8fe7d72270 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -1193,11 +1193,10 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
do_end_tc_call(M,F,Res,Return) ->
Ref = make_ref(),
- case test_server_sup:framework_call(
- end_tc, [?pl2a(M),F,Res], Ref) of
- {fail,FWReason} ->
- {failed,FWReason};
- Ref ->
+ case os:getenv("TEST_SERVER_FRAMEWORK") of
+ FW when FW == "ct_framework";
+ FW == "undefined";
+ FW == false ->
case test_server_sup:framework_call(
end_tc, [?pl2a(M),F,Res, Return], ok) of
{fail,FWReason} ->
@@ -1212,8 +1211,14 @@ do_end_tc_call(M,F,Res,Return) ->
NewReturn ->
NewReturn
end;
- _ ->
- Return
+ Other ->
+ case test_server_sup:framework_call(
+ end_tc, [Other,F,Res], Ref) of
+ {fail,FWReason} ->
+ {failed,FWReason};
+ _Else ->
+ Return
+ end
end.
%% the return value is a list and we have to check if it contains
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index 230f0e9428..73a736f0e8 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -253,6 +253,7 @@ compile_modules(Files,Options) ->
{i, Dir} when is_list(Dir) -> true;
{d, _Macro} -> true;
{d, _Macro, _Value} -> true;
+ export_all -> true;
_ -> false
end
end,
@@ -625,7 +626,7 @@ main_process_loop(State) ->
case get_beam_file(Module,BeamFile0,Compiled0) of
{ok,BeamFile} ->
{Reply,Compiled} =
- case do_compile_beam(Module,BeamFile) of
+ case do_compile_beam(Module,BeamFile,[]) of
{ok, Module} ->
remote_load_compiled(State#main_state.nodes,
[{Module,BeamFile}]),
@@ -1258,13 +1259,13 @@ do_compile(File, UserOptions) ->
Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions,
case compile:file(File, Options) of
{ok, Module, Binary} ->
- do_compile_beam(Module,Binary);
+ do_compile_beam(Module,Binary,UserOptions);
error ->
error
end.
%% Beam is a binary or a .beam file name
-do_compile_beam(Module,Beam) ->
+do_compile_beam(Module,Beam,UserOptions) ->
%% Clear database
do_clear(Module),
@@ -1284,7 +1285,7 @@ do_compile_beam(Module,Beam) ->
%% Compile and load the result
%% It's necessary to check the result of loading since it may
%% fail, for example if Module resides in a sticky directory
- {ok, Module, Binary} = compile:forms(Forms, []),
+ {ok, Module, Binary} = compile:forms(Forms, UserOptions),
case code:load_binary(Module, ?TAG, Binary) of
{module, Module} ->