aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore4
-rw-r--r--.travis.yml24
-rw-r--r--erts/configure.in2
-rw-r--r--erts/doc/src/erlang.xml17
-rw-r--r--erts/doc/src/notes.xml37
-rw-r--r--erts/emulator/Makefile.in3
-rw-r--r--erts/emulator/beam/atom.c3
-rw-r--r--erts/emulator/beam/beam_bif_load.c7
-rw-r--r--erts/emulator/beam/beam_bp.c3
-rw-r--r--erts/emulator/beam/beam_emu.c2
-rw-r--r--erts/emulator/beam/bif.c56
-rw-r--r--erts/emulator/beam/bif.tab5
-rw-r--r--erts/emulator/beam/code_ix.c3
-rw-r--r--erts/emulator/beam/dist.c3
-rw-r--r--erts/emulator/beam/erl_alloc.c3
-rw-r--r--erts/emulator/beam/erl_alloc.h11
-rw-r--r--erts/emulator/beam/erl_alloc.types7
-rw-r--r--erts/emulator/beam/erl_alloc_util.c57
-rw-r--r--erts/emulator/beam/erl_alloc_util.h5
-rw-r--r--erts/emulator/beam/erl_async.c6
-rw-r--r--erts/emulator/beam/erl_bif_info.c463
-rw-r--r--erts/emulator/beam/erl_bif_unique.c6
-rw-r--r--erts/emulator/beam/erl_cpu_topology.c3
-rw-r--r--erts/emulator/beam/erl_db.c63
-rw-r--r--erts/emulator/beam/erl_db.h5
-rw-r--r--erts/emulator/beam/erl_db_hash.c24
-rw-r--r--erts/emulator/beam/erl_db_hash.h4
-rw-r--r--erts/emulator/beam/erl_dirty_bif.tab5
-rw-r--r--erts/emulator/beam/erl_drv_thread.c29
-rw-r--r--erts/emulator/beam/erl_fun.c3
-rw-r--r--erts/emulator/beam/erl_gc.c3
-rw-r--r--erts/emulator/beam/erl_init.c11
-rw-r--r--erts/emulator/beam/erl_instrument.c6
-rw-r--r--erts/emulator/beam/erl_lock_check.c285
-rw-r--r--erts/emulator/beam/erl_lock_check.h50
-rw-r--r--erts/emulator/beam/erl_lock_count.c961
-rw-r--r--erts/emulator/beam/erl_lock_count.h998
-rw-r--r--erts/emulator/beam/erl_lock_flags.c59
-rw-r--r--erts/emulator/beam/erl_lock_flags.h78
-rw-r--r--erts/emulator/beam/erl_msacc.c6
-rw-r--r--erts/emulator/beam/erl_mtrace.c6
-rw-r--r--erts/emulator/beam/erl_nif.c26
-rw-r--r--erts/emulator/beam/erl_node_tables.c44
-rw-r--r--erts/emulator/beam/erl_node_tables.h4
-rw-r--r--erts/emulator/beam/erl_port_task.h8
-rw-r--r--erts/emulator/beam/erl_process.c51
-rw-r--r--erts/emulator/beam/erl_process_lock.c209
-rw-r--r--erts/emulator/beam/erl_process_lock.h180
-rw-r--r--erts/emulator/beam/erl_ptab.c3
-rw-r--r--erts/emulator/beam/erl_smp.h133
-rw-r--r--erts/emulator/beam/erl_thr_progress.c33
-rw-r--r--erts/emulator/beam/erl_threads.h406
-rw-r--r--erts/emulator/beam/erl_time_sup.c11
-rw-r--r--erts/emulator/beam/erl_trace.c10
-rw-r--r--erts/emulator/beam/export.c3
-rw-r--r--erts/emulator/beam/global.h6
-rw-r--r--erts/emulator/beam/io.c161
-rw-r--r--erts/emulator/beam/module.c3
-rw-r--r--erts/emulator/beam/ops.tab8
-rw-r--r--erts/emulator/beam/register.c3
-rw-r--r--erts/emulator/beam/safe_hash.c23
-rw-r--r--erts/emulator/beam/safe_hash.h7
-rw-r--r--erts/emulator/beam/utils.c89
-rw-r--r--erts/emulator/drivers/common/efile_drv.c3
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c108
-rw-r--r--erts/emulator/hipe/hipe_bif0.c3
-rw-r--r--erts/emulator/sys/common/erl_check_io.c36
-rw-r--r--erts/emulator/sys/common/erl_check_io.h9
-rw-r--r--erts/emulator/sys/common/erl_mmap.c9
-rw-r--r--erts/emulator/sys/common/erl_mseg.c6
-rw-r--r--erts/emulator/sys/common/erl_poll.c38
-rw-r--r--erts/emulator/sys/common/erl_poll.h4
-rw-r--r--erts/emulator/sys/unix/sys.c15
-rw-r--r--erts/emulator/sys/unix/sys_time.c4
-rw-r--r--erts/emulator/sys/win32/erl_poll.c10
-rw-r--r--erts/emulator/sys/win32/sys.c15
-rw-r--r--erts/emulator/sys/win32/sys_env.c3
-rw-r--r--erts/emulator/sys/win32/sys_time.c4
-rw-r--r--erts/emulator/test/Makefile1
-rw-r--r--erts/emulator/test/bif_SUITE.erl29
-rw-r--r--erts/emulator/test/fun_SUITE.erl14
-rw-r--r--erts/emulator/test/lcnt_SUITE.erl156
-rw-r--r--erts/emulator/test/nif_SUITE.erl10
-rw-r--r--erts/emulator/test/register_SUITE.erl9
-rw-r--r--erts/etc/common/Makefile.in7
-rw-r--r--erts/etc/common/escript.c21
-rw-r--r--lib/asn1/src/asn1ct_gen.erl48
-rw-r--r--lib/asn1/test/asn1_SUITE.erl12
-rw-r--r--lib/asn1/test/asn1_SUITE_data/EnumN2N.asn122
-rw-r--r--lib/compiler/src/sys_core_fold.erl6
-rw-r--r--lib/compiler/test/core_SUITE.erl8
-rw-r--r--lib/compiler/test/core_SUITE_data/non_variable_apply.core80
-rw-r--r--lib/crypto/c_src/crypto.c958
-rw-r--r--lib/crypto/doc/src/crypto.xml23
-rw-r--r--lib/crypto/src/crypto.erl94
-rw-r--r--lib/crypto/test/blowfish_SUITE.erl5
-rw-r--r--lib/crypto/test/crypto_SUITE.erl116
-rw-r--r--lib/diameter/doc/src/diameter.xml80
-rw-r--r--lib/diameter/doc/src/diameter_codec.xml9
-rw-r--r--lib/diameter/examples/code/node.erl29
-rw-r--r--lib/diameter/include/diameter_gen.hrl8
-rw-r--r--lib/diameter/src/base/diameter.erl17
-rw-r--r--lib/diameter/src/base/diameter_codec.erl197
-rw-r--r--lib/diameter/src/base/diameter_config.erl20
-rw-r--r--lib/diameter/src/base/diameter_gen.erl847
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl181
-rw-r--r--lib/diameter/src/base/diameter_service.erl30
-rw-r--r--lib/diameter/src/base/diameter_traffic.erl397
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl16
-rw-r--r--lib/diameter/src/compiler/diameter_codegen.erl17
-rw-r--r--lib/diameter/src/compiler/diameter_exprecs.erl4
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl4
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl147
-rw-r--r--lib/diameter/test/diameter_codec_SUITE.erl1
-rw-r--r--lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl1
-rw-r--r--lib/diameter/test/diameter_codec_test.erl3
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl908
-rw-r--r--lib/diameter/test/diameter_util.erl13
-rw-r--r--lib/inets/doc/src/httpc.xml2
-rw-r--r--lib/inets/src/http_server/mod_disk_log.erl27
-rw-r--r--lib/inets/src/http_server/mod_log.erl4
-rw-r--r--lib/inets/test/httpd_SUITE.erl129
-rw-r--r--lib/kernel/doc/src/inet.xml11
-rw-r--r--lib/kernel/src/erts_debug.erl35
-rw-r--r--lib/kernel/src/inet.erl3
-rw-r--r--lib/kernel/src/kernel.app.src2
-rw-r--r--lib/observer/src/observer_lib.erl2
-rw-r--r--lib/observer/src/observer_sys_wx.erl55
-rw-r--r--lib/public_key/doc/src/public_key.xml39
-rw-r--r--lib/public_key/include/public_key.hrl3
-rw-r--r--lib/public_key/src/pubkey_crl.erl35
-rw-r--r--lib/public_key/src/public_key.erl159
-rw-r--r--lib/reltool/src/reltool.erl4
-rw-r--r--lib/reltool/src/reltool.hrl2
-rw-r--r--lib/reltool/src/reltool_app_win.erl8
-rw-r--r--lib/reltool/src/reltool_fgraph_win.erl2
-rw-r--r--lib/reltool/src/reltool_mod_win.erl6
-rw-r--r--lib/reltool/src/reltool_server.erl39
-rw-r--r--lib/reltool/src/reltool_sys_win.erl22
-rw-r--r--lib/reltool/src/reltool_target.erl39
-rw-r--r--lib/reltool/src/reltool_utils.erl12
-rw-r--r--lib/runtime_tools/src/observer_backend.erl16
-rw-r--r--lib/sasl/src/release_handler.erl10
-rw-r--r--lib/sasl/src/systools_make.erl6
-rw-r--r--lib/sasl/src/systools_relup.erl4
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl103
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/Makefile.src18
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app8
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl50
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl38
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app8
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup3
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl55
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl38
-rw-r--r--lib/ssh/src/ssh_io.erl8
-rw-r--r--lib/ssh/src/ssh_sftp.erl24
-rw-r--r--lib/ssh/test/ssh_sftp_SUITE.erl31
-rw-r--r--lib/ssl/src/dtls_connection.erl5
-rw-r--r--lib/ssl/src/ssl.erl2
-rw-r--r--lib/ssl/src/ssl_alert.erl76
-rw-r--r--lib/ssl/src/ssl_alert.hrl1
-rw-r--r--lib/ssl/src/ssl_cipher.erl4
-rw-r--r--lib/ssl/src/ssl_connection.erl36
-rw-r--r--lib/ssl/src/ssl_handshake.erl20
-rw-r--r--lib/ssl/src/tls_connection.erl6
-rw-r--r--lib/ssl/test/Makefile1
-rw-r--r--lib/ssl/test/erl_make_certs.erl477
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl183
-rw-r--r--lib/ssl/test/ssl_crl_SUITE.erl12
-rw-r--r--lib/ssl/test/ssl_sni_SUITE.erl47
-rw-r--r--lib/ssl/test/ssl_test_lib.erl201
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl196
-rw-r--r--lib/stdlib/doc/src/lists.xml4
-rw-r--r--lib/stdlib/doc/src/rand.xml2
-rw-r--r--lib/stdlib/src/array.erl2
-rw-r--r--lib/stdlib/src/edlin.erl132
-rw-r--r--lib/stdlib/src/erl_lint.erl11
-rw-r--r--lib/stdlib/src/otp_internal.erl18
-rw-r--r--lib/stdlib/src/shell.erl16
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl49
-rw-r--r--lib/stdlib/test/shell_SUITE.erl50
-rw-r--r--lib/syntax_tools/src/erl_tidy.erl2
-rw-r--r--lib/syntax_tools/test/syntax_tools_SUITE.erl6
-rw-r--r--lib/tools/doc/src/lcnt.xml104
-rw-r--r--lib/tools/doc/src/lcnt_chapter.xml9
-rw-r--r--lib/tools/src/lcnt.erl77
-rw-r--r--lib/tools/src/tools.app.src2
-rw-r--r--lib/tools/test/lcnt_SUITE.erl5
-rw-r--r--lib/wx/api_gen/README3
-rw-r--r--lib/wx/api_gen/wx_doxygen.conf6
-rw-r--r--lib/wx/api_gen/wx_gen.erl7
-rw-r--r--lib/wx/api_gen/wxapi.conf4
-rw-r--r--lib/wx/c_src/gen/wxe_funcs.cpp6
-rw-r--r--lib/wx/c_src/gen/wxe_macros.h10
-rw-r--r--lib/wx/src/gen/wxGraphicsContext.erl4
-rw-r--r--lib/wx/src/gen/wxe_debug.hrl10
-rw-r--r--lib/wx/src/gen/wxe_funcs.hrl10
-rw-r--r--otp_versions.table2
-rw-r--r--system/doc/design_principles/des_princ.xml4
-rw-r--r--system/doc/design_principles/statem.xml8
200 files changed, 7773 insertions, 4679 deletions
diff --git a/.gitignore b/.gitignore
index c867b1a597..a79bcf97c4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -251,6 +251,10 @@ JAVADOC-GENERATED
/lib/compiler/test/*_post_opt_SUITE.erl
/lib/compiler/test/*_inline_SUITE.erl
+# crypto
+/lib/crypto/test/crypto_SUITE_data/*.rsp
+/lib/crypto/test/crypto_SUITE_data/aesval.html
+
# debugger
/lib/debugger/doc/html/images/*.jpg
diff --git a/.travis.yml b/.travis.yml
index eee75c9769..88a4c46f77 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -28,8 +28,18 @@ matrix:
- docker
script:
- ./scripts/build-docker-otp 32 sh -c "scripts/build-otp && ./otp_build tests && scripts/run-smoke-tests && bin/dialyzer --build_plt --apps erts kernel stdlib"
- after_success:
- after_script:
+ - env: Linux64Dialyzer
+ os: linux
+ script:
+ - ./scripts/build-otp
+ - ./scripts/run-dialyzer
+ - env: Linux64SmokeTest
+ os: linux
+ script:
+ - ./scripts/build-otp
+ - ./otp_build tests
+ - make release_docs
+ - ./scripts/run-smoke-tests
before_script:
- set -e
@@ -37,13 +47,3 @@ before_script:
- export PATH=$ERL_TOP/bin:$PATH
- export ERL_LIBS=''
- export MAKEFLAGS=-j4
-
-script:
- - ./scripts/build-otp
-
-after_success:
- - ./scripts/run-dialyzer
- - ./otp_build tests && make release_docs
-
-after_script:
- - ./scripts/run-smoke-tests
diff --git a/erts/configure.in b/erts/configure.in
index 830e3d7776..85351ab7c7 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -3855,7 +3855,7 @@ case $host_os in
darwin*)
# Mach-O linker: a shared lib and a loadable
# object file is not the same thing.
- DED_LDFLAGS="-bundle -flat_namespace -undefined suppress"
+ DED_LDFLAGS="-bundle -bundle_loader ${ERL_TOP}/bin/$host/beam.smp"
case $ARCH in
amd64)
DED_LDFLAGS="-m64 $DED_LDFLAGS"
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 105734d5b2..11f2d36a01 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -1943,23 +1943,26 @@ os_prompt%</pre>
<item>The runtime system exits with integer value
<c><anno>Status</anno></c>
as status code to the calling environment (OS).
+ <note>
+ <p>On many platforms, the OS supports only status
+ codes 0-255. A too large status code is truncated by clearing
+ the high bits.</p>
+ </note>
</item>
<tag>string()</tag>
<item>An Erlang crash dump is produced with <c><anno>Status</anno></c>
as slogan. Then the runtime system exits with status code <c>1</c>.
- Note that only code points in the range 0-255 may be used
- and the string will be truncated if longer than 200 characters.
+ The string will be truncated if longer than 200 characters.
+ <note>
+ <p>Before ERTS 9.1 (OTP-20.1) only code points in the range 0-255
+ was accepted in the string. Now any unicode string is valid.</p>
+ </note>
</item>
<tag><c>abort</c></tag>
<item>The runtime system aborts producing a core dump, if that is
enabled in the OS.
</item>
</taglist>
- <note>
- <p>On many platforms, the OS supports only status
- codes 0-255. A too large status code is truncated by clearing
- the high bits.</p>
- </note>
<p>For integer <c><anno>Status</anno></c>, the Erlang runtime system
closes all ports and allows async threads to finish their
operations before exiting. To exit without such flushing, use
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index 008d43b51a..3d7858a034 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -130,7 +130,6 @@
</section>
<section><title>Erts 9.0</title>
-
<section><title>Fixed Bugs and Malfunctions</title>
<list>
<item>
@@ -729,6 +728,42 @@
</section>
+<section><title>Erts 8.3.5.1</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed a bug in gen_tcp:send where it never returned when
+ repeatedly called on a remotely closed TCP socket.</p>
+ <p>
+ Own Id: OTP-13939 Aux Id: ERL-193 </p>
+ </item>
+ <item>
+ <p>
+ Fixed segfault that could happen during cleanup of
+ aborted erlang:port_command/3 calls. A port_command is
+ aborted if the port is closed at the same time as the
+ port_command was issued. This bug was introduced in
+ erts-8.0.</p>
+ <p>
+ Own Id: OTP-14481</p>
+ </item>
+ <item>
+ <p>
+ Fixed implementation of <c>statistics(wall_clock)</c> and
+ <c>statistics(runtime)</c> so that values do not
+ unnecessarily wrap due to the emulator. Note that the
+ values returned by <c>statistics(runtime)</c> may still
+ wrap due to limitations in the underlying functionality
+ provided by the operating system.</p>
+ <p>
+ Own Id: OTP-14484</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 8.3.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 61c1e14741..1ae905276d 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -116,6 +116,7 @@ ifeq ($(TYPE),lcnt)
PURIFY =
TYPEMARKER = .lcnt
TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT
+ENABLE_ALLOC_TYPE_VARS += lcnt
else
ifeq ($(TYPE),frmptr)
@@ -814,7 +815,7 @@ RUN_OBJS = \
$(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \
$(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \
$(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \
- $(OBJDIR)/erl_msacc.o
+ $(OBJDIR)/erl_msacc.o $(OBJDIR)/erl_lock_flags.o
LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o
NIF_OBJS = $(OBJDIR)/erl_tracer_nif.o
diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c
index 2055c29190..c2d78aaccb 100644
--- a/erts/emulator/beam/atom.c
+++ b/erts/emulator/beam/atom.c
@@ -442,7 +442,8 @@ init_atom_table(void)
erts_smp_atomic_init_nob(&atom_put_ops, 0);
#endif
- erts_smp_rwmtx_init_opt(&atom_table_lock, &rwmtx_opt, "atom_tab");
+ erts_smp_rwmtx_init_opt(&atom_table_lock, &rwmtx_opt, "atom_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) atom_hash;
f.cmp = (HCMP_FUN) atom_cmp;
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 007bf99b6e..14ddb74324 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -97,7 +97,8 @@ init_purge_state(void)
{
purge_state.module = THE_NON_VALUE;
- erts_smp_mtx_init(&purge_state.mtx, "purge_state");
+ erts_smp_mtx_init(&purge_state.mtx, "purge_state", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
purge_state.pending_purge_lambda =
erts_export_put(am_erts_code_purger, am_pending_purge_lambda, 3);
@@ -118,7 +119,9 @@ init_purge_state(void)
void
erts_beam_bif_load_init(void)
{
- erts_smp_mtx_init(&release_literal_areas.mtx, "release_literal_areas");
+ erts_smp_mtx_init(&release_literal_areas.mtx, "release_literal_areas", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+
release_literal_areas.first = NULL;
release_literal_areas.last = NULL;
erts_smp_atomic_init_nob(&erts_copy_literal_area__,
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index b9453c1d9a..950639f7ae 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -165,7 +165,8 @@ erts_bp_init(void) {
erts_smp_atomic32_init_nob(&erts_active_bp_index, 0);
erts_smp_atomic32_init_nob(&erts_staging_bp_index, 1);
#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index");
+ erts_smp_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
#endif
}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 79d751d13e..bc83699951 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -6829,7 +6829,7 @@ apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg)
}
if (is_not_nil(tmp)) { /* Must be well-formed list */
- p->freason = EXC_UNDEF;
+ p->freason = EXC_BADARG;
return NULL;
}
reg[arity] = fun;
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 40dd4129d2..b6595d2a5d 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -62,9 +62,6 @@ static erts_smp_atomic32_t msacc;
static Export *await_sched_wall_time_mod_trap;
static erts_smp_atomic32_t sched_wall_time;
-static erts_smp_mtx_t ports_snapshot_mtx;
-erts_smp_atomic_t erts_dead_ports_ptr; /* To store dying ports during snapshot */
-
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
/*
@@ -3021,17 +3018,17 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
{
Eterm res;
byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT);
- Sint i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS);
-
+ Sint written;
+ int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS,
+ &written);
if (i < 0) {
erts_free(ERTS_ALC_T_TMP, (void *) buf);
- i = erts_list_length(BIF_ARG_1);
- if (i > MAX_ATOM_CHARACTERS) {
+ if (i == -2) {
BIF_ERROR(BIF_P, SYSTEM_LIMIT);
}
BIF_ERROR(BIF_P, BADARG);
}
- res = erts_atom_put(buf, i, ERTS_ATOM_ENC_UTF8, 1);
+ res = erts_atom_put(buf, written, ERTS_ATOM_ENC_UTF8, 1);
ASSERT(is_atom(res));
erts_free(ERTS_ALC_T_TMP, (void *) buf);
BIF_RET(res);
@@ -3042,8 +3039,9 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1)
{
byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT);
- Sint i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS);
-
+ Sint written;
+ int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS,
+ &written);
if (i < 0) {
error:
erts_free(ERTS_ALC_T_TMP, (void *) buf);
@@ -3051,7 +3049,7 @@ BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1)
} else {
Eterm a;
- if (erts_atom_get((char *) buf, i, &a, ERTS_ATOM_ENC_UTF8)) {
+ if (erts_atom_get((char *) buf, written, &a, ERTS_ATOM_ENC_UTF8)) {
erts_free(ERTS_ALC_T_TMP, (void *) buf);
BIF_RET(a);
} else {
@@ -3946,15 +3944,18 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1)
{
Process* p = BIF_P;
Eterm string = BIF_ARG_1;
- Sint len = is_string(string);
- char *str;
+ Sint len = erts_unicode_list_to_buf_len(string);
+ Sint written;
+ byte *str;
+ int res;
- if (len <= 0) {
+ if (len < 0) {
BIF_ERROR(p, BADARG);
}
- str = (char *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1));
- if (intlist_to_buf(string, str, len) != len)
- erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
+ str = (byte *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1));
+ res = erts_unicode_list_to_buf(string, str, len, &written);
+ if (res != 0 || written != len)
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error (%d)\n", __FILE__, __LINE__, res);
str[len] = '\0';
erts_fprintf(stderr, "%s", str);
erts_free(ERTS_ALC_T_TMP, (void *) str);
@@ -3970,9 +3971,6 @@ BIF_RETTYPE display_nl_0(BIF_ALIST_0)
/**********************************************************************/
-#define HALT_MSG_SIZE 200
-static char halt_msg[HALT_MSG_SIZE+1];
-
/* stop the system with exit code and flags */
BIF_RETTYPE halt_2(BIF_ALIST_2)
{
@@ -4022,16 +4020,17 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_exit(ERTS_ABORT_EXIT, "");
}
- else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
- Sint i;
+ else if (is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) {
+# define HALT_MSG_SIZE 200
+ static byte halt_msg[4*HALT_MSG_SIZE+1];
+ Sint written;
- if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE)) == -1) {
+ if (erts_unicode_list_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE,
+ &written) == -1 ) {
goto error;
}
- if (i == -2) /* truncated string */
- i = HALT_MSG_SIZE;
- ASSERT(i >= 0 && i <= HALT_MSG_SIZE);
- halt_msg[i] = '\0';
+ ASSERT(written >= 0 && written < sizeof(halt_msg));
+ halt_msg[written] = '\0';
VERBOSE(DEBUG_SYSTEM,
("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
@@ -5138,9 +5137,6 @@ void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a,
void erts_init_bif(void)
{
- erts_smp_mtx_init(&ports_snapshot_mtx, "ports_snapshot");
- erts_smp_atomic_init_nob(&erts_dead_ports_ptr, (erts_aint_t) NULL);
-
/*
* bif_return_trap/2 is a hidden BIF that bifs that need to
* yield the calling process traps to.
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index a8bbf5f8c1..962b00ae7b 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -437,7 +437,10 @@ bif erts_debug:dump_links/1
#
# Lock counter bif's
#
-bif erts_debug:lock_counters/1
+bif erts_debug:lcnt_control/2
+bif erts_debug:lcnt_control/1
+bif erts_debug:lcnt_collect/0
+bif erts_debug:lcnt_clear/0
#
# New Bifs in R8.
diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c
index ec6267711b..8a3d1b20b4 100644
--- a/erts/emulator/beam/code_ix.c
+++ b/erts/emulator/beam/code_ix.c
@@ -57,7 +57,8 @@ void erts_code_ix_init(void)
*/
erts_smp_atomic32_init_nob(&the_active_code_index, 0);
erts_smp_atomic32_init_nob(&the_staging_code_index, 0);
- erts_smp_mtx_init(&code_write_permission_mtx, "code_write_permission");
+ erts_smp_mtx_init(&code_write_permission_mtx, "code_write_permission", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_tsd_key_create(&has_code_write_permission,
"erts_has_code_write_permission");
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 982f1066df..09fdb897f5 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -3223,7 +3223,8 @@ static ErtsNodesMonitor *nodes_monitors_end;
static void
init_nodes_monitors(void)
{
- erts_smp_mtx_init(&nodes_monitors_mtx, "nodes_monitors");
+ erts_smp_mtx_init(&nodes_monitors_mtx, "nodes_monitors", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
nodes_monitors = NULL;
nodes_monitors_end = NULL;
}
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 169e1e423d..c7ab444c96 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -3819,7 +3819,8 @@ hdbg_init(void)
hdbg_mblks[ERL_ALC_HDBG_MAX_MBLK-1].next = NULL;
free_hdbg_mblks = &hdbg_mblks[0];
used_hdbg_mblks = NULL;
- erts_mtx_init(&hdbg_mblk_mtx, "erts_alloc_hard_debug");
+ erts_mtx_init(&hdbg_mblk_mtx, "erts_alloc_hard_debug", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
}
static void *check_memory_fence(void *ptr,
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index 7b5cbe2178..97a1cf1308 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -344,7 +344,8 @@ ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
#define ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
static erts_smp_spinlock_t NAME##_lck; \
ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
- erts_smp_spinlock_init(&NAME##_lck, #NAME "_alloc_lock"),\
+ erts_smp_spinlock_init(&NAME##_lck, #NAME "_alloc_lock", NIL, \
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
erts_smp_spin_lock(&NAME##_lck), \
erts_smp_spin_unlock(&NAME##_lck))
@@ -358,7 +359,8 @@ ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT)
#define ERTS_TS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
static erts_mtx_t NAME##_lck; \
ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
- erts_mtx_init(NAME##_lck, #NAME "_alloc_lock"), \
+ erts_mtx_init(NAME##_lck, #NAME "_alloc_lock", NIL, \
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
erts_mtx_lock(&NAME##_lck), \
erts_mtx_unlock(&NAME##_lck))
@@ -371,7 +373,8 @@ ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, (void) 0, (void) 0, (void) 0)
#define ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ) \
static erts_spinlock_t NAME##_lck; \
ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, \
- erts_spinlock_init(&NAME##_lck, #NAME "_alloc_lock"),\
+ erts_spinlock_init(&NAME##_lck, #NAME "_alloc_lock", NIL, \
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
erts_spin_lock(&NAME##_lck), \
erts_spin_unlock(&NAME##_lck))
@@ -448,7 +451,7 @@ NAME##_free(TYPE *p) \
}
#ifdef DEBUG
-#define ERTS_PRE_ALLOC_SIZE(SZ) 2
+#define ERTS_PRE_ALLOC_SIZE(SZ) ((SZ) < 1000 ? (SZ)/10 + 10 : 100)
#define ERTS_PRE_ALLOC_CLOBBER(P, T) memset((void *) (P), 0xfd, sizeof(T))
#else
#define ERTS_PRE_ALLOC_SIZE(SZ) ((SZ) > 1 ? (SZ) : 1)
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 8a23a1526e..50a1d97dd5 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -368,6 +368,13 @@ type SSB SHORT_LIVED PROCESSES ssb
+endif
++if lcnt
+
+type LCNT_CARRIER STANDARD SYSTEM lcnt_lock_info_carrier
+type LCNT_VECTOR SHORT_LIVED SYSTEM lcnt_sample_vector
+
++endif
+
type DEBUG SHORT_LIVED SYSTEM debugging
type DDLL_PROCESS STANDARD SYSTEM ddll_processes
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 6fddba4b34..af86ad0548 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -6135,16 +6135,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
if (init->ts) {
allctr->thread_safe = 1;
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_mtx_init_x_opt(&allctr->mutex,
- "alcu_allocator",
- make_small(allctr->alloc_no),
- ERTS_LCNT_LT_ALLOC);
-#else
- erts_mtx_init_x(&allctr->mutex,
- "alcu_allocator",
- make_small(allctr->alloc_no));
-#endif /*ERTS_ENABLE_LOCK_COUNT*/
+ erts_mtx_init(&allctr->mutex, "alcu_allocator", make_small(allctr->alloc_no),
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
#ifdef DEBUG
allctr->debug.saved_tid = 0;
@@ -6324,7 +6316,8 @@ erts_alcu_init(AlcUInit_t *init)
carrier_alignment = sizeof(Unit_t);
#endif
- erts_mtx_init(&init_atoms_mtx, "alcu_init_atoms");
+ erts_mtx_init(&init_atoms_mtx, "alcu_init_atoms", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
atoms_initialized = 0;
initialized = 1;
@@ -6592,3 +6585,45 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk)
#endif /* ERTS_ALLOC_UTIL_HARD_DEBUG */
+#ifdef ERTS_ENABLE_LOCK_COUNT
+
+static void lcnt_enable_allocator_lock_count(Allctr_t *allocator, int enable) {
+ if(!allocator->thread_safe) {
+ return;
+ }
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&allocator->mutex.lcnt,
+ "alcu_allocator", make_small(allocator->alloc_no),
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
+ } else {
+ erts_lcnt_uninstall(&allocator->mutex.lcnt);
+ }
+}
+
+static void lcnt_update_thread_spec_locks(ErtsAllocatorThrSpec_t *tspec, int enable) {
+ if(tspec->enabled) {
+ int i;
+
+ for(i = 0; i < tspec->size; i++) {
+ lcnt_enable_allocator_lock_count(tspec->allctr[i], enable);
+ }
+ }
+}
+
+void erts_lcnt_update_allocator_locks(int enable) {
+ int i;
+
+ for(i = ERTS_ALC_A_MIN; i < ERTS_ALC_A_MAX; i++) {
+ ErtsAllocatorInfo_t *ai = &erts_allctrs_info[i];
+
+ if(ai->enabled && ai->alloc_util) {
+ if(ai->thr_spec) {
+ lcnt_update_thread_spec_locks((ErtsAllocatorThrSpec_t*)ai->extra, enable);
+ } else {
+ lcnt_enable_allocator_lock_count((Allctr_t*)ai->extra, enable);
+ }
+ }
+ }
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index e889980fa4..73c467aa0a 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -220,6 +220,10 @@ void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint *size_p, Uint
void erts_alcu_literal_32_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
#endif
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_allocator_locks(int enable);
+#endif
+
#endif /* !ERL_ALLOC_UTIL__ */
#if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__)
@@ -673,7 +677,6 @@ void erts_alcu_assert_failed(char* expr, char* file, int line, char *func);
int is_sbc_blk(Block_t*);
#endif
-
#endif /* #if defined(GET_ERL_ALLOC_UTIL_IMPL)
&& !defined(ERL_ALLOC_UTIL_IMPL__) */
diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c
index 84254af0c2..9a93034fcb 100644
--- a/erts/emulator/beam/erl_async.c
+++ b/erts/emulator/beam/erl_async.c
@@ -194,7 +194,8 @@ erts_init_async(void)
ptr += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncData));
async->init.data.no_initialized = 0;
- erts_mtx_init(&async->init.data.mtx, "async_init_mtx");
+ erts_mtx_init(&async->init.data.mtx, "async_init_mtx", NIL,
+ ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
erts_cnd_init(&async->init.data.cnd);
erts_atomic_init_nob(&async->init.data.id, 0);
@@ -213,7 +214,8 @@ erts_init_async(void)
for (i = 1; i <= erts_no_schedulers; i++) {
ErtsAsyncReadyQ *arq = async_ready_q(i);
#if ERTS_USE_ASYNC_READY_ENQ_MTX
- erts_mtx_init(&arq->x.data.enq_mtx, "async_enq_mtx");
+ erts_mtx_init(&arq->x.data.enq_mtx, "async_enq_mtx", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
#endif
erts_thr_q_finalize_dequeue_state_init(&arq->fin_deq);
qinit.arg = (void *) (SWord) i;
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 96f9b284b3..e5d7efcc72 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -4452,48 +4452,120 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
}
#ifdef ERTS_ENABLE_LOCK_COUNT
+
+typedef struct {
+ /* info->location_count may increase between size calculation and term
+ * building, so we cap it at the value sampled in lcnt_build_result_vector.
+ *
+ * Shrinking is safe though. */
+ int max_location_count;
+ erts_lcnt_lock_info_t *info;
+} lcnt_sample_t;
+
+typedef struct lcnt_sample_vector_ {
+ lcnt_sample_t *elements;
+ size_t size;
+} lcnt_sample_vector_t;
+
+static lcnt_sample_vector_t lcnt_build_sample_vector(erts_lcnt_lock_info_list_t *list) {
+ erts_lcnt_lock_info_t *iterator;
+ lcnt_sample_vector_t result;
+ size_t allocated_entries;
+
+ allocated_entries = 64;
+ result.size = 0;
+
+ result.elements = erts_alloc(ERTS_ALC_T_LCNT_VECTOR,
+ allocated_entries * sizeof(lcnt_sample_t));
+
+ iterator = NULL;
+ while(erts_lcnt_iterate_list(list, &iterator)) {
+ erts_lcnt_retain_lock_info(iterator);
+
+ result.elements[result.size].max_location_count = iterator->location_count;
+ result.elements[result.size].info = iterator;
+
+ result.size++;
+
+ if(result.size >= allocated_entries) {
+ allocated_entries *= 2;
+
+ result.elements = erts_realloc(ERTS_ALC_T_LCNT_VECTOR, result.elements,
+ allocated_entries * sizeof(lcnt_sample_t));
+ }
+ }
+
+ return result;
+}
+
+static void lcnt_destroy_sample_vector(lcnt_sample_vector_t *vector) {
+ size_t i;
+
+ for(i = 0; i < vector->size; i++) {
+ erts_lcnt_release_lock_info(vector->elements[i].info);
+ }
+
+ erts_free(ERTS_ALC_T_LCNT_VECTOR, vector->elements);
+}
+
+/* The size of an integer is not guaranteed to be constant since we're walking
+ * over live data, and may cross over into bignum territory between size calc
+ * and the actual build. This takes care of that through always assuming the
+ * worst, but needs to be fixed up with HRelease once the final term has been
+ * built. */
+static ERTS_INLINE Eterm bld_unstable_uint64(Uint **hpp, Uint *szp, Uint64 ui) {
+ Eterm res = THE_NON_VALUE;
+
+ if(szp) {
+ *szp += ERTS_UINT64_HEAP_SIZE(~((Uint64) 0));
+ }
+
+ if(hpp) {
+ if (IS_USMALL(0, ui)) {
+ res = make_small(ui);
+ } else {
+ res = erts_uint64_to_big(ui, hpp);
+ }
+ }
+
+ return res;
+}
+
static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_stats_t *stats, Eterm res) {
- Uint tries = 0, colls = 0;
- unsigned long timer_s = 0, timer_ns = 0, timer_n = 0;
- unsigned int line = 0;
unsigned int i;
-
+ const char *file;
+
Eterm af, uil;
Eterm uit, uic;
Eterm uits, uitns, uitn;
Eterm tt, tstat, tloc, t;
Eterm thist, vhist[ERTS_LCNT_HISTOGRAM_SLOT_SIZE];
-
+
/* term:
- * [{{file, line}, {tries, colls, {seconds, nanoseconds, n_blocks}},
- * { .. histogram .. }]
- */
+ * [{{file, line},
+ {tries, colls, {seconds, nanoseconds, n_blocks}},
+ * { .. histogram .. }] */
- tries = (Uint) ethr_atomic_read(&stats->tries);
- colls = (Uint) ethr_atomic_read(&stats->colls);
-
- line = stats->line;
- timer_s = stats->timer.s;
- timer_ns = stats->timer.ns;
- timer_n = stats->timer_n;
-
- af = erts_atom_put((byte *)stats->file, strlen(stats->file), ERTS_ATOM_ENC_LATIN1, 1);
- uil = erts_bld_uint( hpp, szp, line);
+ file = stats->file ? stats->file : "undefined";
+
+ af = erts_atom_put((byte *)file, strlen(file), ERTS_ATOM_ENC_LATIN1, 1);
+ uil = erts_bld_uint( hpp, szp, stats->line);
tloc = erts_bld_tuple(hpp, szp, 2, af, uil);
-
- uit = erts_bld_uint( hpp, szp, tries);
- uic = erts_bld_uint( hpp, szp, colls);
- uits = erts_bld_uint( hpp, szp, timer_s);
- uitns = erts_bld_uint( hpp, szp, timer_ns);
- uitn = erts_bld_uint( hpp, szp, timer_n);
+ uit = bld_unstable_uint64(hpp, szp, (Uint)ethr_atomic_read(&stats->attempts));
+ uic = bld_unstable_uint64(hpp, szp, (Uint)ethr_atomic_read(&stats->collisions));
+
+ uits = bld_unstable_uint64(hpp, szp, stats->total_time_waited.s);
+ uitns = bld_unstable_uint64(hpp, szp, stats->total_time_waited.ns);
+ uitn = bld_unstable_uint64(hpp, szp, stats->times_waited);
tt = erts_bld_tuple(hpp, szp, 3, uits, uitns, uitn);
tstat = erts_bld_tuple(hpp, szp, 3, uit, uic, tt);
for(i = 0; i < ERTS_LCNT_HISTOGRAM_SLOT_SIZE; i++) {
- vhist[i] = erts_bld_uint(hpp, szp, stats->hist.ns[i]);
+ vhist[i] = bld_unstable_uint64(hpp, szp, stats->wait_time_histogram.ns[i]);
}
+
thist = erts_bld_tuplev(hpp, szp, ERTS_LCNT_HISTOGRAM_SLOT_SIZE, vhist);
t = erts_bld_tuple(hpp, szp, 3, tloc, tstat, thist);
@@ -4502,185 +4574,266 @@ static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_s
return res;
}
-static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_t *lock, Eterm res) {
+static Eterm lcnt_pretty_print_lock_id(erts_lcnt_lock_info_t *info) {
+ Eterm id = info->id;
+
+ if((info->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == ERTS_LOCK_TYPE_PROCLOCK) {
+ /* Use registered names as id's for process locks if available. Thread
+ * progress is delayed since we may be running on a dirty scheduler. */
+ ErtsThrPrgrDelayHandle delay_handle;
+ Process *process;
+
+ delay_handle = erts_thr_progress_unmanaged_delay();
+
+ process = erts_proc_lookup(info->id);
+ if (process && process->common.u.alive.reg) {
+ id = process->common.u.alive.reg->name;
+ }
+
+ erts_thr_progress_unmanaged_continue(delay_handle);
+ } else if(info->flags & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR) {
+ if(is_small(id) && !sys_strcmp(info->name, "alcu_allocator")) {
+ const char *name = (const char*)ERTS_ALC_A2AD(signed_val(id));
+ id = erts_atom_put((byte*)name, strlen(name), ERTS_ATOM_ENC_LATIN1, 1);
+ }
+ }
+
+ return id;
+}
+
+static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, lcnt_sample_t *sample, Eterm res) {
+ erts_lcnt_lock_info_t *info = sample->info;
+
Eterm name, type, id, stats = NIL, t;
- Process *proc = NULL;
- char *ltype;
+ const char *lock_desc;
int i;
+
+ /* term: [{name, id, type, stats()}] */
+
+ ASSERT(info->name);
- /* term:
- * [{name, id, type, stats()}]
- */
-
- ASSERT(lock->name);
-
- ltype = erts_lcnt_lock_type(lock->flag);
-
- ASSERT(ltype);
-
- type = erts_atom_put((byte *)ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1);
- name = erts_atom_put((byte *)lock->name, strlen(lock->name), ERTS_ATOM_ENC_LATIN1, 1);
-
- if (lock->flag & ERTS_LCNT_LT_ALLOC) {
- /* use allocator types names as id's for allocator locks */
- ltype = (char *) ERTS_ALC_A2AD(signed_val(lock->id));
- id = erts_atom_put((byte *)ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1);
- } else if (lock->flag & ERTS_LCNT_LT_PROCLOCK) {
- /* use registered names as id's for process locks if available */
- proc = erts_proc_lookup(lock->id);
- if (proc && proc->common.u.alive.reg) {
- id = proc->common.u.alive.reg->name;
- } else {
- /* otherwise use process id */
- id = lock->id;
- }
+ lock_desc = erts_lock_flags_get_type_name(info->flags);
+
+ type = erts_atom_put((byte*)lock_desc, strlen(lock_desc), ERTS_ATOM_ENC_LATIN1, 1);
+ name = erts_atom_put((byte*)info->name, strlen(info->name), ERTS_ATOM_ENC_LATIN1, 1);
+
+ /* Only attempt to resolve ids when actually emitting the term. This ought
+ * to be safe since all immediates are the same size. */
+ if(hpp != NULL) {
+ id = lcnt_pretty_print_lock_id(info);
} else {
- id = lock->id;
+ id = NIL;
}
- for (i = 0; i < lock->n_stats; i++) {
- stats = lcnt_build_lock_stats_term(hpp, szp, &(lock->stats[i]), stats);
+ for(i = 0; i < MIN(info->location_count, sample->max_location_count); i++) {
+ stats = lcnt_build_lock_stats_term(hpp, szp, &(info->location_stats[i]), stats);
}
t = erts_bld_tuple(hpp, szp, 4, name, id, type, stats);
- res = erts_bld_cons( hpp, szp, t, res);
+ res = erts_bld_cons(hpp, szp, t, res);
return res;
}
-static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_data_t *data, Eterm res) {
+static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_time_t *duration,
+ lcnt_sample_vector_t *current_locks,
+ lcnt_sample_vector_t *deleted_locks, Eterm res) {
+ const char *str_duration = "duration";
+ const char *str_locks = "locks";
+
Eterm dts, dtns, tdt, adur, tdur, aloc, lloc = NIL, tloc;
- erts_lcnt_lock_t *lock = NULL;
- char *str_duration = "duration";
- char *str_locks = "locks";
-
- /* term:
- * [{'duration', {seconds, nanoseconds}}, {'locks', locks()}]
- */
-
+ size_t i;
+
+ /* term: [{'duration', {seconds, nanoseconds}}, {'locks', locks()}] */
+
/* duration tuple */
- dts = erts_bld_uint( hpp, szp, data->duration.s);
- dtns = erts_bld_uint( hpp, szp, data->duration.ns);
+ dts = bld_unstable_uint64(hpp, szp, duration->s);
+ dtns = bld_unstable_uint64(hpp, szp, duration->ns);
tdt = erts_bld_tuple(hpp, szp, 2, dts, dtns);
-
+
adur = erts_atom_put((byte *)str_duration, strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1);
tdur = erts_bld_tuple(hpp, szp, 2, adur, tdt);
/* lock tuple */
-
aloc = erts_atom_put((byte *)str_locks, strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1);
-
- for (lock = data->current_locks->head; lock != NULL ; lock = lock->next ) {
- lloc = lcnt_build_lock_term(hpp, szp, lock, lloc);
+
+ for(i = 0; i < current_locks->size; i++) {
+ lloc = lcnt_build_lock_term(hpp, szp, &current_locks->elements[i], lloc);
}
-
- for (lock = data->deleted_locks->head; lock != NULL ; lock = lock->next ) {
- lloc = lcnt_build_lock_term(hpp, szp, lock, lloc);
+
+ for(i = 0; i < deleted_locks->size; i++) {
+ lloc = lcnt_build_lock_term(hpp, szp, &deleted_locks->elements[i], lloc);
}
-
+
tloc = erts_bld_tuple(hpp, szp, 2, aloc, lloc);
-
- res = erts_bld_cons( hpp, szp, tloc, res);
- res = erts_bld_cons( hpp, szp, tdur, res);
+
+ res = erts_bld_cons(hpp, szp, tloc, res);
+ res = erts_bld_cons(hpp, szp, tdur, res);
return res;
-}
+}
+
+static struct {
+ const char *name;
+ erts_lock_flags_t flag;
+} lcnt_category_map[] = {
+ {"allocator", ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR},
+ {"db", ERTS_LOCK_FLAGS_CATEGORY_DB},
+ {"debug", ERTS_LOCK_FLAGS_CATEGORY_DEBUG},
+ {"distribution", ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION},
+ {"generic", ERTS_LOCK_FLAGS_CATEGORY_GENERIC},
+ {"io", ERTS_LOCK_FLAGS_CATEGORY_IO},
+ {"process", ERTS_LOCK_FLAGS_CATEGORY_PROCESS},
+ {"scheduler", ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER},
+ {NULL, 0}
+ };
+
+static erts_lock_flags_t lcnt_atom_to_lock_category(Eterm atom) {
+ int i = 0;
+
+ for(i = 0; lcnt_category_map[i].name != NULL; i++) {
+ if(erts_is_atom_str(lcnt_category_map[i].name, atom, 0)) {
+ return lcnt_category_map[i].flag;
+ }
+ }
+
+ return 0;
+}
+
+static Eterm lcnt_build_category_list(Eterm **hpp, Uint *szp, erts_lock_flags_t mask) {
+ Eterm res;
+ int i;
+
+ res = NIL;
+
+ for(i = 0; lcnt_category_map[i].name != NULL; i++) {
+ if(mask & lcnt_category_map[i].flag) {
+ Eterm category = erts_atom_put((byte*)lcnt_category_map[i].name,
+ strlen(lcnt_category_map[i].name),
+ ERTS_ATOM_ENC_UTF8, 0);
+
+ res = erts_bld_cons(hpp, szp, category, res);
+ }
+ }
+
+ return res;
+}
+
#endif
-BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
+BIF_RETTYPE erts_debug_lcnt_clear_0(BIF_ALIST_0)
{
-#ifdef ERTS_ENABLE_LOCK_COUNT
- Eterm res = NIL;
-#endif
+#ifndef ERTS_ENABLE_LOCK_COUNT
+ BIF_RET(am_error);
+#else
+ erts_lcnt_clear_counters();
+ BIF_RET(am_ok);
+#endif
+}
- if (BIF_ARG_1 == am_enabled) {
-#ifdef ERTS_ENABLE_LOCK_COUNT
- BIF_RET(am_true);
+BIF_RETTYPE erts_debug_lcnt_collect_0(BIF_ALIST_0)
+{
+#ifndef ERTS_ENABLE_LOCK_COUNT
+ BIF_RET(am_error);
#else
- BIF_RET(am_false);
-#endif
- }
-#ifdef ERTS_ENABLE_LOCK_COUNT
+ lcnt_sample_vector_t current_locks, deleted_locks;
+ erts_lcnt_data_t data;
- else if (BIF_ARG_1 == am_info) {
- erts_lcnt_data_t *data;
- Uint hsize = 0;
- Uint *szp;
- Eterm* hp;
+ Eterm *term_heap_start, *term_heap_end;
+ Uint term_heap_size = 0;
+ Eterm result;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ data = erts_lcnt_get_data();
- erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_SUSPEND);
- data = erts_lcnt_get_data();
+ current_locks = lcnt_build_sample_vector(data.current_locks);
+ deleted_locks = lcnt_build_sample_vector(data.deleted_locks);
- /* calculate size */
+ lcnt_build_result_term(NULL, &term_heap_size, &data.duration,
+ &current_locks, &deleted_locks, NIL);
- szp = &hsize;
- lcnt_build_result_term(NULL, szp, data, NIL);
+ term_heap_start = HAlloc(BIF_P, term_heap_size);
+ term_heap_end = term_heap_start;
- /* alloc and build */
+ result = lcnt_build_result_term(&term_heap_end, NULL,
+ &data.duration, &current_locks, &deleted_locks, NIL);
- hp = HAlloc(BIF_P, hsize);
+ HRelease(BIF_P, term_heap_start + term_heap_size, term_heap_end);
- res = lcnt_build_result_term(&hp, NULL, data, res);
-
- erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_SUSPEND);
+ lcnt_destroy_sample_vector(&current_locks);
+ lcnt_destroy_sample_vector(&deleted_locks);
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
-
- BIF_RET(res);
- } else if (BIF_ARG_1 == am_clear) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ BIF_RET(result);
+#endif
+}
+
+BIF_RETTYPE erts_debug_lcnt_control_1(BIF_ALIST_1)
+{
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ if(ERTS_IS_ATOM_STR("mask", BIF_ARG_1)) {
+ erts_lock_flags_t mask;
+ Eterm *term_heap_block;
+ Uint term_heap_size;
- erts_lcnt_clear_counters();
+ mask = erts_lcnt_get_category_mask();
+ term_heap_size = 0;
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ lcnt_build_category_list(NULL, &term_heap_size, mask);
- BIF_RET(am_ok);
- } else if (is_tuple(BIF_ARG_1)) {
- Eterm* ptr = tuple_val(BIF_ARG_1);
-
- if ((arityval(ptr[0]) == 2) && (ptr[2] == am_false || ptr[2] == am_true)) {
- int lock_opt = 0, enable = (ptr[2] == am_true) ? 1 : 0;
- if (ERTS_IS_ATOM_STR("copy_save", ptr[1])) {
- lock_opt = ERTS_LCNT_OPT_COPYSAVE;
- } else if (ERTS_IS_ATOM_STR("process_locks", ptr[1])) {
- lock_opt = ERTS_LCNT_OPT_PROCLOCK;
- } else if (ERTS_IS_ATOM_STR("port_locks", ptr[1])) {
- lock_opt = ERTS_LCNT_OPT_PORTLOCK;
- } else if (ERTS_IS_ATOM_STR("suspend", ptr[1])) {
- lock_opt = ERTS_LCNT_OPT_SUSPEND;
- } else if (ERTS_IS_ATOM_STR("location", ptr[1])) {
- lock_opt = ERTS_LCNT_OPT_LOCATION;
- } else {
- BIF_ERROR(BIF_P, BADARG);
- }
+ term_heap_block = HAlloc(BIF_P, term_heap_size);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ BIF_RET(lcnt_build_category_list(&term_heap_block, NULL, mask));
+ } else if(ERTS_IS_ATOM_STR("copy_save", BIF_ARG_1)) {
+ if(erts_lcnt_get_preserve_info()) {
+ BIF_RET(am_true);
+ }
- if (enable) res = erts_lcnt_set_rt_opt(lock_opt) ? am_true : am_false;
- else res = erts_lcnt_clear_rt_opt(lock_opt) ? am_true : am_false;
-
-#ifdef ERTS_SMP
- if (res != ptr[2] && lock_opt == ERTS_LCNT_OPT_PORTLOCK) {
- erts_lcnt_enable_io_lock_count(enable);
- } else if (res != ptr[2] && lock_opt == ERTS_LCNT_OPT_PROCLOCK) {
- erts_lcnt_enable_proc_lock_count(enable);
- }
+ BIF_RET(am_false);
+ }
#endif
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
- BIF_RET(res);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE erts_debug_lcnt_control_2(BIF_ALIST_2)
+{
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ if(ERTS_IS_ATOM_STR("mask", BIF_ARG_1)) {
+ erts_lock_flags_t category_mask = 0;
+ Eterm categories = BIF_ARG_2;
+
+ if(!(is_list(categories) || is_nil(categories))) {
+ BIF_ERROR(BIF_P, BADARG);
}
- }
-#endif
+ while(is_list(categories)) {
+ Eterm *cell = list_val(categories);
+ erts_lock_flags_t category;
+
+ category = lcnt_atom_to_lock_category(CAR(cell));
+
+ if(!category) {
+ Eterm *hp = HAlloc(BIF_P, 4);
+
+ BIF_RET(TUPLE3(hp, am_error, am_badarg, CAR(cell)));
+ }
+
+ category_mask |= category;
+ categories = CDR(cell);
+ }
+
+ erts_lcnt_set_category_mask(category_mask);
+
+ BIF_RET(am_ok);
+ } else if(BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) {
+ int enabled = (BIF_ARG_2 == am_true);
+
+ if(ERTS_IS_ATOM_STR("copy_save", BIF_ARG_1)) {
+ erts_lcnt_set_preserve_info(enabled);
+
+ BIF_RET(am_ok);
+ }
+ }
+#endif
BIF_ERROR(BIF_P, BADARG);
}
diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c
index fc6fb5f868..2f8adc87d5 100644
--- a/erts/emulator/beam/erl_bif_unique.c
+++ b/erts/emulator/beam/erl_bif_unique.c
@@ -392,7 +392,8 @@ init_magic_ref_tables(void)
erts_snprintf(&tblp->name[0], sizeof(tblp->name),
"magic_ref_table_0");
hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs);
- erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table");
+ erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
hash_funcs.hash = nsched_mreft_hash;
hash_funcs.cmp = nsched_mreft_cmp;
@@ -402,7 +403,8 @@ init_magic_ref_tables(void)
erts_snprintf(&tblp->name[0], sizeof(tblp->name),
"magic_ref_table_%d", i);
hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs);
- erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table");
+ erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
}
diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c
index 50f33b2014..f8b2fa744f 100644
--- a/erts/emulator/beam/erl_cpu_topology.c
+++ b/erts/emulator/beam/erl_cpu_topology.c
@@ -1706,7 +1706,8 @@ erts_init_cpu_topology(void)
{
int ix;
- erts_smp_rwmtx_init(&cpuinfo_rwmtx, "cpu_info");
+ erts_smp_rwmtx_init(&cpuinfo_rwmtx, "cpu_info", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
scheduler2cpu_map = erts_alloc(ERTS_ALC_T_CPUDATA,
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 17e0f2aeec..b83134c79c 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -575,9 +575,7 @@ delete_owned_table(Process *p, DbTable *tb)
table_dec_refc(tb, 1);
}
-
-static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock,
- char *rwname, char* fixname)
+static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock)
{
#ifdef ERTS_SMP
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
@@ -587,9 +585,10 @@ static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock,
rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
#endif
#ifdef ERTS_SMP
- erts_smp_rwmtx_init_opt_x(&tb->common.rwlock, &rwmtx_opt,
- rwname, tb->common.the_name);
- erts_smp_mtx_init_x(&tb->common.fixlock, fixname, tb->common.the_name);
+ erts_smp_rwmtx_init_opt(&tb->common.rwlock, &rwmtx_opt, "db_tab",
+ tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
+ erts_smp_mtx_init(&tb->common.fixlock, "db_tab_fix",
+ tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
tb->common.is_thread_safe = !(tb->common.status & DB_FINE_LOCKED);
#endif
}
@@ -1753,8 +1752,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
/* Note, 'type' is *read only* from now on... */
#endif
erts_smp_refc_init(&tb->common.fix_count, 0);
- db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ),
- "db_tab", "db_tab_fix");
+ db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ));
tb->common.keypos = keypos;
tb->common.owner = BIF_P->common.id;
set_heir(BIF_P, tb, heir, heir_data);
@@ -3391,8 +3389,9 @@ void init_db(ErtsDbSpinCount db_spin_count)
rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
for (i=0; i<META_NAME_TAB_LOCK_CNT; i++) {
- erts_smp_rwmtx_init_opt_x(&meta_name_tab_rwlocks[i].lck, &rwmtx_opt,
- "meta_name_tab", make_small(i));
+ erts_smp_rwmtx_init_opt(&meta_name_tab_rwlocks[i].lck, &rwmtx_opt,
+ "meta_name_tab", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DB);
}
#endif
@@ -4334,3 +4333,47 @@ erts_ets_colliding_names(Process* p, Eterm name, Uint cnt)
return list;
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+
+void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable) {
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&tb->common.rwlock.lcnt, "db_tab",
+ tb->common.the_name, ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_DB);
+ erts_lcnt_install_new_lock_info(&tb->common.fixlock.lcnt, "db_tab_fix",
+ tb->common.the_name, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DB);
+ } else {
+ erts_lcnt_uninstall(&tb->common.rwlock.lcnt);
+ erts_lcnt_uninstall(&tb->common.fixlock.lcnt);
+ }
+
+ if(IS_HASH_TABLE(tb->common.status)) {
+ erts_lcnt_enable_db_hash_lock_count(&tb->hash, enable);
+ }
+}
+
+static void lcnt_update_db_locks_per_sched(void *enable) {
+ ErtsSchedulerData *esdp;
+ DbTable *head;
+
+ esdp = erts_get_scheduler_data();
+ head = esdp->ets_tables.clist;
+
+ if(head) {
+ DbTable *iterator = head;
+
+ do {
+ if(is_table_alive(iterator)) {
+ erts_lcnt_enable_db_lock_count(iterator, !!enable);
+ }
+
+ iterator = iterator->common.all.next;
+ } while (iterator != head);
+ }
+}
+
+void erts_lcnt_update_db_locks(int enable) {
+ erts_schedule_multi_misc_aux_work(0, erts_no_schedulers,
+ &lcnt_update_db_locks_per_sched, (void*)(UWord)enable);
+}
+
+#endif /* ERTS_ENABLE_LOCK_COUNT */ \ No newline at end of file
diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h
index 4ff9f224e8..d83126b3a2 100644
--- a/erts/emulator/beam/erl_db.h
+++ b/erts/emulator/beam/erl_db.h
@@ -129,6 +129,11 @@ extern erts_smp_atomic_t erts_ets_misc_mem_size;
Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt);
Uint erts_db_get_max_tabs(void);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable);
+void erts_lcnt_update_db_locks(int enable);
+#endif
+
#endif /* ERL_DB_H__ */
#if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__)
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 0addfaa3c7..ae9322dfd3 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -675,8 +675,8 @@ int db_create_hash(Process *p, DbTable *tbl)
(DbTable *) tb,
sizeof(DbTableHashFineLocks));
for (i=0; i<DB_HASH_LOCK_CNT; ++i) {
- erts_smp_rwmtx_init_opt_x(&tb->locks->lck_vec[i].lck, &rwmtx_opt,
- "db_hash_slot", tb->common.the_name);
+ erts_smp_rwmtx_init_opt(&tb->locks->lck_vec[i].lck, &rwmtx_opt,
+ "db_hash_slot", tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
}
/* This important property is needed to guarantee the two buckets
* involved in a grow/shrink operation it protected by the same lock:
@@ -3206,3 +3206,23 @@ Eterm erts_ets_hash_sizeof_ext_segtab(void)
return make_small(((SIZEOF_EXT_SEGTAB(0)-1) / sizeof(UWord)) + 1);
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_db_hash_lock_count(DbTableHash *tb, int enable) {
+ int i;
+
+ if(tb->locks == NULL) {
+ return;
+ }
+
+ for(i = 0; i < DB_HASH_LOCK_CNT; i++) {
+ erts_lcnt_ref_t *ref = &tb->locks->lck_vec[i].lck.lcnt;
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(ref, "db_hash_slot", tb->common.the_name,
+ ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_DB);
+ } else {
+ erts_lcnt_uninstall(ref);
+ }
+ }
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index f491c85d95..523ed7860e 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -103,4 +103,8 @@ typedef struct {
void db_calc_stats_hash(DbTableHash* tb, DbHashStats*);
Eterm erts_ets_hash_sizeof_ext_segtab(void);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_db_hash_lock_count(DbTableHash *tb, int enable);
+#endif
+
#endif /* _DB_HASH_H */
diff --git a/erts/emulator/beam/erl_dirty_bif.tab b/erts/emulator/beam/erl_dirty_bif.tab
index 69421dcfcc..10c76d2579 100644
--- a/erts/emulator/beam/erl_dirty_bif.tab
+++ b/erts/emulator/beam/erl_dirty_bif.tab
@@ -46,6 +46,11 @@
dirty-cpu erts_debug:dirty_cpu/2
dirty-io erts_debug:dirty_io/2
+# lcnt_control/1 doesn't need to be dirty.
+dirty-cpu erts_debug:lcnt_control/2
+dirty-cpu erts_debug:lcnt_collect/0
+dirty-cpu erts_debug:lcnt_clear/0
+
# --- TEST of Dirty BIF functionality ---
# Functions below will execute on dirty schedulers when emulator has
# been configured for testing dirty schedulers. This is used for test
diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c
index 0e6aadf568..742c428f2a 100644
--- a/erts/emulator/beam/erl_drv_thread.c
+++ b/erts/emulator/beam/erl_drv_thread.c
@@ -55,7 +55,7 @@ fatal_error(int err, char *func)
struct ErlDrvMutex_ {
ethr_mutex mtx;
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
#endif
char *name;
};
@@ -68,7 +68,7 @@ struct ErlDrvCond_ {
struct ErlDrvRWLock_ {
ethr_rwmutex rwmtx;
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
#endif
char *name;
};
@@ -146,7 +146,8 @@ void erl_drv_thr_init(void)
sizeof(char *)*ERL_DRV_TSD_KEYS_INC);
for (i = 0; i < ERL_DRV_TSD_KEYS_INC; i++)
used_tsd_keys[i] = NULL;
- erts_mtx_init(&tsd_mtx, "drv_tsd");
+ erts_mtx_init(&tsd_mtx, "drv_tsd", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
}
/*
@@ -176,7 +177,8 @@ erl_drv_mutex_create(char *name)
dmtx->name = no_name;
}
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&dmtx->lcnt, dmtx->name, ERTS_LCNT_LT_MUTEX);
+ erts_lcnt_init_ref_x(&dmtx->lcnt, dmtx->name, NIL,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
}
return dmtx;
@@ -191,7 +193,7 @@ erl_drv_mutex_destroy(ErlDrvMutex *dmtx)
#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&dmtx->lcnt);
+ erts_lcnt_uninstall(&dmtx->lcnt);
#endif
res = dmtx ? ethr_mutex_destroy(&dmtx->mtx) : EINVAL;
if (res != 0)
@@ -368,7 +370,8 @@ erl_drv_rwlock_create(char *name)
drwlck->name = no_name;
}
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&drwlck->lcnt, drwlck->name, ERTS_LCNT_LT_RWMUTEX);
+ erts_lcnt_init_ref_x(&drwlck->lcnt, drwlck->name, NIL,
+ ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
}
return drwlck;
@@ -383,7 +386,7 @@ erl_drv_rwlock_destroy(ErlDrvRWLock *drwlck)
#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&drwlck->lcnt);
+ erts_lcnt_uninstall(&drwlck->lcnt);
#endif
res = drwlck ? ethr_rwmutex_destroy(&drwlck->rwmtx) : EINVAL;
if (res != 0)
@@ -411,7 +414,7 @@ erl_drv_rwlock_tryrlock(ErlDrvRWLock *drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_tryrlock()");
res = ethr_rwmutex_tryrlock(&drwlck->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LCNT_LO_READ);
+ erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LOCK_OPTIONS_READ);
#endif
return res;
#else
@@ -426,7 +429,7 @@ erl_drv_rwlock_rlock(ErlDrvRWLock *drwlck)
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_rlock(&drwlck->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -442,7 +445,7 @@ erl_drv_rwlock_runlock(ErlDrvRWLock *drwlck)
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_runlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_runlock(&drwlck->rwmtx);
#endif
@@ -457,7 +460,7 @@ erl_drv_rwlock_tryrwlock(ErlDrvRWLock *drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_tryrwlock()");
res = ethr_rwmutex_tryrwlock(&drwlck->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LOCK_OPTIONS_RDWR);
#endif
return res;
#else
@@ -472,7 +475,7 @@ erl_drv_rwlock_rwlock(ErlDrvRWLock *drwlck)
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rwlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwlock(&drwlck->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -488,7 +491,7 @@ erl_drv_rwlock_rwunlock(ErlDrvRWLock *drwlck)
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rwunlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwunlock(&drwlck->rwmtx);
#endif
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index d18016c42e..535f677bb3 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -63,7 +63,8 @@ erts_init_fun_table(void)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&erts_fun_table_lock, &rwmtx_opt, "fun_tab");
+ erts_smp_rwmtx_init_opt(&erts_fun_table_lock, &rwmtx_opt, "fun_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) fun_hash;
f.cmp = (HCMP_FUN) fun_cmp;
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 3c8bdaa62e..8cb977a7f3 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -274,7 +274,8 @@ erts_init_gc(void)
}
#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info");
+ erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
init_gc_info(&dirty_gc.info);
#endif
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 6172595552..5206d7564f 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -2357,8 +2357,12 @@ erl_start(int argc, char **argv)
#ifdef ERTS_SMP
erts_start_schedulers();
- /* Let system specific code decide what to do with the main thread... */
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_post_startup();
+#endif
+
+ /* Let system specific code decide what to do with the main thread... */
erts_sys_main_thread(); /* May or may not return! */
#else
{
@@ -2373,6 +2377,11 @@ erl_start(int argc, char **argv)
erts_sched_init_time_sup(esdp);
erts_ets_sched_spec_data_init(esdp);
erts_aux_work_timeout_late_init(esdp);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_post_startup();
+#endif
+
process_main(esdp->x_reg_array, esdp->f_reg_array);
}
#endif
diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c
index 4d4defd8b5..634509f880 100644
--- a/erts/emulator/beam/erl_instrument.c
+++ b/erts/emulator/beam/erl_instrument.c
@@ -1200,7 +1200,8 @@ erts_instr_init(int stat, int map_stat)
stats = erts_alloc(ERTS_ALC_T_INSTR_INFO, sizeof(struct stats_));
- erts_mtx_init(&instr_mutex, "instr");
+ erts_mtx_init(&instr_mutex, "instr", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
mem_anchor = NULL;
@@ -1223,7 +1224,8 @@ erts_instr_init(int stat, int map_stat)
if (map_stat) {
- erts_mtx_init(&instr_x_mutex, "instr_x");
+ erts_mtx_init(&instr_x_mutex, "instr_x", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
erts_instr_memory_map = 1;
erts_instr_stat = 1;
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index f270d8baef..cf091ee43f 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -104,7 +104,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "db_tab", "address" },
{ "proc_status", "pid" },
{ "proc_trace", "pid" },
- { "ports_snapshot", NULL },
{ "db_tab_fix", "address" },
{ "db_hash_slot", "address" },
{ "node_table", NULL },
@@ -161,6 +160,9 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "mtrace_op", NULL },
{ "instr_x", NULL },
{ "instr", NULL },
+#ifdef ERTS_SMP
+ { "pollsets_lock", NULL },
+#endif
{ "alcu_allocator", "index" },
{ "mseg", NULL },
#ifdef ERTS_SMP
@@ -173,7 +175,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "get_time", NULL },
{ "get_corrected_time", NULL },
{ "breakpoints", NULL },
- { "pollsets_lock", NULL },
{ "pix_lock", "address" },
{ "run_queues_lists", NULL },
{ "sched_stat", NULL },
@@ -199,41 +200,20 @@ static erts_lc_lock_order_t erts_lock_order[] = {
#define ERTS_LOCK_ORDER_SIZE \
(sizeof(erts_lock_order)/sizeof(erts_lc_lock_order_t))
-#define LOCK_IS_TYPE_ORDER_VIOLATION(LCK_FLG, LCKD_FLG) \
- (((LCKD_FLG) & (ERTS_LC_FLG_LT_SPINLOCK|ERTS_LC_FLG_LT_RWSPINLOCK)) \
- && ((LCK_FLG) \
- & ERTS_LC_FLG_LT_ALL \
- & ~(ERTS_LC_FLG_LT_SPINLOCK|ERTS_LC_FLG_LT_RWSPINLOCK)))
+#define LOCK_IS_TYPE_ORDER_VIOLATION(LCK_FLG, LCKD_FLG) \
+ (((LCKD_FLG) & ERTS_LOCK_FLAGS_MASK_TYPE) == ERTS_LOCK_FLAGS_TYPE_SPINLOCK \
+ && \
+ ((LCK_FLG) & ERTS_LOCK_FLAGS_MASK_TYPE) != ERTS_LOCK_FLAGS_TYPE_SPINLOCK)
static __decl_noreturn void __noreturn lc_abort(void);
-static char *
-lock_type(Uint16 flags)
+static const char *rw_op_str(erts_lock_options_t options)
{
- switch (flags & ERTS_LC_FLG_LT_ALL) {
- case ERTS_LC_FLG_LT_SPINLOCK: return "[spinlock]";
- case ERTS_LC_FLG_LT_RWSPINLOCK: return "[rw(spin)lock]";
- case ERTS_LC_FLG_LT_MUTEX: return "[mutex]";
- case ERTS_LC_FLG_LT_RWMUTEX: return "[rwmutex]";
- case ERTS_LC_FLG_LT_PROCLOCK: return "[proclock]";
- default: return "";
+ if(options == ERTS_LOCK_OPTIONS_WRITE) {
+ ERTS_INTERNAL_ERROR("Only write flag present");
}
-}
-static char *
-rw_op_str(Uint16 flags)
-{
- switch (flags & ERTS_LC_FLG_LO_READ_WRITE) {
- case ERTS_LC_FLG_LO_READ_WRITE:
- return " (rw)";
- case ERTS_LC_FLG_LO_READ:
- return " (r)";
- case ERTS_LC_FLG_LO_WRITE:
- ERTS_INTERNAL_ERROR("Only write flag present");
- default:
- break;
- }
- return "";
+ return erts_lock_options_get_short_desc(options);
}
typedef struct erts_lc_locked_lock_t_ erts_lc_locked_lock_t;
@@ -244,7 +224,8 @@ struct erts_lc_locked_lock_t_ {
Sint16 id;
char *file;
unsigned int line;
- Uint16 flags;
+ erts_lock_flags_t flags;
+ erts_lock_options_t taken_options;
};
typedef struct {
@@ -431,7 +412,7 @@ make_my_locked_locks(void)
}
static ERTS_INLINE erts_lc_locked_lock_t *
-new_locked_lock(erts_lc_lock_t *lck, Uint16 op_flags,
+new_locked_lock(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_lock_t *l_lck = (erts_lc_locked_lock_t *) lc_alloc();
@@ -441,12 +422,13 @@ new_locked_lock(erts_lc_lock_t *lck, Uint16 op_flags,
l_lck->extra = lck->extra;
l_lck->file = file;
l_lck->line = line;
- l_lck->flags = lck->flags | op_flags;
+ l_lck->flags = lck->flags;
+ l_lck->taken_options = options;
return l_lck;
}
static void
-raw_print_lock(char *prefix, Sint16 id, Wterm extra, Uint16 flags,
+raw_print_lock(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags,
char* file, unsigned int line, char *suffix)
{
char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE
@@ -458,16 +440,16 @@ raw_print_lock(char *prefix, Sint16 id, Wterm extra, Uint16 flags,
erts_fprintf(stderr,"%p",_unchecked_boxed_val(extra));
else
erts_fprintf(stderr,"%T",extra);
- erts_fprintf(stderr,"%s",lock_type(flags));
+ erts_fprintf(stderr,"[%s]",erts_lock_flags_get_type_name(flags));
if (file)
erts_fprintf(stderr,"(%s:%d)",file,line);
- erts_fprintf(stderr,"'%s%s",rw_op_str(flags),suffix);
+ erts_fprintf(stderr,"'(%s)%s",rw_op_str(flags),suffix);
}
static void
-print_lock2(char *prefix, Sint16 id, Wterm extra, Uint16 flags, char *suffix)
+print_lock2(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags, char *suffix)
{
raw_print_lock(prefix, id, extra, flags, NULL, 0, suffix);
}
@@ -522,9 +504,9 @@ uninitialized_lock(void)
static void
lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
- Uint16 op_flags)
+ erts_lock_options_t options)
{
- erts_fprintf(stderr, "%s%s", prefix, rw_op_str(op_flags));
+ erts_fprintf(stderr, "%s (%s)", prefix, rw_op_str(options));
print_lock(" ", lck, " lock which is already locked by thread!\n");
print_curr_locks(l_lcks);
lc_abort();
@@ -532,9 +514,9 @@ lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
static void
unlock_op_mismatch(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
- Uint16 op_flags)
+ erts_lock_options_t options)
{
- erts_fprintf(stderr, "Unlocking%s ", rw_op_str(op_flags));
+ erts_fprintf(stderr, "Unlocking (%s) ", rw_op_str(options));
print_lock("", lck, " lock which mismatch previous lock operation!\n");
print_curr_locks(l_lcks);
lc_abort();
@@ -745,84 +727,128 @@ erts_lc_get_lock_order_id(char *name)
return (Sint16) -1;
}
+static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
+{
+ if(locked_lock->id < comparand->id) {
+ return -1;
+ } else if(locked_lock->id > comparand->id) {
+ return 1;
+ }
-static int
-find_lock(erts_lc_locked_lock_t **l_lcks, erts_lc_lock_t *lck)
+ return 0;
+}
+
+static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
{
- erts_lc_locked_lock_t *l_lck = *l_lcks;
+ int order = compare_locked_by_id(locked_lock, comparand);
+
+ if(order) {
+ return order;
+ } else if(locked_lock->extra < comparand->extra) {
+ return -1;
+ } else if(locked_lock->extra > comparand->extra) {
+ return 1;
+ }
- if (l_lck) {
- if (l_lck->id == lck->id && l_lck->extra == lck->extra) {
- if ((l_lck->flags & lck->flags) == lck->flags)
- return 1;
- return 0;
- }
- else if (l_lck->id < lck->id
- || (l_lck->id == lck->id
- && l_lck->extra < lck->extra)) {
- for (l_lck = l_lck->next; l_lck; l_lck = l_lck->next) {
- if (l_lck->id > lck->id
- || (l_lck->id == lck->id
- && l_lck->extra >= lck->extra)) {
- *l_lcks = l_lck;
- if (l_lck->id == lck->id
- && l_lck->extra == lck->extra
- && ((l_lck->flags & lck->flags) == lck->flags))
- return 1;
- return 0;
- }
- }
- }
- else {
- for (l_lck = l_lck->prev; l_lck; l_lck = l_lck->prev) {
- if (l_lck->id < lck->id
- || (l_lck->id == lck->id
- && l_lck->extra <= lck->extra)) {
- *l_lcks = l_lck;
- if (l_lck->id == lck->id
- && l_lck->extra == lck->extra
- && ((l_lck->flags & lck->flags) == lck->flags))
- return 1;
- return 0;
- }
- }
- }
+ return 0;
+}
+
+typedef int (*locked_compare_func)(erts_lc_locked_lock_t *, erts_lc_lock_t *);
+
+/* Searches through a list of taken locks, bailing when it hits an entry whose
+ * order relative to the search template is the opposite of the one at the
+ * start of the search. (*closest_neighbor) is either set to the exact match,
+ * or the one closest to it in the sort order. */
+static int search_locked_list(locked_compare_func compare,
+ erts_lc_locked_lock_t *locked_locks,
+ erts_lc_lock_t *search_template,
+ erts_lc_locked_lock_t **closest_neighbor)
+{
+ erts_lc_locked_lock_t *iterator = locked_locks;
+
+ (*closest_neighbor) = iterator;
+
+ if(iterator) {
+ int relative_order = compare(iterator, search_template);
+
+ if(relative_order < 0) {
+ while((iterator = iterator->next) != NULL) {
+ relative_order = compare(iterator, search_template);
+
+ if(relative_order >= 0) {
+ (*closest_neighbor) = iterator;
+ break;
+ }
+ }
+ } else if(relative_order > 0) {
+ while((iterator = iterator->prev) != NULL) {
+ relative_order = compare(iterator, search_template);
+
+ if(relative_order <= 0) {
+ (*closest_neighbor) = iterator;
+ break;
+ }
+ }
+ }
+
+ return relative_order == 0;
}
+
return 0;
}
+/* Searches for a lock in the given list that matches search_template, and sets
+ * (*locked_locks) to the closest lock in the sort order. */
static int
-find_id(erts_lc_locked_lock_t **l_lcks, Sint16 id)
-{
- erts_lc_locked_lock_t *l_lck = *l_lcks;
-
- if (l_lck) {
- if (l_lck->id == id)
- return 1;
- else if (l_lck->id < id) {
- for (l_lck = l_lck->next; l_lck; l_lck = l_lck->next) {
- if (l_lck->id >= id) {
- *l_lcks = l_lck;
- if (l_lck->id == id)
- return 1;
- return 0;
- }
- }
- }
- else {
- for (l_lck = l_lck->prev; l_lck; l_lck = l_lck->prev) {
- if (l_lck->id <= id) {
- *l_lcks = l_lck;
- if (l_lck->id == id)
- return 1;
- return 0;
- }
- }
- }
+find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
+{
+ erts_lc_locked_lock_t *closest_neighbor;
+ int found_lock;
+
+ found_lock = search_locked_list(compare_locked_by_id_extra,
+ (*locked_locks),
+ search_template,
+ &closest_neighbor);
+
+ (*locked_locks) = closest_neighbor;
+
+ if(found_lock) {
+ erts_lock_options_t relevant_options;
+ erts_lock_flags_t relevant_flags;
+
+ /* We only care about the options and flags that are set in the
+ * template. */
+ relevant_options = (closest_neighbor->taken_options & search_template->taken_options);
+ relevant_flags = (closest_neighbor->flags & search_template->flags);
+
+ return search_template->taken_options == relevant_options &&
+ search_template->flags == relevant_flags;
}
+
return 0;
}
+/* Searches for a lock in the given list by id, and sets (*locked_locks) to the
+ * closest lock in the sort order. */
+static int
+find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id)
+{
+ erts_lc_locked_lock_t *closest_neighbor;
+ erts_lc_lock_t search_template;
+ int found_lock;
+
+ search_template.id = id;
+
+ found_lock = search_locked_list(compare_locked_by_id,
+ (*locked_locks),
+ &search_template,
+ &closest_neighbor);
+
+ (*locked_locks) = closest_neighbor;
+
+ return found_lock;
+}
+
void
erts_lc_have_locks(int *resv, erts_lc_lock_t *locks, int len)
{
@@ -918,17 +944,17 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
}
void
-erts_lc_check_no_locked_of_type(Uint16 flags)
+erts_lc_check_no_locked_of_type(erts_lock_flags_t type)
{
erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
if (l_lcks) {
erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) {
- if (l_lck->flags & flags) {
+ if ((l_lck->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) {
erts_fprintf(stderr,
"Locked lock of type %s found which isn't "
"allowed here!\n",
- lock_type(l_lck->flags));
+ erts_lock_flags_get_type_name(l_lck->flags));
print_curr_locks(l_lcks);
lc_abort();
}
@@ -937,7 +963,7 @@ erts_lc_check_no_locked_of_type(Uint16 flags)
}
int
-erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
#ifdef ERTS_LC_DO_NOT_FORCE_BUSY_TRYLOCK_ON_LOCK_ORDER_VIOLATION
return 0;
@@ -986,7 +1012,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags)
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, op_flags);
+ lock_twice("Trylocking", l_lcks, lck, options);
break;
}
}
@@ -1008,7 +1034,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags)
#endif
}
-void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_locks_t *l_lcks;
@@ -1021,7 +1047,7 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
return;
l_lcks = make_my_locked_locks();
- l_lck = locked ? new_locked_lock(lck, op_flags, file, line) : NULL;
+ l_lck = locked ? new_locked_lock(lck, options, file, line) : NULL;
if (!l_lcks->locked.last) {
ASSERT(!l_lcks->locked.first);
@@ -1039,7 +1065,7 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, op_flags);
+ lock_twice("Trylocking", l_lcks, lck, options);
if (locked) {
l_lck->next = tl_lck->next;
l_lck->prev = tl_lck;
@@ -1062,14 +1088,14 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
}
-void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
if (!find_lock(&l_lck, lck))
required_not_locked(l_lcks, lck);
- l_lck = new_locked_lock(lck, op_flags, file, line);
+ l_lck = new_locked_lock(lck, options, file, line);
if (!l_lcks->required.last) {
ASSERT(!l_lcks->required.first);
l_lck->next = l_lck->prev = NULL;
@@ -1109,7 +1135,7 @@ void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags,
}
}
-void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
@@ -1137,7 +1163,7 @@ void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
lc_free((void *) l_lck);
}
-void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_locks_t *l_lcks;
@@ -1150,7 +1176,7 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
return;
l_lcks = make_my_locked_locks();
- l_lck = new_locked_lock(lck, op_flags, file, line);
+ l_lck = new_locked_lock(lck, options, file, line);
if (!l_lcks->locked.last) {
ASSERT(!l_lcks->locked.first);
@@ -1166,12 +1192,12 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
l_lcks->locked.last = l_lck;
}
else if (l_lcks->locked.last->id == lck->id && l_lcks->locked.last->extra == lck->extra)
- lock_twice("Locking", l_lcks, lck, op_flags);
+ lock_twice("Locking", l_lcks, lck, options);
else
lock_order_violation(l_lcks, lck);
}
-void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
erts_lc_locked_locks_t *l_lcks;
erts_lc_locked_lock_t *l_lck;
@@ -1192,8 +1218,8 @@ void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
for (l_lck = l_lcks ? l_lcks->locked.last : NULL; l_lck; l_lck = l_lck->prev) {
if (l_lck->id == lck->id && l_lck->extra == lck->extra) {
- if ((l_lck->flags & ERTS_LC_FLG_LO_ALL) != op_flags)
- unlock_op_mismatch(l_lcks, lck, op_flags);
+ if ((l_lck->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options)
+ unlock_op_mismatch(l_lcks, lck, options);
if (l_lck->prev)
l_lck->prev->next = l_lck->next;
else
@@ -1210,7 +1236,7 @@ void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
unlock_of_not_locked(l_lcks, lck);
}
-void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
erts_lc_locked_locks_t *l_lcks;
erts_lc_locked_lock_t *l_lck;
@@ -1274,23 +1300,25 @@ void erts_lc_unrequire_lock(erts_lc_lock_t *lck)
}
void
-erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags)
+erts_lc_init_lock(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags)
{
lck->id = erts_lc_get_lock_order_id(name);
lck->extra = (UWord) &lck->extra;
ASSERT(is_not_immed(lck->extra));
lck->flags = flags;
+ lck->taken_options = 0;
lck->inited = ERTS_LC_INITITALIZED;
}
void
-erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, Uint16 flags, Eterm extra)
+erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags, Eterm extra)
{
lck->id = erts_lc_get_lock_order_id(name);
lck->extra = extra;
ASSERT(is_immed(lck->extra));
lck->flags = flags;
+ lck->taken_options = 0;
lck->inited = ERTS_LC_INITITALIZED;
}
@@ -1304,6 +1332,7 @@ erts_lc_destroy_lock(erts_lc_lock_t *lck)
lck->id = -1;
lck->extra = THE_NON_VALUE;
lck->flags = 0;
+ lck->taken_options = 0;
}
void
diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h
index 18296d1fec..8c754a8dfa 100644
--- a/erts/emulator/beam/erl_lock_check.h
+++ b/erts/emulator/beam/erl_lock_check.h
@@ -36,6 +36,8 @@
#ifdef ERTS_ENABLE_LOCK_CHECK
+#include "erl_lock_flags.h"
+
#ifndef ERTS_ENABLE_LOCK_POSITION
/* Enable in order for _x variants of mtx functions to be used. */
#define ERTS_ENABLE_LOCK_POSITION 1
@@ -44,36 +46,14 @@
typedef struct {
int inited;
Sint16 id;
- Uint16 flags;
+ erts_lock_flags_t flags;
+ erts_lock_options_t taken_options;
UWord extra;
} erts_lc_lock_t;
#define ERTS_LC_INITITALIZED 0x7f7f7f7f
-
-#define ERTS_LC_FLG_LT_SPINLOCK (((Uint16) 1) << 0)
-#define ERTS_LC_FLG_LT_RWSPINLOCK (((Uint16) 1) << 1)
-#define ERTS_LC_FLG_LT_MUTEX (((Uint16) 1) << 2)
-#define ERTS_LC_FLG_LT_RWMUTEX (((Uint16) 1) << 3)
-#define ERTS_LC_FLG_LT_PROCLOCK (((Uint16) 1) << 4)
-
-#define ERTS_LC_FLG_LO_READ (((Uint16) 1) << 5)
-#define ERTS_LC_FLG_LO_WRITE (((Uint16) 1) << 6)
-
-#define ERTS_LC_FLG_LO_READ_WRITE (ERTS_LC_FLG_LO_READ \
- | ERTS_LC_FLG_LO_WRITE)
-
-#define ERTS_LC_FLG_LT_ALL (ERTS_LC_FLG_LT_SPINLOCK \
- | ERTS_LC_FLG_LT_RWSPINLOCK \
- | ERTS_LC_FLG_LT_MUTEX \
- | ERTS_LC_FLG_LT_RWMUTEX \
- | ERTS_LC_FLG_LT_PROCLOCK)
-
-#define ERTS_LC_FLG_LO_ALL (ERTS_LC_FLG_LO_READ \
- | ERTS_LC_FLG_LO_WRITE)
-
-
-#define ERTS_LC_LOCK_INIT(ID, X, F) {ERTS_LC_INITITALIZED, (ID), (F), (X)}
+#define ERTS_LC_LOCK_INIT(ID, X, F) {ERTS_LC_INITITALIZED, (ID), (F), 0, (X)}
void erts_lc_init(void);
void erts_lc_late_init(void);
@@ -83,31 +63,31 @@ void erts_lc_check(erts_lc_lock_t *have, int have_len,
void erts_lc_check_exact(erts_lc_lock_t *have, int have_len);
void erts_lc_have_locks(int *resv, erts_lc_lock_t *lcks, int len);
void erts_lc_have_lock_ids(int *resv, int *ids, int len);
-void erts_lc_check_no_locked_of_type(Uint16 flags);
-int erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags);
-void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_check_no_locked_of_type(erts_lock_flags_t flags);
+int erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
+void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line);
-void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line);
-void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags);
-void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags);
+void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
+void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
int erts_lc_trylock_force_busy(erts_lc_lock_t *lck);
void erts_lc_trylock_x(int locked, erts_lc_lock_t *lck,
char* file, unsigned int line);
void erts_lc_lock_x(erts_lc_lock_t *lck, char* file, unsigned int line);
void erts_lc_unlock(erts_lc_lock_t *lck);
void erts_lc_might_unlock(erts_lc_lock_t *lck);
-void erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags);
-void erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, Uint16 flags, Eterm extra);
+void erts_lc_init_lock(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags);
+void erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags, Eterm extra);
void erts_lc_destroy_lock(erts_lc_lock_t *lck);
void erts_lc_fail(char *fmt, ...);
int erts_lc_assert_failed(char *file, int line, char *assertion);
void erts_lc_set_thread_name(char *thread_name);
void erts_lc_pll(void);
-void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line);
-void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags);
+void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
void erts_lc_require_lock(erts_lc_lock_t *lck, char *file, unsigned int line);
void erts_lc_unrequire_lock(erts_lc_lock_t *lck);
diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c
index 678bc43f04..d2e8f47d59 100644
--- a/erts/emulator/beam/erl_lock_count.c
+++ b/erts/emulator/beam/erl_lock_count.c
@@ -18,51 +18,37 @@
* %CopyrightEnd%
*/
-/*
- * Description: Statistics for locks.
- *
- * Author: Björn-Egil Dahlberg
- * Date: 2008-07-03
- */
-
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
-/* Needed for VxWorks va_arg */
+#ifdef ERTS_ENABLE_LOCK_COUNT
+
#include "sys.h"
-#ifdef ERTS_ENABLE_LOCK_COUNT
+#include "global.h"
#include "erl_lock_count.h"
-#include "ethread.h"
-#include "erl_term.h"
-#include "atom.h"
-#include <stdio.h>
-
-/* globals, dont access these without locks or blocks */
+#include "erl_thr_progress.h"
-ethr_mutex lcnt_data_lock;
-erts_lcnt_data_t *erts_lcnt_data;
-Uint16 erts_lcnt_rt_options;
-erts_lcnt_time_t timer_start;
-const char *str_undefined = "undefined";
+#include "erl_node_tables.h"
+#include "erl_alloc_util.h"
+#include "erl_check_io.h"
+#include "erl_poll.h"
+#include "erl_db.h"
-static ethr_tsd_key lcnt_thr_data_key;
-static int lcnt_n_thr;
-static erts_lcnt_thread_data_t *lcnt_thread_data[2048];
+#define LCNT_MAX_CARRIER_ENTRIES 255
-/* local functions */
+/* - Locals that are shared with the header implementation - */
-static ERTS_INLINE void lcnt_lock(void) {
- ethr_mutex_lock(&lcnt_data_lock);
-}
+#ifdef DEBUG
+int lcnt_initialization_completed__;
+#endif
-static ERTS_INLINE void lcnt_unlock(void) {
- ethr_mutex_unlock(&lcnt_data_lock);
-}
+erts_lock_flags_t lcnt_category_mask__;
+ethr_tsd_key lcnt_thr_data_key__;
-const int log2_tab64[64] = {
+const int lcnt_log2_tab64__[64] = {
63, 0, 58, 1, 59, 47, 53, 2,
60, 39, 48, 27, 54, 33, 42, 3,
61, 51, 37, 40, 49, 18, 28, 20,
@@ -72,635 +58,624 @@ const int log2_tab64[64] = {
56, 45, 25, 31, 35, 16, 9, 12,
44, 24, 15, 8, 23, 7, 6, 5};
-static ERTS_INLINE int lcnt_log2(Uint64 v) {
- v |= v >> 1;
- v |= v >> 2;
- v |= v >> 4;
- v |= v >> 8;
- v |= v >> 16;
- v |= v >> 32;
- return log2_tab64[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58];
-}
-
-static char* lcnt_lock_type(Uint16 flag) {
- switch(flag & ERTS_LCNT_LT_ALL) {
- case ERTS_LCNT_LT_SPINLOCK: return "spinlock";
- case ERTS_LCNT_LT_RWSPINLOCK: return "rw_spinlock";
- case ERTS_LCNT_LT_MUTEX: return "mutex";
- case ERTS_LCNT_LT_RWMUTEX: return "rw_mutex";
- case ERTS_LCNT_LT_PROCLOCK: return "proclock";
- default: return "";
- }
-}
+/* - Local variables - */
-static void lcnt_clear_stats(erts_lcnt_lock_stats_t *stats) {
- ethr_atomic_set(&stats->tries, 0);
- ethr_atomic_set(&stats->colls, 0);
- stats->timer.s = 0;
- stats->timer.ns = 0;
- stats->timer_n = 0;
- stats->file = (char *)str_undefined;
- stats->line = 0;
- sys_memzero(stats->hist.ns, sizeof(stats->hist.ns));
-}
+typedef struct lcnt_static_lock_ref_ {
+ erts_lcnt_ref_t *reference;
-static void lcnt_time(erts_lcnt_time_t *time) {
- /*
- * erts_sys_hrtime() is the highest resolution
- * we could find, it may or may not be monotonic...
- */
- ErtsMonotonicTime mtime = erts_sys_hrtime();
- time->s = (unsigned long) (mtime / 1000000000LL);
- time->ns = (unsigned long) (mtime - 1000000000LL*time->s);
-}
+ erts_lock_flags_t flags;
+ const char *name;
+ Eterm id;
-static void lcnt_time_diff(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0) {
- long ds;
- long dns;
+ struct lcnt_static_lock_ref_ *next;
+} lcnt_static_lock_ref_t;
- ds = t1->s - t0->s;
- dns = t1->ns - t0->ns;
+static ethr_atomic_t lcnt_static_lock_registry;
- /* the difference should not be able to get bigger than 1 sec in ns*/
+static erts_lcnt_lock_info_list_t lcnt_current_lock_list;
+static erts_lcnt_lock_info_list_t lcnt_deleted_lock_list;
- if (dns < 0) {
- ds -= 1;
- dns += 1000000000LL;
- }
+static erts_lcnt_time_t lcnt_timer_start;
- ASSERT(ds >= 0);
+static int lcnt_preserve_info;
- d->s = ds;
- d->ns = dns;
-}
+/* local functions */
+
+static void lcnt_clear_stats(erts_lcnt_lock_info_t *info) {
+ size_t i;
+
+ for(i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) {
+ erts_lcnt_lock_stats_t *stats = &info->location_stats[i];
-/* difference d must be non-negative */
+ sys_memzero(&stats->wait_time_histogram, sizeof(stats->wait_time_histogram));
-static void lcnt_time_add(erts_lcnt_time_t *t, erts_lcnt_time_t *d) {
- t->s += d->s;
- t->ns += d->ns;
+ stats->total_time_waited.s = 0;
+ stats->total_time_waited.ns = 0;
- t->s += t->ns / 1000000000LL;
- t->ns = t->ns % 1000000000LL;
+ stats->times_waited = 0;
+
+ stats->file = NULL;
+ stats->line = 0;
+
+ ethr_atomic_set(&stats->attempts, 0);
+ ethr_atomic_set(&stats->collisions, 0);
+ }
+
+ info->location_count = 1;
}
-static erts_lcnt_thread_data_t *lcnt_thread_data_alloc(void) {
- erts_lcnt_thread_data_t *eltd;
+static lcnt_thread_data_t__ *lcnt_thread_data_alloc(void) {
+ lcnt_thread_data_t__ *eltd =
+ (lcnt_thread_data_t__*)malloc(sizeof(lcnt_thread_data_t__));
- eltd = (erts_lcnt_thread_data_t*)malloc(sizeof(erts_lcnt_thread_data_t));
- if (!eltd) {
- ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!");
+ if(!eltd) {
+ ERTS_INTERNAL_ERROR("Failed to allocate lcnt thread data.");
}
+
eltd->timer_set = 0;
eltd->lock_in_conflict = 0;
- eltd->id = lcnt_n_thr++;
- /* set thread data to array */
- lcnt_thread_data[eltd->id] = eltd;
-
return eltd;
}
-static erts_lcnt_thread_data_t *lcnt_get_thread_data(void) {
- return (erts_lcnt_thread_data_t *)ethr_tsd_get(lcnt_thr_data_key);
-}
+/* - List operations -
+ *
+ * Info entries are kept in a doubly linked list where each entry is locked
+ * with its neighbors rather than a global lock. Deletion is rather quick, but
+ * insertion is still serial since the head becomes a de facto global lock.
+ *
+ * We rely on ad-hoc spinlocks to avoid "recursing" into this module. */
-/* debug */
+#define LCNT_SPINLOCK_YIELD_ITERATIONS 50
-#if 0
-static char* lock_opt(Uint16 flag) {
- if ((flag & ERTS_LCNT_LO_WRITE) && (flag & ERTS_LCNT_LO_READ)) return "rw";
- if (flag & ERTS_LCNT_LO_READ ) return "r ";
- if (flag & ERTS_LCNT_LO_WRITE) return " w";
- return "--";
-}
+#define LCNT_SPINLOCK_HELPER_INIT \
+ Uint failed_spin_count = 0;
-static void print_lock_x(erts_lcnt_lock_t *lock, Uint16 flag, char *action) {
- erts_aint_t w_state, r_state;
- char *type;
+#define LCNT_SPINLOCK_HELPER_YIELD \
+ do { \
+ failed_spin_count++; \
+ if(!(failed_spin_count % LCNT_SPINLOCK_YIELD_ITERATIONS)) { \
+ erts_thr_yield(); \
+ } else { \
+ ERTS_SPIN_BODY; \
+ } \
+ } while(0)
- if (strcmp(lock->name, "run_queue") != 0) return;
- type = lcnt_lock_type(lock->flag);
- r_state = ethr_atomic_read(&lock->r_state);
- w_state = ethr_atomic_read(&lock->w_state);
+static void lcnt_unlock_list_entry(erts_lcnt_lock_info_t *info) {
+ ethr_atomic32_set_relb(&info->lock, 0);
+}
- if (lock->flag & flag) {
- erts_fprintf(stderr,"%10s [%24s] [r/w state %4ld/%4ld] %2s id %T\r\n",
- action,
- lock->name,
- r_state,
- w_state,
- type,
- lock->id);
- }
+static int lcnt_try_lock_list_entry(erts_lcnt_lock_info_t *info) {
+ return ethr_atomic32_cmpxchg_acqb(&info->lock, 1, 0) == 0;
}
-#endif
-static erts_lcnt_lock_stats_t *lcnt_get_lock_stats(erts_lcnt_lock_t *lock, char *file, unsigned int line) {
- unsigned int i;
- erts_lcnt_lock_stats_t *stats = NULL;
+static void lcnt_lock_list_entry(erts_lcnt_lock_info_t *info) {
+ LCNT_SPINLOCK_HELPER_INIT;
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_LOCATION) {
- for (i = 0; i < lock->n_stats; i++) {
- if ((lock->stats[i].file == file) && (lock->stats[i].line == line)) {
- return &(lock->stats[i]);
- }
- }
- if (lock->n_stats < ERTS_LCNT_MAX_LOCK_LOCATIONS) {
- stats = &lock->stats[lock->n_stats];
- lock->n_stats++;
- stats->file = file;
- stats->line = line;
- return stats;
- }
+ while(!lcnt_try_lock_list_entry(info)) {
+ LCNT_SPINLOCK_HELPER_YIELD;
}
- return &lock->stats[0];
}
-static void lcnt_update_stats_hist(erts_lcnt_hist_t *hist, erts_lcnt_time_t *time_wait) {
- int idx;
- unsigned long r;
+static void lcnt_lock_list_entry_with_neighbors(erts_lcnt_lock_info_t *info) {
+ LCNT_SPINLOCK_HELPER_INIT;
- if (time_wait->s > 0 || time_wait->ns > ERTS_LCNT_HISTOGRAM_MAX_NS) {
- idx = ERTS_LCNT_HISTOGRAM_SLOT_SIZE - 1;
- } else {
- r = time_wait->ns >> ERTS_LCNT_HISTOGRAM_RSHIFT;
- if (r) idx = lcnt_log2(r);
- else idx = 0;
+ for(;;) {
+ if(!lcnt_try_lock_list_entry(info))
+ goto retry_after_entry_failed;
+ if(!lcnt_try_lock_list_entry(info->next))
+ goto retry_after_next_failed;
+ if(!lcnt_try_lock_list_entry(info->prev))
+ goto retry_after_prev_failed;
+
+ return;
+
+ retry_after_prev_failed:
+ lcnt_unlock_list_entry(info->next);
+ retry_after_next_failed:
+ lcnt_unlock_list_entry(info);
+ retry_after_entry_failed:
+ LCNT_SPINLOCK_HELPER_YIELD;
}
- hist->ns[idx]++;
}
-static void lcnt_update_stats(erts_lcnt_lock_stats_t *stats, int lock_in_conflict,
- erts_lcnt_time_t *time_wait) {
+static void lcnt_unlock_list_entry_with_neighbors(erts_lcnt_lock_info_t *info) {
+ lcnt_unlock_list_entry(info->prev);
+ lcnt_unlock_list_entry(info->next);
+ lcnt_unlock_list_entry(info);
+}
- ethr_atomic_inc(&stats->tries);
+static void lcnt_insert_list_entry(erts_lcnt_lock_info_list_t *list, erts_lcnt_lock_info_t *info) {
+ erts_lcnt_lock_info_t *next, *prev;
- if (lock_in_conflict)
- ethr_atomic_inc(&stats->colls);
+ prev = &list->head;
- if (time_wait) {
- lcnt_time_add(&(stats->timer), time_wait);
- stats->timer_n++;
- lcnt_update_stats_hist(&stats->hist,time_wait);
- }
-}
+ lcnt_lock_list_entry(prev);
-/* interface */
+ next = prev->next;
-void erts_lcnt_init() {
- erts_lcnt_thread_data_t *eltd = NULL;
+ lcnt_lock_list_entry(next);
- /* init lock */
- if (ethr_mutex_init(&lcnt_data_lock) != 0) abort();
+ info->next = next;
+ info->prev = prev;
- /* init tsd */
- lcnt_n_thr = 0;
- ethr_tsd_key_create(&lcnt_thr_data_key, "lcnt_data");
+ prev->next = info;
+ next->prev = info;
- lcnt_lock();
+ lcnt_unlock_list_entry(next);
+ lcnt_unlock_list_entry(prev);
+}
+
+static void lcnt_insert_list_carrier(erts_lcnt_lock_info_list_t *list,
+ erts_lcnt_lock_info_carrier_t *carrier) {
+ erts_lcnt_lock_info_t *next, *prev;
+ size_t i;
- erts_lcnt_rt_options = ERTS_LCNT_OPT_LOCATION | ERTS_LCNT_OPT_PROCLOCK;
- eltd = lcnt_thread_data_alloc();
- ethr_tsd_set(lcnt_thr_data_key, eltd);
+ for(i = 0; i < carrier->entry_count; i++) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[i];
- /* init lcnt structure */
- erts_lcnt_data = (erts_lcnt_data_t*)malloc(sizeof(erts_lcnt_data_t));
- if (!erts_lcnt_data) {
- ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!");
+ info->prev = &carrier->entries[i - 1];
+ info->next = &carrier->entries[i + 1];
}
- erts_lcnt_data->current_locks = erts_lcnt_list_init();
- erts_lcnt_data->deleted_locks = erts_lcnt_list_init();
- lcnt_unlock();
+ prev = &list->head;
+
+ lcnt_lock_list_entry(prev);
+
+ next = prev->next;
+
+ lcnt_lock_list_entry(next);
+
+ next->prev = &carrier->entries[carrier->entry_count - 1];
+ carrier->entries[carrier->entry_count - 1].next = next;
+ prev->next = &carrier->entries[0];
+ carrier->entries[0].prev = prev;
+
+ lcnt_unlock_list_entry(next);
+ lcnt_unlock_list_entry(prev);
}
-void erts_lcnt_late_init() {
- /* set start timer and zero statistics */
- erts_lcnt_clear_counters();
- erts_thr_install_exit_handler(erts_lcnt_thread_exit_handler);
+static void lcnt_init_list(erts_lcnt_lock_info_list_t *list) {
+ /* Ensure that ref_count operations explode when touching the sentinels in
+ * DEBUG mode. */
+ ethr_atomic_init(&(list->head.ref_count), -1);
+ ethr_atomic_init(&(list->tail.ref_count), -1);
+
+ ethr_atomic32_init(&(list->head.lock), 0);
+ (list->head).next = &list->tail;
+ (list->head).prev = &list->tail;
+
+ ethr_atomic32_init(&(list->tail.lock), 0);
+ (list->tail).next = &list->head;
+ (list->tail).prev = &list->head;
}
-/* list operations */
+/* - Carrier operations - */
-/* BEGIN ASSUMPTION: lcnt_data_lock taken */
+int lcnt_thr_progress_unmanaged_delay__(void) {
+ return erts_thr_progress_unmanaged_delay();
+}
-erts_lcnt_lock_list_t *erts_lcnt_list_init(void) {
- erts_lcnt_lock_list_t *list;
+void lcnt_thr_progress_unmanaged_continue__(int handle) {
+ return erts_thr_progress_unmanaged_continue(handle);
+}
- list = (erts_lcnt_lock_list_t*)malloc(sizeof(erts_lcnt_lock_list_t));
- if (!list) {
- ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!");
- }
- list->head = NULL;
- list->tail = NULL;
- list->n = 0;
- return list;
+void lcnt_deallocate_carrier__(erts_lcnt_lock_info_carrier_t *carrier) {
+ ASSERT(ethr_atomic_read(&carrier->ref_count) == 0);
+ erts_free(ERTS_ALC_T_LCNT_CARRIER, (void*)carrier);
}
-static void lcnt_list_free(erts_lcnt_lock_t *head) {
- erts_lcnt_lock_t *lock, *next;
+static void lcnt_thr_prg_cleanup_carrier(void *data) {
+ erts_lcnt_lock_info_carrier_t *carrier = data;
+ size_t entry_count, i;
+
+ /* carrier->entry_count will be replaced with garbage if it's deallocated
+ * on the final iteration, so we'll tuck it away to get a clean exit. */
+ entry_count = carrier->entry_count;
- lock = head;
+ for(i = 0; i < entry_count; i++) {
+ ASSERT(ethr_atomic_read(&carrier->ref_count) >= (entry_count - i));
- while(lock != NULL) {
- next = lock->next;
- free(lock);
- lock = next;
+ erts_lcnt_release_lock_info(&carrier->entries[i]);
}
}
-void erts_lcnt_list_insert(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) {
- erts_lcnt_lock_t *tail = NULL;
+static void lcnt_schedule_carrier_cleanup(void *data) {
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+
+ /* We can't issue cleanup jobs on anything other than normal schedulers, so
+ * we move to the first scheduler if required. */
- tail = list->tail;
- if (tail) {
- tail->next = lock;
- lock->prev = tail;
+ if(!esdp || esdp->type != ERTS_SCHED_NORMAL) {
+ erts_schedule_misc_aux_work(1, &lcnt_schedule_carrier_cleanup, data);
} else {
- list->head = lock;
- lock->prev = NULL;
- ASSERT(!lock->next);
+ erts_lcnt_lock_info_carrier_t *carrier = data;
+ size_t carrier_size;
+
+ carrier_size = sizeof(erts_lcnt_lock_info_carrier_t) +
+ sizeof(erts_lcnt_lock_info_t) * carrier->entry_count;
+
+ erts_schedule_thr_prgr_later_cleanup_op(&lcnt_thr_prg_cleanup_carrier,
+ data, (ErtsThrPrgrLaterOp*)&carrier->release_entries, carrier_size);
}
- lock->next = NULL;
- list->tail = lock;
+}
- list->n++;
+static void lcnt_info_deallocate(erts_lcnt_lock_info_t *info) {
+ lcnt_release_carrier__(info->carrier);
}
-void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) {
- if (lock->next) lock->next->prev = lock->prev;
- if (lock->prev) lock->prev->next = lock->next;
- if (list->head == lock) list->head = lock->next;
- if (list->tail == lock) list->tail = lock->prev;
+static void lcnt_info_dispose(erts_lcnt_lock_info_t *info) {
+ ASSERT(ethr_atomic_read(&info->ref_count) == 0);
+
+ if(lcnt_preserve_info) {
+ ethr_atomic_set(&info->ref_count, 1);
+
+ /* Move straight to deallocation the next time around. */
+ info->dispose = &lcnt_info_deallocate;
- lock->prev = NULL;
- lock->next = NULL;
- list->n--;
+ lcnt_insert_list_entry(&lcnt_deleted_lock_list, info);
+ } else {
+ lcnt_info_deallocate(info);
+ }
}
-/* END ASSUMPTION: lcnt_data_lock taken */
+static void lcnt_lock_info_init_helper(erts_lcnt_lock_info_t *info) {
+ ethr_atomic_init(&info->ref_count, 1);
+ ethr_atomic32_init(&info->lock, 0);
+
+ ethr_atomic_init(&info->r_state, 0);
+ ethr_atomic_init(&info->w_state, 0);
-/* lock operations */
+ info->dispose = &lcnt_info_dispose;
-/* interface to erl_threads.h */
-/* only lock on init and destroy, all others should use atomics */
-void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag ) {
- erts_lcnt_init_lock_x(lock, name, flag, NIL);
+ lcnt_clear_stats(info);
}
-void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id) {
- int i;
+erts_lcnt_lock_info_carrier_t *erts_lcnt_create_lock_info_carrier(int entry_count) {
+ erts_lcnt_lock_info_carrier_t *result;
+ size_t carrier_size, i;
- if (flag & ERTS_LCNT_LT_DISABLE) {
- ERTS_LCNT_CLEAR_FLAG(lock);
- return;
- }
+ ASSERT(entry_count > 0 && entry_count <= LCNT_MAX_CARRIER_ENTRIES);
+ ASSERT(lcnt_initialization_completed__);
- lock->next = NULL;
- lock->prev = NULL;
- lock->flag = flag;
- lock->name = name;
- lock->id = id;
+ carrier_size = sizeof(erts_lcnt_lock_info_carrier_t) +
+ sizeof(erts_lcnt_lock_info_t) * entry_count;
- ethr_atomic_init(&lock->r_state, 0);
- ethr_atomic_init(&lock->w_state, 0);
-#ifdef DEBUG
- ethr_atomic_init(&lock->flowstate, 0);
-#endif
+ result = (erts_lcnt_lock_info_carrier_t*)erts_alloc(ERTS_ALC_T_LCNT_CARRIER, carrier_size);
+ result->entry_count = entry_count;
- lock->n_stats = 1;
+ ethr_atomic_init(&result->ref_count, entry_count);
- for (i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) {
- lcnt_clear_stats(&lock->stats[i]);
- }
+ for(i = 0; i < entry_count; i++) {
+ erts_lcnt_lock_info_t *info = &result->entries[i];
- lcnt_lock();
- erts_lcnt_list_insert(erts_lcnt_data->current_locks, lock);
- lcnt_unlock();
-}
+ lcnt_lock_info_init_helper(info);
-/* init empty, instead of zero struct
- * used by process locks probes
- */
-void erts_lcnt_init_lock_empty(erts_lcnt_lock_t *lock) {
- lock->next = NULL;
- lock->prev = NULL;
- lock->flag = 0;
- lock->name = NULL;
- lock->id = NIL;
- ethr_atomic_init(&lock->r_state, 0);
- ethr_atomic_init(&lock->w_state, 0);
-#ifdef DEBUG
- ethr_atomic_init(&lock->flowstate, 0);
-#endif
- lock->n_stats = 0;
- sys_memzero(lock->stats, sizeof(lock->stats));
-}
-/* destroy lock */
-void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock) {
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
- lcnt_lock();
-
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_COPYSAVE) {
- erts_lcnt_lock_t *deleted_lock;
- /* copy structure and insert the copy */
- deleted_lock = (erts_lcnt_lock_t*)malloc(sizeof(erts_lcnt_lock_t));
- if (!deleted_lock) {
- ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!");
- }
- memcpy(deleted_lock, lock, sizeof(erts_lcnt_lock_t));
- deleted_lock->next = NULL;
- deleted_lock->prev = NULL;
- erts_lcnt_list_insert(erts_lcnt_data->deleted_locks, deleted_lock);
+ info->carrier = result;
}
- /* delete original */
- erts_lcnt_list_delete(erts_lcnt_data->current_locks, lock);
- ERTS_LCNT_CLEAR_FLAG(lock);
- lcnt_unlock();
+ return result;
}
-/* lock */
+void erts_lcnt_install(erts_lcnt_ref_t *ref, erts_lcnt_lock_info_carrier_t *carrier) {
+ ethr_sint_t swapped_carrier;
-void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option) {
- erts_aint_t r_state = 0, w_state = 0;
- erts_lcnt_thread_data_t *eltd;
+#ifdef DEBUG
+ int i;
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
+ /* Verify that all locks share the same categories/static property; all
+ * other flags are fair game. */
+ for(i = 1; i < carrier->entry_count; i++) {
+ const erts_lock_flags_t SIGNIFICANT_DIFF_MASK =
+ ERTS_LOCK_FLAGS_MASK_CATEGORY | ERTS_LOCK_FLAGS_PROPERTY_STATIC;
- eltd = lcnt_get_thread_data();
- ASSERT(eltd);
+ erts_lcnt_lock_info_t *previous, *current;
- w_state = ethr_atomic_read(&lock->w_state);
+ previous = &carrier->entries[i - 1];
+ current = &carrier->entries[i];
- if (option & ERTS_LCNT_LO_WRITE) {
- r_state = ethr_atomic_read(&lock->r_state);
- ethr_atomic_inc( &lock->w_state);
- }
- if (option & ERTS_LCNT_LO_READ) {
- ethr_atomic_inc( &lock->r_state);
+ ASSERT(!((previous->flags ^ current->flags) & SIGNIFICANT_DIFF_MASK));
}
+#endif
- /* we cannot acquire w_lock if either w or r are taken */
- /* we cannot acquire r_lock if w_lock is taken */
+ swapped_carrier = ethr_atomic_cmpxchg_mb(ref, (ethr_sint_t)carrier, (ethr_sint_t)NULL);
- if ((w_state > 0) || (r_state > 0)) {
- eltd->lock_in_conflict = 1;
- if (eltd->timer_set == 0) {
- lcnt_time(&eltd->timer);
- }
- eltd->timer_set++;
+ if(swapped_carrier != (ethr_sint_t)NULL) {
+#ifdef DEBUG
+ ASSERT(ethr_atomic_read(&carrier->ref_count) == carrier->entry_count);
+ ethr_atomic_set(&carrier->ref_count, 0);
+#endif
+
+ lcnt_deallocate_carrier__(carrier);
} else {
- eltd->lock_in_conflict = 0;
+ lcnt_insert_list_carrier(&lcnt_current_lock_list, carrier);
}
}
-void erts_lcnt_lock(erts_lcnt_lock_t *lock) {
- erts_aint_t w_state;
- erts_lcnt_thread_data_t *eltd;
+void erts_lcnt_uninstall(erts_lcnt_ref_t *ref) {
+ ethr_sint_t previous_carrier, swapped_carrier;
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
+ previous_carrier = ethr_atomic_read(ref);
+ swapped_carrier = ethr_atomic_cmpxchg_mb(ref, (ethr_sint_t)NULL, previous_carrier);
- w_state = ethr_atomic_read(&lock->w_state);
- ethr_atomic_inc(&lock->w_state);
- eltd = lcnt_get_thread_data();
+ if(previous_carrier && previous_carrier == swapped_carrier) {
+ lcnt_schedule_carrier_cleanup((void*)previous_carrier);
+ }
+}
- ASSERT(eltd);
+/* - Static lock registry -
+ *
+ * Since static locks can be trusted to never disappear, we can track them
+ * pretty cheaply and won't need to bother writing an "erts_lcnt_update_xx"
+ * variant. */
+
+static void lcnt_init_static_lock_registry(void) {
+ ethr_atomic_init(&lcnt_static_lock_registry, (ethr_sint_t)NULL);
+}
+
+static void lcnt_update_static_locks(void) {
+ lcnt_static_lock_ref_t *iterator =
+ (lcnt_static_lock_ref_t*)ethr_atomic_read(&lcnt_static_lock_registry);
+
+ while(iterator != NULL) {
+ if(!erts_lcnt_check_enabled(iterator->flags)) {
+ erts_lcnt_uninstall(iterator->reference);
+ } else if(!erts_lcnt_check_ref_installed(iterator->reference)) {
+ erts_lcnt_lock_info_carrier_t *carrier = erts_lcnt_create_lock_info_carrier(1);
+
+ erts_lcnt_init_lock_info_idx(carrier, 0, iterator->name, iterator->id, iterator->flags);
- if (w_state > 0) {
- eltd->lock_in_conflict = 1;
- /* only set the timer if nobody else has it
- * This should only happen when proc_locks aquires several locks
- * 'atomicly'. All other locks will block the thread if w_state > 0
- * i.e. locked.
- */
- if (eltd->timer_set == 0) {
- lcnt_time(&eltd->timer);
+ erts_lcnt_install(iterator->reference, carrier);
}
- eltd->timer_set++;
- } else {
- eltd->lock_in_conflict = 0;
+
+ iterator = iterator->next;
}
}
-/* if a lock wasn't really a lock operation, bad bad process locks */
+void lcnt_register_static_lock__(erts_lcnt_ref_t *reference, const char *name, Eterm id,
+ erts_lock_flags_t flags) {
+ lcnt_static_lock_ref_t *lock = malloc(sizeof(lcnt_static_lock_ref_t));
+ int retry_insertion;
+
+ ASSERT(flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC);
+
+ lock->reference = reference;
+ lock->flags = flags;
+ lock->name = name;
+ lock->id = id;
+
+ do {
+ ethr_sint_t swapped_head;
-void erts_lcnt_lock_unaquire(erts_lcnt_lock_t *lock) {
- /* should check if this thread was "waiting" */
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
+ lock->next = (lcnt_static_lock_ref_t*)ethr_atomic_read(&lcnt_static_lock_registry);
- ethr_atomic_dec(&lock->w_state);
+ swapped_head = ethr_atomic_cmpxchg_acqb(
+ &lcnt_static_lock_registry,
+ (ethr_sint_t)lock,
+ (ethr_sint_t)lock->next);
+
+ retry_insertion = (swapped_head != (ethr_sint_t)lock->next);
+ } while(retry_insertion);
}
-/*
- * erts_lcnt_lock_post
- *
- * Used when we get a lock (i.e. directly after a lock operation)
- * if the timer was set then we had to wait for the lock
- * lock_post will calculate the wait time.
- */
+/* - Initialization - */
+
+void erts_lcnt_pre_thr_init() {
+ /* Ensure that the dependency hack mentioned in the header doesn't
+ * explode at runtime. */
+ ERTS_CT_ASSERT(sizeof(LcntThrPrgrLaterOp) >= sizeof(ErtsThrPrgrLaterOp));
+ ERTS_CT_ASSERT(ERTS_THR_PRGR_DHANDLE_MANAGED ==
+ (ErtsThrPrgrDelayHandle)LCNT_THR_PRGR_DHANDLE_MANAGED);
-void erts_lcnt_lock_post(erts_lcnt_lock_t *lock) {
- erts_lcnt_lock_post_x(lock, (char*)str_undefined, 0);
+ lcnt_init_list(&lcnt_current_lock_list);
+ lcnt_init_list(&lcnt_deleted_lock_list);
+
+ lcnt_init_static_lock_registry();
}
-void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line) {
- erts_lcnt_thread_data_t *eltd;
- erts_lcnt_time_t timer;
- erts_lcnt_time_t time_wait;
- erts_lcnt_lock_stats_t *stats;
-#ifdef DEBUG
- erts_aint_t flowstate;
-#endif
+void erts_lcnt_post_thr_init() {
+ /* ASSUMPTION: this is safe since it runs prior to the creation of other
+ * threads (Directly after ethread init). */
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
+ ethr_tsd_key_create(&lcnt_thr_data_key__, "lcnt_data");
+
+ erts_lcnt_thread_setup();
+}
+
+void erts_lcnt_late_init() {
+ /* Set start timer and zero all statistics */
+ erts_lcnt_clear_counters();
+ erts_thr_install_exit_handler(erts_lcnt_thread_exit_handler);
#ifdef DEBUG
- if (!(lock->flag & (ERTS_LCNT_LT_RWMUTEX | ERTS_LCNT_LT_RWSPINLOCK))) {
- flowstate = ethr_atomic_read(&lock->flowstate);
- ASSERT(flowstate == 0);
- ethr_atomic_inc(&lock->flowstate);
- }
+ /* It's safe to use erts_alloc and thread progress past this point. */
+ lcnt_initialization_completed__ = 1;
#endif
+}
- eltd = lcnt_get_thread_data();
-
- ASSERT(eltd);
+void erts_lcnt_post_startup(void) {
+ /* Default to capturing everything to match the behavior of the old lock
+ * counter build. */
+ erts_lcnt_set_category_mask(ERTS_LOCK_FLAGS_MASK_CATEGORY);
+}
- /* if lock was in conflict, time it */
- stats = lcnt_get_lock_stats(lock, file, line);
- if (eltd->timer_set) {
- lcnt_time(&timer);
+void erts_lcnt_thread_setup() {
+ lcnt_thread_data_t__ *eltd = lcnt_thread_data_alloc();
- lcnt_time_diff(&time_wait, &timer, &(eltd->timer));
- lcnt_update_stats(stats, eltd->lock_in_conflict, &time_wait);
- eltd->timer_set--;
- ASSERT(eltd->timer_set >= 0);
- } else {
- lcnt_update_stats(stats, eltd->lock_in_conflict, NULL);
- }
+ ASSERT(eltd);
+ ethr_tsd_set(lcnt_thr_data_key__, eltd);
}
-/* unlock */
+void erts_lcnt_thread_exit_handler() {
+ lcnt_thread_data_t__ *eltd = lcnt_get_thread_data__();
-void erts_lcnt_unlock_opt(erts_lcnt_lock_t *lock, Uint16 option) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
- if (option & ERTS_LCNT_LO_WRITE) ethr_atomic_dec(&lock->w_state);
- if (option & ERTS_LCNT_LO_READ ) ethr_atomic_dec(&lock->r_state);
+ if (eltd) {
+ free(eltd);
+ }
}
-void erts_lcnt_unlock(erts_lcnt_lock_t *lock) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
+/* - BIF interface - */
+
+void erts_lcnt_retain_lock_info(erts_lcnt_lock_info_t *info) {
#ifdef DEBUG
- {
- erts_aint_t w_state;
- erts_aint_t flowstate;
-
- /* flowstate */
- flowstate = ethr_atomic_read(&lock->flowstate);
- ASSERT(flowstate == 1);
- ethr_atomic_dec(&lock->flowstate);
-
- /* write state */
- w_state = ethr_atomic_read(&lock->w_state);
- ASSERT(w_state > 0);
- }
+ ASSERT(ethr_atomic_inc_read_acqb(&info->ref_count) >= 2);
+#else
+ ethr_atomic_inc_acqb(&info->ref_count);
#endif
- ethr_atomic_dec(&lock->w_state);
}
-/* trylock */
+void erts_lcnt_release_lock_info(erts_lcnt_lock_info_t *info) {
+ ethr_sint_t count;
+
+ /* We need to acquire the lock before decrementing ref_count to avoid
+ * racing with list iteration; there's a short window between reading the
+ * reference to info and increasing its ref_count. */
+ lcnt_lock_list_entry_with_neighbors(info);
+
+ count = ethr_atomic_dec_read(&info->ref_count);
-void erts_lcnt_trylock_opt(erts_lcnt_lock_t *lock, int res, Uint16 option) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
- /* Determine lock_state via res instead of state */
- if (res != EBUSY) {
- if (option & ERTS_LCNT_LO_WRITE) ethr_atomic_inc(&lock->w_state);
- if (option & ERTS_LCNT_LO_READ ) ethr_atomic_inc(&lock->r_state);
- lcnt_update_stats(&(lock->stats[0]), 0, NULL);
+ ASSERT(count >= 0);
+
+ if(count > 0) {
+ lcnt_unlock_list_entry_with_neighbors(info);
} else {
- ethr_atomic_inc(&lock->stats[0].tries);
- ethr_atomic_inc(&lock->stats[0].colls);
+ (info->next)->prev = info->prev;
+ (info->prev)->next = info->next;
+
+ lcnt_unlock_list_entry_with_neighbors(info);
+
+ info->dispose(info);
}
}
+erts_lock_flags_t erts_lcnt_get_category_mask() {
+ return lcnt_category_mask__;
+}
-void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res) {
- /* Determine lock_state via res instead of state */
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return;
- if (res != EBUSY) {
-#ifdef DEBUG
- {
- erts_aint_t flowstate;
- flowstate = ethr_atomic_read(&lock->flowstate);
- ASSERT(flowstate == 0);
- ethr_atomic_inc( &lock->flowstate);
- }
+#ifdef ERTS_ENABLE_KERNEL_POLL
+/* erl_poll/erl_check_io only exports one of these variants at a time, and we
+ * may need to use either one depending on emulator startup flags. */
+void erts_lcnt_update_pollset_locks_nkp(int);
+void erts_lcnt_update_pollset_locks_kp(int);
+
+void erts_lcnt_update_cio_locks_nkp(int);
+void erts_lcnt_update_cio_locks_kp(int);
#endif
- ethr_atomic_inc(&lock->w_state);
- lcnt_update_stats(&(lock->stats[0]), 0, NULL);
- } else {
- ethr_atomic_inc(&lock->stats[0].tries);
- ethr_atomic_inc(&lock->stats[0].colls);
+
+void erts_lcnt_set_category_mask(erts_lock_flags_t mask) {
+ erts_lock_flags_t changed_categories;
+
+ ASSERT(!(mask & ~ERTS_LOCK_FLAGS_MASK_CATEGORY));
+ ASSERT(lcnt_initialization_completed__);
+
+ changed_categories = (lcnt_category_mask__ ^ mask);
+ lcnt_category_mask__ = mask;
+
+ if(changed_categories) {
+ lcnt_update_static_locks();
}
-}
-/* thread operations */
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION) {
+ erts_lcnt_update_distribution_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ }
-void erts_lcnt_thread_setup(void) {
- erts_lcnt_thread_data_t *eltd;
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR) {
+ erts_lcnt_update_allocator_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
+ }
- lcnt_lock();
- /* lock for thread id global update */
- eltd = lcnt_thread_data_alloc();
- lcnt_unlock();
- ASSERT(eltd);
- ethr_tsd_set(lcnt_thr_data_key, eltd);
-}
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_PROCESS) {
+ erts_lcnt_update_process_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
+ }
-void erts_lcnt_thread_exit_handler() {
- erts_lcnt_thread_data_t *eltd;
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_IO) {
+#ifdef ERTS_ENABLE_KERNEL_POLL
+ if(erts_use_kernel_poll) {
+ erts_lcnt_update_pollset_locks_kp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_cio_locks_kp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ } else {
+ erts_lcnt_update_pollset_locks_nkp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_cio_locks_nkp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
+#else
+ erts_lcnt_update_pollset_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_cio_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+#endif
- eltd = ethr_tsd_get(lcnt_thr_data_key);
+ erts_lcnt_update_driver_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_port_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
- if (eltd) {
- free(eltd);
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_DB) {
+ erts_lcnt_update_db_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_DB);
}
}
-/* bindings for bifs */
-
-Uint16 erts_lcnt_set_rt_opt(Uint16 opt) {
- Uint16 prev;
- prev = (erts_lcnt_rt_options & opt);
- erts_lcnt_rt_options |= opt;
- return prev;
+void erts_lcnt_set_preserve_info(int enable) {
+ lcnt_preserve_info = enable;
}
-Uint16 erts_lcnt_clear_rt_opt(Uint16 opt) {
- Uint16 prev;
- prev = (erts_lcnt_rt_options & opt);
- erts_lcnt_rt_options &= ~opt;
- return prev;
+int erts_lcnt_get_preserve_info() {
+ return lcnt_preserve_info;
}
void erts_lcnt_clear_counters(void) {
- erts_lcnt_lock_t *lock;
- erts_lcnt_lock_list_t *list;
- erts_lcnt_lock_stats_t *stats;
- int i;
+ erts_lcnt_lock_info_t *iterator;
- lcnt_lock();
+ lcnt_time__(&lcnt_timer_start);
- list = erts_lcnt_data->current_locks;
+ iterator = NULL;
+ while(erts_lcnt_iterate_list(&lcnt_current_lock_list, &iterator)) {
+ lcnt_clear_stats(iterator);
+ }
- for (lock = list->head; lock != NULL; lock = lock->next) {
- for( i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) {
- stats = &lock->stats[i];
- lcnt_clear_stats(stats);
- }
- lock->n_stats = 1;
+ iterator = NULL;
+ while(erts_lcnt_iterate_list(&lcnt_deleted_lock_list, &iterator)) {
+ erts_lcnt_release_lock_info(iterator);
}
+}
- lock = erts_lcnt_data->deleted_locks->head;
- erts_lcnt_data->deleted_locks->head = NULL;
- erts_lcnt_data->deleted_locks->tail = NULL;
- erts_lcnt_data->deleted_locks->n = 0;
+erts_lcnt_data_t erts_lcnt_get_data(void) {
+ erts_lcnt_time_t timer_stop;
+ erts_lcnt_data_t result;
- lcnt_time(&timer_start);
+ lcnt_time__(&timer_stop);
- lcnt_unlock();
+ result.timer_start = lcnt_timer_start;
- /* free deleted locks */
- lcnt_list_free(lock);
+ result.current_locks = &lcnt_current_lock_list;
+ result.deleted_locks = &lcnt_deleted_lock_list;
+
+ lcnt_time_diff__(&result.duration, &timer_stop, &result.timer_start);
+
+ return result;
}
-erts_lcnt_data_t *erts_lcnt_get_data(void) {
- erts_lcnt_time_t timer_stop;
+int erts_lcnt_iterate_list(erts_lcnt_lock_info_list_t *list, erts_lcnt_lock_info_t **iterator) {
+ erts_lcnt_lock_info_t *current, *next;
- lcnt_lock();
+ current = *iterator ? *iterator : &list->head;
- lcnt_time(&timer_stop);
- lcnt_time_diff(&(erts_lcnt_data->duration), &timer_stop, &timer_start);
+ ASSERT(current != &list->tail);
- lcnt_unlock();
+ lcnt_lock_list_entry(current);
- return erts_lcnt_data;
-}
+ next = current->next;
+
+ if(next != &list->tail) {
+ erts_lcnt_retain_lock_info(next);
+ }
+
+ lcnt_unlock_list_entry(current);
+
+ if(current != &list->head) {
+ erts_lcnt_release_lock_info(current);
+ }
+
+ *iterator = next;
-char *erts_lcnt_lock_type(Uint16 type) {
- return lcnt_lock_type(type);
+ return next != &list->tail;
}
-#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */
+#endif /* #ifdef ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h
index 6caffbfe86..89d95a73cf 100644
--- a/erts/emulator/beam/erl_lock_count.h
+++ b/erts/emulator/beam/erl_lock_count.h
@@ -18,64 +18,51 @@
* %CopyrightEnd%
*/
-/*
- * Description: Statistics for locks.
- *
- * Author: Björn-Egil Dahlberg
- * Date: 2008-07-03
- * Abstract:
- * Locks statistics internal representation.
- *
- * Conceptual representation,
- * - set name
- * | - id (the unique lock)
- * | | - lock type
- * | | - statistics
- * | | | - location (file and line number)
- * | | | - tries
- * | | | - collisions (including trylock busy)
- * | | | - timer (time spent in waiting for lock)
- * | | | - n_timer (collisions excluding trylock busy)
- * | | | - histogram
- * | | | | - # 0 = log2(lock wait_time ns)
- * | | | | - ...
- * | | | | - # n = log2(lock wait_time ns)
- *
- * Each instance of a lock is the unique lock, i.e. set and id in that set.
- * For each lock there is a set of statistics with where and what impact
- * the lock aqusition had.
- *
- * Runtime options
- * - suspend, used when internal lock-counting can't be applied. For instance
- * when allocating a term for the outside and halloc needs to be used.
- * Default: off.
- * - location, reserved and not used.
- * - proclock, disable proclock counting. Used when performance might be an
- * issue. Accessible from erts_debug:lock_counters({process_locks, bool()}).
- * Default: off.
- * - copysave, enable saving of destroyed locks (and thereby its statistics).
- * If memory constraints is an issue this need to be disabled.
- * Accessible from erts_debug:lock_counters({copy_save, bool()}).
- * Default: off.
+/**
+ * @description Statistics for locks.
+ * @file erl_lock_count.h
+ *
+ * @author Björn-Egil Dahlberg
+ * @author John Högberg
+ *
+ * Conceptual representation:
*
+ * - set name
+ * | - id (the unique lock)
+ * | | - lock type
+ * | | - statistics
+ * | | | - location (file and line number)
+ * | | | - attempts
+ * | | | - collisions (including trylock busy)
+ * | | | - timer (time spent in waiting for lock)
+ * | | | - n_timer (collisions excluding trylock busy)
+ * | | | - histogram
+ * | | | | - # 0 = log2(lock wait_time ns)
+ * | | | | - ...
+ * | | | | - # n = log2(lock wait_time ns)
+ *
+ * Each instance of a lock is the unique lock, i.e. set and id in that set.
+ * For each lock there is a set of statistics with where and what impact
+ * the lock acquisition had.
*/
-#include "sys.h"
-
#ifndef ERTS_LOCK_COUNT_H__
#define ERTS_LOCK_COUNT_H__
#ifdef ERTS_ENABLE_LOCK_COUNT
#ifndef ERTS_ENABLE_LOCK_POSITION
-/* Enable in order for _x variants of mtx functions to be used. */
+/** @brief Controls whether _x variants of mtx functions are used. */
#define ERTS_ENABLE_LOCK_POSITION 1
#endif
+#include "sys.h"
#include "ethread.h"
-#define ERTS_LCNT_MAX_LOCK_LOCATIONS (10)
+#include "erl_term.h"
+#include "erl_lock_flags.h"
+
+#define ERTS_LCNT_MAX_LOCK_LOCATIONS (5)
-/* histogram */
#define ERTS_LCNT_HISTOGRAM_MAX_NS (((unsigned long)1LL << 28) - 1)
#if 0 || defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT)
#define ERTS_LCNT_HISTOGRAM_SLOT_SIZE (30)
@@ -85,154 +72,857 @@
#define ERTS_LCNT_HISTOGRAM_RSHIFT (10)
#endif
-#define ERTS_LCNT_LT_SPINLOCK (((Uint16) 1) << 0)
-#define ERTS_LCNT_LT_RWSPINLOCK (((Uint16) 1) << 1)
-#define ERTS_LCNT_LT_MUTEX (((Uint16) 1) << 2)
-#define ERTS_LCNT_LT_RWMUTEX (((Uint16) 1) << 3)
-#define ERTS_LCNT_LT_PROCLOCK (((Uint16) 1) << 4)
-#define ERTS_LCNT_LT_ALLOC (((Uint16) 1) << 5)
+typedef struct {
+ unsigned long s;
+ unsigned long ns;
+} erts_lcnt_time_t;
+
+typedef struct {
+ /* @brief log2 array of nano seconds occurences */
+ Uint32 ns[ERTS_LCNT_HISTOGRAM_SLOT_SIZE];
+} erts_lcnt_hist_t;
-#define ERTS_LCNT_LO_READ (((Uint16) 1) << 6)
-#define ERTS_LCNT_LO_WRITE (((Uint16) 1) << 7)
+typedef struct {
+ /** @brief In which file the lock was taken. May be NULL. */
+ const char *file;
+ /** @brief Line number in \c file */
+ unsigned int line;
-#define ERTS_LCNT_LT_DISABLE (((Uint16) 1) << 8)
+ /* "attempts" and "collisions" need to be atomic since try_lock busy does
+ * not acquire a lock and there is no post action to rectify the
+ * situation. */
-#define ERTS_LCNT_LO_READ_WRITE ( ERTS_LCNT_LO_READ \
- | ERTS_LCNT_LO_WRITE )
+ ethr_atomic_t attempts;
+ ethr_atomic_t collisions;
-#define ERTS_LCNT_LT_ALL ( ERTS_LCNT_LT_SPINLOCK \
- | ERTS_LCNT_LT_RWSPINLOCK \
- | ERTS_LCNT_LT_MUTEX \
- | ERTS_LCNT_LT_RWMUTEX \
- | ERTS_LCNT_LT_PROCLOCK )
+ erts_lcnt_time_t total_time_waited;
+ Uint64 times_waited;
-#define ERTS_LCNT_LOCK_TYPE(lock) ((lock)->flag & ERTS_LCNT_LT_ALL)
-#define ERTS_LCNT_IS_LOCK_INVALID(lock) (!((lock)->flag & ERTS_LCNT_LT_ALL))
-#define ERTS_LCNT_CLEAR_FLAG(lock) ((lock)->flag = 0)
+ erts_lcnt_hist_t wait_time_histogram;
+} erts_lcnt_lock_stats_t;
-/* runtime options */
+typedef struct lcnt_lock_info_t_ {
+ erts_lock_flags_t flags;
+ const char *name;
+ /** @brief Id if possible, must be an immediate */
+ Eterm id;
-#define ERTS_LCNT_OPT_SUSPEND (((Uint16) 1) << 0)
-#define ERTS_LCNT_OPT_LOCATION (((Uint16) 1) << 1)
-#define ERTS_LCNT_OPT_PROCLOCK (((Uint16) 1) << 2)
-#define ERTS_LCNT_OPT_PORTLOCK (((Uint16) 1) << 3)
-#define ERTS_LCNT_OPT_COPYSAVE (((Uint16) 1) << 4)
+ /* The first entry is reserved as a fallback for when location information
+ * is missing, and when the lock is used in more than (MAX_LOCK_LOCATIONS
+ * - 1) different places. */
+ erts_lcnt_lock_stats_t location_stats[ERTS_LCNT_MAX_LOCK_LOCATIONS];
+ unsigned int location_count;
-typedef struct {
- unsigned long s;
- unsigned long ns;
-} erts_lcnt_time_t;
+ /* -- Everything below is internal to this module ---------------------- */
+
+ /* Lock states; rw locks uses both states, other locks only uses w_state */
-extern erts_lcnt_time_t timer_start;
+ /** @brief Write state. 0 = not taken, otherwise n threads waiting */
+ ethr_atomic_t w_state;
+ /** @brief Read state. 0 = not taken, > 0 -> writes will wait */
+ ethr_atomic_t r_state;
+
+ struct lcnt_lock_info_t_ *prev;
+ struct lcnt_lock_info_t_ *next;
+
+ /** @brief Used in place of erts_refc_t to avoid a circular dependency. */
+ ethr_atomic_t ref_count;
+ ethr_atomic32_t lock;
+
+ /** @brief Deletion hook called once \c ref_count reaches 0; may defer
+ * deletion by modifying \c ref_count. */
+ void (*dispose)(struct lcnt_lock_info_t_ *);
+
+ struct lcnt_lock_info_carrier_ *carrier;
+} erts_lcnt_lock_info_t;
+
+typedef struct lcnt_lock_info_list_ {
+ erts_lcnt_lock_info_t head;
+ erts_lcnt_lock_info_t tail;
+} erts_lcnt_lock_info_list_t;
typedef struct {
- Uint32 ns[ERTS_LCNT_HISTOGRAM_SLOT_SIZE]; /* log2 array of nano seconds occurences */
-} erts_lcnt_hist_t;
+ erts_lcnt_time_t timer_start; /**< Time of last clear */
+ erts_lcnt_time_t duration; /**< Time since last clear */
-typedef struct erts_lcnt_lock_stats_s {
- /* "tries" and "colls" needs to be atomic since
- * trylock busy does not acquire a lock and there
- * is no post action to rectify the situation
- */
+ erts_lcnt_lock_info_list_t *current_locks;
+ erts_lcnt_lock_info_list_t *deleted_locks;
+} erts_lcnt_data_t;
- char *file; /* which file the lock was taken */
- unsigned int line; /* line number in file */
+typedef struct lcnt_lock_info_carrier_ erts_lcnt_lock_info_carrier_t;
- ethr_atomic_t tries; /* n tries to get lock */
- ethr_atomic_t colls; /* n collisions of tries to get lock */
+typedef ethr_atomic_t erts_lcnt_ref_t;
- unsigned long timer_n; /* #times waited for lock */
- erts_lcnt_time_t timer; /* total wait time for lock */
- erts_lcnt_hist_t hist;
-} erts_lcnt_lock_stats_t;
+/* -- Globals -------------------------------------------------------------- */
+
+/** @brief Checks whether counting is enabled for any of the given
+ * categories. */
+#define erts_lcnt_check_enabled(flags) \
+ (lcnt_category_mask__ & flags)
+
+/* -- Lock operations ------------------------------------------------------
+ *
+ * All of these will nop if there's nothing "installed" on the given reference,
+ * in order to transparently support enable/disable at runtime. */
+
+/** @brief Records that a lock is being acquired. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock(erts_lcnt_ref_t *ref);
+
+/** @copydoc erts_lcnt_lock
+ * @param option Notes whether the lock is a read or write lock. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option);
+
+/** @brief Records that a lock has been acquired. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post(erts_lcnt_ref_t *ref);
+
+/** @copydoc erts_lcnt_lock_post.
+ * @param file The name of the file where the lock was acquired.
+ * @param line The line at which the lock was acquired. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post_x(erts_lcnt_ref_t *ref, char *file, unsigned int line);
+
+/** @brief Records that a lock has been released. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock(erts_lcnt_ref_t *ref);
+
+/** @copydoc erts_lcnt_unlock_opt
+ * @param option Whether the lock is a read or write lock. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option);
+
+/** @brief Rectifies the case where a lock wasn't actually a lock operation.
+ *
+ * Only used for process locks at the moment. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_unacquire(erts_lcnt_ref_t *ref);
+
+/** @brief Records the result of a trylock, placing the queried lock status in
+ * \c result. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock(erts_lcnt_ref_t *ref, int result);
+
+/** @copydoc erts_lcnt_trylock
+ * @param option Whether the lock is a read or write lock. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock_opt(erts_lcnt_ref_t *ref, int result, erts_lock_options_t option);
+
+/* Indexed variants of the standard lock operations, for use when a single
+ * reference contains many counters (eg. process locks).
+ *
+ * erts_lcnt_open_ref must be used to safely extract the installed carrier,
+ * which must released with erts_lcnt_close_reference on success.
+ *
+ * Refer to \c erts_lcnt_lock for example usage. */
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+ERTS_GLB_INLINE
+void erts_lcnt_lock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option);
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_x_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, char *file, unsigned int line);
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_unacquire_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option);
+
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result);
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result, erts_lock_options_t option);
+
+/* -- Reference operations ------------------------------------------------- */
+
+/** @brief Registers a lock counter reference; this must be called prior to
+ * using any other functions in this module. */
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref(erts_lcnt_ref_t *ref);
+
+/** @brief As \c erts_lcnt_init_ref, but also enables lock counting right
+ * away if appropriate to reduce noise.
+ * @param id An immediate erlang term with whatever extra data you want to
+ * identify this lock with. */
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref_x(erts_lcnt_ref_t *ref, const char *name,
+ Eterm id, erts_lock_flags_t flags);
+
+/** @brief Checks whether counting is enabled on the given reference. */
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_check_ref_installed(erts_lcnt_ref_t *ref);
+
+/** @brief Convenience macro to re/enable counting on an already initialized
+ * reference. Don't forget to specify the lock type in \c flags! */
+#define erts_lcnt_install_new_lock_info(ref, name, id, flags) \
+ if(!erts_lcnt_check_ref_installed(ref)) { \
+ erts_lcnt_lock_info_carrier_t *__carrier; \
+ __carrier = erts_lcnt_create_lock_info_carrier(1);\
+ erts_lcnt_init_lock_info_idx(__carrier, 0, name, id, flags); \
+ erts_lcnt_install(ref, __carrier);\
+ } while(0)
+
+erts_lcnt_lock_info_carrier_t *erts_lcnt_create_lock_info_carrier(int count);
+
+/* @brief Initializes the lock info at the given index.
+ * @param id An immediate erlang term with whatever extra data you want to
+ * identify this lock with.
+ * @param flags The flags the lock itself was initialized with. Keep in mind
+ * that all locks in a carrier must share the same category/static property. */
+ERTS_GLB_INLINE
+void erts_lcnt_init_lock_info_idx(erts_lcnt_lock_info_carrier_t *carrier, int index,
+ const char *name, Eterm id, erts_lock_flags_t flags);
+
+/** @brief Atomically installs the given lock counters. Nops (and releases the
+ * provided carrier) if something was already installed. */
+void erts_lcnt_install(erts_lcnt_ref_t *ref, erts_lcnt_lock_info_carrier_t *carrier);
+
+/** @brief Atomically removes the currently installed lock counters. Nops if
+ * nothing was installed. */
+void erts_lcnt_uninstall(erts_lcnt_ref_t *ref);
+
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_open_ref(erts_lcnt_ref_t *ref, int *handle, erts_lcnt_lock_info_carrier_t **result);
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_close_ref(int handle, erts_lcnt_lock_info_carrier_t *carrier);
+
+/* -- Module initialization ------------------------------------------------ */
+
+void erts_lcnt_pre_thr_init(void);
+void erts_lcnt_post_thr_init(void);
+void erts_lcnt_late_init(void);
+
+/* @brief Called after everything in the system has been initialized, including
+ * the schedulers. This is mainly a backwards compatibility shim for matching
+ * the old lcnt behavior where all lock counting was enabled by default. */
+void erts_lcnt_post_startup(void);
+
+void erts_lcnt_thread_setup(void);
+void erts_lcnt_thread_exit_handler(void);
+
+/* -- BIF interface -------------------------------------------------------- */
-/* rw locks uses both states, other locks only uses w_state */
-typedef struct erts_lcnt_lock_s {
- char *name; /* lock name */
- Uint16 flag; /* lock type */
- Eterm id; /* id if possible */
+/** @brief Safely iterates through all entries in the given list.
+ *
+ * The referenced item will be valid until the next call to
+ * \c erts_lcnt_iterate_list after which point it may be destroyed; call
+ * erts_lcnt_retain_lock_info if you wish to hang on to it beyond that point.
+ *
+ * Iteration can be cancelled by calling erts_lcnt_release_lock_info on the
+ * iterator and breaking out of the loop.
+ *
+ * @param iterator The iteration variable; set the pointee to NULL to start
+ * iteration.
+ * @return 1 while the iterator is valid, 0 at the end of the list. */
+int erts_lcnt_iterate_list(erts_lcnt_lock_info_list_t *list, erts_lcnt_lock_info_t **iterator);
+
+/** @brief Clears the counter state of all locks, and releases all locks
+ * preserved through erts_lcnt_set_preserve_info (if any). */
+void erts_lcnt_clear_counters(void);
+
+/** @brief Retrieves the global lock counter state.
+ *
+ * Note that the lists may be modified while you're mucking around with them.
+ * Always use \c erts_lcnt_iterate_list to enumerate them. */
+erts_lcnt_data_t erts_lcnt_get_data(void);
+
+void erts_lcnt_retain_lock_info(erts_lcnt_lock_info_t *info);
+void erts_lcnt_release_lock_info(erts_lcnt_lock_info_t *info);
+
+/** @brief Sets whether to preserve the info of destroyed/uninstalled locks.
+ *
+ * This option makes no distinction whether the lock was destroyed or if lock
+ * counting was simply disabled, so erts_lcnt_set_category_mask must not be
+ * used while this option is active. */
+void erts_lcnt_set_preserve_info(int enable);
+
+int erts_lcnt_get_preserve_info(void);
+
+/** @brief Updates the category mask, enabling or disabling counting on the
+ * affected locks as necessary.
+ *
+ * This is not guaranteed to find all existing locks; only those that are
+ * flagged as static locks and those reachable through other means can be
+ * altered. */
+void erts_lcnt_set_category_mask(erts_lock_flags_t mask);
+
+erts_lock_flags_t erts_lcnt_get_category_mask(void);
+
+/* -- Inline implementation ------------------------------------------------ */
+
+/* The following is a hack to get the things we need from erl_thr_progress.h,
+ * which we can't #include without dependency hell breaking loose.
+ *
+ * The size of LcntThrPrgrLaterOp and value of the constant are verified at
+ * compile-time in erts_lcnt_pre_thr_init. */
+
+int lcnt_thr_progress_unmanaged_delay__(void);
+void lcnt_thr_progress_unmanaged_continue__(int handle);
+typedef struct { Uint64 _[4]; } LcntThrPrgrLaterOp;
+#define LCNT_THR_PRGR_DHANDLE_MANAGED -1
+
+struct lcnt_lock_info_carrier_ {
+ ethr_atomic_t ref_count;
+
+ LcntThrPrgrLaterOp release_entries;
+
+ unsigned char entry_count;
+ erts_lcnt_lock_info_t entries[];
+};
+
+typedef struct {
+ erts_lcnt_time_t timer; /* timer */
+ int timer_set; /* bool */
+ int lock_in_conflict; /* bool */
+} lcnt_thread_data_t__;
+
+extern const int lcnt_log2_tab64__[];
+
+extern ethr_tsd_key lcnt_thr_data_key__;
+extern erts_lock_flags_t lcnt_category_mask__;
#ifdef DEBUG
- ethr_atomic_t flowstate;
+extern int lcnt_initialization_completed__;
#endif
- /* lock states */
- ethr_atomic_t w_state; /* 0 not taken, otherwise n threads waiting */
- ethr_atomic_t r_state; /* 0 not taken, > 0 -> writes will wait */
+void lcnt_register_static_lock__(erts_lcnt_ref_t *reference, const char *name, Eterm id,
+ erts_lock_flags_t flags);
- /* statistics */
- unsigned int n_stats;
- erts_lcnt_lock_stats_t stats[ERTS_LCNT_MAX_LOCK_LOCATIONS]; /* first entry is "undefined"*/
+void lcnt_deallocate_carrier__(erts_lcnt_lock_info_carrier_t *carrier);
- /* chains for list handling */
- /* data is hold by lcnt_lock */
- struct erts_lcnt_lock_s *prev;
- struct erts_lcnt_lock_s *next;
-} erts_lcnt_lock_t;
+ERTS_GLB_INLINE
+int lcnt_log2__(Uint64 v);
-typedef struct {
- erts_lcnt_lock_t *head;
- erts_lcnt_lock_t *tail;
- unsigned long n;
-} erts_lcnt_lock_list_t;
+ERTS_GLB_INLINE
+void lcnt_update_wait_histogram__(erts_lcnt_hist_t *hist, erts_lcnt_time_t *time_waited);
-typedef struct {
- erts_lcnt_time_t duration; /* time since last clear */
- erts_lcnt_lock_list_t *current_locks;
- erts_lcnt_lock_list_t *deleted_locks;
-} erts_lcnt_data_t;
+ERTS_GLB_INLINE
+void lcnt_update_stats__(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, erts_lcnt_time_t *time_waited);
-typedef struct {
- int id;
+ERTS_GLB_INLINE
+erts_lcnt_lock_stats_t *lcnt_get_lock_stats__(erts_lcnt_lock_info_t *info, char *file, unsigned int line);
- erts_lcnt_time_t timer; /* timer */
- int timer_set; /* bool */
- int lock_in_conflict; /* bool */
-} erts_lcnt_thread_data_t;
+ERTS_GLB_INLINE
+void lcnt_dec_lock_state__(ethr_atomic_t *l_state);
-/* globals */
+ERTS_GLB_INLINE
+void lcnt_time__(erts_lcnt_time_t *time);
-extern Uint16 erts_lcnt_rt_options;
+ERTS_GLB_INLINE
+void lcnt_time_add__(erts_lcnt_time_t *t, erts_lcnt_time_t *d);
-/* function declerations */
+ERTS_GLB_INLINE
+void lcnt_time_diff__(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0);
-void erts_lcnt_init(void);
-void erts_lcnt_late_init(void);
+ERTS_GLB_INLINE
+void lcnt_retain_carrier__(erts_lcnt_lock_info_carrier_t *carrier);
-/* thread operations */
-void erts_lcnt_thread_setup(void);
-void erts_lcnt_thread_exit_handler(void);
+ERTS_GLB_INLINE
+void lcnt_release_carrier__(erts_lcnt_lock_info_carrier_t *carrier);
+
+ERTS_GLB_INLINE
+lcnt_thread_data_t__ *lcnt_get_thread_data__(void);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE
+void lcnt_time__(erts_lcnt_time_t *time) {
+ /*
+ * erts_sys_hrtime() is the highest resolution
+ * we could find, it may or may not be monotonic...
+ */
+ ErtsMonotonicTime mtime = erts_sys_hrtime();
+ time->s = (unsigned long) (mtime / 1000000000LL);
+ time->ns = (unsigned long) (mtime - 1000000000LL*time->s);
+}
+
+/* difference d must be non-negative */
+
+ERTS_GLB_INLINE
+void lcnt_time_add__(erts_lcnt_time_t *t, erts_lcnt_time_t *d) {
+ t->s += d->s;
+ t->ns += d->ns;
+
+ t->s += t->ns / 1000000000LL;
+ t->ns = t->ns % 1000000000LL;
+}
+
+ERTS_GLB_INLINE
+void lcnt_time_diff__(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0) {
+ long ds;
+ long dns;
+
+ ds = t1->s - t0->s;
+ dns = t1->ns - t0->ns;
+
+ /* the difference should not be able to get bigger than 1 sec in ns*/
+
+ if (dns < 0) {
+ ds -= 1;
+ dns += 1000000000LL;
+ }
+
+ ASSERT(ds >= 0);
+
+ d->s = ds;
+ d->ns = dns;
+}
+
+ERTS_GLB_INLINE
+int lcnt_log2__(Uint64 v) {
+ v |= v >> 1;
+ v |= v >> 2;
+ v |= v >> 4;
+ v |= v >> 8;
+ v |= v >> 16;
+ v |= v >> 32;
+
+ return lcnt_log2_tab64__[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58];
+}
+
+ERTS_GLB_INLINE
+void lcnt_update_wait_histogram__(erts_lcnt_hist_t *hist, erts_lcnt_time_t *time_waited) {
+ int idx;
+
+ if(time_waited->s > 0 || time_waited->ns > ERTS_LCNT_HISTOGRAM_MAX_NS) {
+ idx = ERTS_LCNT_HISTOGRAM_SLOT_SIZE - 1;
+ } else {
+ unsigned long r = time_waited->ns >> ERTS_LCNT_HISTOGRAM_RSHIFT;
+
+ idx = r ? lcnt_log2__(r) : 0;
+ }
+
+ hist->ns[idx]++;
+}
+
+ERTS_GLB_INLINE
+void lcnt_update_stats__(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, erts_lcnt_time_t *time_waited) {
+ ethr_atomic_inc(&stats->attempts);
+
+ if(lock_in_conflict) {
+ ethr_atomic_inc(&stats->collisions);
+ }
+
+ if(time_waited) {
+ stats->times_waited++;
+
+ lcnt_time_add__(&stats->total_time_waited, time_waited);
+ lcnt_update_wait_histogram__(&stats->wait_time_histogram, time_waited);
+ }
+}
+
+/* If we were installed while the lock was held, r/w_state will be 0 and we
+ * can't tell which unlock or unacquire operation was the last. To get around
+ * this we assume that all excess operations go *towards* zero rather than down
+ * to zero, eventually becoming consistent with the actual state once the lock
+ * is fully released.
+ *
+ * Conflicts might not be counted until the recorded state is fully consistent
+ * with the actual state, but there should be no other ill effects. */
+
+ERTS_GLB_INLINE
+void lcnt_dec_lock_state__(ethr_atomic_t *l_state) {
+ ethr_sint_t state = ethr_atomic_dec_read_acqb(l_state);
+
+ /* We can not assume that state is >= -1 here; unlock and unacquire might
+ * bring it below -1 and race to increment it back. */
+
+ if(state < 0) {
+ ethr_atomic_inc_acqb(l_state);
+ }
+}
+
+ERTS_GLB_INLINE
+erts_lcnt_lock_stats_t *lcnt_get_lock_stats__(erts_lcnt_lock_info_t *info, char *file, unsigned int line) {
+ unsigned int i;
+
+ ASSERT(info->location_count >= 1 && info->location_count <= ERTS_LCNT_MAX_LOCK_LOCATIONS);
+
+ for(i = 0; i < info->location_count; i++) {
+ erts_lcnt_lock_stats_t *stats = &info->location_stats[i];
+
+ if(stats->file == file && stats->line == line) {
+ return stats;
+ }
+ }
-/* list operations (local) */
-erts_lcnt_lock_list_t *erts_lcnt_list_init(void);
+ if(info->location_count < ERTS_LCNT_MAX_LOCK_LOCATIONS) {
+ erts_lcnt_lock_stats_t *stats = &info->location_stats[info->location_count];
-void erts_lcnt_list_insert(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock);
-void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock);
+ stats->file = file;
+ stats->line = line;
-/* lock operations (global) */
-void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag);
-void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id);
-void erts_lcnt_init_lock_empty(erts_lcnt_lock_t *lock);
-void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock);
+ info->location_count++;
-void erts_lcnt_lock(erts_lcnt_lock_t *lock);
-void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option);
-void erts_lcnt_lock_post(erts_lcnt_lock_t *lock);
-void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line);
-void erts_lcnt_lock_unaquire(erts_lcnt_lock_t *lock);
+ return stats;
+ }
-void erts_lcnt_unlock(erts_lcnt_lock_t *lock);
-void erts_lcnt_unlock_opt(erts_lcnt_lock_t *lock, Uint16 option);
+ return &info->location_stats[0];
+}
-void erts_lcnt_trylock_opt(erts_lcnt_lock_t *lock, int res, Uint16 option);
-void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res);
+ERTS_GLB_INLINE
+lcnt_thread_data_t__ *lcnt_get_thread_data__(void) {
+ lcnt_thread_data_t__ *eltd = (lcnt_thread_data_t__ *)ethr_tsd_get(lcnt_thr_data_key__);
-/* bif interface */
-Uint16 erts_lcnt_set_rt_opt(Uint16 opt);
-Uint16 erts_lcnt_clear_rt_opt(Uint16 opt);
-void erts_lcnt_clear_counters(void);
-char *erts_lcnt_lock_type(Uint16 type);
-erts_lcnt_data_t *erts_lcnt_get_data(void);
+ ASSERT(eltd);
+
+ return eltd;
+}
+
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_open_ref(erts_lcnt_ref_t *ref, int *handle, erts_lcnt_lock_info_carrier_t **result) {
+ if(ERTS_LIKELY(!erts_lcnt_check_ref_installed(ref))) {
+ return 0;
+ }
+
+ ASSERT(lcnt_initialization_completed__);
+
+ (*handle) = lcnt_thr_progress_unmanaged_delay__();
+ (*result) = (erts_lcnt_lock_info_carrier_t*)ethr_atomic_read(ref);
+
+ if(*result) {
+ if(*handle != LCNT_THR_PRGR_DHANDLE_MANAGED) {
+ lcnt_retain_carrier__(*result);
+ lcnt_thr_progress_unmanaged_continue__(*handle);
+ }
+
+ return 1;
+ } else if(*handle != LCNT_THR_PRGR_DHANDLE_MANAGED) {
+ lcnt_thr_progress_unmanaged_continue__(*handle);
+ }
+
+ return 0;
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_close_ref(int handle, erts_lcnt_lock_info_carrier_t *carrier) {
+ if(handle != LCNT_THR_PRGR_DHANDLE_MANAGED) {
+ lcnt_release_carrier__(carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref(erts_lcnt_ref_t *ref) {
+ ethr_atomic_init(ref, (ethr_sint_t)NULL);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref_x(erts_lcnt_ref_t *ref, const char *name,
+ Eterm id, erts_lock_flags_t flags) {
+ erts_lcnt_init_ref(ref);
+
+ if(flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC) {
+ lcnt_register_static_lock__(ref, name, id, flags);
+ }
+
+ if(erts_lcnt_check_enabled(flags)) {
+ erts_lcnt_install_new_lock_info(ref, name, id, flags);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_check_ref_installed(erts_lcnt_ref_t *ref) {
+ return (!!*ethr_atomic_addr(ref));
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_opt_idx(carrier, 0, option);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_post_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post_x(erts_lcnt_ref_t *ref, char *file, unsigned int line) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_post_x_idx(carrier, 0, file, line);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_unacquire(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_unacquire_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_unlock_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_unlock_opt_idx(carrier, 0, option);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock(erts_lcnt_ref_t *ref, int result) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_trylock_idx(carrier, 0, result);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock_opt(erts_lcnt_ref_t *ref, int result, erts_lock_options_t option) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_trylock_opt_idx(carrier, 0, result, option);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ erts_lcnt_lock_opt_idx(carrier, index, ERTS_LOCK_OPTIONS_WRITE);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ lcnt_thread_data_t__ *eltd = lcnt_get_thread_data__();
+
+ ASSERT(index < carrier->entry_count);
+
+ ASSERT((option & ERTS_LOCK_OPTIONS_READ) || (option & ERTS_LOCK_OPTIONS_WRITE));
+
+ if(option & ERTS_LOCK_OPTIONS_WRITE) {
+ ethr_sint_t w_state, r_state;
+
+ w_state = ethr_atomic_inc_read(&info->w_state) - 1;
+ r_state = ethr_atomic_read(&info->r_state);
+
+ /* We cannot acquire w_lock if either w or r are taken */
+ eltd->lock_in_conflict = (w_state > 0) || (r_state > 0);
+ } else {
+ ethr_sint_t w_state = ethr_atomic_read(&info->w_state);
+
+ /* We cannot acquire r_lock if w_lock is taken */
+ eltd->lock_in_conflict = (w_state > 0);
+ }
+
+ if(option & ERTS_LOCK_OPTIONS_READ) {
+ ASSERT(info->flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE);
+ ethr_atomic_inc(&info->r_state);
+ }
+
+ if(eltd->lock_in_conflict) {
+ /* Only set the timer if nobody else has it. This should only happen
+ * when proc_locks acquires several locks "atomically." All other locks
+ * will block the thread when locked (w_state > 0) */
+ if(eltd->timer_set == 0) {
+ lcnt_time__(&eltd->timer);
+ }
+
+ eltd->timer_set++;
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ erts_lcnt_lock_post_x_idx(carrier, index, NULL, 0);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_x_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, char *file, unsigned int line) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ lcnt_thread_data_t__ *eltd = lcnt_get_thread_data__();
+ erts_lcnt_lock_stats_t *stats;
+
+ ASSERT(index < carrier->entry_count);
+
+ /* If the lock was in conflict, update the time spent waiting. */
+ stats = lcnt_get_lock_stats__(info, file, line);
+ if(eltd->timer_set) {
+ erts_lcnt_time_t time_wait;
+ erts_lcnt_time_t timer;
+
+ lcnt_time__(&timer);
+
+ lcnt_time_diff__(&time_wait, &timer, &eltd->timer);
+ lcnt_update_stats__(stats, eltd->lock_in_conflict, &time_wait);
+
+ eltd->timer_set--;
+
+ ASSERT(eltd->timer_set >= 0);
+ } else {
+ lcnt_update_stats__(stats, eltd->lock_in_conflict, NULL);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ ASSERT(index < carrier->entry_count);
+
+ erts_lcnt_unlock_opt_idx(carrier, index, ERTS_LOCK_OPTIONS_WRITE);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(index < carrier->entry_count);
+
+ ASSERT((option & ERTS_LOCK_OPTIONS_READ) || (option & ERTS_LOCK_OPTIONS_WRITE));
+
+ if(option & ERTS_LOCK_OPTIONS_WRITE) {
+ lcnt_dec_lock_state__(&info->w_state);
+ }
+
+ if(option & ERTS_LOCK_OPTIONS_READ) {
+ ASSERT(info->flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE);
+ lcnt_dec_lock_state__(&info->r_state);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_unacquire_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(index < carrier->entry_count);
+
+ lcnt_dec_lock_state__(&info->w_state);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result) {
+ ASSERT(index < carrier->entry_count);
+
+ erts_lcnt_trylock_opt_idx(carrier, index, result, ERTS_LOCK_OPTIONS_WRITE);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result, erts_lock_options_t option) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(index < carrier->entry_count);
+
+ ASSERT((option & ERTS_LOCK_OPTIONS_READ) || (option & ERTS_LOCK_OPTIONS_WRITE));
+
+ if(result != EBUSY) {
+ if(option & ERTS_LOCK_OPTIONS_WRITE) {
+ ethr_atomic_inc(&info->w_state);
+ }
+
+ if(option & ERTS_LOCK_OPTIONS_READ) {
+ ASSERT(info->flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE);
+ ethr_atomic_inc(&info->r_state);
+ }
+
+ lcnt_update_stats__(&info->location_stats[0], 0, NULL);
+ } else {
+ ethr_atomic_inc(&info->location_stats[0].attempts);
+ ethr_atomic_inc(&info->location_stats[0].collisions);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_init_lock_info_idx(erts_lcnt_lock_info_carrier_t *carrier, int index,
+ const char *name, Eterm id, erts_lock_flags_t flags) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(is_immed(id));
+
+ ASSERT(flags & ERTS_LOCK_FLAGS_MASK_TYPE);
+ ASSERT(flags & ERTS_LOCK_FLAGS_MASK_CATEGORY);
+
+ info->flags = flags;
+ info->name = name;
+ info->id = id;
+}
+
+ERTS_GLB_INLINE
+void lcnt_retain_carrier__(erts_lcnt_lock_info_carrier_t *carrier) {
+#ifdef DEBUG
+ ASSERT(ethr_atomic_inc_read_acqb(&carrier->ref_count) >= 2);
+#else
+ ethr_atomic_inc_acqb(&carrier->ref_count);
+#endif
+}
+
+ERTS_GLB_INLINE
+void lcnt_release_carrier__(erts_lcnt_lock_info_carrier_t *carrier) {
+ ethr_sint_t count = ethr_atomic_dec_read_relb(&carrier->ref_count);
+
+ ASSERT(count >= 0);
+
+ if(count == 0) {
+ lcnt_deallocate_carrier__(carrier);
+ }
+}
+
+#endif
#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */
#endif /* ifndef ERTS_LOCK_COUNT_H__ */
diff --git a/erts/emulator/beam/erl_lock_flags.c b/erts/emulator/beam/erl_lock_flags.c
new file mode 100644
index 0000000000..e0a0e95c09
--- /dev/null
+++ b/erts/emulator/beam/erl_lock_flags.c
@@ -0,0 +1,59 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "erl_lock_flags.h"
+
+const char *erts_lock_flags_get_type_name(erts_lock_flags_t flags) {
+ switch(flags & ERTS_LOCK_FLAGS_MASK_TYPE) {
+ case ERTS_LOCK_FLAGS_TYPE_PROCLOCK:
+ return "proclock";
+ case ERTS_LOCK_FLAGS_TYPE_MUTEX:
+ if(flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE) {
+ return "rw_mutex";
+ }
+
+ return "mutex";
+ case ERTS_LOCK_FLAGS_TYPE_SPINLOCK:
+ if(flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE) {
+ return "rw_spinlock";
+ }
+
+ return "spinlock";
+ default:
+ return "garbage";
+ }
+}
+
+const char *erts_lock_options_get_short_desc(erts_lock_options_t options) {
+ switch(options) {
+ case ERTS_LOCK_OPTIONS_RDWR:
+ return "rw";
+ case ERTS_LOCK_OPTIONS_READ:
+ return "r";
+ case ERTS_LOCK_OPTIONS_WRITE:
+ return "w";
+ default:
+ return "none";
+ }
+}
diff --git a/erts/emulator/beam/erl_lock_flags.h b/erts/emulator/beam/erl_lock_flags.h
new file mode 100644
index 0000000000..d711f69456
--- /dev/null
+++ b/erts/emulator/beam/erl_lock_flags.h
@@ -0,0 +1,78 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifndef ERTS_LOCK_FLAGS_H__
+#define ERTS_LOCK_FLAGS_H__
+
+#define ERTS_LOCK_OPTIONS_READ (1 << 1)
+#define ERTS_LOCK_OPTIONS_WRITE (1 << 2)
+
+#define ERTS_LOCK_OPTIONS_RDWR (ERTS_LOCK_OPTIONS_READ | ERTS_LOCK_OPTIONS_WRITE)
+
+/* Property/category are bitfields to simplify their use in masks. */
+#define ERTS_LOCK_FLAGS_MASK_CATEGORY (0xFFC0)
+#define ERTS_LOCK_FLAGS_MASK_PROPERTY (0x0030)
+
+/* Type is a plain number. */
+#define ERTS_LOCK_FLAGS_MASK_TYPE (0x000F)
+
+#define ERTS_LOCK_FLAGS_TYPE_SPINLOCK (1)
+#define ERTS_LOCK_FLAGS_TYPE_MUTEX (2)
+#define ERTS_LOCK_FLAGS_TYPE_PROCLOCK (3)
+
+/* "Static" guarantees that the lock will never be destroyed once created. */
+#define ERTS_LOCK_FLAGS_PROPERTY_STATIC (1 << 4)
+#define ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE (1 << 5)
+
+#define ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR (1 << 6)
+#define ERTS_LOCK_FLAGS_CATEGORY_PROCESS (1 << 7)
+#define ERTS_LOCK_FLAGS_CATEGORY_IO (1 << 8)
+#define ERTS_LOCK_FLAGS_CATEGORY_DB (1 << 9)
+#define ERTS_LOCK_FLAGS_CATEGORY_DEBUG (1 << 10)
+#define ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER (1 << 11)
+#define ERTS_LOCK_FLAGS_CATEGORY_GENERIC (1 << 12)
+#define ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION (1 << 13)
+
+#define ERTS_LOCK_TYPE_SPINLOCK \
+ (ERTS_LOCK_FLAGS_TYPE_SPINLOCK)
+#define ERTS_LOCK_TYPE_RWSPINLOCK \
+ (ERTS_LOCK_TYPE_SPINLOCK | \
+ ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE)
+#define ERTS_LOCK_TYPE_MUTEX \
+ (ERTS_LOCK_FLAGS_TYPE_MUTEX)
+#define ERTS_LOCK_TYPE_RWMUTEX \
+ (ERTS_LOCK_TYPE_MUTEX | \
+ ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE)
+#define ERTS_LOCK_TYPE_PROCLOCK \
+ (ERTS_LOCK_FLAGS_CATEGORY_PROCESS | \
+ ERTS_LOCK_FLAGS_TYPE_PROCLOCK)
+
+/* -- -- */
+
+typedef unsigned short erts_lock_flags_t;
+typedef unsigned short erts_lock_options_t;
+
+/* @brief Gets the type name of the lock, honoring the RW flag if supplied. */
+const char *erts_lock_flags_get_type_name(erts_lock_flags_t flags);
+
+/* @brief Gets a short-form description of the given lock options. (rw/r/w) */
+const char *erts_lock_options_get_short_desc(erts_lock_options_t options);
+
+#endif /* ERTS_LOCK_FLAGS_H__ */
diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c
index 2d70f0d874..6c477be615 100644
--- a/erts/emulator/beam/erl_msacc.c
+++ b/erts/emulator/beam/erl_msacc.c
@@ -76,7 +76,8 @@ void erts_msacc_early_init(void) {
#ifndef ERTS_MSACC_ALWAYS_ON
erts_msacc_enabled = 0;
#endif
- erts_rwmtx_init(&msacc_mutex,"msacc_list_mutex");
+ erts_rwmtx_init(&msacc_mutex, "msacc_list_mutex", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
#ifdef USE_THREADS
erts_tsd_key_create(&erts_msacc_key,"erts_msacc_key");
#else
@@ -109,7 +110,8 @@ void erts_msacc_init_thread(char *type, int id, int managed) {
#ifdef USE_THREADS
erts_rwmtx_rwlock(&msacc_mutex);
if (!managed) {
- erts_mtx_init(&msacc->mtx,"msacc_unmanaged_mutex");
+ erts_mtx_init(&msacc->mtx, "msacc_unmanaged_mutex", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
msacc->next = msacc_unmanaged;
msacc_unmanaged = msacc;
msacc_unmanaged_count++;
diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c
index 19bb7d5b31..f2a660f085 100644
--- a/erts/emulator/beam/erl_mtrace.c
+++ b/erts/emulator/beam/erl_mtrace.c
@@ -583,8 +583,10 @@ void erts_mtrace_init(char *receiver, char *nodename)
byte ip_addr[4];
Uint16 port;
- erts_mtx_init(&mtrace_buf_mutex, "mtrace_buf");
- erts_mtx_init(&mtrace_op_mutex, "mtrace_op");
+ erts_mtx_init(&mtrace_buf_mutex, "mtrace_buf", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
+ erts_mtx_init(&mtrace_op_mutex, "mtrace_op", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
socket_desc = erts_sock_open();
if (socket_desc == ERTS_SOCK_INVALID_SOCKET) {
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 4815e5e7bb..9caeed3273 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -588,6 +588,10 @@ int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks)
ErlTraceMessageQueue *msgq, **last_msgq;
int reds = 0;
+ /* Only one thread at a time is allowed to flush trace messages,
+ so we require the main lock to be held when doing the flush */
+ ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
+
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE);
msgq = c_p->trace_msg_q;
@@ -889,26 +893,27 @@ static Eterm call_whereis(ErlNifEnv *env, Eterm name)
Process *c_p;
Eterm res;
int scheduler;
- int unlock;
execution_state(env, &c_p, &scheduler);
ASSERT((c_p && scheduler) || (!c_p && !scheduler));
- unlock = 0;
if (scheduler < 0) {
/* dirty scheduler */
if (ERTS_PROC_IS_EXITING(c_p))
return 0;
- if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
- unlock = 1;
- }
+ if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC)
+ c_p = NULL; /* as we don't have main lock */
}
- res = erts_whereis_name_to_id(c_p, name);
- if (unlock)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ if (c_p) {
+ /* main lock may be released below and c_p->htop updated by others */
+ flush_env(env);
+ }
+ res = erts_whereis_name_to_id(c_p, name);
+ if (c_p)
+ cache_env(env);
return res;
}
@@ -2456,7 +2461,8 @@ void* enif_alloc_resource(ErlNifResourceType* type, size_t data_sz)
erts_refc_inc(&resource->type->refc, 2);
if (type->down) {
resource->monitors = (ErtsResourceMonitors*) (resource->data + monitors_offs);
- erts_smp_mtx_init(&resource->monitors->lock, "resource_monitors");
+ erts_smp_mtx_init(&resource->monitors->lock, "resource_monitors", NIL,
+ ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
resource->monitors->root = NULL;
resource->monitors->pending_failed_fire = 0;
resource->monitors->is_dying = 0;
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index 3c5945d48d..deadf435e9 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -85,21 +85,20 @@ dist_table_cmp(void *dep1, void *dep2)
static void*
dist_table_alloc(void *dep_tmpl)
{
- Eterm chnl_nr;
Eterm sysname;
DistEntry *dep;
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
sysname = ((DistEntry *) dep_tmpl)->sysname;
- chnl_nr = make_small((Uint) atom_val(sysname));
dep = (DistEntry *) erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry));
dist_entries++;
dep->prev = NULL;
erts_smp_refc_init(&dep->refc, -1);
- erts_smp_rwmtx_init_opt_x(&dep->rwmtx, &rwmtx_opt, "dist_entry", chnl_nr);
+ erts_smp_rwmtx_init_opt(&dep->rwmtx, &rwmtx_opt, "dist_entry", sysname,
+ ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
dep->sysname = sysname;
dep->cid = NIL;
dep->connection_id = 0;
@@ -107,12 +106,14 @@ dist_table_alloc(void *dep_tmpl)
dep->flags = 0;
dep->version = 0;
- erts_smp_mtx_init_x(&dep->lnk_mtx, "dist_entry_links", chnl_nr);
+ erts_smp_mtx_init(&dep->lnk_mtx, "dist_entry_links", sysname,
+ ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
dep->node_links = NULL;
dep->nlinks = NULL;
dep->monitors = NULL;
- erts_smp_mtx_init_x(&dep->qlock, "dist_entry_out_queue", chnl_nr);
+ erts_smp_mtx_init(&dep->qlock, "dist_entry_out_queue", sysname,
+ ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
dep->qflgs = 0;
dep->qsize = 0;
dep->out_queue.first = NULL;
@@ -760,8 +761,10 @@ void erts_init_node_tables(int dd_sec)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table");
- erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table");
+ erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
f.hash = (H_FUN) dist_table_hash;
f.cmp = (HCMP_FUN) dist_table_cmp;
@@ -818,6 +821,33 @@ int erts_lc_is_de_rlocked(DistEntry *dep)
#endif
#endif
+#ifdef ERTS_ENABLE_LOCK_COUNT
+
+static void erts_lcnt_enable_dist_lock_count(void *dep_raw, void *enable) {
+ DistEntry *dep = (DistEntry*)dep_raw;
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&dep->rwmtx.lcnt, "dist_entry", dep->sysname,
+ ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ erts_lcnt_install_new_lock_info(&dep->lnk_mtx.lcnt, "dist_entry_links", dep->sysname,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ erts_lcnt_install_new_lock_info(&dep->qlock.lcnt, "dist_entry_out_queue", dep->sysname,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ } else {
+ erts_lcnt_uninstall(&dep->rwmtx.lcnt);
+ erts_lcnt_uninstall(&dep->lnk_mtx.lcnt);
+ erts_lcnt_uninstall(&dep->qlock.lcnt);
+ }
+}
+
+void erts_lcnt_update_distribution_locks(int enable) {
+ erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ hash_foreach(&erts_dist_table, erts_lcnt_enable_dist_lock_count,
+ (void*)(UWord)enable);
+ erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+}
+#endif
+
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
* The following is only supposed to be used for testing, and debugging. *
* *
diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h
index 489da1ba17..91bcb4fce1 100644
--- a/erts/emulator/beam/erl_node_tables.h
+++ b/erts/emulator/beam/erl_node_tables.h
@@ -195,6 +195,10 @@ int erts_lc_is_de_rwlocked(DistEntry *);
int erts_lc_is_de_rlocked(DistEntry *);
#endif
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_distribution_locks(int enable);
+#endif
+
ERTS_GLB_INLINE void erts_deref_dist_entry(DistEntry *dep);
ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np);
ERTS_GLB_INLINE void erts_smp_de_rlock(DistEntry *dep);
diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h
index 9cca62ffaf..39f403b443 100644
--- a/erts/emulator/beam/erl_port_task.h
+++ b/erts/emulator/beam/erl_port_task.h
@@ -188,13 +188,7 @@ erts_port_task_init_sched(ErtsPortTaskSched *ptsp, Eterm instr_id)
ptsp->taskq.in.last = NULL;
erts_smp_atomic32_init_nob(&ptsp->flags, 0);
#ifdef ERTS_SMP
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_mtx_init_x_opt(&ptsp->mtx, lock_str, instr_id,
- ((erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)
- ? 0 : ERTS_LCNT_LT_DISABLE));
-#else
- erts_mtx_init_x(&ptsp->mtx, lock_str, instr_id);
-#endif
+ erts_mtx_init(&ptsp->mtx, lock_str, instr_id, ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
}
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index fc2b34e70f..63c838a91d 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -841,7 +841,9 @@ erts_late_init_process(void)
{
int ix;
- erts_smp_spinlock_init(&erts_sched_stat.lock, "sched_stat");
+ erts_smp_spinlock_init(&erts_sched_stat.lock, "sched_stat", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
+
for (ix = 0; ix < ERTS_NO_PRIO_LEVELS; ix++) {
Eterm atom;
char *atom_str;
@@ -2010,12 +2012,13 @@ erts_schedule_multi_misc_aux_work(int ignore_self,
int id, self = 0;
if (ignore_self) {
- ErtsSchedulerData *esdp = erts_get_scheduler_data();
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
- if (esdp)
- self = (int) esdp->no;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+
+ /* ignore_self is meaningless on dirty schedulers since aux work can
+ * only run on normal schedulers, and their ids do not translate. */
+ if(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ self = (int)esdp->no;
+ }
}
ASSERT(0 < max_sched && max_sched <= erts_no_schedulers);
@@ -6232,13 +6235,17 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
* id if the esdp->no <-> ix+1 mapping change.
*/
- erts_smp_mtx_init_x(&rq->mtx, "run_queue", make_small(ix + 1));
+ erts_smp_mtx_init(&rq->mtx, "run_queue", make_small(ix + 1),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
erts_smp_cnd_init(&rq->cnd);
#ifdef ERTS_DIRTY_SCHEDULERS
#ifdef ERTS_SMP
- if (ERTS_RUNQ_IX_IS_DIRTY(ix))
- erts_smp_spinlock_init(&rq->sleepers.lock, "dirty_run_queue_sleep_list");
+ if (ERTS_RUNQ_IX_IS_DIRTY(ix)) {
+ erts_smp_spinlock_init(&rq->sleepers.lock, "dirty_run_queue_sleep_list",
+ make_small(ix + 1),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
+ }
rq->sleepers.list = NULL;
#endif
#endif
@@ -6431,7 +6438,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
init_no_runqs(no_schedulers_online, no_schedulers_online);
balance_info.last_active_runqs = no_schedulers;
- erts_smp_mtx_init(&balance_info.update_mtx, "migration_info_update");
+ erts_smp_mtx_init(&balance_info.update_mtx, "migration_info_update", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
balance_info.forced_check_balance = 0;
balance_info.halftime = 1;
balance_info.full_reds_history_index = 0;
@@ -7493,7 +7501,8 @@ sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi)
static void
init_scheduler_suspend(void)
{
- erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd");
+ erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
schdlr_sspnd.online.normal = 1;
schdlr_sspnd.curr_online.normal = 1;
schdlr_sspnd.active.normal = 1;
@@ -11768,9 +11777,11 @@ flush_dirty_trace_messages(void *vpid)
erts_free(ERTS_ALC_T_DIRTY_SL, vpid);
#endif
- proc = erts_proc_lookup(pid);
- if (proc)
- (void) erts_flush_trace_messages(proc, 0);
+ proc = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_MAIN, 0);
+ if (proc) {
+ (void) erts_flush_trace_messages(proc, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
+ }
}
#endif /* ERTS_DIRTY_SCHEDULERS */
@@ -14102,8 +14113,11 @@ erts_continue_exit_process(Process *p)
have none here */
}
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+
#ifdef ERTS_SMP
- erts_flush_trace_messages(p, 0);
+ erts_flush_trace_messages(p, ERTS_PROC_LOCK_MAIN);
#endif
ERTS_TRACER_CLEAR(&ERTS_TRACER(p));
@@ -14111,11 +14125,6 @@ erts_continue_exit_process(Process *p)
if (!delay_del_proc)
delete_process(p);
-#ifdef ERTS_SMP
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
-#endif
-
return;
yield:
diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c
index c0e7380ed0..ff124d5ba7 100644
--- a/erts/emulator/beam/erl_process_lock.c
+++ b/erts/emulator/beam/erl_process_lock.c
@@ -112,21 +112,13 @@ static struct {
erts_pix_lock_t erts_pix_locks[ERTS_NO_OF_PIX_LOCKS];
-#ifdef ERTS_ENABLE_LOCK_COUNT
-static void lcnt_enable_proc_lock_count(Process *proc, int enable);
-#endif
-
void
erts_init_proc_lock(int cpus)
{
int i;
for (i = 0; i < ERTS_NO_OF_PIX_LOCKS; i++) {
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_mtx_init_x(&erts_pix_locks[i].u.mtx,
- "pix_lock", make_small(i));
-#else
- erts_mtx_init(&erts_pix_locks[i].u.mtx, "pix_lock");
-#endif
+ erts_mtx_init(&erts_pix_locks[i].u.mtx, "pix_lock", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
}
#if ERTS_PROC_LOCK_OWN_IMPL
erts_thr_install_exit_handler(cleanup_tse);
@@ -944,7 +936,7 @@ erts_pid2proc_opt(Process *c_p,
erts_proc_inc_refc(proc);
#if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_COUNT)
- erts_lcnt_proc_lock_unaquire(&proc->lock, lcnt_locks);
+ erts_lcnt_proc_lock_unacquire(&proc->lock, lcnt_locks);
#endif
managed = dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED;
@@ -1062,32 +1054,38 @@ erts_proc_lock_init(Process *p)
#endif
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
- erts_mtx_init_x(&p->lock.main, "proc_main", p->common.id);
+ erts_mtx_init(&p->lock.main, "proc_main", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.main.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.main.lc);
#endif
- erts_mtx_init_x(&p->lock.link, "proc_link", p->common.id);
+ erts_mtx_init(&p->lock.link, "proc_link", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.link.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.link.lc);
#endif
- erts_mtx_init_x(&p->lock.msgq, "proc_msgq", p->common.id);
+ erts_mtx_init(&p->lock.msgq, "proc_msgq", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.msgq.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.msgq.lc);
#endif
- erts_mtx_init_x(&p->lock.btm, "proc_btm", p->common.id);
+ erts_mtx_init(&p->lock.btm, "proc_btm", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.btm.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.btm.lc);
#endif
- erts_mtx_init_x(&p->lock.status, "proc_status", p->common.id);
+ erts_mtx_init(&p->lock.status, "proc_status", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.status.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.status.lc);
#endif
- erts_mtx_init_x(&p->lock.trace, "proc_trace", p->common.id);
+ erts_mtx_init(&p->lock.trace, "proc_trace", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.trace.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.trace.lc);
@@ -1124,117 +1122,70 @@ erts_proc_lock_fin(Process *p)
#if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_COUNT)
-void erts_lcnt_enable_proc_lock_count(int enable) {
- int ix, max = erts_ptab_max(&erts_proc);
- Process *proc = NULL;
- for (ix = 0; ix < max; ++ix) {
- if ((proc = erts_pix2proc(ix)) != NULL)
- lcnt_enable_proc_lock_count(proc, enable);
- } /* for all processes */
-}
-
void erts_lcnt_proc_lock_init(Process *p) {
- if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) {
- erts_lcnt_init_lock_empty(&(p->lock.lcnt_main));
- erts_lcnt_init_lock_empty(&(p->lock.lcnt_link));
- erts_lcnt_init_lock_empty(&(p->lock.lcnt_msgq));
- erts_lcnt_init_lock_empty(&(p->lock.lcnt_btm));
- erts_lcnt_init_lock_empty(&(p->lock.lcnt_status));
- erts_lcnt_init_lock_empty(&(p->lock.lcnt_trace));
- } else { /* now the common case */
- Eterm pid = (p->common.id != ERTS_INVALID_PID) ? p->common.id : NIL;
- erts_lcnt_init_lock_x(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK, pid);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, pid);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK, pid);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_btm), "proc_btm", ERTS_LCNT_LT_PROCLOCK, pid);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_status),"proc_status",ERTS_LCNT_LT_PROCLOCK, pid);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_trace), "proc_trace", ERTS_LCNT_LT_PROCLOCK, pid);
- } /* the lock names should really be aligned to four characters */
+ erts_lcnt_init_ref(&p->lock.lcnt_carrier);
+
+ if(erts_lcnt_check_enabled(ERTS_LOCK_FLAGS_CATEGORY_PROCESS)) {
+ erts_lcnt_enable_proc_lock_count(p, 1);
+ }
} /* logic reversed */
void erts_lcnt_proc_lock_destroy(Process *p) {
- erts_lcnt_destroy_lock(&(p->lock.lcnt_main));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_link));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_msgq));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_btm));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_status));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_trace));
+ erts_lcnt_uninstall(&p->lock.lcnt_carrier);
}
-static void lcnt_enable_proc_lock_count(Process *proc, int enable) {
- if (enable) {
- if (!ERTS_LCNT_LOCK_TYPE(&(proc->lock.lcnt_main))) {
- erts_lcnt_proc_lock_init(proc);
- }
- }
- else {
- if (ERTS_LCNT_LOCK_TYPE(&(proc->lock.lcnt_main))) {
- erts_lcnt_proc_lock_destroy(proc);
- }
+void erts_lcnt_enable_proc_lock_count(Process *proc, int enable) {
+ if(proc->common.id == ERTS_INVALID_PID) {
+ /* Locks without an id are more trouble than they're worth; there's no
+ * way to look them up and we can't track them with _STATIC since it's
+ * too early to tell whether we're a system process (proc->static_flags
+ * hasn't been not set yet). */
+ } else if(!enable) {
+ erts_lcnt_proc_lock_destroy(proc);
+ } else if(!erts_lcnt_check_ref_installed(&proc->lock.lcnt_carrier)) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+
+ carrier = erts_lcnt_create_lock_info_carrier(ERTS_LCNT_PROCLOCK_COUNT);
+
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN,
+ "proc_main", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK,
+ "proc_link", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ,
+ "proc_msgq", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM,
+ "proc_btm", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS,
+ "proc_status",proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE,
+ "proc_trace", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+
+ erts_lcnt_install(&proc->lock.lcnt_carrier, carrier);
}
}
-void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
- if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return;
- if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock(&(lock->lcnt_main)); }
- if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock(&(lock->lcnt_link)); }
- if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock(&(lock->lcnt_msgq)); }
- if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_lock(&(lock->lcnt_btm)); }
- if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock(&(lock->lcnt_status)); }
- if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_lock(&(lock->lcnt_trace)); }
-}
+void erts_lcnt_update_process_locks(int enable) {
+ int i, max;
-void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks,
- char *file, unsigned int line) {
- if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return;
- if (locks & ERTS_PROC_LOCK_MAIN) {
- erts_lcnt_lock_post_x(&(lock->lcnt_main), file, line);
- }
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_lock_post_x(&(lock->lcnt_link), file, line);
- }
- if (locks & ERTS_PROC_LOCK_MSGQ) {
- erts_lcnt_lock_post_x(&(lock->lcnt_msgq), file, line);
- }
- if (locks & ERTS_PROC_LOCK_BTM) {
- erts_lcnt_lock_post_x(&(lock->lcnt_btm), file, line);
- }
- if (locks & ERTS_PROC_LOCK_STATUS) {
- erts_lcnt_lock_post_x(&(lock->lcnt_status), file, line);
- }
- if (locks & ERTS_PROC_LOCK_TRACE) {
- erts_lcnt_lock_post_x(&(lock->lcnt_trace), file, line);
- }
-}
+ max = erts_ptab_max(&erts_proc);
-void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks) {
- if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return;
- if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock_unaquire(&(lock->lcnt_main)); }
- if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock_unaquire(&(lock->lcnt_link)); }
- if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock_unaquire(&(lock->lcnt_msgq)); }
- if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_lock_unaquire(&(lock->lcnt_btm)); }
- if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock_unaquire(&(lock->lcnt_status)); }
- if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_lock_unaquire(&(lock->lcnt_trace)); }
-}
+ for(i = 0; i < max; i++) {
+ int delay_handle;
+ Process *proc;
+
+ delay_handle = erts_thr_progress_unmanaged_delay();
+ proc = erts_pix2proc(i);
+
+ if(proc != NULL) {
+ erts_lcnt_enable_proc_lock_count(proc, enable);
+ }
-void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
- if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return;
- if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_unlock(&(lock->lcnt_main)); }
- if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_unlock(&(lock->lcnt_link)); }
- if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_unlock(&(lock->lcnt_msgq)); }
- if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_unlock(&(lock->lcnt_btm)); }
- if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_unlock(&(lock->lcnt_status)); }
- if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_unlock(&(lock->lcnt_trace)); }
+ if(delay_handle != ERTS_THR_PRGR_DHANDLE_MANAGED) {
+ erts_thr_progress_unmanaged_continue(delay_handle);
+ }
+ }
}
-void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res) {
- if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return;
- if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_trylock(&(lock->lcnt_main), res); }
- if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_trylock(&(lock->lcnt_link), res); }
- if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_trylock(&(lock->lcnt_msgq), res); }
- if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_trylock(&(lock->lcnt_btm), res); }
- if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_trylock(&(lock->lcnt_status), res); }
- if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_trylock(&(lock->lcnt_trace), res); }
-} /* reversed logic */
+
#endif /* ERTS_ENABLE_LOCK_COUNT */
@@ -1249,7 +1200,7 @@ erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line
{
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_lock_x(&lck,file,line);
@@ -1282,7 +1233,7 @@ erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked,
{
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_trylock_x(locked, &lck, file, line);
@@ -1314,7 +1265,7 @@ erts_proc_lc_unlock(Process *p, ErtsProcLocks locks)
{
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_TRACE) {
lck.id = lc_id.proc_lock_trace;
erts_lc_unlock(&lck);
@@ -1349,7 +1300,7 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks)
#if ERTS_PROC_LOCK_OWN_IMPL
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_TRACE) {
lck.id = lc_id.proc_lock_trace;
erts_lc_might_unlock(&lck);
@@ -1397,7 +1348,7 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file,
#if ERTS_PROC_LOCK_OWN_IMPL
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_require_lock(&lck, file, line);
@@ -1444,7 +1395,7 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks)
#if ERTS_PROC_LOCK_OWN_IMPL
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_TRACE) {
lck.id = lc_id.proc_lock_trace;
erts_lc_unrequire_lock(&lck);
@@ -1493,7 +1444,7 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks)
if (locks & ERTS_PROC_LOCKS_ALL) {
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN)
lck.id = lc_id.proc_lock_main;
@@ -1524,7 +1475,7 @@ void erts_proc_lc_chk_only_proc_main(Process *p)
#if ERTS_PROC_LOCK_OWN_IMPL
#define ERTS_PROC_LC_EMPTY_LOCK_INIT \
- ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LC_FLG_LT_PROCLOCK)
+ ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LOCK_TYPE_PROCLOCK)
#endif /* ERTS_PROC_LOCK_OWN_IMPL */
void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks)
@@ -1739,22 +1690,22 @@ erts_proc_lc_my_proc_locks(Process *p)
#if ERTS_PROC_LOCK_OWN_IMPL
erts_lc_lock_t locks[6] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_link,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_msgq,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_btm,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_status,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_trace,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK)};
+ ERTS_LOCK_TYPE_PROCLOCK)};
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
erts_lc_lock_t locks[6] = {p->lock.main.lc,
p->lock.link.lc,
diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h
index 6e704b185d..023ba4d4ae 100644
--- a/erts/emulator/beam/erl_process_lock.h
+++ b/erts/emulator/beam/erl_process_lock.h
@@ -78,13 +78,19 @@ typedef struct erts_proc_lock_t_ {
ErtsProcLocks flags;
#endif
erts_tse_t *queue[ERTS_PROC_LOCK_MAX_BIT+1];
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt_main;
- erts_lcnt_lock_t lcnt_link;
- erts_lcnt_lock_t lcnt_msgq;
- erts_lcnt_lock_t lcnt_btm;
- erts_lcnt_lock_t lcnt_status;
- erts_lcnt_lock_t lcnt_trace;
+#if defined(ERTS_ENABLE_LOCK_COUNT) && !ERTS_PROC_LOCK_RAW_MUTEX_IMPL
+ /* Each erts_mtx_t has its own lock counter ^ */
+
+ #define ERTS_LCNT_PROCLOCK_IDX_MAIN 0
+ #define ERTS_LCNT_PROCLOCK_IDX_LINK 1
+ #define ERTS_LCNT_PROCLOCK_IDX_MSGQ 2
+ #define ERTS_LCNT_PROCLOCK_IDX_BTM 3
+ #define ERTS_LCNT_PROCLOCK_IDX_STATUS 4
+ #define ERTS_LCNT_PROCLOCK_IDX_TRACE 5
+
+ #define ERTS_LCNT_PROCLOCK_COUNT 6
+
+ erts_lcnt_ref_t lcnt_carrier;
#endif
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
erts_mtx_t main;
@@ -245,14 +251,170 @@ typedef struct erts_proc_lock_t_ {
void erts_lcnt_proc_lock_init(Process *p);
void erts_lcnt_proc_lock_destroy(Process *p);
+
+ERTS_GLB_INLINE
void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, char *file, unsigned int line);
-void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock_unacquire(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res);
-void erts_lcnt_enable_proc_lock_count(int enable);
+void erts_lcnt_enable_proc_lock_count(Process *proc, int enable);
+void erts_lcnt_update_process_locks(int enable);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks,
+ char *file, unsigned int line) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE, file, line);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock_unacquire(erts_proc_lock_t *lock, ErtsProcLocks locks) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN, res);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK, res);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ, res);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM, res);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS, res);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE, res);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+} /* reversed logic */
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
#endif /* ERTS_ENABLE_LOCK_COUNT*/
diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c
index c3d59cb3a8..b3bcb3af3f 100644
--- a/erts/emulator/beam/erl_ptab.c
+++ b/erts/emulator/beam/erl_ptab.c
@@ -372,7 +372,8 @@ erts_ptab_init_table(ErtsPTab *ptab,
rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&ptab->list.data.rwmtx, &rwmtx_opts, name);
+ erts_smp_rwmtx_init_opt(&ptab->list.data.rwmtx, &rwmtx_opts, name, NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
erts_smp_atomic32_init_nob(&ptab->vola.tile.count, 0);
last_data_init_nob(ptab, ~((Uint64) 0));
diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h
index 181736b009..696bdbdaf1 100644
--- a/erts/emulator/beam/erl_smp.h
+++ b/erts/emulator/beam/erl_smp.h
@@ -128,14 +128,14 @@ ERTS_GLB_INLINE int erts_smp_equal_tids(erts_smp_tid_t x, erts_smp_tid_t y);
#define ERTS_SMP_HAVE_REC_MTX_INIT 1
ERTS_GLB_INLINE void erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx);
#endif
-ERTS_GLB_INLINE void erts_smp_mtx_init_x(erts_smp_mtx_t *mtx,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name);
-ERTS_GLB_INLINE void erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name);
+ERTS_GLB_INLINE void erts_smp_mtx_init(erts_smp_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
+ERTS_GLB_INLINE void erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_mtx_destroy(erts_smp_mtx_t *mtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_smp_mtx_trylock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line);
@@ -153,18 +153,15 @@ ERTS_GLB_INLINE void erts_smp_cnd_wait(erts_smp_cnd_t *cnd,
ERTS_GLB_INLINE void erts_smp_cnd_signal(erts_smp_cnd_t *cnd);
ERTS_GLB_INLINE void erts_smp_cnd_broadcast(erts_smp_cnd_t *cnd);
ERTS_GLB_INLINE void erts_smp_rwmtx_set_reader_group(int no);
-ERTS_GLB_INLINE void erts_smp_rwmtx_init_opt_x(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_smp_rwmtx_init_x(erts_smp_rwmtx_t *rwmtx,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_smp_rwmtx_init_opt(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name);
+ erts_smp_rwmtx_opt_t *opt,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line);
@@ -181,11 +178,10 @@ ERTS_GLB_INLINE void erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx);
ERTS_GLB_INLINE void erts_smp_rwmtx_rwunlock(erts_smp_rwmtx_t *rwmtx);
ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rlocked(erts_smp_rwmtx_t *mtx);
ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx);
-ERTS_GLB_INLINE void erts_smp_spinlock_init_x(erts_smp_spinlock_t *lock,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_smp_spinlock_init(erts_smp_spinlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_spinlock_destroy(erts_smp_spinlock_t *lock);
ERTS_GLB_INLINE void erts_smp_spin_unlock(erts_smp_spinlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -194,11 +190,10 @@ ERTS_GLB_INLINE void erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file,
ERTS_GLB_INLINE void erts_smp_spin_lock(erts_smp_spinlock_t *lock);
#endif
ERTS_GLB_INLINE int erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock);
-ERTS_GLB_INLINE void erts_smp_rwlock_init_x(erts_smp_rwlock_t *lock,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_smp_rwlock_init(erts_smp_rwlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_rwlock_destroy(erts_smp_rwlock_t *lock);
ERTS_GLB_INLINE void erts_smp_read_unlock(erts_smp_rwlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -1062,34 +1057,18 @@ erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx)
#endif
ERTS_GLB_INLINE void
-erts_smp_mtx_init_x(erts_smp_mtx_t *mtx, char *name, Eterm extra)
+erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_mtx_init_x(mtx, name, extra);
+ erts_mtx_init(mtx, name, extra, flags);
#endif
}
ERTS_GLB_INLINE void
-erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx, char *name, Eterm extra)
+erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_mtx_init_locked_x_opt(mtx, name, extra, 0);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name)
-{
-#ifdef ERTS_SMP
- erts_mtx_init(mtx, name);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name)
-{
-#ifdef ERTS_SMP
- erts_mtx_init_locked(mtx, name);
+ erts_mtx_init_locked(mtx, name, extra, flags);
#endif
}
@@ -1211,39 +1190,25 @@ erts_smp_rwmtx_set_reader_group(int no)
}
ERTS_GLB_INLINE void
-erts_smp_rwmtx_init_opt_x(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name,
- Eterm extra)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_init_opt_x(rwmtx, opt, name, extra);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_init_x(erts_smp_rwmtx_t *rwmtx, char *name, Eterm extra)
+erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_rwmtx_init_x(rwmtx, name, extra);
+ erts_smp_rwmtx_init_opt(rwmtx, NULL, name, extra, flags);
#endif
}
ERTS_GLB_INLINE void
erts_smp_rwmtx_init_opt(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_init_opt(rwmtx, opt, name);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx, char *name)
+ erts_smp_rwmtx_opt_t *opt,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_rwmtx_init(rwmtx, name);
+ erts_rwmtx_init_opt(rwmtx, opt, name, extra, flags);
#endif
}
@@ -1379,20 +1344,10 @@ erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx)
}
ERTS_GLB_INLINE void
-erts_smp_spinlock_init_x(erts_smp_spinlock_t *lock, char *name, Eterm extra)
-{
-#ifdef ERTS_SMP
- erts_spinlock_init_x(lock, name, extra);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_spinlock_init(erts_smp_spinlock_t *lock, char *name)
+erts_smp_spinlock_init(erts_smp_spinlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_spinlock_init(lock, name);
+ erts_spinlock_init(lock, name, extra, flags);
#else
(void)lock;
#endif
@@ -1445,20 +1400,10 @@ erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock)
}
ERTS_GLB_INLINE void
-erts_smp_rwlock_init_x(erts_smp_rwlock_t *lock, char *name, Eterm extra)
-{
-#ifdef ERTS_SMP
- erts_rwlock_init_x(lock, name, extra);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwlock_init(erts_smp_rwlock_t *lock, char *name)
+erts_smp_rwlock_init(erts_smp_rwlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_rwlock_init(lock, name);
+ erts_rwlock_init(lock, name, extra, flags);
#else
(void)lock;
#endif
diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c
index 700ed90def..2a9f276e02 100644
--- a/erts/emulator/beam/erl_thr_progress.c
+++ b/erts/emulator/beam/erl_thr_progress.c
@@ -321,13 +321,23 @@ tmp_thr_prgr_data(ErtsSchedulerData *esdp)
ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(esdp);
if (!tpd) {
- /*
- * We only allocate the part up to the wakeup_request field
- * which is the first field only used by registered threads
- */
- tpd = erts_alloc(ERTS_ALC_T_T_THR_PRGR_DATA,
- offsetof(ErtsThrPrgrData, wakeup_request));
- init_tmp_thr_prgr_data(tpd);
+ /*
+ * We only allocate the part up to the wakeup_request field which is
+ * the first field only used by registered threads
+ */
+ size_t alloc_size = offsetof(ErtsThrPrgrData, wakeup_request);
+
+ /* We may land here as a result of unmanaged_delay being called from
+ * the lock counting module, which in turn might be called from within
+ * the allocator, so we use plain malloc to avoid deadlocks. */
+ tpd =
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ malloc(alloc_size);
+#else
+ erts_alloc(ERTS_ALC_T_T_THR_PRGR_DATA, alloc_size);
+#endif
+
+ init_tmp_thr_prgr_data(tpd);
}
return tpd;
@@ -337,8 +347,13 @@ static ERTS_INLINE void
return_tmp_thr_prgr_data(ErtsThrPrgrData *tpd)
{
if (tpd->is_temporary) {
- erts_tsd_set(erts_thr_prgr_data_key__, NULL);
- erts_free(ERTS_ALC_T_T_THR_PRGR_DATA, tpd);
+ erts_tsd_set(erts_thr_prgr_data_key__, NULL);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ free(tpd);
+#else
+ erts_free(ERTS_ALC_T_T_THR_PRGR_DATA, tpd);
+#endif
}
}
diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h
index 9612b70469..8b5c17d739 100644
--- a/erts/emulator/beam/erl_threads.h
+++ b/erts/emulator/beam/erl_threads.h
@@ -259,13 +259,16 @@
#include "sys.h"
+#include "erl_lock_flags.h"
+#include "erl_term.h"
+
#ifdef USE_THREADS
#define ETHR_TRY_INLINE_FUNCS
#include "ethread.h"
+
#include "erl_lock_check.h"
#include "erl_lock_count.h"
-#include "erl_term.h"
#if defined(__GLIBC__) && (__GLIBC__ << 16) + __GLIBC_MINOR__ < (2 << 16) + 4
/*
@@ -307,9 +310,11 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
-
} erts_mtx_t;
typedef ethr_cond erts_cnd_t;
@@ -320,7 +325,10 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
} erts_rwmtx_t;
@@ -365,7 +373,10 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
} erts_spinlock_t;
@@ -376,7 +387,10 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
} erts_rwlock_t;
@@ -479,11 +493,14 @@ ERTS_GLB_INLINE void erts_thr_install_exit_handler(void (*exit_handler)(void));
ERTS_GLB_INLINE erts_tid_t erts_thr_self(void);
ERTS_GLB_INLINE int erts_thr_getname(erts_tid_t tid, char *buf, size_t len);
ERTS_GLB_INLINE int erts_equal_tids(erts_tid_t x, erts_tid_t y);
-ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra);
-ERTS_GLB_INLINE void erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt);
-ERTS_GLB_INLINE void erts_mtx_init_locked_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt);
-ERTS_GLB_INLINE void erts_mtx_init(erts_mtx_t *mtx, char *name);
-ERTS_GLB_INLINE void erts_mtx_init_locked(erts_mtx_t *mtx, char *name);
+ERTS_GLB_INLINE void erts_mtx_init(erts_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
+ERTS_GLB_INLINE void erts_mtx_init_locked(erts_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_mtx_destroy(erts_mtx_t *mtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_mtx_trylock_x(erts_mtx_t *mtx, char *file,
@@ -502,18 +519,15 @@ ERTS_GLB_INLINE void erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx);
ERTS_GLB_INLINE void erts_cnd_signal(erts_cnd_t *cnd);
ERTS_GLB_INLINE void erts_cnd_broadcast(erts_cnd_t *cnd);
ERTS_GLB_INLINE void erts_rwmtx_set_reader_group(int no);
-ERTS_GLB_INLINE void erts_rwmtx_init_opt_x(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_rwmtx_init_x(erts_rwmtx_t *rwmtx,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name);
+ erts_rwmtx_opt_t *opt,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_rwmtx_init(erts_rwmtx_t *rwmtx,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_rwmtx_destroy(erts_rwmtx_t *rwmtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_rwmtx_tryrlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line);
@@ -603,16 +617,10 @@ ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_cmpxchg(erts_no_atomic64_t *xchgp
ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_bset(erts_no_atomic64_t *var,
erts_aint64_t mask,
erts_aint64_t set);
-
-ERTS_GLB_INLINE void erts_spinlock_init_x_opt(erts_spinlock_t *lock,
- char *name,
- Eterm extra,
- Uint16 opt);
-ERTS_GLB_INLINE void erts_spinlock_init_x(erts_spinlock_t *lock,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_spinlock_init(erts_spinlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_spinlock_destroy(erts_spinlock_t *lock);
ERTS_GLB_INLINE void erts_spin_unlock(erts_spinlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -621,11 +629,10 @@ ERTS_GLB_INLINE void erts_spin_lock_x(erts_spinlock_t *lock, char *file, unsigne
ERTS_GLB_INLINE void erts_spin_lock(erts_spinlock_t *lock);
#endif
ERTS_GLB_INLINE int erts_lc_spinlock_is_locked(erts_spinlock_t *lock);
-ERTS_GLB_INLINE void erts_rwlock_init_x(erts_rwlock_t *lock,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_rwlock_init(erts_rwlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_rwlock_destroy(erts_rwlock_t *lock);
ERTS_GLB_INLINE void erts_read_unlock(erts_rwlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -2159,97 +2166,41 @@ erts_equal_tids(erts_tid_t x, erts_tid_t y)
}
ERTS_GLB_INLINE void
-erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra)
+erts_mtx_init(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra);
-#endif
-#endif
-}
+ if (res) {
+ erts_thr_fatal_error(res, "initialize mutex");
+ }
-ERTS_GLB_INLINE void
-erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt)
-{
-#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra);
-#endif
+ flags |= ERTS_LOCK_TYPE_MUTEX;
+#ifdef DEBUG
+ mtx->flags = flags;
#endif
-}
-
-ERTS_GLB_INLINE void
-erts_mtx_init_locked_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt)
-{
-#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra);
-#endif
- ethr_mutex_lock(&mtx->mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_trylock(1, &mtx->lc);
+ erts_lc_init_lock_x(&mtx->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock(&mtx->lcnt, 1);
-#endif
+ erts_lcnt_init_ref_x(&mtx->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
-erts_mtx_init(erts_mtx_t *mtx, char *name)
+erts_mtx_init_locked(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX);
-#endif
-#endif
-}
+ erts_mtx_init(mtx, name, extra, flags);
-ERTS_GLB_INLINE void
-erts_mtx_init_locked(erts_mtx_t *mtx, char *name)
-{
-#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX);
-#endif
ethr_mutex_lock(&mtx->mtx);
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_trylock(1, &mtx->lc);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock(&mtx->lcnt, 1);
-#endif
+ #ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_trylock(1, &mtx->lc);
+ #endif
+ #ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_trylock(&mtx->lcnt, 1);
+ #endif
#endif
}
@@ -2258,11 +2209,14 @@ erts_mtx_destroy(erts_mtx_t *mtx)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(mtx->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&mtx->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&mtx->lcnt);
+ erts_lcnt_uninstall(&mtx->lcnt);
#endif
res = ethr_mutex_destroy(&mtx->mtx);
if (res != 0) {
@@ -2359,7 +2313,8 @@ erts_lc_mtx_is_locked(erts_mtx_t *mtx)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
- lc.flags = 0;
+ lc.flags = ERTS_LOCK_FLAGS_TYPE_MUTEX;
+ lc.taken_options = 0;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -2459,7 +2414,7 @@ erts_rwmtx_set_reader_group(int no)
#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_check_no_locked_of_type(ERTS_LC_FLG_LT_RWMUTEX);
+ erts_lc_check_no_locked_of_type(ERTS_LOCK_TYPE_RWMUTEX);
#endif
res = ethr_rwmutex_set_reader_group(no);
if (res != 0)
@@ -2468,57 +2423,32 @@ erts_rwmtx_set_reader_group(int no)
}
ERTS_GLB_INLINE void
-erts_rwmtx_init_opt_x(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name,
- Eterm extra)
-{
+erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx, erts_rwmtx_opt_t *opt,
+ char *name, Eterm extra, erts_lock_flags_t flags) {
#ifdef USE_THREADS
int res = ethr_rwmutex_init_opt(&rwmtx->rwmtx, opt);
- if (res != 0)
- erts_thr_fatal_error(res, "initialize rwmutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&rwmtx->lc, name, ERTS_LC_FLG_LT_RWMUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- if (name && name[0] == '\0')
- erts_lcnt_init_lock_x(&rwmtx->lcnt, NULL, ERTS_LCNT_LT_RWMUTEX, extra);
- else
- erts_lcnt_init_lock_x(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX, extra);
-#endif
-#endif
-}
+ if (res != 0) {
+ erts_thr_fatal_error(res, "initialize rwmutex");
+ }
-ERTS_GLB_INLINE void
-erts_rwmtx_init_x(erts_rwmtx_t *rwmtx,
- char *name,
- Eterm extra)
-{
- erts_rwmtx_init_opt_x(rwmtx, NULL, name, extra);
-}
+ flags |= ERTS_LOCK_TYPE_RWMUTEX;
+#ifdef DEBUG
+ rwmtx->flags = flags;
+#endif
-ERTS_GLB_INLINE void
-erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name)
-{
-#ifdef USE_THREADS
- int res = ethr_rwmutex_init_opt(&rwmtx->rwmtx, opt);
- if (res != 0)
- erts_thr_fatal_error(res, "initialize rwmutex");
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&rwmtx->lc, name, ERTS_LC_FLG_LT_RWMUTEX);
+ erts_lc_init_lock_x(&rwmtx->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX);
-#endif
+ erts_lcnt_init_ref_x(&rwmtx->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
-erts_rwmtx_init(erts_rwmtx_t *rwmtx, char *name)
-{
- erts_rwmtx_init_opt(rwmtx, NULL, name);
+erts_rwmtx_init(erts_rwmtx_t *rwmtx, char *name, Eterm extra,
+ erts_lock_flags_t flags) {
+ erts_rwmtx_init_opt(rwmtx, NULL, name, extra, flags);
}
ERTS_GLB_INLINE void
@@ -2526,11 +2456,14 @@ erts_rwmtx_destroy(erts_rwmtx_t *rwmtx)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(rwmtx->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&rwmtx->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&rwmtx->lcnt);
+ erts_lcnt_uninstall(&rwmtx->lcnt);
#endif
res = ethr_rwmutex_destroy(&rwmtx->rwmtx);
if (res != 0) {
@@ -2558,7 +2491,7 @@ erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx)
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
- if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ))
+ if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ))
return EBUSY; /* Make sure caller can handle the situation without
causing a lock order violation */
#endif
@@ -2567,13 +2500,13 @@ erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx)
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ,file,line);
+ erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_READ,file,line);
#else
- erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ);
+ erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LOCK_OPTIONS_READ);
#endif
return res;
@@ -2592,13 +2525,13 @@ erts_rwmtx_rlock(erts_rwmtx_t *rwmtx)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LC_FLG_LO_READ,file,line);
+ erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ,file,line);
#else
- erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_lock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_rlock(&rwmtx->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -2612,10 +2545,10 @@ erts_rwmtx_runlock(erts_rwmtx_t *rwmtx)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_unlock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_runlock(&rwmtx->rwmtx);
#endif
@@ -2633,7 +2566,7 @@ erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx)
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
- if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE))
+ if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR))
return EBUSY; /* Make sure caller can handle the situation without
causing a lock order violation */
#endif
@@ -2642,13 +2575,13 @@ erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx)
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line);
+ erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
#else
- erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LOCK_OPTIONS_RDWR);
#endif
return res;
@@ -2667,13 +2600,13 @@ erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line);
+ erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
#else
- erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_lock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwlock(&rwmtx->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -2687,10 +2620,10 @@ erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_unlock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwunlock(&rwmtx->rwmtx);
#endif
@@ -2728,7 +2661,8 @@ erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
- lc.flags = ERTS_LC_FLG_LO_READ;
+ lc.flags = ERTS_LOCK_TYPE_RWMUTEX;
+ lc.taken_options = ERTS_LOCK_OPTIONS_READ;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -2742,7 +2676,8 @@ erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
- lc.flags = ERTS_LC_FLG_LO_READ|ERTS_LC_FLG_LO_WRITE;
+ lc.flags = ERTS_LOCK_TYPE_RWMUTEX;
+ lc.taken_options = ERTS_LOCK_OPTIONS_RDWR;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -3075,59 +3010,26 @@ erts_no_atomic64_read_bset(erts_no_atomic64_t *var,
/* spinlock */
ERTS_GLB_INLINE void
-erts_spinlock_init_x(erts_spinlock_t *lock, char *name, Eterm extra)
+erts_spinlock_init(erts_spinlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
int res = ethr_spinlock_init(&lock->slck);
- if (res)
- erts_thr_fatal_error(res, "init spinlock");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK, extra);
-#endif
-#else
- (void)lock;
-#endif
-}
+ if (res) {
+ erts_thr_fatal_error(res, "init spinlock");
+ }
-ERTS_GLB_INLINE void
-erts_spinlock_init_x_opt(erts_spinlock_t *lock, char *name, Eterm extra,
- Uint16 opt)
-{
-#ifdef USE_THREADS
- int res = ethr_spinlock_init(&lock->slck);
- if (res)
- erts_thr_fatal_error(res, "init spinlock");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK|opt, extra);
+ flags |= ERTS_LOCK_TYPE_SPINLOCK;
+#ifdef DEBUG
+ lock->flags = flags;
#endif
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_spinlock_init(erts_spinlock_t *lock, char *name)
-{
-#ifdef USE_THREADS
- int res = ethr_spinlock_init(&lock->slck);
- if (res)
- erts_thr_fatal_error(res, "init spinlock");
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK);
+ erts_lc_init_lock_x(&lock->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK);
-#endif
-#else
- (void)lock;
+ erts_lcnt_init_ref_x(&lock->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
@@ -3135,11 +3037,14 @@ erts_spinlock_destroy(erts_spinlock_t *lock)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(lock->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&lock->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&lock->lcnt);
+ erts_lcnt_uninstall(&lock->lcnt);
#endif
res = ethr_spinlock_destroy(&lock->slck);
if (res != 0) {
@@ -3207,7 +3112,8 @@ erts_lc_spinlock_is_locked(erts_spinlock_t *lock)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
- lc.flags = 0;
+ lc.flags = ERTS_LOCK_TYPE_SPINLOCK;
+ lc.taken_options = 0;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -3218,39 +3124,26 @@ erts_lc_spinlock_is_locked(erts_spinlock_t *lock)
/* rwspinlock */
ERTS_GLB_INLINE void
-erts_rwlock_init_x(erts_rwlock_t *lock, char *name, Eterm extra)
+erts_rwlock_init(erts_rwlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
int res = ethr_rwlock_init(&lock->rwlck);
- if (res)
- erts_thr_fatal_error(res, "init rwlock");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_RWSPINLOCK, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_RWSPINLOCK, extra);
-#endif
-#else
- (void)lock;
+ if (res) {
+ erts_thr_fatal_error(res, "init rwlock");
+ }
+
+ flags |= ERTS_LOCK_TYPE_RWSPINLOCK;
+#ifdef DEBUG
+ lock->flags = flags;
#endif
-}
-ERTS_GLB_INLINE void
-erts_rwlock_init(erts_rwlock_t *lock, char *name)
-{
-#ifdef USE_THREADS
- int res = ethr_rwlock_init(&lock->rwlck);
- if (res)
- erts_thr_fatal_error(res, "init rwlock");
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&lock->lc, name, ERTS_LC_FLG_LT_RWSPINLOCK);
+ erts_lc_init_lock_x(&lock->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&lock->lcnt, name, ERTS_LCNT_LT_RWSPINLOCK);
-#endif
-#else
- (void)lock;
+ erts_lcnt_init_ref_x(&lock->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
@@ -3258,11 +3151,14 @@ erts_rwlock_destroy(erts_rwlock_t *lock)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(lock->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&lock->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&lock->lcnt);
+ erts_lcnt_uninstall(&lock->lcnt);
#endif
res = ethr_rwlock_destroy(&lock->rwlck);
if (res != 0) {
@@ -3286,10 +3182,10 @@ erts_read_unlock(erts_rwlock_t *lock)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&lock->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_unlock_flg(&lock->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_read_unlock(&lock->rwlck);
#else
@@ -3307,13 +3203,13 @@ erts_read_lock(erts_rwlock_t *lock)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&lock->lc, ERTS_LC_FLG_LO_READ,file,line);
+ erts_lc_lock_flg_x(&lock->lc, ERTS_LOCK_OPTIONS_READ,file,line);
#else
- erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_lock_flg(&lock->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_lock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_read_lock(&lock->rwlck);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -3329,10 +3225,10 @@ erts_write_unlock(erts_rwlock_t *lock)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_unlock_flg(&lock->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_write_unlock(&lock->rwlck);
#else
@@ -3350,13 +3246,13 @@ erts_write_lock(erts_rwlock_t *lock)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line);
+ erts_lc_lock_flg_x(&lock->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
#else
- erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_lock_flg(&lock->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_lock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_write_lock(&lock->rwlck);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -3373,7 +3269,8 @@ erts_lc_rwlock_is_rlocked(erts_rwlock_t *lock)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
- lc.flags = ERTS_LC_FLG_LO_READ;
+ lc.flags = ERTS_LOCK_TYPE_RWSPINLOCK;
+ lc.taken_options = ERTS_LOCK_OPTIONS_READ;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -3387,7 +3284,8 @@ erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
- lc.flags = ERTS_LC_FLG_LO_READ|ERTS_LC_FLG_LO_WRITE;
+ lc.flags = ERTS_LOCK_TYPE_RWSPINLOCK;
+ lc.taken_options = ERTS_LOCK_OPTIONS_RDWR;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 0421adb409..f6bb52dde1 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -954,8 +954,10 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX);
- erts_smp_mtx_init(&erts_timeofday_mtx, "timeofday");
- erts_smp_mtx_init(&erts_get_time_mtx, "get_time");
+ erts_smp_mtx_init(&erts_timeofday_mtx, "timeofday", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ erts_smp_mtx_init(&erts_get_time_mtx, "get_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
time_sup.r.o.correction = time_correction;
time_sup.r.o.warp_mode = time_warp_mode;
@@ -1120,8 +1122,9 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&time_sup.inf.c.parmon.rwmtx,
- &rwmtx_opts, "get_corrected_time");
+ erts_smp_rwmtx_init_opt(&time_sup.inf.c.parmon.rwmtx, &rwmtx_opts,
+ "get_corrected_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
cdatap = &time_sup.inf.c.parmon.cdata;
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 4b06c55770..db7d0ac449 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -336,7 +336,8 @@ void erts_init_trace(void) {
rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&sys_trace_rwmtx, &rwmtx_opts, "sys_tracers");
+ erts_smp_rwmtx_init_opt(&sys_trace_rwmtx, &rwmtx_opts, "sys_tracers", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
#ifdef HAVE_ERTS_NOW_CPU
erts_cpu_timestamp = 0;
@@ -2625,7 +2626,8 @@ init_sys_msg_dispatcher(void)
sys_message_queue = NULL;
sys_message_queue_end = NULL;
erts_smp_cnd_init(&smq_cnd);
- erts_smp_mtx_init(&smq_mtx, "sys_msg_q");
+ erts_smp_mtx_init(&smq_mtx, "sys_msg_q", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
erts_smp_thr_create(&sys_msg_dispatcher_tid,
sys_msg_dispatcher_func,
NULL,
@@ -3185,7 +3187,9 @@ static void init_tracer_nif()
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&tracer_mtx, &rwmtx_opt, "tracer_mtx");
+
+ erts_smp_rwmtx_init_opt(&tracer_mtx, &rwmtx_opt, "tracer_mtx", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
erts_tracer_nif_clear();
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
index 57f5ba5436..828c833ffc 100644
--- a/erts/emulator/beam/export.c
+++ b/erts/emulator/beam/export.c
@@ -182,7 +182,8 @@ init_export_table(void)
HashFunctions f;
int i;
- erts_smp_mtx_init(&export_staging_lock, "export_tab");
+ erts_smp_mtx_init(&export_staging_lock, "export_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
erts_smp_atomic_init_nob(&total_entries_bytes, 0);
f.hash = (H_FUN) export_hash;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index fc95535ec3..182d3aa44e 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1183,7 +1183,8 @@ void erts_ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon);
Eterm erts_driver_monitor_to_ref(Eterm* hp, const ErlDrvMonitor *mon);
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT)
-void erts_lcnt_enable_io_lock_count(int enable);
+void erts_lcnt_update_driver_locks(int enable);
+void erts_lcnt_update_port_locks(int enable);
#endif
/* driver_tab.c */
@@ -1287,7 +1288,8 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen);
void bin_write(fmtfn_t, void*, byte*, size_t);
Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */
-Sint erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len);
+int erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written);
+Sint erts_unicode_list_to_buf_len(Eterm list);
struct Sint_buf {
#if defined(ARCH_64)
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 75545df80a..b609f6de39 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -258,14 +258,7 @@ static ERTS_INLINE void port_init_instr(Port *prt
#ifdef ERTS_SMP
ASSERT(prt->drv_ptr && prt->lock);
if (!prt->drv_ptr->lock) {
- char *lock_str = "port_lock";
-#ifdef ERTS_ENABLE_LOCK_COUNT
- Uint16 opt = ((erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)
- ? 0 : ERTS_LCNT_LT_DISABLE);
-#else
- Uint16 opt = 0;
-#endif
- erts_mtx_init_locked_x_opt(prt->lock, lock_str, id, opt);
+ erts_mtx_init_locked(prt->lock, "port_lock", id, ERTS_LOCK_FLAGS_CATEGORY_IO);
}
#endif
erts_port_task_init_sched(&prt->sched, id);
@@ -3399,9 +3392,8 @@ void erts_init_io(int port_tab_size,
else if (port_tab_size < ERTS_MIN_PORTS)
port_tab_size = ERTS_MIN_PORTS;
- erts_smp_rwmtx_init_opt(&erts_driver_list_lock,
- &drv_list_rwmtx_opts,
- "driver_list");
+ erts_smp_rwmtx_init_opt(&erts_driver_list_lock, &drv_list_rwmtx_opts, "driver_list", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
driver_list = NULL;
erts_smp_tsd_key_create(&driver_list_lock_status_key,
"erts_driver_list_lock_status_key");
@@ -3438,67 +3430,94 @@ void erts_init_io(int port_tab_size,
}
#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP)
-static ERTS_INLINE void lcnt_enable_drv_lock_count(erts_driver_t *dp, int enable)
+static void lcnt_enable_driver_lock_count(erts_driver_t *dp, int enable)
{
if (dp->lock) {
- if (enable)
- erts_lcnt_init_lock_x(&dp->lock->lcnt,
- "driver_lock",
- ERTS_LCNT_LT_MUTEX,
- erts_atom_put((byte*)dp->name,
- sys_strlen(dp->name),
- ERTS_ATOM_ENC_LATIN1,
- 1));
-
- else
- erts_lcnt_destroy_lock(&dp->lock->lcnt);
+ if (enable) {
+ Eterm name_as_atom = erts_atom_put((byte*)dp->name, sys_strlen(dp->name),
+ ERTS_ATOM_ENC_LATIN1, 1);
+ erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock", name_as_atom,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ } else {
+ erts_lcnt_uninstall(&dp->lock->lcnt);
+ }
}
}
-static ERTS_INLINE void lcnt_enable_port_lock_count(Port *prt, int enable)
+static void lcnt_enable_port_lock_count(Port *prt, int enable)
{
erts_aint32_t state = erts_atomic32_read_nob(&prt->state);
- if (!enable) {
- erts_lcnt_destroy_lock(&prt->sched.mtx.lcnt);
- if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK)
- erts_lcnt_destroy_lock(&prt->lock->lcnt);
+
+ if(enable) {
+ ErlDrvPDL pdl = prt->port_data_lock;
+
+ erts_lcnt_install_new_lock_info(&prt->sched.mtx.lcnt, "port_sched_lock",
+ prt->common.id, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+
+ if(pdl) {
+ erts_lcnt_install_new_lock_info(&pdl->mtx.lcnt, "port_data_lock",
+ prt->common.id, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
+
+ if(state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) {
+ erts_lcnt_install_new_lock_info(&prt->lock->lcnt, "port_lock",
+ prt->common.id, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
+ } else {
+ erts_lcnt_uninstall(&prt->sched.mtx.lcnt);
+
+ if(prt->port_data_lock) {
+ erts_lcnt_uninstall(&prt->port_data_lock->mtx.lcnt);
+ }
+
+ if(state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) {
+ erts_lcnt_uninstall(&prt->lock->lcnt);
+ }
}
- else {
- erts_lcnt_init_lock_x(&prt->sched.mtx.lcnt,
- "port_sched_lock",
- ERTS_LCNT_LT_MUTEX,
- prt->common.id);
- if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK)
- erts_lcnt_init_lock_x(&prt->lock->lcnt,
- "port_lock",
- ERTS_LCNT_LT_MUTEX,
- prt->common.id);
+}
+
+void erts_lcnt_update_driver_locks(int enable) {
+ erts_driver_t *driver;
+
+ lcnt_enable_driver_lock_count(&vanilla_driver, enable);
+ lcnt_enable_driver_lock_count(&spawn_driver, enable);
+#ifndef __WIN32__
+ lcnt_enable_driver_lock_count(&forker_driver, enable);
+#endif
+ lcnt_enable_driver_lock_count(&fd_driver, enable);
+
+ erts_rwmtx_rlock(&erts_driver_list_lock);
+
+ for (driver = driver_list; driver; driver = driver->next) {
+ lcnt_enable_driver_lock_count(driver, enable);
}
+
+ erts_rwmtx_runlock(&erts_driver_list_lock);
}
-void erts_lcnt_enable_io_lock_count(int enable) {
- erts_driver_t *dp;
- int ix, max = erts_ptab_max(&erts_port);
- Port *prt;
+void erts_lcnt_update_port_locks(int enable) {
+ int i, max;
- for (ix = 0; ix < max; ix++) {
- if ((prt = erts_pix2port(ix)) != NULL) {
- lcnt_enable_port_lock_count(prt, enable);
+ max = erts_ptab_max(&erts_port);
+
+ for(i = 0; i < max; i++) {
+ int delay_handle;
+ Port *port;
+
+ delay_handle = erts_thr_progress_unmanaged_delay();
+ port = erts_pix2port(i);
+
+ if(port != NULL) {
+ lcnt_enable_port_lock_count(port, enable);
}
- } /* for all ports */
- lcnt_enable_drv_lock_count(&vanilla_driver, enable);
- lcnt_enable_drv_lock_count(&spawn_driver, enable);
-#ifndef __WIN32__
- lcnt_enable_drv_lock_count(&forker_driver, enable);
-#endif
- lcnt_enable_drv_lock_count(&fd_driver, enable);
- /* enable lock counting in all drivers */
- for (dp = driver_list; dp; dp = dp->next) {
- lcnt_enable_drv_lock_count(dp, enable);
+ if(delay_handle != ERTS_THR_PRGR_DHANDLE_MANAGED) {
+ erts_thr_progress_unmanaged_continue(delay_handle);
+ }
}
-} /* enable/disable lock counting of ports */
+}
+
#endif /* defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) */
/*
* Buffering of data when using line oriented I/O on ports
@@ -3681,7 +3700,7 @@ deliver_result(Port *prt, Eterm sender, Eterm pid, Eterm res)
ERTS_SMP_CHK_NO_PROC_LOCKS;
ASSERT(!prt || prt->common.id == sender);
-#ifdef ERTS_SMP
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ASSERT(!prt || erts_lc_is_port_locked(prt));
#endif
@@ -7071,7 +7090,7 @@ driver_pdl_create(ErlDrvPort dp)
return NULL;
pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK,
sizeof(struct erl_drv_port_data_lock));
- erts_mtx_init_x(&pdl->mtx, "port_data_lock", pp->common.id);
+ erts_mtx_init(&pdl->mtx, "port_data_lock", pp->common.id, ERTS_LOCK_FLAGS_CATEGORY_IO);
pdl_init_refc(pdl);
erts_port_inc_refc(pp);
pdl->prt = pp;
@@ -8238,22 +8257,16 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
drv->flags = de->driver_flags;
drv->handle = handle;
#ifdef ERTS_SMP
- if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING)
- drv->lock = NULL;
- else {
- drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK,
- sizeof(erts_mtx_t));
- erts_mtx_init_x(drv->lock,
- "driver_lock",
-#if defined(ERTS_ENABLE_LOCK_CHECK) || defined(ERTS_ENABLE_LOCK_COUNT)
- erts_atom_put((byte *) drv->name,
- sys_strlen(drv->name),
- ERTS_ATOM_ENC_LATIN1,
- 1)
-#else
- NIL
-#endif
- );
+ if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING) {
+ drv->lock = NULL;
+ } else {
+ Eterm driver_id = erts_atom_put((byte *) drv->name,
+ sys_strlen(drv->name),
+ ERTS_ATOM_ENC_LATIN1, 1);
+
+ drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK, sizeof(erts_mtx_t));
+
+ erts_mtx_init(drv->lock, "driver_lock", driver_id, ERTS_LOCK_FLAGS_CATEGORY_IO);
}
#endif
drv->entry = de;
diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c
index 8ab6c713d6..7987cb2eb5 100644
--- a/erts/emulator/beam/module.c
+++ b/erts/emulator/beam/module.c
@@ -120,7 +120,8 @@ void init_module_table(void)
}
for (i=0; i<ERTS_NUM_CODE_IX; i++) {
- erts_smp_rwmtx_init_x(&the_old_code_rwlocks[i], "old_code", make_small(i));
+ erts_smp_rwmtx_init(&the_old_code_rwlocks[i], "old_code", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
erts_smp_atomic_init_nob(&tot_module_bytes, 0);
}
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index cdf9cb58b9..44613c7d85 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -1174,9 +1174,9 @@ bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action
%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action
-i_bs_get_binary_imm2 f x I I I d
-i_bs_get_binary2 f x I s I d
-i_bs_get_binary_all2 f x I I d
+i_bs_get_binary_imm2 f x I I I x
+i_bs_get_binary2 f x I s I x
+i_bs_get_binary_all2 f x I I x
i_bs_get_binary_all_reuse x f I
# Fetching float from binaries.
@@ -1186,7 +1186,7 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \
bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail
%macro: i_bs_get_float2 BsGetFloat2 -fail_action
-i_bs_get_float2 f x I s I d
+i_bs_get_float2 f x I s I x
# Miscellanous
diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c
index 7f60710124..bf3267cff1 100644
--- a/erts/emulator/beam/register.c
+++ b/erts/emulator/beam/register.c
@@ -145,7 +145,8 @@ void init_register_table(void)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&regtab_rwmtx, &rwmtx_opt, "reg_tab");
+ erts_smp_rwmtx_init_opt(&regtab_rwmtx, &rwmtx_opt, "reg_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) reg_hash;
f.cmp = (HCMP_FUN) reg_cmp;
diff --git a/erts/emulator/beam/safe_hash.c b/erts/emulator/beam/safe_hash.c
index 30b26a7296..527c9efeca 100644
--- a/erts/emulator/beam/safe_hash.c
+++ b/erts/emulator/beam/safe_hash.c
@@ -155,7 +155,8 @@ int safe_hash_table_sz(SafeHash *h)
** Init a pre allocated or static hash structure
** and allocate buckets. NOT SAFE
*/
-SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, int size, SafeHashFunctions fun)
+SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, erts_lock_flags_t flags,
+ int size, SafeHashFunctions fun)
{
int i, bytes;
@@ -170,7 +171,8 @@ SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, int size,
erts_smp_atomic_init_nob(&h->is_rehashing, 0);
erts_smp_atomic_init_nob(&h->nitems, 0);
for (i=0; i<SAFE_HASH_LOCK_CNT; i++) {
- erts_smp_mtx_init(&h->lock_vec[i].mtx,"safe_hash");
+ erts_smp_mtx_init(&h->lock_vec[i].mtx, "safe_hash", NIL,
+ flags);
}
return h;
}
@@ -273,5 +275,22 @@ void safe_hash_for_each(SafeHash* h, void (*func)(void *, void *), void *func_ar
}
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_hash_lock_count(SafeHash *h, erts_lock_flags_t flags, int enable) {
+ int i;
+
+ for(i = 0; i < SAFE_HASH_LOCK_CNT; i++) {
+ erts_smp_mtx_t *lock = &h->lock_vec[i].mtx;
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&lock->lcnt, "safe_hash", NIL,
+ ERTS_LOCK_TYPE_MUTEX | flags);
+ } else {
+ erts_lcnt_uninstall(&lock->lcnt);
+ }
+ }
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
+
#endif /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */
diff --git a/erts/emulator/beam/safe_hash.h b/erts/emulator/beam/safe_hash.h
index 285103cb17..dde48a6de8 100644
--- a/erts/emulator/beam/safe_hash.h
+++ b/erts/emulator/beam/safe_hash.h
@@ -28,6 +28,7 @@
#include "sys.h"
#include "erl_alloc.h"
+#include "erl_lock_flags.h"
typedef unsigned long SafeHashValue;
@@ -85,7 +86,7 @@ typedef struct
/* A: Lockless atomics */
} SafeHash;
-SafeHash* safe_hash_init(ErtsAlcType_t, SafeHash*, char*, int, SafeHashFunctions);
+SafeHash* safe_hash_init(ErtsAlcType_t, SafeHash*, char*, erts_lock_flags_t, int, SafeHashFunctions);
void safe_hash_get_info(SafeHashInfo*, SafeHash*);
int safe_hash_table_sz(SafeHash *);
@@ -96,5 +97,9 @@ void* safe_hash_erase(SafeHash*, void*);
void safe_hash_for_each(SafeHash*, void (*func)(void *, void *), void *);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_hash_lock_count(SafeHash*, erts_lock_flags_t, int);
+#endif
+
#endif /* __SAFE_HASH_H__ */
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 457cada745..bab7352479 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -42,6 +42,7 @@
#include "dist.h"
#include "erl_printf.h"
#include "erl_threads.h"
+#include "erl_lock_count.h"
#include "erl_smp.h"
#include "erl_time.h"
#include "erl_thr_progress.h"
@@ -3634,13 +3635,78 @@ intlist_to_buf(Eterm list, char *buf, Sint len)
return -2; /* not enough space */
}
-/* Fill buf with the contents of the unicode list.
- * Return the number of bytes in the buffer,
- * or -1 for type error,
- * or -2 for not enough buffer space (buffer contains truncated result).
+/** @brief Fill buf with the UTF8 contents of the unicode list
+ * @param len Max number of characters to write.
+ * @param written NULL or bytes written.
+ * @return 0 ok,
+ * -1 type error,
+ * -2 list too long, only \c len characters written
*/
+int
+erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written)
+{
+ Eterm* listptr;
+ Sint sz = 0;
+ Sint val;
+ int res;
+
+ while (1) {
+ if (is_nil(list)) {
+ res = 0;
+ break;
+ }
+ if (is_not_list(list)) {
+ res = -1;
+ break;
+ }
+ listptr = list_val(list);
+
+ if (len-- <= 0) {
+ res = -2;
+ break;
+ }
+
+ if (is_not_small(CAR(listptr))) {
+ res = -1;
+ break;
+ }
+ val = signed_val(CAR(listptr));
+ if (0 <= val && val < 0x80) {
+ buf[sz] = val;
+ sz++;
+ } else if (val < 0x800) {
+ buf[sz+0] = 0xC0 | (val >> 6);
+ buf[sz+1] = 0x80 | (val & 0x3F);
+ sz += 2;
+ } else if (val < 0x10000UL) {
+ if (0xD800 <= val && val <= 0xDFFF) {
+ res = -1;
+ break;
+ }
+ buf[sz+0] = 0xE0 | (val >> 12);
+ buf[sz+1] = 0x80 | ((val >> 6) & 0x3F);
+ buf[sz+2] = 0x80 | (val & 0x3F);
+ sz += 3;
+ } else if (val < 0x110000) {
+ buf[sz+0] = 0xF0 | (val >> 18);
+ buf[sz+1] = 0x80 | ((val >> 12) & 0x3F);
+ buf[sz+2] = 0x80 | ((val >> 6) & 0x3F);
+ buf[sz+3] = 0x80 | (val & 0x3F);
+ sz += 4;
+ } else {
+ res = -1;
+ break;
+ }
+ list = CDR(listptr);
+ }
+
+ if (written)
+ *written = sz;
+ return res;
+}
+
Sint
-erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len)
+erts_unicode_list_to_buf_len(Eterm list)
{
Eterm* listptr;
Sint sz = 0;
@@ -3653,7 +3719,7 @@ erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len)
}
listptr = list_val(list);
- while (len-- > 0) {
+ while (1) {
Sint val;
if (is_not_small(CAR(listptr))) {
@@ -3661,25 +3727,15 @@ erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len)
}
val = signed_val(CAR(listptr));
if (0 <= val && val < 0x80) {
- buf[sz] = val;
sz++;
} else if (val < 0x800) {
- buf[sz+0] = 0xC0 | (val >> 6);
- buf[sz+1] = 0x80 | (val & 0x3F);
sz += 2;
} else if (val < 0x10000UL) {
if (0xD800 <= val && val <= 0xDFFF) {
return -1;
}
- buf[sz+0] = 0xE0 | (val >> 12);
- buf[sz+1] = 0x80 | ((val >> 6) & 0x3F);
- buf[sz+2] = 0x80 | (val & 0x3F);
sz += 3;
} else if (val < 0x110000) {
- buf[sz+0] = 0xF0 | (val >> 18);
- buf[sz+1] = 0x80 | ((val >> 12) & 0x3F);
- buf[sz+2] = 0x80 | ((val >> 6) & 0x3F);
- buf[sz+3] = 0x80 | (val & 0x3F);
sz += 4;
} else {
return -1;
@@ -3693,7 +3749,6 @@ erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len)
}
listptr = list_val(list);
}
- return -2; /* not enough space */
}
/*
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index 1538191d67..3a7b3bb50c 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -742,7 +742,8 @@ file_init(void)
efile_init();
#ifdef USE_VM_PROBES
- erts_mtx_init(&dt_driver_mutex, "efile_drv dtrace mutex");
+ erts_mtx_init(&dt_driver_mutex, "efile_drv dtrace mutex", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
pthread_key_create(&dt_driver_key, NULL);
#endif /* USE_VM_PROBES */
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index e425b99f16..f3c1aa1c4a 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -108,16 +108,15 @@ static int lbuf_size = BUFSIZ;
static Uint32 *lbuf; /* The current line buffer */
static int llen; /* The current line length */
static int lpos; /* The current "cursor position" in the line buffer */
-
+ /* NOTE: not the same as column position a char may not take a"
+ * column to display or it might take many columns
+ */
/*
* Tags used in line buffer to show that these bytes represent special characters,
* Max unicode is 0x0010ffff, so we have lots of place for meta tags...
*/
#define CONTROL_TAG 0x10000000U /* Control character, value in first position */
#define ESCAPED_TAG 0x01000000U /* Escaped character, value in first position */
-#ifdef HAVE_WCWIDTH
-#define WIDE_TAG 0x02000000U /* Wide character, value in first position */
-#endif
#define TAG_MASK 0xFF000000U
#define MAXSIZE (1 << 16)
@@ -156,6 +155,8 @@ static int insert_buf(byte*,int);
static int write_buf(Uint32 *,int);
static int outc(int c);
static int move_cursor(int,int);
+static int cp_pos_to_col(int cp_pos);
+
/* Termcap functions. */
static int start_termcap(void);
@@ -991,24 +992,26 @@ static int del_chars(int n)
{
int i, l, r;
int pos;
+ int gcs; /* deleted grapheme characters */
update_cols();
/* Step forward or backwards over n logical characters. */
pos = step_over_chars(n);
-
+ DEBUGLOG(("del_chars: %d from %d %d %d\n", n, lpos, pos, llen));
if (pos > lpos) {
l = pos - lpos; /* Buffer characters to delete */
r = llen - lpos - l; /* Characters after deleted */
+ gcs = cp_pos_to_col(pos) - cp_pos_to_col(lpos);
/* Fix up buffer and buffer pointers. */
if (r > 0)
memmove(lbuf + lpos, lbuf + pos, r * sizeof(Uint32));
llen -= l;
/* Write out characters after, blank the tail and jump back to lpos. */
write_buf(lbuf + lpos, r);
- for (i = l ; i > 0; --i)
+ for (i = gcs ; i > 0; --i)
outc(' ');
- if (COL(llen+l) == 0 && xn)
+ if (xn && COL(cp_pos_to_col(llen)+gcs) == 0)
{
outc(' ');
move_left(1);
@@ -1018,7 +1021,7 @@ static int del_chars(int n)
else if (pos < lpos) {
l = lpos - pos; /* Buffer characters */
r = llen - lpos; /* Characters after deleted */
- move_cursor(lpos, lpos-l); /* Move back */
+ gcs = -move_cursor(lpos, lpos-l); /* Move back */
/* Fix up buffer and buffer pointers. */
if (r > 0)
memmove(lbuf + pos, lbuf + lpos, r * sizeof(Uint32));
@@ -1026,14 +1029,14 @@ static int del_chars(int n)
llen -= l;
/* Write out characters after, blank the tail and jump back to lpos. */
write_buf(lbuf + lpos, r);
- for (i = l ; i > 0; --i)
- outc(' ');
- if (COL(llen+l) == 0 && xn)
+ for (i = gcs ; i > 0; --i)
+ outc(' ');
+ if (xn && COL(cp_pos_to_col(llen)+gcs) == 0)
{
- outc(' ');
- move_left(1);
+ outc(' ');
+ move_left(1);
}
- move_cursor(llen + l, lpos);
+ move_cursor(llen + l, lpos);
}
return TRUE;
}
@@ -1047,22 +1050,12 @@ static int step_over_chars(int n)
end = lbuf + llen;
c = lbuf + lpos;
for ( ; n > 0 && c < end; --n) {
-#ifdef HAVE_WCWIDTH
- while (*c & WIDE_TAG) {
- c++;
- }
-#endif
c++;
while (c < end && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0))
c++;
}
for ( ; n < 0 && c > beg; n++) {
--c;
-#ifdef HAVE_WCWIDTH
- while (c > beg + 1 && (c[-1] & WIDE_TAG)) {
- --c;
- }
-#endif
while (c > beg && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0))
--c;
}
@@ -1088,15 +1081,6 @@ static int insert_buf(byte *s, int n)
++pos;
}
if ((utf8_mode && (ch >= 128 || isprint(ch))) || (ch <= 255 && isprint(ch))) {
-#ifdef HAVE_WCWIDTH
- int width;
- if ((width = wcwidth(ch)) > 1) {
- while (--width) {
- DEBUGLOG(("insert_buf: Wide(UTF-8):%d,%d",width,ch));
- lbuf[lpos++] = (WIDE_TAG | ((Uint32) ch));
- }
- }
-#endif
DEBUGLOG(("insert_buf: Printable(UTF-8):%d",ch));
lbuf[lpos++] = (Uint32) ch;
} else if (ch >= 128) { /* not utf8 mode */
@@ -1110,15 +1094,13 @@ static int insert_buf(byte *s, int n)
lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch));
ch = 0;
} while (lpos % 8);
- } else if (ch == '\e' || ch == '\n' || ch == '\r') {
+ } else if (ch == '\e') {
+ lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch));
+ } else if (ch == '\n' || ch == '\r') {
write_buf(lbuf + buffpos, lpos - buffpos);
- if (ch == '\e') {
- outc('\e');
- } else {
outc('\r');
if (ch == '\n')
outc('\n');
- }
if (llen > lpos) {
memcpy(lbuf, lbuf + lpos, llen - lpos);
}
@@ -1166,14 +1148,17 @@ static int write_buf(Uint32 *s, int n)
}
--n;
++s;
- }
- else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) {
+ } else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) {
outc(lastput = ' ');
--n; s++;
while (n > 0 && *s == CONTROL_TAG) {
outc(lastput = ' ');
--n; s++;
}
+ } else if (*s == (CONTROL_TAG | ((Uint32) '\e'))) {
+ outc('\e');
+ --n;
+ ++s;
} else if (*s & CONTROL_TAG) {
outc('^');
outc(lastput = ((byte) ((*s == 0177) ? '?' : *s | 0x40)));
@@ -1204,10 +1189,6 @@ static int write_buf(Uint32 *s, int n)
if (octbuff != octtmp) {
driver_free(octbuff);
}
-#ifdef HAVE_WCWIDTH
- } else if (*s & WIDE_TAG) {
- --n; s++;
-#endif
} else {
DEBUGLOG(("write_buf: Very unexpected character %d",(int) *s));
++n;
@@ -1216,7 +1197,7 @@ static int write_buf(Uint32 *s, int n)
}
/* Check landed in first column of new line and have 'xn' bug. */
n = s - lbuf;
- if (COL(n) == 0 && xn && n != 0) {
+ if (xn && n != 0 && COL(cp_pos_to_col(n)) == 0) {
if (n >= llen) {
outc(' ');
} else if (lastput == 0) { /* A multibyte UTF8 character */
@@ -1246,14 +1227,19 @@ static int outc(int c)
return 1;
}
-static int move_cursor(int from, int to)
+static int move_cursor(int from_pos, int to_pos)
{
+ int from_col, to_col;
int dc, dl;
-
update_cols();
- dc = COL(to) - COL(from);
- dl = LINE(to) - LINE(from);
+ from_col = cp_pos_to_col(from_pos);
+ to_col = cp_pos_to_col(to_pos);
+
+ dc = COL(to_col) - COL(from_col);
+ dl = LINE(to_col) - LINE(from_col);
+ DEBUGLOG(("move_cursor: from %d %d to %d %d => %d %d\n",
+ from_pos, from_col, to_pos, to_col, dl, dc));
if (dl > 0)
move_down(dl);
else if (dl < 0)
@@ -1262,7 +1248,29 @@ static int move_cursor(int from, int to)
move_right(dc);
else if (dc < 0)
move_left(-dc);
- return TRUE;
+ return to_col-from_col;
+}
+
+static int cp_pos_to_col(int cp_pos)
+{
+#ifdef HAVE_WCWIDTH
+ int i;
+ int col = 0;
+
+ for (i = 0; i < cp_pos; i++) {
+ int w = wcwidth(lbuf[i]);
+ if (w > 0) {
+ col += w;
+ }
+ }
+ return col;
+#else
+ /*
+ * We dont' have any character width information. Assume that
+ * code points are one column wide.
+ */
+ return cp_pos;
+#endif
}
static int start_termcap(void)
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index 0225f17613..94bc563fda 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -1129,7 +1129,8 @@ struct hipe_ref {
static inline void hipe_mfa_info_table_init_lock(void)
{
- erts_smp_rwmtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock");
+ erts_smp_rwmtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
static inline void hipe_mfa_info_table_rlock(void)
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index ad580e7d52..799f67fc45 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -2564,24 +2564,22 @@ ERTS_CIO_EXPORT(erts_init_check_io)(void)
#ifdef ERTS_SMP
init_removed_fd_alloc();
pollset.removed_list = NULL;
- erts_smp_spinlock_init(&pollset.removed_list_lock,
- "pollset_rm_list");
+ erts_smp_spinlock_init(&pollset.removed_list_lock, "pollset_rm_list", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
{
- int i;
- for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) {
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_smp_mtx_init_x(&drv_ev_state_locks[i].lck, "drv_ev_state", make_small(i));
-#else
- erts_smp_mtx_init(&drv_ev_state_locks[i].lck, "drv_ev_state");
-#endif
- }
+ int i;
+ for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) {
+ erts_smp_mtx_init(&drv_ev_state_locks[i].lck, "drv_ev_state", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
}
#endif
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
max_fds = ERTS_CIO_POLL_MAX_FDS();
erts_smp_atomic_init_nob(&drv_ev_state_len, 0);
drv_ev_state = NULL;
- erts_smp_mtx_init(&drv_ev_state_grow_lock, "drv_ev_state_grow");
+ erts_smp_mtx_init(&drv_ev_state_grow_lock, "drv_ev_state_grow", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
#else
{
SafeHashFunctions hf;
@@ -2591,10 +2589,11 @@ ERTS_CIO_EXPORT(erts_init_check_io)(void)
hf.free = &drv_ev_state_free;
num_state_prealloc = 0;
state_prealloc_first = NULL;
- erts_smp_spinlock_init(&state_prealloc_lock,"state_prealloc");
+ erts_smp_spinlock_init(&state_prealloc_lock,"state_prealloc", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
- safe_hash_init(ERTS_ALC_T_DRV_EV_STATE, &drv_ev_state_tab, "drv_ev_state_tab",
- DRV_EV_STATE_HTAB_SIZE, hf);
+ safe_hash_init(ERTS_ALC_T_DRV_EV_STATE, &drv_ev_state_tab, "drv_ev_state_tab",
+ ERTS_LOCK_FLAGS_CATEGORY_IO, DRV_EV_STATE_HTAB_SIZE, hf);
}
#endif
}
@@ -3130,3 +3129,12 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(ErtsCheckIoDebugInfo *ciodip)
return counters.num_errors;
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void ERTS_CIO_EXPORT(erts_lcnt_update_cio_locks)(int enable) {
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ erts_lcnt_enable_hash_lock_count(&drv_ev_state_tab, ERTS_LOCK_FLAGS_CATEGORY_IO, enable);
+#else
+ (void)enable;
+#endif
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h
index ee4abeece9..2d3bb98afa 100644
--- a/erts/emulator/sys/common/erl_check_io.h
+++ b/erts/emulator/sys/common/erl_check_io.h
@@ -59,6 +59,11 @@ void erts_init_check_io_nkp(void);
int erts_check_io_debug_kp(ErtsCheckIoDebugInfo *);
int erts_check_io_debug_nkp(ErtsCheckIoDebugInfo *);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_cio_locks_kp(int enable);
+void erts_lcnt_update_cio_locks_nkp(int enable);
+#endif
+
#else /* !ERTS_ENABLE_KERNEL_POLL */
Uint erts_check_io_size(void);
@@ -72,6 +77,10 @@ void erts_check_io_interrupt_timed(int, ErtsMonotonicTime);
void erts_check_io(int);
void erts_init_check_io(void);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_cio_locks(int enable);
+#endif
+
#endif
extern erts_smp_atomic_t erts_check_io_time;
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index bb930ff03b..214ed01c82 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -2212,9 +2212,11 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
erts_exit(1, "erts_mmap: Failed to open /dev/zero\n");
#endif
- erts_smp_mtx_init(&mm->mtx, "erts_mmap");
+ erts_smp_mtx_init(&mm->mtx, "erts_mmap", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
if (is_first_call) {
- erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+ erts_mtx_init(&am.init_mutex, "mmap_init_atoms", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
@@ -2816,7 +2818,8 @@ static void hard_dbg_mseg_init(void)
{
ErtsFreeSegDesc_fake* p;
- erts_mtx_init(&hard_dbg_mseg_mtx, "hard_dbg_mseg");
+ erts_mtx_init(&hard_dbg_mseg_mtx, "hard_dbg_mseg", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
hard_dbg_mseg_tree.root = NULL;
hard_dbg_mseg_tree.order = ADDR_ORDER;
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index b8f0bb7150..d69a79dc2a 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -1420,7 +1420,8 @@ erts_mseg_init(ErtsMsegInit_t *init)
atoms_initialized = 0;
- erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
+ erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
#ifdef ERTS_HAVE_EXEC_MMAPPER
/* Initialize erts_exec_mapper *FIRST*, to increase probability
@@ -1449,7 +1450,8 @@ erts_mseg_init(ErtsMsegInit_t *init)
ma->is_thread_safe = 0;
else {
ma->is_thread_safe = 1;
- erts_mtx_init(&ma->mtx, "mseg");
+ erts_mtx_init(&ma->mtx, "mseg", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
}
ma->is_cache_check_scheduled = 0;
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 5e7ae8953a..52a8b6a53f 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -336,7 +336,7 @@ static void fatal_error_async_signal_safe(char *error_str);
static int max_fds = -1;
static ErtsPollSet pollsets;
-static erts_smp_spinlock_t pollsets_lock;
+static erts_smp_mtx_t pollsets_lock;
#if ERTS_POLL_USE_POLL
@@ -2583,7 +2583,8 @@ ERTS_POLL_EXPORT(erts_poll_max_fds)(void)
void
ERTS_POLL_EXPORT(erts_poll_init)(void)
{
- erts_smp_spinlock_init(&pollsets_lock, "pollsets_lock");
+ erts_smp_mtx_init(&pollsets_lock, "pollsets_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
pollsets = NULL;
errno = 0;
@@ -2689,7 +2690,7 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
#endif
#ifdef ERTS_SMP
erts_atomic32_init_nob(&ps->polled, 0);
- erts_smp_mtx_init(&ps->mtx, "pollset");
+ erts_smp_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
erts_atomic32_init_nob(&ps->wakeup_state, (erts_aint32_t) 0);
@@ -2731,10 +2732,10 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
#endif
erts_smp_atomic_set_nob(&ps->no_of_user_fds, 0); /* Don't count wakeup pipe and fallback fd */
- erts_smp_spin_lock(&pollsets_lock);
+ erts_smp_mtx_lock(&pollsets_lock);
ps->next = pollsets;
pollsets = ps;
- erts_smp_spin_unlock(&pollsets_lock);
+ erts_smp_mtx_unlock(&pollsets_lock);
return ps;
}
@@ -2795,7 +2796,7 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps)
close(ps->timer_fd);
#endif
- erts_smp_spin_lock(&pollsets_lock);
+ erts_smp_mtx_lock(&pollsets_lock);
if (ps == pollsets)
pollsets = pollsets->next;
else {
@@ -2805,7 +2806,7 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps)
ASSERT(ps == prev_ps->next);
prev_ps->next = ps->next;
}
- erts_smp_spin_unlock(&pollsets_lock);
+ erts_smp_mtx_unlock(&pollsets_lock);
erts_free(ERTS_ALC_T_POLLSET, (void *) ps);
}
@@ -3148,3 +3149,26 @@ print_misc_debug_info(void)
}
#endif
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+static void erts_lcnt_enable_pollset_lock_count(ErtsPollSet pollset, int enable) {
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&pollset->mtx.lcnt, "pollset_rm", NIL,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ } else {
+ erts_lcnt_uninstall(&pollset->mtx.lcnt);
+ }
+}
+
+void ERTS_POLL_EXPORT(erts_lcnt_update_pollset_locks)(int enable) {
+ ErtsPollSet iterator;
+
+ erts_smp_mtx_lock(&pollsets_lock);
+
+ for(iterator = pollsets; iterator != NULL; iterator = iterator->next) {
+ erts_lcnt_enable_pollset_lock_count(iterator, enable);
+ }
+
+ erts_smp_mtx_unlock(&pollsets_lock);
+}
+#endif
diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h
index c16122610d..b3b4d79984 100644
--- a/erts/emulator/sys/common/erl_poll.h
+++ b/erts/emulator/sys/common/erl_poll.h
@@ -260,4 +260,8 @@ void ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet,
int erts_poll_new_table_len(int old_len, int need_len);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void ERTS_POLL_EXPORT(erts_lcnt_update_pollset_locks)(int enable);
+#endif
+
#endif /* #ifndef ERL_POLL_H__ */
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index 5cf0a49972..50d8a35217 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -438,14 +438,18 @@ erts_sys_pre_init(void)
/* After creation in parent */
eid.thread_create_parent_func = thr_create_cleanup,
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_pre_thr_init();
+#endif
+
erts_thr_init(&eid);
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init();
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_post_thr_init();
#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init();
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_init();
#endif
#endif /* USE_THREADS */
@@ -1545,7 +1549,8 @@ erl_sys_args(int* argc, char** argv)
{
int i, j;
- erts_smp_rwmtx_init(&environ_rwmtx, "environ");
+ erts_smp_rwmtx_init(&environ_rwmtx, "environ", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
i = 1;
diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c
index 4f26639703..102ef7bebf 100644
--- a/erts/emulator/sys/unix/sys_time.c
+++ b/erts/emulator/sys/unix/sys_time.c
@@ -304,8 +304,8 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
erts_sys_time_data__.r.o.os_times =
clock_gettime_times_verified;
#endif
- erts_smp_mtx_init(&internal_state.w.f.mtx,
- "os_monotonic_time");
+ erts_smp_mtx_init(&internal_state.w.f.mtx, "os_monotonic_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
internal_state.w.f.last_delivered
= clock_gettime_monotonic();
init_resp->os_monotonic_time_info.locked_use = 1;
diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c
index b10fc1e430..8743f83a50 100644
--- a/erts/emulator/sys/win32/erl_poll.c
+++ b/erts/emulator/sys/win32/erl_poll.c
@@ -142,7 +142,8 @@ static erts_mtx_t save_ops_mtx;
static void poll_debug_init(void)
{
- erts_mtx_init(&save_ops_mtx, "save_ops_lock");
+ erts_mtx_init(&save_ops_mtx, "save_ops_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
}
void poll_debug_set_active_fd(ErtsSysFdType fd)
@@ -677,7 +678,7 @@ static void new_waiter(ErtsPollSet ps)
w->active_events = 1;
w->highwater = 1;
w->total_events = 1;
- erts_mtx_init(&w->mtx, "pollwaiter");
+ erts_mtx_init(&w->mtx, "pollwaiter", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
/*
@@ -1359,7 +1360,7 @@ ErtsPollSet erts_poll_create_pollset(void)
erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
#ifdef ERTS_SMP
- erts_smp_mtx_init(&ps->mtx, "pollset");
+ erts_smp_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
init_timeout_time(ps);
@@ -1411,7 +1412,8 @@ void erts_poll_init(void)
HARDTRACEF(("In erts_poll_init"));
erts_sys_break_event = CreateManualEvent(FALSE);
- erts_mtx_init(&break_waiter_lock,"break_waiter_lock");
+ erts_mtx_init(&break_waiter_lock, "break_waiter_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
break_happened_event = CreateManualEvent(FALSE);
erts_atomic32_init_nob(&break_waiter_state, 0);
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 28019e306c..15c59109b1 100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -3195,15 +3195,22 @@ erts_sys_pre_init(void)
/* After creation in parent */
eid.thread_create_parent_func = thr_create_cleanup;
- erts_thr_init(&eid);
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init();
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_pre_thr_init();
#endif
+
+ erts_thr_init(&eid);
+
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init();
+ erts_lcnt_post_thr_init();
#endif
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_init();
#endif
+#endif /* USE_THREADS */
+
erts_init_sys_time_sup();
erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c
index 21ef71ad9a..8fcee1cbb6 100644
--- a/erts/emulator/sys/win32/sys_env.c
+++ b/erts/emulator/sys/win32/sys_env.c
@@ -37,7 +37,8 @@ static erts_smp_rwmtx_t environ_rwmtx;
void
erts_sys_env_init(void)
{
- erts_smp_rwmtx_init(&environ_rwmtx, "environ");
+ erts_smp_rwmtx_init(&environ_rwmtx, "environ", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
int
diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c
index e8c67b3928..88131aaa6a 100644
--- a/erts/emulator/sys/win32/sys_time.c
+++ b/erts/emulator/sys/win32/sys_time.c
@@ -300,8 +300,8 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
module = GetModuleHandle(kernel_dll_name);
if (!module) {
get_tick_count:
- erts_smp_mtx_init(&internal_state.w.f.mtime_mtx,
- "os_monotonic_time");
+ erts_smp_mtx_init(&internal_state.w.f.mtime_mtx, "os_monotonic_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
internal_state.w.f.wrap = 0;
internal_state.w.f.last_tick_count = 0;
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index fcd7244ae9..370fcb0f3a 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -73,6 +73,7 @@ MODULES= \
hipe_SUITE \
list_bif_SUITE \
lttng_SUITE \
+ lcnt_SUITE \
map_SUITE \
match_spec_SUITE \
module_info_SUITE \
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index 339c827602..2320870a0e 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -24,7 +24,7 @@
-include_lib("kernel/include/file.hrl").
-export([all/0, suite/0,
- display/1, display_huge/0,
+ display/1, display_huge/0, display_string/1,
erl_bif_types/1,guard_bifs_in_erl_bif_types/1,
shadow_comments/1,list_to_utf8_atom/1,
specs/1,improper_bif_stubs/1,auto_imports/1,
@@ -43,7 +43,7 @@ all() ->
[erl_bif_types, guard_bifs_in_erl_bif_types, shadow_comments,
specs, improper_bif_stubs, auto_imports,
t_list_to_existing_atom, os_env, otp_7526,
- display, list_to_utf8_atom,
+ display, display_string, list_to_utf8_atom,
atom_to_binary, binary_to_atom, binary_to_existing_atom,
erl_crash_dump_bytes, min_max, erlang_halt, is_builtin,
error_stacktrace, error_stacktrace_during_call_trace].
@@ -68,6 +68,28 @@ deeep(N,Acc) ->
deeep(N) ->
deeep(N,[hello]).
+display_string(Config) when is_list(Config) ->
+ true = erlang:display_string("hej"),
+ true = erlang:display_string(""),
+ true = erlang:display_string("hopp"),
+ true = erlang:display_string("\n"),
+ true = erlang:display_string(lists:seq(1100,1200)),
+ {error,badarg} = try
+ erlang:display_string(atom),
+ ok
+ catch
+ T0:E0 ->
+ {T0, E0}
+ end,
+ {error,badarg} = try
+ erlang:display_string(make_ref()),
+ ok
+ catch
+ T1:E1 ->
+ {T1, E1}
+ end,
+ ok.
+
erl_bif_types(Config) when is_list(Config) ->
ensure_erl_bif_types_compiled(),
@@ -691,6 +713,9 @@ erlang_halt(Config) when is_list(Config) ->
{badrpc,nodedown} = rpc:call(N3, erlang, halt, [0,[]]),
{ok,N4} = slave:start(H, halt_node4),
{badrpc,nodedown} = rpc:call(N4, erlang, halt, [lists:duplicate(300,$x)]),
+ %% Test unicode slogan
+ {ok,N4} = slave:start(H, halt_node4),
+ {badrpc,nodedown} = rpc:call(N4, erlang, halt, [[339,338,254,230,198,295,167,223,32,12507,12531,12480]]),
% This test triggers a segfault when dumping a crash dump
% to make sure that we can handle it properly.
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index e4640909aa..7d29ebec52 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -22,6 +22,7 @@
-export([all/0, suite/0,
bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1,
+ bad_arglist/1,
equality/1,ordering/1,
fun_to_port/1,t_phash/1,t_phash2/1,md5/1,
refc/1,refc_ets/1,refc_dist/1,
@@ -39,6 +40,7 @@ suite() ->
all() ->
[bad_apply, bad_fun_call, badarity, ext_badarity,
+ bad_arglist,
equality, ordering, fun_to_port, t_phash,
t_phash2, md5, refc, refc_ets, refc_dist,
const_propagation, t_arity, t_is_function2, t_fun_info,
@@ -107,6 +109,18 @@ bad_call_fc(Fun) ->
ct:fail({bad_result,Other})
end.
+% Test erlang:apply with non-proper arg-list
+bad_arglist(Config) when is_list(Config) ->
+ Fun = fun(A,B) -> A+B end,
+ {'EXIT', {badarg,_}} = (catch apply(Fun, 17)),
+ {'EXIT', {badarg,_}} = (catch apply(Fun, [17|18])),
+ {'EXIT', {badarg,_}} = (catch apply(Fun, [17,18|19])),
+ {'EXIT', {badarg,_}} = (catch apply(lists,seq, 17)),
+ {'EXIT', {badarg,_}} = (catch apply(lists,seq, [17|18])),
+ {'EXIT', {badarg,_}} = (catch apply(lists,seq, [17,18|19])),
+ ok.
+
+
%% Call and apply valid funs with wrong number of arguments.
badarity(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl
new file mode 100644
index 0000000000..504b9b54cf
--- /dev/null
+++ b/erts/emulator/test/lcnt_SUITE.erl
@@ -0,0 +1,156 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(lcnt_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+-export(
+ [all/0, suite/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2]).
+
+-export(
+ [toggle_lock_counting/1, error_on_invalid_category/1, preserve_locks/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
+
+all() ->
+ [toggle_lock_counting, error_on_invalid_category, preserve_locks].
+
+init_per_suite(Config) ->
+ case erlang:system_info(lock_counting) of
+ true ->
+ %% The tests will run straight over these properties, so we have to
+ %% preserve them to avoid tainting the other tests.
+ OldCopySave = erts_debug:lcnt_control(copy_save),
+ OldMask = erts_debug:lcnt_control(mask),
+ [{lcnt_SUITE, {OldCopySave, OldMask}} | Config];
+ _ ->
+ {skip, "Lock counting is not enabled"}
+ end.
+
+end_per_suite(Config) ->
+ {OldCopySave, OldMask} = proplists:get_value(lcnt_SUITE, Config),
+
+ erts_debug:lcnt_control(copy_save, OldCopySave),
+ OldCopySave = erts_debug:lcnt_control(copy_save),
+
+ erts_debug:lcnt_control(mask, OldMask),
+ OldMask = erts_debug:lcnt_control(mask),
+
+ erts_debug:lcnt_clear(),
+ ok.
+
+init_per_testcase(_Case, Config) ->
+ disable_lock_counting(),
+ Config.
+
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+disable_lock_counting() ->
+ ok = erts_debug:lcnt_control(copy_save, false),
+ ok = erts_debug:lcnt_control(mask, []),
+ ok = erts_debug:lcnt_clear(),
+
+ %% Sanity check.
+ false = erts_debug:lcnt_control(copy_save),
+ [] = erts_debug:lcnt_control(mask),
+
+ %% The above commands rely on some lazy operations, so we'll have to wait
+ %% for the list to clear.
+ ok = wait_for_empty_lock_list().
+
+wait_for_empty_lock_list() ->
+ wait_for_empty_lock_list(10).
+wait_for_empty_lock_list(Tries) when Tries > 0 ->
+ try_flush_cleanup_ops(),
+ case erts_debug:lcnt_collect() of
+ [{duration, _}, {locks, []}] ->
+ ok;
+ _ ->
+ timer:sleep(50),
+ wait_for_empty_lock_list(Tries - 1)
+ end;
+wait_for_empty_lock_list(0) ->
+ ct:fail("Lock list failed to clear after disabling lock counting.").
+
+%% Queue up a lot of thread progress cleanup ops in a vain attempt to
+%% flush the lock list.
+try_flush_cleanup_ops() ->
+ false = lists:member(process, erts_debug:lcnt_control(mask)),
+ [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)].
+
+%%
+%% Test cases
+%%
+
+toggle_lock_counting(Config) when is_list(Config) ->
+ Categories =
+ [allocator, db, debug, distribution, generic, io, process, scheduler],
+ lists:foreach(
+ fun(Category) ->
+ Locks = get_lock_info_for(Category),
+ if
+ Locks =/= [] ->
+ disable_lock_counting();
+ Locks =:= [] ->
+ ct:fail("Failed to toggle ~p locks.", [Category])
+ end
+ end, Categories).
+
+get_lock_info_for(Categories) when is_list(Categories) ->
+ ok = erts_debug:lcnt_control(mask, Categories),
+ [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(),
+ Locks;
+
+get_lock_info_for(Category) when is_atom(Category) ->
+ get_lock_info_for([Category]).
+
+preserve_locks(Config) when is_list(Config) ->
+ erts_debug:lcnt_control(mask, [process]),
+
+ erts_debug:lcnt_control(copy_save, true),
+ [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)],
+
+ %% Wait for the processes to be fully destroyed before disabling copy_save,
+ %% then remove all active locks from the list. (There's no foolproof method
+ %% to do this; sleeping before/after is the best way we have)
+ timer:sleep(500),
+
+ erts_debug:lcnt_control(copy_save, false),
+ erts_debug:lcnt_control(mask, []),
+
+ try_flush_cleanup_ops(),
+ timer:sleep(500),
+
+ case erts_debug:lcnt_collect() of
+ [{duration, _}, {locks, Locks}] when length(Locks) > 0 ->
+ ct:pal("Preserved ~p locks.", [length(Locks)]);
+ [{duration, _}, {locks, []}] ->
+ ct:fail("copy_save didn't preserve any locks.")
+ end.
+
+error_on_invalid_category(Config) when is_list(Config) ->
+ {error, badarg, q_invalid} = erts_debug:lcnt_control(mask, [q_invalid]),
+ ok.
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index 05c250125d..0337274178 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -2886,11 +2886,15 @@ nif_whereis_parallel(Config) when is_list(Config) ->
true = lists:all(PidReg, Procs),
%% tell them all to 'fire' as fast as we can
- [P ! {Ref, send_proc} || {_, P, _} <- Procs],
+ repeat(10, fun(_) ->
+ [P ! {Ref, send_proc} || {_, P, _} <- Procs]
+ end, void),
%% each gets forwarded through two processes
- true = lists:all(RecvNum, NSeq),
- true = lists:all(RecvNum, NSeq),
+ repeat(10, fun(_) ->
+ true = lists:all(RecvNum, NSeq),
+ true = lists:all(RecvNum, NSeq)
+ end, void),
%% tell them all to 'quit' by name
[N ! {Ref, quit} || {N, _, _} <- Procs],
diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl
index 43ae749498..49da94a775 100644
--- a/erts/emulator/test/register_SUITE.erl
+++ b/erts/emulator/test/register_SUITE.erl
@@ -44,14 +44,7 @@ all() ->
-define(OTP_8099_NAME, otp_8099_reg_proc).
otp_8099(Config) when is_list(Config) ->
- case catch erlang:system_info(lock_counting) of
- true -> {skipped,
- "Lock counting enabled. Current lock counting "
- "implementation cannot handle this many "
- "processes."};
- _ ->
- otp_8099_test(1000000)
- end.
+ otp_8099_test(1000000).
otp_8099_test(0) ->
ok;
diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in
index 583426460e..5b1b9119ce 100644
--- a/erts/etc/common/Makefile.in
+++ b/erts/etc/common/Makefile.in
@@ -57,7 +57,7 @@ ERTS_INCL = -I$(ERL_TOP)/erts/include \
CC = @CC@
WFLAGS = @WFLAGS@
CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSDIR) -I$(EMUDIR) \
- $(ERTS_INCL) -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\"
+ -I$(COMSYSDIR) $(ERTS_INCL) -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\"
LD = @LD@
LIBS = @LIBS@
LDFLAGS = @LDFLAGS@
@@ -70,13 +70,16 @@ endif
ifeq ($(TARGET),win32)
ifeq ($(TYPE),debug)
CFLAGS = $(subst -O2,-g,@CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSDIR) \
- -I$(EMUDIR) $(ERTS_INCL) -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\")
+ -I$(EMUDIR) -I$(COMSYSDIR) $(ERTS_INCL) \
+ -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\")
LDFLAGS += -g
endif
endif
+
BINDIR = $(ERL_TOP)/bin/$(TARGET)
OBJDIR = $(ERL_TOP)/erts/obj$(TYPEMARKER)/$(TARGET)
EMUDIR = $(ERL_TOP)/erts/emulator/beam
+COMSYSDIR = $(ERL_TOP)/erts/emulator/sys/common
EMUOSDIR = $(ERL_TOP)/erts/emulator/@ERLANG_OSTYPE@
SYSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@
DRVDIR = $(ERL_TOP)/erts/emulator/drivers/@ERLANG_OSTYPE@
diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c
index 7f0af77a4c..9cd5dd3fab 100644
--- a/erts/etc/common/escript.c
+++ b/erts/etc/common/escript.c
@@ -74,7 +74,6 @@ static void error(char* format, ...);
static void* emalloc(size_t size);
static void efree(void *p);
static char* strsave(char* string);
-static void push_words(char* src);
static int run_erlang(char* name, char** argv);
static char* get_default_emulator(char* progname);
#ifdef __WIN32__
@@ -583,26 +582,6 @@ main(int argc, char** argv)
return run_erlang(eargv[0], eargv);
}
-static void
-push_words(char* src)
-{
- char sbuf[PMAX];
- char* dst;
-
- dst = sbuf;
- while ((*dst++ = *src++) != '\0') {
- if (isspace((int)*src)) {
- *dst = '\0';
- PUSH(strsave(sbuf));
- dst = sbuf;
- do {
- src++;
- } while (isspace((int)*src));
- }
- }
- if (sbuf[0])
- PUSH(strsave(sbuf));
-}
#ifdef __WIN32__
wchar_t *make_commandline(char **argv)
{
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 838d59a512..806f8420ec 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -145,27 +145,37 @@ pgen_n2nconversion(_Erules,#typedef{name=TypeName,typespec=#type{def={'ENUMERATE
pgen_n2nconversion(_Erules,_) ->
true.
-pgen_name2numfunc(_TypeName,[], _) ->
+pgen_name2numfunc(TypeNameAsAtom,Mapping,Ext) when is_atom(TypeNameAsAtom) ->
+ FuncName = list_to_atom("name2num_"++atom_to_list(TypeNameAsAtom)),
+ pgen_name2numfunc1(FuncName,Mapping,Ext).
+
+pgen_name2numfunc1(_FuncName,[], _) ->
true;
-pgen_name2numfunc(TypeName,[{Atom,Number}], extension_marker) ->
- emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,";",nl]),
- emit(["name2num_",TypeName,"({asn1_enum, Num}) -> Num.",nl,nl]);
-pgen_name2numfunc(TypeName,[{Atom,Number}], _) ->
- emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,".",nl,nl]);
-pgen_name2numfunc(TypeName,[{Atom,Number}|NNRest], EM) ->
- emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,";",nl]),
- pgen_name2numfunc(TypeName,NNRest, EM).
-
-pgen_num2namefunc(_TypeName,[], _) ->
+pgen_name2numfunc1(FuncName,[{Atom,Number}], extension_marker) ->
+ emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,";",nl]),
+ emit([{asis,FuncName},"({asn1_enum, Num}) -> Num.",nl,nl]);
+pgen_name2numfunc1(FuncName,[{Atom,Number}], _) ->
+ emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,".",nl,nl]);
+pgen_name2numfunc1(FuncName,[{Atom,Number}|NNRest], EM) ->
+ emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,";",nl]),
+ pgen_name2numfunc1(FuncName,NNRest, EM).
+
+pgen_num2namefunc(TypeNameAsAtom,Mapping,Ext) when is_atom(TypeNameAsAtom) ->
+ FuncName = list_to_atom("num2name_"++atom_to_list(TypeNameAsAtom)),
+ pgen_num2namefunc1(FuncName,Mapping,Ext).
+
+pgen_num2namefunc1(_FuncName,[], _) ->
true;
-pgen_num2namefunc(TypeName,[{Atom,Number}], extension_marker) ->
- emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},";",nl]),
- emit(["num2name_",TypeName,"(ExtensionNum) -> {asn1_enum, ExtensionNum}.",nl,nl]);
-pgen_num2namefunc(TypeName,[{Atom,Number}], _) ->
- emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},".",nl,nl]);
-pgen_num2namefunc(TypeName,[{Atom,Number}|NNRest], EM) ->
- emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},";",nl]),
- pgen_num2namefunc(TypeName,NNRest, EM).
+pgen_num2namefunc1(FuncName,[{Atom,Number}], extension_marker) ->
+ emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},";",nl]),
+ emit([{asis,FuncName},"(ExtensionNum) -> {asn1_enum, ExtensionNum}.",nl,nl]);
+pgen_num2namefunc1(FuncName,[{Atom,Number}], _) ->
+ emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},".",nl,nl]);
+pgen_num2namefunc1(FuncName,[{Atom,Number}|NNRest], EM) ->
+ emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},";",nl]),
+ pgen_num2namefunc1(FuncName,NNRest, EM).
+
+
pgen_objects(_,_,_,[]) ->
true;
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index 69f226bcc0..c61cecca4c 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -1205,14 +1205,14 @@ testComment(Config) ->
testName2Number(Config) ->
N2NOptions0 = [{n2n,Type} ||
- Type <- ['CauseMisc', 'CauseProtocol',
- 'CauseRadioNetwork',
- 'CauseTransport','CauseNas']],
+ Type <- ['Cause-Misc', 'CauseProtocol']],
N2NOptions = [?NO_MAPS_MODULE|N2NOptions0],
- asn1_test_lib:compile("S1AP-IEs", Config, N2NOptions),
+ asn1_test_lib:compile("EnumN2N", Config, N2NOptions),
- 0 = 'S1AP-IEs':name2num_CauseMisc('control-processing-overload'),
- 'unknown-PLMN' = 'S1AP-IEs':num2name_CauseMisc(5),
+ 0 = 'EnumN2N':'name2num_Cause-Misc'('control-processing-overload'),
+ 'unknown-PLMN' = 'EnumN2N':'num2name_Cause-Misc'(5),
+ 4 = 'EnumN2N':name2num_CauseProtocol('semantic-error'),
+ 'transfer-syntax-error' = 'EnumN2N':num2name_CauseProtocol(0),
%% OTP-10144
%% Test that n2n option generates name2num and num2name functions supporting
diff --git a/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1 b/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1
index a724f2f3f5..a610eb6230 100644
--- a/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1
@@ -1,6 +1,28 @@
EnumN2N DEFINITIONS AUTOMATIC TAGS ::=
BEGIN
+Cause-Misc ::= ENUMERATED {
+ control-processing-overload,
+ not-enough-user-plane-processing-resources,
+ hardware-failure,
+ om-intervention,
+ unspecified,
+ unknown-PLMN,
+...
+}
+
+CauseProtocol ::= ENUMERATED {
+ transfer-syntax-error,
+ abstract-syntax-error-reject,
+ abstract-syntax-error-ignore-and-notify,
+ message-not-compatible-with-receiver-state,
+ semantic-error,
+ abstract-syntax-error-falsely-constructed-message,
+ unspecified,
+ ...
+}
+
+
NoExt ::= ENUMERATED {
blue(0),
red(1),
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index e0cd6da06f..d73060fb7e 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -395,10 +395,10 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
Op1 = expr(Op0, value, Sub),
As1 = expr_list(As0, value, Sub),
- case Op1 of
- #c_var{} ->
+ case cerl:is_data(Op1) of
+ false ->
App#c_apply{op=Op1,args=As1};
- _ ->
+ true ->
add_warning(App, invalid_call),
Err = #c_call{anno=Anno,
module=#c_literal{val=erlang},
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index f8839da42f..0e07e8dd2e 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -28,7 +28,8 @@
map_core_test/1,eval_case/1,bad_boolean_guard/1,
bs_shadowed_size_var/1,
cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1,
- cover_v3_kernel_4/1,cover_v3_kernel_5/1]).
+ cover_v3_kernel_4/1,cover_v3_kernel_5/1,
+ non_variable_apply/1]).
-include_lib("common_test/include/ct.hrl").
@@ -56,7 +57,8 @@ groups() ->
map_core_test,eval_case,bad_boolean_guard,
bs_shadowed_size_var,
cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3,
- cover_v3_kernel_4,cover_v3_kernel_5
+ cover_v3_kernel_4,cover_v3_kernel_5,
+ non_variable_apply
]}].
@@ -90,7 +92,7 @@ end_per_group(_GroupName, Config) ->
?comp(cover_v3_kernel_3).
?comp(cover_v3_kernel_4).
?comp(cover_v3_kernel_5).
-
+?comp(non_variable_apply).
try_it(Mod, Conf) ->
Src = filename:join(proplists:get_value(data_dir, Conf),
diff --git a/lib/compiler/test/core_SUITE_data/non_variable_apply.core b/lib/compiler/test/core_SUITE_data/non_variable_apply.core
new file mode 100644
index 0000000000..d9322cc455
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/non_variable_apply.core
@@ -0,0 +1,80 @@
+module 'non_variable_apply' ['module_info'/0,
+ 'module_info'/1,
+ 'non_variable_apply'/0]
+ attributes []
+
+'non_variable_apply'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <OkFun> =
+ fun (_@c0) ->
+ %% Line 5
+ case _@c0 of
+ <'ok'> when 'true' ->
+ 'ok'
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'-non_variable_apply/0-fun-0-',1}}] )
+ -| ['compiler_generated'] )
+ end
+ in let <F> =
+ fun (_@c5,_@c4) ->
+ %% Line 6
+ case <_@c5,_@c4> of
+ <F,X> when 'true' ->
+ apply apply 'id'/1 (F) (X)
+ ( <_@c7,_@c6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c7,_@c6})
+ -| [{'function_name',{'-non_variable_apply/0-fun-1-',2}}] )
+ -| ['compiler_generated'] )
+ end
+ in %% Line 9
+ apply F
+ (OkFun, 'ok')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'non_variable_apply',0}}] )
+ -| ['compiler_generated'] )
+ end
+'id'/1 =
+ %% Line 11
+ fun (_@c0) ->
+ case _@c0 of
+ <I> when 'true' ->
+ I
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'id',1}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('non_variable_apply')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'module_info',0}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/1 =
+ fun (_@c0) ->
+ case _@c0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('non_variable_apply', X)
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'module_info',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 688ec339aa..1d9c1e0f88 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -110,6 +110,10 @@
#endif
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+# define HAS_EVP_PKEY_CTX
+#endif
+
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
#include <openssl/modes.h>
@@ -433,13 +437,11 @@ static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NI
static ERL_NIF_TERM strong_rand_range_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_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -452,8 +454,6 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_
static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -506,13 +506,11 @@ static ErlNifFunc nif_funcs[] = {
{"strong_rand_range_nif", 1, strong_rand_range_nif},
{"rand_uniform_nif", 2, rand_uniform_nif},
{"mod_exp_nif", 4, mod_exp_nif},
- {"dss_verify_nif", 4, dss_verify_nif},
- {"rsa_verify_nif", 4, rsa_verify_nif},
{"do_exor", 2, do_exor},
{"rc4_set_key", 1, rc4_set_key},
{"rc4_encrypt_with_state", 2, rc4_encrypt_with_state},
- {"rsa_sign_nif", 3, rsa_sign_nif},
- {"dss_sign_nif", 3, dss_sign_nif},
+ {"pkey_sign_nif", 5, pkey_sign_nif},
+ {"pkey_verify_nif", 6, pkey_verify_nif},
{"rsa_public_crypt", 4, rsa_public_crypt},
{"rsa_private_crypt", 4, rsa_private_crypt},
{"rsa_generate_key_nif", 2, rsa_generate_key_nif},
@@ -525,8 +523,6 @@ static ErlNifFunc nif_funcs[] = {
{"srp_host_secret_nif", 5, srp_host_secret_nif},
{"ec_key_generate", 2, ec_key_generate},
- {"ecdsa_sign_nif", 4, ecdsa_sign_nif},
- {"ecdsa_verify_nif", 5, ecdsa_verify_nif},
{"ecdh_compute_key_nif", 3, ecdh_compute_key_nif},
{"rand_seed_nif", 1, rand_seed_nif},
@@ -589,6 +585,23 @@ static ERL_NIF_TERM atom_des_ecb;
static ERL_NIF_TERM atom_blowfish_ecb;
#endif
+static ERL_NIF_TERM atom_rsa;
+static ERL_NIF_TERM atom_dss;
+static ERL_NIF_TERM atom_ecdsa;
+static ERL_NIF_TERM atom_rsa_mgf1_md;
+static ERL_NIF_TERM atom_rsa_padding;
+static ERL_NIF_TERM atom_rsa_pkcs1_pss_padding;
+static ERL_NIF_TERM atom_rsa_x931_padding;
+static ERL_NIF_TERM atom_rsa_pss_saltlen;
+static ERL_NIF_TERM atom_sha224;
+static ERL_NIF_TERM atom_sha256;
+static ERL_NIF_TERM atom_sha384;
+static ERL_NIF_TERM atom_sha512;
+static ERL_NIF_TERM atom_md5;
+static ERL_NIF_TERM atom_ripemd160;
+
+
+
static ErlNifResourceType* hmac_context_rtype;
struct hmac_context
{
@@ -916,6 +929,20 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
#else
atom_not_supported = enif_make_atom(env,"not_supported");
#endif
+ atom_rsa = enif_make_atom(env,"rsa");
+ atom_dss = enif_make_atom(env,"dss");
+ atom_ecdsa = enif_make_atom(env,"ecdsa");
+ atom_rsa_mgf1_md = enif_make_atom(env,"rsa_mgf1_md");
+ atom_rsa_padding = enif_make_atom(env,"rsa_padding");
+ atom_rsa_pkcs1_pss_padding = enif_make_atom(env,"rsa_pkcs1_pss_padding");
+ atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding");
+ atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen");
+ atom_sha224 = enif_make_atom(env,"sha224");
+ atom_sha256 = enif_make_atom(env,"sha256");
+ atom_sha384 = enif_make_atom(env,"sha384");
+ atom_sha512 = enif_make_atom(env,"sha512");
+ atom_md5 = enif_make_atom(env,"md5");
+ atom_ripemd160 = enif_make_atom(env,"ripemd160");
init_digest_types(env);
init_cipher_types(env);
@@ -1010,6 +1037,8 @@ static int algo_pubkey_cnt, algo_pubkey_fips_cnt;
static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */
static int algo_cipher_cnt, algo_cipher_fips_cnt;
static ERL_NIF_TERM algo_cipher[24]; /* increase when extending the list */
+static int algo_mac_cnt, algo_mac_fips_cnt;
+static ERL_NIF_TERM algo_mac[2]; /* increase when extending the list */
static void init_algorithms_types(ErlNifEnv* env)
{
@@ -1093,9 +1122,19 @@ static void init_algorithms_types(ErlNifEnv* env)
algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305");
#endif
+ // Validated algorithms first
+ algo_mac_cnt = 0;
+ algo_mac[algo_mac_cnt++] = enif_make_atom(env,"hmac");
+#ifdef HAVE_CMAC
+ algo_mac[algo_mac_cnt++] = enif_make_atom(env,"cmac");
+#endif
+ // Non-validated algorithms follow
+ algo_mac_fips_cnt = algo_mac_cnt;
+
ASSERT(algo_hash_cnt <= sizeof(algo_hash)/sizeof(ERL_NIF_TERM));
ASSERT(algo_pubkey_cnt <= sizeof(algo_pubkey)/sizeof(ERL_NIF_TERM));
ASSERT(algo_cipher_cnt <= sizeof(algo_cipher)/sizeof(ERL_NIF_TERM));
+ ASSERT(algo_mac_cnt <= sizeof(algo_mac)/sizeof(ERL_NIF_TERM));
}
static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -1105,15 +1144,19 @@ static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt;
int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt;
int cipher_cnt = fips_mode ? algo_cipher_fips_cnt : algo_cipher_cnt;
+ int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt;
#else
int hash_cnt = algo_hash_cnt;
int pubkey_cnt = algo_pubkey_cnt;
int cipher_cnt = algo_cipher_cnt;
+ int mac_cnt = algo_mac_cnt;
#endif
- return enif_make_tuple3(env,
+ return enif_make_tuple4(env,
enif_make_list_from_array(env, algo_hash, hash_cnt),
enif_make_list_from_array(env, algo_pubkey, pubkey_cnt),
- enif_make_list_from_array(env, algo_cipher, cipher_cnt));
+ enif_make_list_from_array(env, algo_cipher, cipher_cnt),
+ enif_make_list_from_array(env, algo_mac, mac_cnt)
+ );
}
static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -2448,44 +2491,6 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
return ret;
}
-static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (sha, Digest, Signature,Key=[P, Q, G, Y]) */
- ErlNifBinary digest_bin, sign_bin;
- BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL;
- ERL_NIF_TERM head, tail;
- DSA *dsa;
- int i;
-
- if (argv[0] != atom_sha
- || !enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != SHA_DIGEST_LENGTH
- || !enif_inspect_binary(env, argv[2], &sign_bin)
- || !enif_get_list_cell(env, argv[3], &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_q)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_g)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_y)
- || !enif_is_empty_list(env,tail)) {
-
- if (dsa_p) BN_free(dsa_p);
- if (dsa_q) BN_free(dsa_q);
- if (dsa_g) BN_free(dsa_g);
- if (dsa_y) BN_free(dsa_y);
- return enif_make_badarg(env);
- }
-
- dsa = DSA_new();
- DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
- DSA_set0_key(dsa, dsa_y, NULL);
- i = DSA_verify(0, digest_bin.data, SHA_DIGEST_LENGTH,
- sign_bin.data, sign_bin.size, dsa);
- DSA_free(dsa);
- return(i > 0) ? atom_true : atom_false;
-}
-
static void init_digest_types(ErlNifEnv* env)
{
struct digest_type_t* p = digest_types;
@@ -2532,73 +2537,6 @@ static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len)
return NULL;
}
-static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Signature, Key=[E,N]) */
- ErlNifBinary digest_bin, sign_bin;
- ERL_NIF_TERM head, tail, ret;
- int i;
- RSA *rsa;
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- EVP_PKEY *pkey;
- EVP_PKEY_CTX *ctx;
-#endif
- const EVP_MD *md;
- const ERL_NIF_TERM type = argv[0];
- struct digest_type_t *digp = NULL;
- BIGNUM *rsa_e;
- BIGNUM *rsa_n;
-
- digp = get_digest_type(type);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
-
- rsa = RSA_new();
-
- if (!enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != EVP_MD_size(md)
- || !enif_inspect_binary(env, argv[2], &sign_bin)
- || !enif_get_list_cell(env, argv[3], &head, &tail)
- || !get_bn_from_bin(env, head, &rsa_e)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &rsa_n)
- || !enif_is_empty_list(env, tail)) {
-
- ret = enif_make_badarg(env);
- goto done;
- }
-
- (void) RSA_set0_key(rsa, rsa_n, rsa_e, NULL);
-
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- pkey = EVP_PKEY_new();
- EVP_PKEY_set1_RSA(pkey, rsa);
-
- ctx = EVP_PKEY_CTX_new(pkey, NULL);
- EVP_PKEY_verify_init(ctx);
- EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING);
- EVP_PKEY_CTX_set_signature_md(ctx, md);
-
- i = EVP_PKEY_verify(ctx, sign_bin.data, sign_bin.size,
- digest_bin.data, digest_bin.size);
- EVP_PKEY_CTX_free(ctx);
- EVP_PKEY_free(pkey);
-#else
- i = RSA_verify(md->type, digest_bin.data, EVP_MD_size(md),
- sign_bin.data, sign_bin.size, rsa);
-#endif
-
- ret = (i==1 ? atom_true : atom_false);
-
-done:
- RSA_free(rsa);
- return ret;
-}
-
static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Data1, Data2) */
ErlNifBinary d1, d2;
@@ -2702,100 +2640,33 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
return 1;
}
-static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */
- ErlNifBinary digest_bin, ret_bin;
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- EVP_PKEY *pkey;
- EVP_PKEY_CTX *ctx;
- size_t rsa_s_len;
-#else
- unsigned rsa_s_len, len;
-#endif
- RSA *rsa;
- int i;
- struct digest_type_t *digp;
- const EVP_MD *md;
-
- digp = get_digest_type(argv[0]);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
- if (!enif_inspect_binary(env,argv[1],&digest_bin)
- || digest_bin.size != EVP_MD_size(md)) {
- return enif_make_badarg(env);
- }
+static int get_rsa_public_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
+{
+ /* key=[E,N] */
+ ERL_NIF_TERM head, tail;
+ BIGNUM *e, *n;
- rsa = RSA_new();
- if (!get_rsa_private_key(env, argv[2], rsa)) {
- RSA_free(rsa);
- return enif_make_badarg(env);
+ if (!enif_get_list_cell(env, key, &head, &tail)
+ || !get_bn_from_bin(env, head, &e)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &n)
+ || !enif_is_empty_list(env, tail)) {
+ return 0;
}
-
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- pkey = EVP_PKEY_new();
- EVP_PKEY_set1_RSA(pkey, rsa);
- rsa_s_len=(size_t)EVP_PKEY_size(pkey);
- enif_alloc_binary(rsa_s_len, &ret_bin);
-
- ctx = EVP_PKEY_CTX_new(pkey, NULL);
- EVP_PKEY_sign_init(ctx);
- EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING);
- EVP_PKEY_CTX_set_signature_md(ctx, md);
-
- i = EVP_PKEY_sign(ctx, ret_bin.data, &rsa_s_len,
- digest_bin.data, digest_bin.size);
- ASSERT(i<=0 || rsa_s_len <= ret_bin.size);
- EVP_PKEY_CTX_free(ctx);
- EVP_PKEY_free(pkey);
-#else
- enif_alloc_binary(RSA_size(rsa), &ret_bin);
- len = EVP_MD_size(md);
-
- ERL_VALGRIND_ASSERT_MEM_DEFINED(digest_bin.data, len);
- i = RSA_sign(md->type, digest_bin.data, len,
- ret_bin.data, &rsa_s_len, rsa);
-#endif
-
- RSA_free(rsa);
- if (i > 0) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, rsa_s_len);
- if (rsa_s_len != ret_bin.size) {
- enif_realloc_binary(&ret_bin, rsa_s_len);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(ret_bin.data, rsa_s_len);
- }
- return enif_make_binary(env,&ret_bin);
- }
- else {
- enif_release_binary(&ret_bin);
- return atom_error;
- }
+ (void) RSA_set0_key(rsa, n, e, NULL);
+ return 1;
}
-
-static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (sha, Digest, Key=[P,Q,G,PrivKey]) */
- ErlNifBinary digest_bin, ret_bin;
+static int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa)
+{
+ /* key=[P,Q,G,KEY] */
ERL_NIF_TERM head, tail;
- unsigned int dsa_s_len;
- DSA* dsa;
BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL;
BIGNUM *dummy_pub_key, *priv_key = NULL;
- int i;
-
- if (argv[0] != atom_sha
- || !enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != SHA_DIGEST_LENGTH) {
- return enif_make_badarg(env);
- }
- if (!enif_get_list_cell(env, argv[2], &head, &tail)
+ if (!enif_get_list_cell(env, key, &head, &tail)
|| !get_bn_from_bin(env, head, &dsa_p)
|| !enif_get_list_cell(env, tail, &head, &tail)
|| !get_bn_from_bin(env, head, &dsa_q)
@@ -2808,7 +2679,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
if (dsa_q) BN_free(dsa_q);
if (dsa_g) BN_free(dsa_g);
if (priv_key) BN_free(priv_key);
- return enif_make_badarg(env);
+ return 0;
}
/* Note: DSA_set0_key() does not allow setting only the
@@ -2818,27 +2689,39 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
*/
dummy_pub_key = BN_dup(priv_key);
- dsa = DSA_new();
DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
DSA_set0_key(dsa, dummy_pub_key, priv_key);
- enif_alloc_binary(DSA_size(dsa), &ret_bin);
- i = DSA_sign(NID_sha1, digest_bin.data, SHA_DIGEST_LENGTH,
- ret_bin.data, &dsa_s_len, dsa);
- DSA_free(dsa);
-
- if (i) {
- if (dsa_s_len != ret_bin.size) {
- enif_realloc_binary(&ret_bin, dsa_s_len);
- }
- return enif_make_binary(env, &ret_bin);
- }
- else {
- enif_release_binary(&ret_bin);
- return atom_error;
- }
+ return 1;
}
+static int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa)
+{
+ /* key=[P, Q, G, Y] */
+ ERL_NIF_TERM head, tail;
+ BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL;
+
+ if (!enif_get_list_cell(env, key, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_p)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_q)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_g)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_y)
+ || !enif_is_empty_list(env,tail)) {
+ if (dsa_p) BN_free(dsa_p);
+ if (dsa_q) BN_free(dsa_q);
+ if (dsa_g) BN_free(dsa_g);
+ if (dsa_y) BN_free(dsa_y);
+ return 0;
+ }
+
+ DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
+ DSA_set0_key(dsa, dsa_y, NULL);
+ return 1;
+}
+
static int rsa_pad(ERL_NIF_TERM term, int* padding)
{
if (term == atom_rsa_pkcs1_padding) {
@@ -3788,99 +3671,6 @@ badarg:
#endif
}
-static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Curve, Key) */
-#if defined(HAVE_EC)
- ErlNifBinary digest_bin, ret_bin;
- unsigned int dsa_s_len;
- EC_KEY* key = NULL;
- int i, len;
- struct digest_type_t *digp;
- const EVP_MD *md;
-
- digp = get_digest_type(argv[0]);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
- len = EVP_MD_size(md);
-
- if (!enif_inspect_binary(env,argv[1],&digest_bin)
- || digest_bin.size != len
- || !get_ec_key(env, argv[2], argv[3], atom_undefined, &key))
- goto badarg;
-
- enif_alloc_binary(ECDSA_size(key), &ret_bin);
-
- i = ECDSA_sign(EVP_MD_type(md), digest_bin.data, len,
- ret_bin.data, &dsa_s_len, key);
-
- EC_KEY_free(key);
- if (i) {
- if (dsa_s_len != ret_bin.size) {
- enif_realloc_binary(&ret_bin, dsa_s_len);
- }
- return enif_make_binary(env, &ret_bin);
- }
- else {
- enif_release_binary(&ret_bin);
- return atom_error;
- }
-
-badarg:
- if (key)
- EC_KEY_free(key);
- return make_badarg_maybe(env);
-#else
- return atom_notsup;
-#endif
-}
-
-static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Signature, Curve, Key) */
-#if defined(HAVE_EC)
- ErlNifBinary digest_bin, sign_bin;
- int i, len;
- EC_KEY* key = NULL;
- const ERL_NIF_TERM type = argv[0];
- struct digest_type_t *digp = NULL;
- const EVP_MD *md;
-
- digp = get_digest_type(type);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
- len = EVP_MD_size(md);
-
- if (!enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != len
- || !enif_inspect_binary(env, argv[2], &sign_bin)
- || !get_ec_key(env, argv[3], atom_undefined, argv[4], &key))
- goto badarg;
-
- i = ECDSA_verify(EVP_MD_type(md), digest_bin.data, len,
- sign_bin.data, sign_bin.size, key);
-
- EC_KEY_free(key);
-
- return (i==1 ? atom_true : atom_false);
-
-badarg:
- if (key)
- EC_KEY_free(key);
- return make_badarg_maybe(env);
-#else
- return atom_notsup;
-#endif
-}
-
/*
(_OthersPublicKey, _MyPrivateKey)
(_OthersPublicKey, _MyEC_Point)
@@ -3939,6 +3729,548 @@ out_err:
#endif
}
+/*================================================================*/
+#define PKEY_BADARG -1
+#define PKEY_NOTSUP 0
+#define PKEY_OK 1
+
+typedef struct PKeyCryptOptions {
+ const EVP_MD *rsa_mgf1_md;
+ ErlNifBinary rsa_oaep_label;
+ const EVP_MD *rsa_oaep_md;
+ int rsa_padding;
+ const EVP_MD *signature_md;
+} PKeyCryptOptions;
+
+typedef struct PKeySignOptions {
+ const EVP_MD *rsa_mgf1_md;
+ int rsa_padding;
+ int rsa_pss_saltlen;
+} PKeySignOptions;
+
+static int get_pkey_digest_type(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM type,
+ const EVP_MD **md)
+{
+ struct digest_type_t *digp = NULL;
+ *md = NULL;
+
+ if (type == atom_none && algorithm == atom_rsa) return PKEY_OK;
+
+ digp = get_digest_type(type);
+ if (!digp) return PKEY_BADARG;
+ if (!digp->md.p) return PKEY_NOTSUP;
+
+ *md = digp->md.p;
+ return PKEY_OK;
+}
+
+
+static int get_pkey_sign_digest(ErlNifEnv *env, ERL_NIF_TERM algorithm,
+ ERL_NIF_TERM type, ERL_NIF_TERM data,
+ unsigned char *md_value, const EVP_MD **mdp,
+ unsigned char **tbsp, size_t *tbslenp)
+{
+ int i;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+ ErlNifBinary tbs_bin;
+ EVP_MD_CTX *mdctx;
+ const EVP_MD *md = *mdp;
+ unsigned char *tbs = *tbsp;
+ size_t tbslen = *tbslenp;
+ unsigned int tbsleni;
+
+ if ((i = get_pkey_digest_type(env, algorithm, type, &md)) != PKEY_OK) {
+ return i;
+ }
+ if (enif_get_tuple(env, data, &tpl_arity, &tpl_terms)) {
+ if (tpl_arity != 2 || tpl_terms[0] != atom_digest
+ || !enif_inspect_binary(env, tpl_terms[1], &tbs_bin)
+ || (md != NULL && tbs_bin.size != EVP_MD_size(md))) {
+ return PKEY_BADARG;
+ }
+ /* We have a digest (= hashed text) in tbs_bin */
+ tbs = tbs_bin.data;
+ tbslen = tbs_bin.size;
+ } else if (md == NULL) {
+ if (!enif_inspect_binary(env, data, &tbs_bin)) {
+ return PKEY_BADARG;
+ }
+ /* md == NULL, that is no hashing because DigestType argument was atom_none */
+ tbs = tbs_bin.data;
+ tbslen = tbs_bin.size;
+ } else {
+ if (!enif_inspect_binary(env, data, &tbs_bin)) {
+ return PKEY_BADARG;
+ }
+ /* We have the cleartext in tbs_bin and the hash algo info in md */
+ tbs = md_value;
+ mdctx = EVP_MD_CTX_create();
+ if (!mdctx) {
+ return PKEY_BADARG;
+ }
+ /* Looks well, now hash the plain text into a digest according to md */
+ if (EVP_DigestInit_ex(mdctx, md, NULL) <= 0) {
+ EVP_MD_CTX_destroy(mdctx);
+ return PKEY_BADARG;
+ }
+ if (EVP_DigestUpdate(mdctx, tbs_bin.data, tbs_bin.size) <= 0) {
+ EVP_MD_CTX_destroy(mdctx);
+ return PKEY_BADARG;
+ }
+ if (EVP_DigestFinal_ex(mdctx, tbs, &tbsleni) <= 0) {
+ EVP_MD_CTX_destroy(mdctx);
+ return PKEY_BADARG;
+ }
+ tbslen = (size_t)(tbsleni);
+ EVP_MD_CTX_destroy(mdctx);
+ }
+
+ *mdp = md;
+ *tbsp = tbs;
+ *tbslenp = tbslen;
+
+ return PKEY_OK;
+}
+
+
+static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM options,
+ const EVP_MD *md, PKeySignOptions *opt)
+{
+ ERL_NIF_TERM head, tail;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+ const EVP_MD *opt_md;
+ int i;
+
+ if (!enif_is_list(env, options)) {
+ return PKEY_BADARG;
+ }
+
+ /* defaults */
+ if (algorithm == atom_rsa) {
+ opt->rsa_mgf1_md = NULL;
+ opt->rsa_padding = RSA_PKCS1_PADDING;
+ opt->rsa_pss_saltlen = -2;
+ }
+
+ if (enif_is_empty_list(env, options)) {
+ return PKEY_OK;
+ }
+
+ if (algorithm == atom_rsa) {
+ tail = options;
+ while (enif_get_list_cell(env, tail, &head, &tail)) {
+ if (enif_get_tuple(env, head, &tpl_arity, &tpl_terms) && tpl_arity == 2) {
+ if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) {
+ i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
+ if (i != PKEY_OK) {
+ return i;
+ }
+ opt->rsa_mgf1_md = opt_md;
+ } else if (tpl_terms[0] == atom_rsa_padding) {
+ if (tpl_terms[1] == atom_rsa_pkcs1_padding) {
+ opt->rsa_padding = RSA_PKCS1_PADDING;
+ } else if (tpl_terms[1] == atom_rsa_pkcs1_pss_padding) {
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+ opt->rsa_padding = RSA_PKCS1_PSS_PADDING;
+ if (opt->rsa_mgf1_md == NULL) {
+ opt->rsa_mgf1_md = md;
+ }
+#else
+ return PKEY_NOTSUP;
+#endif
+ } else if (tpl_terms[1] == atom_rsa_x931_padding) {
+ opt->rsa_padding = RSA_X931_PADDING;
+ } else if (tpl_terms[1] == atom_rsa_no_padding) {
+ opt->rsa_padding = RSA_NO_PADDING;
+ } else {
+ return PKEY_BADARG;
+ }
+ } else if (tpl_terms[0] == atom_rsa_pss_saltlen) {
+ if (!enif_get_int(env, tpl_terms[1], &(opt->rsa_pss_saltlen))
+ || opt->rsa_pss_saltlen < -2) {
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+
+ return PKEY_OK;
+}
+
+static int get_pkey_sign_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey)
+{
+ if (algorithm == atom_rsa) {
+ RSA *rsa = RSA_new();
+
+ if (!get_rsa_private_key(env, key, rsa)) {
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_RSA(*pkey, rsa)) {
+ EVP_PKEY_free(*pkey);
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+ } else if (algorithm == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = NULL;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+
+ if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2
+ && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1])
+ && get_ec_key(env, tpl_terms[0], tpl_terms[1], atom_undefined, &ec)) {
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) {
+ EVP_PKEY_free(*pkey);
+ EC_KEY_free(ec);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+#else
+ return PKEY_NOTSUP;
+#endif
+ } else if (algorithm == atom_dss) {
+ DSA *dsa = DSA_new();
+
+ if (!get_dss_private_key(env, key, dsa)) {
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_DSA(*pkey, dsa)) {
+ EVP_PKEY_free(*pkey);
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+
+ return PKEY_OK;
+}
+
+static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
+{/* (Algorithm, Type, Data|{digest,Digest}, Key, Options) */
+ int i;
+ const EVP_MD *md = NULL;
+ unsigned char md_value[EVP_MAX_MD_SIZE];
+ EVP_PKEY *pkey;
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX *ctx;
+ size_t siglen;
+#else
+ unsigned len, siglen;
+#endif
+ PKeySignOptions sig_opt;
+ ErlNifBinary sig_bin; /* signature */
+ unsigned char *tbs; /* data to be signed */
+ size_t tbslen;
+/*char buf[1024];
+enif_get_atom(env,argv[0],buf,1024,ERL_NIF_LATIN1); printf("algo=%s ",buf);
+enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf);
+printf("\r\n");
+*/
+ i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ i = get_pkey_sign_options(env, argv[0], argv[4], md, &sig_opt);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ if (get_pkey_sign_key(env, argv[0], argv[3], &pkey) != PKEY_OK) {
+ return enif_make_badarg(env);
+ }
+
+#ifdef HAS_EVP_PKEY_CTX
+/* printf("EVP interface\r\n");
+ */
+ ctx = EVP_PKEY_CTX_new(pkey, NULL);
+ if (!ctx) goto badarg;
+ if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg;
+ if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg;
+
+ if (argv[0] == atom_rsa) {
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg;
+ if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) {
+ if (sig_opt.rsa_mgf1_md != NULL) {
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,1)
+ if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg;
+#else
+ EVP_PKEY_CTX_free(ctx);
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ }
+ if (sig_opt.rsa_pss_saltlen > -2
+ && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0)
+ goto badarg;
+ }
+ }
+
+ if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) <= 0) goto badarg;
+ enif_alloc_binary(siglen, &sig_bin);
+
+ if (md != NULL) {
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md));
+ }
+ i = EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen);
+
+ EVP_PKEY_CTX_free(ctx);
+#else
+/*printf("Old interface\r\n");
+ */
+ if (argv[0] == atom_rsa) {
+ RSA *rsa = EVP_PKEY_get1_RSA(pkey);
+ enif_alloc_binary(RSA_size(rsa), &sig_bin);
+ len = EVP_MD_size(md);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+ i = RSA_sign(md->type, tbs, len, sig_bin.data, &siglen, rsa);
+ RSA_free(rsa);
+ } else if (argv[0] == atom_dss) {
+ DSA *dsa = EVP_PKEY_get1_DSA(pkey);
+ enif_alloc_binary(DSA_size(dsa), &sig_bin);
+ len = EVP_MD_size(md);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+ i = DSA_sign(md->type, tbs, len, sig_bin.data, &siglen, dsa);
+ DSA_free(dsa);
+ } else if (argv[0] == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
+ enif_alloc_binary(ECDSA_size(ec), &sig_bin);
+ len = EVP_MD_size(md);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+ i = ECDSA_sign(md->type, tbs, len, sig_bin.data, &siglen, ec);
+ EC_KEY_free(ec);
+#else
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ } else {
+ goto badarg;
+ }
+#endif
+
+ EVP_PKEY_free(pkey);
+ if (i == 1) {
+ ERL_VALGRIND_MAKE_MEM_DEFINED(sig_bin.data, siglen);
+ if (siglen != sig_bin.size) {
+ enif_realloc_binary(&sig_bin, siglen);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(sig_bin.data, siglen);
+ }
+ return enif_make_binary(env, &sig_bin);
+ } else {
+ enif_release_binary(&sig_bin);
+ return atom_error;
+ }
+
+ badarg:
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX_free(ctx);
+#endif
+ EVP_PKEY_free(pkey);
+ return enif_make_badarg(env);
+}
+
+
+static int get_pkey_verify_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key,
+ EVP_PKEY **pkey)
+{
+ if (algorithm == atom_rsa) {
+ RSA *rsa = RSA_new();
+
+ if (!get_rsa_public_key(env, key, rsa)) {
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_RSA(*pkey, rsa)) {
+ EVP_PKEY_free(*pkey);
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+ } else if (algorithm == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = NULL;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+
+ if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2
+ && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1])
+ && get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec)) {
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) {
+ EVP_PKEY_free(*pkey);
+ EC_KEY_free(ec);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+#else
+ return PKEY_NOTSUP;
+#endif
+ } else if (algorithm == atom_dss) {
+ DSA *dsa = DSA_new();
+
+ if (!get_dss_public_key(env, key, dsa)) {
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_DSA(*pkey, dsa)) {
+ EVP_PKEY_free(*pkey);
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+
+ return PKEY_OK;
+}
+
+static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
+{/* (Algorithm, Type, Data|{digest,Digest}, Signature, Key, Options) */
+ int i;
+ const EVP_MD *md = NULL;
+ unsigned char md_value[EVP_MAX_MD_SIZE];
+ EVP_PKEY *pkey;
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX *ctx;
+#else
+#endif
+ PKeySignOptions sig_opt;
+ ErlNifBinary sig_bin; /* signature */
+ unsigned char *tbs; /* data to be signed */
+ size_t tbslen;
+
+ if (!enif_inspect_binary(env, argv[3], &sig_bin)) {
+ return enif_make_badarg(env);
+ }
+
+ i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ i = get_pkey_sign_options(env, argv[0], argv[5], md, &sig_opt);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ if (get_pkey_verify_key(env, argv[0], argv[4], &pkey) != PKEY_OK) {
+ return enif_make_badarg(env);
+ }
+
+#ifdef HAS_EVP_PKEY_CTX
+/* printf("EVP interface\r\n");
+ */
+ ctx = EVP_PKEY_CTX_new(pkey, NULL);
+ if (!ctx) goto badarg;
+ if (EVP_PKEY_verify_init(ctx) <= 0) goto badarg;
+ if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg;
+
+ if (argv[0] == atom_rsa) {
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg;
+ if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) {
+ if (sig_opt.rsa_mgf1_md != NULL) {
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,1)
+ if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg;
+#else
+ EVP_PKEY_CTX_free(ctx);
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ }
+ if (sig_opt.rsa_pss_saltlen > -2
+ && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0)
+ goto badarg;
+ }
+ }
+
+ if (md != NULL) {
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md));
+ }
+ i = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen);
+
+ EVP_PKEY_CTX_free(ctx);
+#else
+/*printf("Old interface\r\n");
+*/
+ if (argv[0] == atom_rsa) {
+ RSA *rsa = EVP_PKEY_get1_RSA(pkey);
+ i = RSA_verify(md->type, tbs, tbslen, sig_bin.data, sig_bin.size, rsa);
+ RSA_free(rsa);
+ } else if (argv[0] == atom_dss) {
+ DSA *dsa = EVP_PKEY_get1_DSA(pkey);
+ i = DSA_verify(0, tbs, tbslen, sig_bin.data, sig_bin.size, dsa);
+ DSA_free(dsa);
+ } else if (argv[0] == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
+ i = ECDSA_verify(EVP_MD_type(md), tbs, tbslen, sig_bin.data, sig_bin.size, ec);
+ EC_KEY_free(ec);
+#else
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ } else {
+ goto badarg;
+ }
+#endif
+
+ EVP_PKEY_free(pkey);
+ if (i == 1) {
+ return atom_true;
+ } else {
+ return atom_false;
+ }
+
+ badarg:
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX_free(ctx);
+#endif
+ EVP_PKEY_free(pkey);
+ return enif_make_badarg(env);
+}
+
+
+/*================================================================*/
+
static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ErlNifBinary seed_bin;
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 89ef529c5d..5b2c46a004 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -159,12 +159,24 @@
<code>digest_type() = md5 | sha | sha224 | sha256 | sha384 | sha512</code>
+ <code>rsa_digest_type() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512</code>
+
+ <code>dss_digest_type() = sha | sha224 | sha256 | sha384 | sha512</code> <p>Note that the actual supported
+ dss_digest_type depends on the underlying crypto library. In OpenSSL version >= 1.0.1 the listed digest are supported, while in 1.0.0 only sha, sha224 and sha256 are supported. In version 0.9.8 only sha is supported.</p>
+
+ <code>ecdsa_digest_type() = sha | sha224 | sha256 | sha384 | sha512</code>
+
+ <code>sign_options() = [{rsa_pad, rsa_sign_padding()} | {rsa_pss_saltlen, integer()}]</code>
+
+ <code>rsa_sign_padding() = rsa_pkcs1_padding | rsa_pkcs1_pss_padding</code>
+
<code> hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512 </code> <p>md4 is also supported for hash_init/1 and hash/2.
Note that both md4 and md5 are recommended only for compatibility with existing applications.
</p>
<code> cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm |
aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | des_cfb |
des3_cbc | des3_cfb | des_ede3 | rc2_cbc | rc4 </code>
+ <code> mac_algorithms() = hmac | cmac</code>
<code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
<p>Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported
with ecdsa and ecdh.
@@ -681,6 +693,7 @@
<func>
<name>sign(Algorithm, DigestType, Msg, Key) -> binary()</name>
+ <name>sign(Algorithm, DigestType, Msg, Key, Options) -> binary()</name>
<fsummary> Create digital signature.</fsummary>
<type>
<v>Algorithm = rsa | dss | ecdsa </v>
@@ -688,8 +701,9 @@
<d>The msg is either the binary "cleartext" data to be
signed or it is the hashed value of "cleartext" i.e. the
digest (plaintext).</d>
- <v>DigestType = digest_type()</v>
+ <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()]</v>
+ <v>Options = sign_options()</v>
</type>
<desc>
<p>Creates a digital signature.</p>
@@ -835,7 +849,8 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
<type>
<v> AlgorithmList = [{hashs, [hash_algorithms()]},
{ciphers, [cipher_algorithms()]},
- {public_keys, [public_key_algorithms()]}
+ {public_keys, [public_key_algorithms()]},
+ {macs, [mac_algorithms()]}]
</v>
</type>
<desc>
@@ -869,15 +884,17 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
<func>
<name>verify(Algorithm, DigestType, Msg, Signature, Key) -> boolean()</name>
+ <name>verify(Algorithm, DigestType, Msg, Signature, Key, Options) -> boolean()</name>
<fsummary>Verifies a digital signature.</fsummary>
<type>
<v> Algorithm = rsa | dss | ecdsa </v>
<v>Msg = binary() | {digest,binary()}</v>
<d>The msg is either the binary "cleartext" data
or it is the hashed value of "cleartext" i.e. the digest (plaintext).</d>
- <v>DigestType = digest_type()</v>
+ <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Signature = binary()</v>
<v>Key = rsa_public() | dss_public() | [ecdh_public(),ecdh_params()]</v>
+ <v>Options = sign_options()</v>
</type>
<desc>
<p>Verifies a digital signature</p>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index d111525214..1df05462c9 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -25,7 +25,7 @@
-export([start/0, stop/0, info_lib/0, info_fips/0, supports/0, enable_fips_mode/1,
version/0, bytes_to_integer/1]).
-export([hash/2, hash_init/1, hash_update/2, hash_final/1]).
--export([sign/4, verify/5]).
+-export([sign/4, sign/5, verify/5, verify/6]).
-export([generate_key/2, generate_key/3, compute_key/4]).
-export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]).
-export([cmac/3, cmac/4]).
@@ -45,6 +45,10 @@
-export([ec_curve/1, ec_curves/0]).
-export([rand_seed/1]).
+%% Private. For tests.
+-export([packed_openssl_version/4]).
+
+
-deprecated({rand_uniform, 2, next_major_release}).
%% This should correspond to the similar macro in crypto.c
@@ -87,11 +91,12 @@ stop() ->
application:stop(crypto).
supports()->
- {Hashs, PubKeys, Ciphers} = algorithms(),
+ {Hashs, PubKeys, Ciphers, Macs} = algorithms(),
[{hashs, Hashs},
{ciphers, Ciphers},
- {public_keys, PubKeys}
+ {public_keys, PubKeys},
+ {macs, Macs}
].
info_lib() -> ?nif_stub.
@@ -388,36 +393,31 @@ mod_pow(Base, Exponent, Prime) ->
<<0>> -> error;
R -> R
end.
-verify(dss, none, Data, Signature, Key) when is_binary(Data) ->
- verify(dss, sha, {digest, Data}, Signature, Key);
-verify(Alg, Type, Data, Signature, Key) when is_binary(Data) ->
- verify(Alg, Type, {digest, hash(Type, Data)}, Signature, Key);
-verify(dss, Type, {digest, Digest}, Signature, Key) ->
- dss_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key));
-verify(rsa, Type, {digest, Digest}, Signature, Key) ->
- notsup_to_error(
- rsa_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key)));
-verify(ecdsa, Type, {digest, Digest}, Signature, [Key, Curve]) ->
- notsup_to_error(
- ecdsa_verify_nif(Type, Digest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key))).
-sign(dss, none, Data, Key) when is_binary(Data) ->
- sign(dss, sha, {digest, Data}, Key);
-sign(Alg, Type, Data, Key) when is_binary(Data) ->
- sign(Alg, Type, {digest, hash(Type, Data)}, Key);
-sign(rsa, Type, {digest, Digest}, Key) ->
- case rsa_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [rsa, Type, {digest, Digest}, Key]);
- Sign -> Sign
- end;
-sign(dss, Type, {digest, Digest}, Key) ->
- case dss_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [dss, Type, {digest, Digest}, Key]);
- Sign -> Sign
- end;
-sign(ecdsa, Type, {digest, Digest}, [Key, Curve]) ->
- case ecdsa_sign_nif(Type, Digest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [ecdsa, Type, {digest, Digest}, [Key, Curve]]);
- Sign -> Sign
+
+verify(Algorithm, Type, Data, Signature, Key) ->
+ verify(Algorithm, Type, Data, Signature, Key, []).
+
+%% Backwards compatible
+verify(Algorithm = dss, none, Digest, Signature, Key, Options) ->
+ verify(Algorithm, sha, {digest, Digest}, Signature, Key, Options);
+verify(Algorithm, Type, Data, Signature, Key, Options) ->
+ case pkey_verify_nif(Algorithm, Type, Data, Signature, format_pkey(Algorithm, Key), Options) of
+ notsup -> erlang:error(notsup);
+ Boolean -> Boolean
+ end.
+
+
+sign(Algorithm, Type, Data, Key) ->
+ sign(Algorithm, Type, Data, Key, []).
+
+%% Backwards compatible
+sign(Algorithm = dss, none, Digest, Key, Options) ->
+ sign(Algorithm, sha, {digest, Digest}, Key, Options);
+sign(Algorithm, Type, Data, Key, Options) ->
+ case pkey_sign_nif(Algorithm, Type, Data, format_pkey(Algorithm, Key), Options) of
+ error -> erlang:error(badkey, [Algorithm, Type, Data, Key, Options]);
+ notsup -> erlang:error(notsup);
+ Signature -> Signature
end.
-spec public_encrypt(rsa, binary(), [binary()], rsa_padding()) ->
@@ -838,13 +838,9 @@ srp_value_B_nif(_Multiplier, _Verifier, _Generator, _Exponent, _Prime) -> ?nif_s
%% Digital signatures --------------------------------------------------------------------
-rsa_sign_nif(_Type,_Digest,_Key) -> ?nif_stub.
-dss_sign_nif(_Type,_Digest,_Key) -> ?nif_stub.
-ecdsa_sign_nif(_Type, _Digest, _Curve, _Key) -> ?nif_stub.
-dss_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub.
-rsa_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub.
-ecdsa_verify_nif(_Type, _Digest, _Signature, _Curve, _Key) -> ?nif_stub.
+pkey_sign_nif(_Algorithm, _Type, _Digest, _Key, _Options) -> ?nif_stub.
+pkey_verify_nif(_Algorithm, _Type, _Data, _Signature, _Key, _Options) -> ?nif_stub.
%% Public Keys --------------------------------------------------------------------
%% RSA Rivest-Shamir-Adleman functions
@@ -961,6 +957,15 @@ ensure_int_as_bin(Int) when is_integer(Int) ->
ensure_int_as_bin(Bin) ->
Bin.
+format_pkey(rsa, Key) ->
+ map_ensure_int_as_bin(Key);
+format_pkey(ecdsa, [Key, Curve]) ->
+ {nif_curve_params(Curve), ensure_int_as_bin(Key)};
+format_pkey(dss, Key) ->
+ map_ensure_int_as_bin(Key);
+format_pkey(_, Key) ->
+ Key.
+
%%--------------------------------------------------------------------
%%
-type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'.
@@ -1003,3 +1008,14 @@ erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) ->
%%
mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub.
+
+%%%----------------------------------------------------------------
+%% 9470495 == V(0,9,8,zh).
+%% 268435615 == V(1,0,0,i).
+%% 268439663 == V(1,0,1,f).
+
+packed_openssl_version(MAJ, MIN, FIX, P0) ->
+ %% crypto.c
+ P1 = atom_to_list(P0),
+ P = lists:sum([C-$a||C<-P1]),
+ ((((((((MAJ bsl 8) bor MIN) bsl 8 ) bor FIX) bsl 8) bor (P+1)) bsl 4) bor 16#f).
diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl
index c2d0d2621b..c9033ac4f8 100644
--- a/lib/crypto/test/blowfish_SUITE.erl
+++ b/lib/crypto/test/blowfish_SUITE.erl
@@ -47,6 +47,11 @@
init_per_suite(Config) ->
case catch crypto:start() of
ok ->
+ catch ct:comment("~s",[element(3,hd(crypto:info_lib()))]),
+ catch ct:log("crypto:info_lib() -> ~p~n"
+ "crypto:supports() -> ~p~n"
+ "crypto:version() -> ~p~n"
+ ,[crypto:info_lib(), crypto:supports(), crypto:version()]),
Config;
_Else ->
{skip,"Could not start crypto!"}
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 164f43dcb0..88f13d766c 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -177,6 +177,12 @@ init_per_suite(Config) ->
try crypto:start() of
ok ->
+ catch ct:comment("~s",[element(3,hd(crypto:info_lib()))]),
+ catch ct:log("crypto:info_lib() -> ~p~n"
+ "crypto:supports() -> ~p~n"
+ "crypto:version() -> ~p~n"
+ ,[crypto:info_lib(), crypto:supports(), crypto:version()]),
+
try crypto:strong_rand_bytes(1) of
_ ->
Config
@@ -745,10 +751,44 @@ do_sign_verify({Type, Hash, Public, Private, Msg}) ->
Signature = crypto:sign(Type, Hash, Msg, Private),
case crypto:verify(Type, Hash, Msg, Signature, Public) of
true ->
+ ct:log("OK crypto:sign(~p, ~p, ..., ..., ...)", [Type,Hash]),
negative_verify(Type, Hash, Msg, <<10,20>>, Public);
false ->
+ ct:log("ERROR crypto:sign(~p, ~p, ..., ..., ...)", [Type,Hash]),
ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public]}})
- end.
+ end;
+do_sign_verify({Type, Hash, Public, Private, Msg, Options}) ->
+ LibVer =
+ case crypto:info_lib() of
+ [{<<"OpenSSL">>,Ver,<<"OpenSSL",_/binary>>}] -> Ver;
+ _ -> infinity
+ end,
+ Pad = proplists:get_value(rsa_padding, Options),
+ NotSupLow = lists:member(Pad, [rsa_pkcs1_pss_padding]),
+ try
+ crypto:sign(Type, Hash, Msg, Private, Options)
+ of
+ Signature ->
+ case crypto:verify(Type, Hash, Msg, Signature, Public, Options) of
+ true ->
+ ct:log("OK crypto:sign(~p, ~p, ..., ..., ..., ~p)", [Type,Hash,Options]),
+ negative_verify(Type, Hash, Msg, <<10,20>>, Public, Options);
+ false ->
+ ct:log("ERROR crypto:sign(~p, ~p, ..., ..., ..., ~p)", [Type,Hash,Options]),
+ ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public, Options]}})
+ end
+ catch
+ error:notsup when NotSupLow == true,
+ is_integer(LibVer),
+ LibVer < 16#10001000 ->
+ %% Thoose opts where introduced in 1.0.1
+ ct:log("notsup but OK in old cryptolib crypto:sign(~p, ~p, ..., ..., ..., ~p)",
+ [Type,Hash,Options]),
+ true;
+ C:E ->
+ ct:log("~p:~p crypto:sign(~p, ~p, ..., ..., ..., ~p)", [C,E,Type,Hash,Options]),
+ ct:fail({{crypto, sign_verify, [LibVer, Type, Hash, Msg, Public, Options]}})
+ end.
negative_verify(Type, Hash, Msg, Signature, Public) ->
case crypto:verify(Type, Hash, Msg, Signature, Public) of
@@ -758,6 +798,14 @@ negative_verify(Type, Hash, Msg, Signature, Public) ->
ok
end.
+negative_verify(Type, Hash, Msg, Signature, Public, Options) ->
+ case crypto:verify(Type, Hash, Msg, Signature, Public, Options) of
+ true ->
+ ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public, Options]}, should_fail});
+ false ->
+ ok
+ end.
+
do_public_encrypt({Type, Public, Private, Msg, Padding}) ->
PublicEcn = (catch crypto:public_encrypt(Type, Msg, Public, Padding)),
case crypto:private_decrypt(Type, PublicEcn, Private, Padding) of
@@ -1172,13 +1220,29 @@ group_config(dss = Type, Config) ->
Msg = dss_plain(),
Public = dss_params() ++ [dss_public()],
Private = dss_params() ++ [dss_private()],
- SignVerify = [{Type, sha, Public, Private, Msg}],
+ SupportedHashs = proplists:get_value(hashs, crypto:supports(), []),
+ DssHashs =
+ case crypto:info_lib() of
+ [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer), LibVer > 16#10001000 ->
+ [sha, sha224, sha256, sha384, sha512];
+ [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer), LibVer > 16#10000000 ->
+ [sha, sha224, sha256];
+ _Else ->
+ [sha]
+ end,
+ SignVerify = [{Type, Hash, Public, Private, Msg}
+ || Hash <- DssHashs,
+ lists:member(Hash, SupportedHashs)],
[{sign_verify, SignVerify} | Config];
group_config(ecdsa = Type, Config) ->
{Private, Public} = ec_key_named(),
Msg = ec_msg(),
- SignVerify = [{Type, sha, Public, Private, Msg}],
+ SupportedHashs = proplists:get_value(hashs, crypto:supports(), []),
+ DssHashs = [sha, sha224, sha256, sha384, sha512],
+ SignVerify = [{Type, Hash, Public, Private, Msg}
+ || Hash <- DssHashs,
+ lists:member(Hash, SupportedHashs)],
[{sign_verify, SignVerify} | Config];
group_config(srp, Config) ->
GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()],
@@ -1262,18 +1326,38 @@ group_config(_, Config) ->
Config.
sign_verify_tests(Type, Msg, Public, Private, PublicS, PrivateS) ->
- sign_verify_tests(Type, [md5, sha, sha224, sha256], Msg, Public, Private) ++
- sign_verify_tests(Type, [sha384, sha512], Msg, PublicS, PrivateS).
-
-sign_verify_tests(Type, Hashs, Msg, Public, Private) ->
- lists:foldl(fun(Hash, Acc) ->
- case is_supported(Hash) of
- true ->
- [{Type, Hash, Public, Private, Msg}|Acc];
- false ->
- Acc
- end
- end, [], Hashs).
+ gen_sign_verify_tests(Type, [md5, ripemd160, sha, sha224, sha256], Msg, Public, Private,
+ [undefined,
+ [{rsa_padding, rsa_pkcs1_pss_padding}],
+ [{rsa_padding, rsa_pkcs1_pss_padding}, {rsa_pss_saltlen, 0}],
+ [{rsa_padding, rsa_x931_padding}]
+ ]) ++
+ gen_sign_verify_tests(Type, [sha384, sha512], Msg, PublicS, PrivateS,
+ [undefined,
+ [{rsa_padding, rsa_pkcs1_pss_padding}],
+ [{rsa_padding, rsa_pkcs1_pss_padding}, {rsa_pss_saltlen, 0}],
+ [{rsa_padding, rsa_x931_padding}]
+ ]).
+
+gen_sign_verify_tests(Type, Hashs, Msg, Public, Private, Opts) ->
+ lists:foldr(fun(Hash, Acc0) ->
+ case is_supported(Hash) of
+ true ->
+ lists:foldr(fun
+ (undefined, Acc1) ->
+ [{Type, Hash, Public, Private, Msg} | Acc1];
+ ([{rsa_padding, rsa_x931_padding} | _], Acc1)
+ when Hash =:= md5
+ orelse Hash =:= ripemd160
+ orelse Hash =:= sha224 ->
+ Acc1;
+ (Opt, Acc1) ->
+ [{Type, Hash, Public, Private, Msg, Opt} | Acc1]
+ end, Acc0, Opts);
+ false ->
+ Acc0
+ end
+ end, [], Hashs).
rfc_1321_msgs() ->
[<<"">>,
@@ -2294,7 +2378,7 @@ fmt_words(Words) ->
log_rsp_size(Label, Term) ->
S = erts_debug:size(Term),
- ct:pal("~s: ~w test(s), Memory used: ~s",
+ ct:log("~s: ~w test(s), Memory used: ~s",
[Label, length(Term), fmt_words(S)]).
read_rsp(Config, Type, Files) ->
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 2cbe48ecce..3ad24257a5 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -798,6 +798,35 @@ be matched by corresponding &capability; configuration, of
</item>
<tag>
+<marker id="decode_format"/>
+<c>{decode_format, record | list | map | false}</c></tag>
+<item>
+<p>
+The format of decoded messages and grouped AVPs in the <c>msg</c> field
+of diameter_packet records and <c>value</c> field of diameter_avp
+records respectively.
+If <c>record</c> then a record whose definition is generated from the
+dictionary file in question.
+If <c>list</c> or <c>map</c> then a <c>[Name | Avps]</c> pair where
+<c>Avps</c> is either a list of AVP name/values pairs or a map keyed on
+AVP names respectively.
+If <c>false</c> then the representation is omitted and <c>msg</c> and
+<c>value</c> fields are set to <c>false</c>.
+See also &codec_message;.</p>
+
+<p>
+Defaults to <c>record</c>.</p>
+
+<note>
+<p>
+AVPs are decoded into a list of diameter_avp records in <c>avps</c>
+field of diameter_packet records independently of
+<c>decode_format</c>.</p>
+</note>
+
+</item>
+
+<tag>
<marker id="incoming_maxlen"/><c>{incoming_maxlen, 0..16777215}</c></tag>
<item>
<p>
@@ -927,6 +956,37 @@ Defaults to the empty list.</p>
</item>
<tag>
+<marker id="strict_arities"/><c>{strict_arities, boolean()
+ | encode
+ | decode}</c></tag>
+<item>
+<p>
+Whether or not to require that the number of AVPs in a message or
+grouped AVP agree with those specified in the dictionary in question.
+If <c>true</c> then mismatches in an outgoing messages cause message
+encoding to fail, while mismatches in an incoming message are reported
+as 5005/5009 errors in the errors field of the diameter_packet record
+passed to &app_handle_request; or &app_handle_answer; callbacks.
+If <c>false</c> then neither error is enforced/detected.
+If <c>encode</c> or <c>decode</c> then errors are only
+enforced/detected on outgoing or incoming messages respectively.</p>
+
+<p>
+Defaults to <c>true</c>.</p>
+
+<note>
+<p>
+Disabling arity checks affects the form of messages at encode/decode.
+In particular, decoded AVPs are represented as lists of values,
+regardless of the AVP's arity (ie. expected number in the message/AVP
+grammar in question), and values are expected to be supplied as lists
+at encode.
+This differs from the historic decode behaviour of representing AVPs
+of arity 1 as bare values, not wrapped in a list.</p>
+</note>
+</item>
+
+<tag>
<marker id="strict_mbit"/><c>{strict_mbit, boolean()}</c></tag>
<item>
<p>
@@ -993,6 +1053,26 @@ The default value is for backwards compatibility.</p>
</item>
+<tag>
+<marker id="traffic_counters"/><c>{traffic_counters, boolean()}</c></tag>
+<item>
+<p>
+Whether or not to count application-specific messages; those for which
+&man_app; callbacks take place.
+If false then only messages handled by diameter itself are counted:
+CER/CEA, DWR/DWA, DPR/DPA.</p>
+
+<p>
+Defaults to <c>true</c>.</p>
+
+<note>
+<p>
+Disabling counters is a performance improvement, but means that the
+omitted counters are not returned by &service_info;.</p>
+</note>
+
+</item>
+
<tag><c>{use_shared_peers, boolean() | [node()] | evaluable()}</c></tag>
<item>
<p>
diff --git a/lib/diameter/doc/src/diameter_codec.xml b/lib/diameter/doc/src/diameter_codec.xml
index 0117c1c88a..0846334d23 100644
--- a/lib/diameter/doc/src/diameter_codec.xml
+++ b/lib/diameter/doc/src/diameter_codec.xml
@@ -230,7 +230,8 @@ header.</p>
</item>
<tag>
-<marker id="message"/><c>message() = record() | list()</c></tag>
+<marker id="message"/><c>message() = record()
+ | maybe_improper_list()</c></tag>
<item>
<p>
The representation of a Diameter message as passed to
@@ -240,7 +241,11 @@ a message as defined in a dictionary file is encoded as a record with
one field for each component AVP.
Equivalently, a message can also be encoded as a list whose head is
the atom-valued message name (as specified in the relevant dictionary
-file) and whose tail is a list of <c>{AvpName, AvpValue}</c> pairs.</p>
+file) and whose tail is either a list of AVP name/values
+pairs or a map with values keyed on AVP names.
+The format at decode is determined by &mod_service_opt;
+<c>decode_format</c>.
+Any of the formats is accepted at encode.</p>
<p>
Another list-valued representation allows a message to be specified
diff --git a/lib/diameter/examples/code/node.erl b/lib/diameter/examples/code/node.erl
index 246be4194b..fc5830f8e2 100644
--- a/lib/diameter/examples/code/node.erl
+++ b/lib/diameter/examples/code/node.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,6 +30,8 @@
connect/2,
stop/1]).
+-export([message/3]).
+
-type protocol()
:: tcp | sctp.
@@ -128,6 +130,8 @@ stop(Name) ->
server_opts({T, Addr, Port}) ->
[{transport_module, tmod(T)},
{transport_config, [{reuseaddr, true},
+ {sender, true},
+ {message_cb, [fun ?MODULE:message/3, 0]},
{ip, addr(Addr)},
{port, Port}]}];
@@ -173,3 +177,26 @@ addr(loopback) ->
{127,0,0,1};
addr(A) ->
A.
+
+%% ---------------------------------------------------------------------------
+
+%% message/3
+%%
+%% Simple message callback that limits the number of concurrent
+%% requests on the peer connection in question.
+
+%% Incoming request.
+message(recv, <<_:32, 1:1, _/bits>> = Bin, N) ->
+ [Bin, N < 32, fun ?MODULE:message/3, N+1];
+
+%% Outgoing request.
+message(ack, <<_:32, 1:1, _/bits>>, _) ->
+ [];
+
+%% Incoming answer or request discarded.
+message(ack, _, N) ->
+ [N =< 32, fun ?MODULE:message/3, N-1];
+
+%% Outgoing message or incoming answer.
+message(_, Bin, _) ->
+ [Bin].
diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl
index fb6370fe54..548763ec7d 100644
--- a/lib/diameter/include/diameter_gen.hrl
+++ b/lib/diameter/include/diameter_gen.hrl
@@ -26,13 +26,13 @@
%% encode_avps/3
-encode_avps(Name, Vals, Opts) ->
- diameter_gen:encode_avps(Name, Vals, Opts#{module => ?MODULE}).
+encode_avps(Name, Avps, Opts) ->
+ diameter_gen:encode_avps(Name, Avps, Opts#{module => ?MODULE}).
%% decode_avps/2
-decode_avps(Name, Recs, Opts) ->
- diameter_gen:decode_avps(Name, Recs, Opts#{module => ?MODULE}).
+decode_avps(Name, Avps, Opts) ->
+ diameter_gen:decode_avps(Name, Avps, Opts#{module => ?MODULE}).
%% avp/5
diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index bd92e16fba..2e18a1d903 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -47,6 +47,8 @@
stop/0]).
-export_type([evaluable/0,
+ decode_format/0,
+ strict_arities/0,
restriction/0,
message_length/0,
remotes/0,
@@ -330,6 +332,18 @@ call(SvcName, App, Message) ->
-type message_length()
:: 0..16#FFFFFF.
+-type decode_format()
+ :: record
+ | list
+ | map
+ | false
+ | record_from_map.
+
+-type strict_arities()
+ :: false
+ | encode
+ | decode.
+
%% Options passed to start_service/2
-type service_opt()
@@ -338,7 +352,10 @@ call(SvcName, App, Message) ->
| {restrict_connections, restriction()}
| {sequence, sequence() | evaluable()}
| {share_peers, remotes()}
+ | {decode_format, decode_format()}
+ | {traffic_counters, boolean()}
| {string_decode, boolean()}
+ | {strict_arities, true | strict_arities()}
| {strict_mbit, boolean()}
| {incoming_maxlen, message_length()}
| {use_shared_peers, remotes()}
diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl
index 82fa796e69..63e39b12d1 100644
--- a/lib/diameter/src/base/diameter_codec.erl
+++ b/lib/diameter/src/base/diameter_codec.erl
@@ -29,7 +29,7 @@
msg_name/2,
msg_id/1]).
-%% Towards generated encoders (from diameter_gen.hrl).
+%% towards diameter_gen
-export([pack_data/2,
pack_avp/2]).
@@ -110,7 +110,7 @@ encode(Mod, Opts, Msg) ->
enc(_, Opts, #diameter_packet{msg = [#diameter_header{} = Hdr | As]}
= Pkt) ->
- try encode_avps(reorder(As), Opts) of
+ try encode_avps(As, Opts) of
Avps ->
Bin = list_to_binary(Avps),
Len = 20 + size(Bin),
@@ -206,51 +206,12 @@ values(Avps) ->
%% Message as a list of #diameter_avp{} ...
encode_avps(_, _, [#diameter_avp{} | _] = Avps, Opts) ->
- encode_avps(reorder(Avps), Opts);
+ encode_avps(Avps, Opts);
%% ... or as a tuple list or record.
encode_avps(Mod, MsgName, Values, Opts) ->
Mod:encode_avps(MsgName, Values, Opts).
-%% reorder/1
-%%
-%% Reorder AVPs for the relay case using the index field of
-%% diameter_avp records. Decode populates this field in collect_avps
-%% and presents AVPs in reverse order. A relay then sends the reversed
-%% list with a Route-Record AVP prepended. The goal here is just to do
-%% lists:reverse/1 in Grouped AVPs and the outer list, but only in the
-%% case there are indexed AVPs at all, so as not to reverse lists that
-%% have been explicilty sent (unindexed, in the desired order) as a
-%% diameter_avp list. The effect is the same as lists:keysort/2, but
-%% only on the cases we expect, not a general sort.
-
-reorder(Avps) ->
- case reorder(Avps, []) of
- false ->
- Avps;
- Sorted ->
- Sorted
- end.
-
-%% reorder/3
-
-%% In case someone has reversed the list already. (Not likely.)
-reorder([#diameter_avp{index = 0} | _] = Avps, Acc) ->
- Avps ++ Acc;
-
-%% Assume indexed AVPs are in reverse order.
-reorder([#diameter_avp{index = N} = A | Avps], Acc)
- when is_integer(N) ->
- lists:reverse(Avps, [A | Acc]);
-
-%% An unindexed AVP.
-reorder([H | T], Acc) ->
- reorder(T, [H | Acc]);
-
-%% No indexed members.
-reorder([], _) ->
- false.
-
%% encode_avps/2
encode_avps(Avps, Opts) ->
@@ -287,7 +248,8 @@ rec2msg(Mod, Rec) ->
%% longer *the* decode.
decode(Mod, Pkt) ->
- Opts = #{string_decode => true,
+ Opts = #{decode_format => record,
+ string_decode => true,
strict_mbit => true,
rfc => 6733},
decode(Mod, Opts, Pkt).
@@ -326,13 +288,7 @@ decode(Mod, AppMod, Opts, Pkt) ->
%% Relay application: just extract the avp's without any decoding of
%% their data since we don't know the application in question.
decode(?APP_ID_RELAY, _, _, _, #diameter_packet{} = Pkt) ->
- case collect_avps(Pkt) of
- {E, As} ->
- Pkt#diameter_packet{avps = As,
- errors = [E]};
- As ->
- Pkt#diameter_packet{avps = As}
- end;
+ collect_avps(Pkt);
%% Otherwise decode using the dictionary.
decode(_, Mod, AppMod, Opts, #diameter_packet{header = Hdr} = Pkt) ->
@@ -341,44 +297,50 @@ decode(_, Mod, AppMod, Opts, #diameter_packet{header = Hdr} = Pkt) ->
is_error = IsError}
= Hdr,
- MsgName = if IsError andalso not IsRequest ->
+ MsgName = if IsError, not IsRequest ->
'answer-message';
true ->
Mod:msg_name(CmdCode, IsRequest)
end,
- decode_avps(MsgName, Mod, AppMod, Opts, Pkt, collect_avps(Pkt));
+ decode_avps(MsgName, Mod, AppMod, Opts, Pkt);
decode(Id, Mod, AppMod, Opts, Bin)
when is_binary(Bin) ->
decode(Id, Mod, AppMod, Opts, #diameter_packet{header = decode_header(Bin),
bin = Bin}).
-%% decode_avps/6
-
-decode_avps(MsgName, Mod, AppMod, Opts, Pkt, {E, Avps}) ->
- ?LOG(invalid_avp_length, Pkt#diameter_packet.header),
- #diameter_packet{errors = Failed}
- = P
- = decode_avps(MsgName, Mod, AppMod, Opts, Pkt, Avps),
- P#diameter_packet{errors = [E | Failed]};
+%% decode_avps/5
-decode_avps('', _, _, _, Pkt, Avps) -> %% unknown message ...
- ?LOG(unknown_message, Pkt#diameter_packet.header),
- Pkt#diameter_packet{avps = lists:reverse(Avps),
- errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED
+decode_avps('', _, _, _, #diameter_packet{header = H, %% unknown message
+ bin = Bin}
+ = Pkt) ->
+ ?LOG(unknown_message, H),
+ Pkt#diameter_packet{avps = collect_avps(Bin),
+ errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED
%% msg = undefined identifies this case.
-decode_avps(MsgName, Mod, AppMod, Opts, Pkt, Avps) -> %% ... or not
+decode_avps(MsgName, Mod, AppMod, Opts, #diameter_packet{bin = Bin} = Pkt) ->
+ {_, Avps} = split_binary(Bin, 20),
{Rec, As, Errors} = Mod:decode_avps(MsgName,
Avps,
Opts#{dictionary => AppMod,
failed_avp => false}),
?LOGC([] /= Errors, decode_errors, Pkt#diameter_packet.header),
- Pkt#diameter_packet{msg = Rec,
+ Pkt#diameter_packet{msg = reformat(MsgName, Rec, Opts),
errors = Errors,
avps = As}.
+%% reformat/3
+
+reformat(MsgName, Avps, #{decode_format := T})
+ when T == map;
+ T == list ->
+ [MsgName | Avps];
+
+reformat(_, Msg, _) ->
+ Msg.
+
%%% ---------------------------------------------------------------------------
%%% # decode_header/1
%%% ---------------------------------------------------------------------------
@@ -515,24 +477,21 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/binary>>) ->
%%% # collect_avps/1
%%% ---------------------------------------------------------------------------
-%% Note that the returned list of AVP's is reversed relative to their
-%% order in the binary. Note also that grouped avp's aren't unraveled,
-%% only those at the top level.
+%% This is only used for the relay decode. Note that grouped avp's
+%% aren't unraveled, only those at the top level.
--spec collect_avps(#diameter_packet{} | binary())
- -> [Avp]
- | {Error, [Avp]}
- when Avp :: #diameter_avp{},
- Error :: {5014, #diameter_avp{}}.
+-spec collect_avps(#diameter_packet{})
+ -> #diameter_packet{};
+ (binary())
+ -> [#diameter_avp{}].
-collect_avps(#diameter_packet{bin = <<_:20/binary, Avps/binary>>}) ->
- collect_avps(Avps, 0, []);
+collect_avps(#diameter_packet{bin = Bin} = Pkt) ->
+ Pkt#diameter_packet{avps = collect_avps(Bin)};
-collect_avps(Bin)
- when is_binary(Bin) ->
- collect_avps(Bin, 0, []).
+collect_avps(<<_:20/binary, Avps/binary>>) ->
+ collect(Avps).
-%% collect_avps/3
+%% collect/1
%% 0 1 2 3
%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
@@ -546,66 +505,48 @@ collect_avps(Bin)
%% | Data ...
%% +-+-+-+-+-+-+-+-+
-collect_avps(<<Code:32, V:1, M:1, P:1, _:5, Len:24, I:V/unit:32, Rest/binary>>,
- N,
- Acc) ->
- collect_avps(Code,
- if 1 == V -> I; 0 == V -> undefined end,
- 1 == M,
- 1 == P,
- Len - 8 - V*4, %% Might be negative, which ensures
- ?PAD(Len), %% failure of the Data match below.
- Rest,
- N,
- Acc);
-
-collect_avps(<<>>, _, Acc) ->
- Acc;
+collect(<<Code:32, V:1, M:1, P:1, _:5, Len:24, I:V/unit:32, Rest/binary>>) ->
+ collect(Rest,
+ Code,
+ if 1 == V -> I; 0 == V -> undefined end,
+ Len - 8 - V*4, %% Might be negative, which ensures
+ ?PAD(Len), %% failure of the match below.
+ 1 == M,
+ 1 == P);
+
+collect(<<>>) ->
+ [];
%% Header is truncated. pack_avp/1 will pad this at encode if sent in
%% a Failed-AVP.
-collect_avps(Bin, _, Acc) ->
- {{5014, #diameter_avp{data = Bin}}, Acc}.
+collect(Bin) ->
+ [#diameter_avp{data = {5014, Bin}}].
-%% collect_avps/9
+%% collect/7
-%% Duplicate the diameter_avp creation in each branch below to avoid
-%% modifying the record, which profiling has shown to be a relatively
-%% costly part of building the list.
-
-collect_avps(Code, VendorId, M, P, Len, Pad, Rest, N, Acc) ->
- case Rest of
- <<Data:Len/binary, _:Pad/binary, T/binary>> ->
+collect(Bin, Code, Vid, DataLen, Pad, M, P) ->
+ case Bin of
+ <<Data:DataLen/binary, _:Pad/binary, Rest/binary>> ->
Avp = #diameter_avp{code = Code,
- vendor_id = VendorId,
+ vendor_id = Vid,
is_mandatory = M,
need_encryption = P,
- data = Data,
- index = N},
- collect_avps(T, N+1, [Avp | Acc]);
+ data = Data},
+ [Avp | collect(Rest)];
_ ->
%% Length in header points past the end of the message, or
- %% doesn't span the header. As stated in the 6733 text
- %% above, it's sufficient to return a zero-filled minimal
- %% payload if this is a request. Do this (in cases that we
- %% know the type) by inducing a decode failure and letting
- %% the dictionary's decode (in diameter_gen) deal with it.
- %%
- %% Note that the extra bit can only occur in the trailing
- %% AVP of a message or Grouped AVP, since a faulty AVP
- %% Length is otherwise indistinguishable from a correct
- %% one here, as we don't know the types of the AVPs being
- %% extracted.
- Avp = #diameter_avp{code = Code,
- vendor_id = VendorId,
- is_mandatory = M,
- need_encryption = P,
- data = {5014, Rest},
- index = N},
- [Avp | Acc]
+ %% doesn't span the header. Note that an length error can
+ %% only occur in the trailing AVP of a message or Grouped
+ %% AVP, since a faulty AVP Length is otherwise
+ %% indistinguishable from a correct one here, as we don't
+ %% know the types of the AVPs being extracted.
+ [#diameter_avp{code = Code,
+ vendor_id = Vid,
+ is_mandatory = M,
+ need_encryption = P,
+ data = {5014, Bin}}]
end.
-
%% 3588:
%%
%% DIAMETER_INVALID_AVP_LENGTH 5014
diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl
index 34018ae6d3..f1b6e56782 100644
--- a/lib/diameter/src/base/diameter_config.erl
+++ b/lib/diameter/src/base/diameter_config.erl
@@ -712,7 +712,10 @@ make_config(SvcName, Opts) ->
{?NOMASK, sequence},
{nodes, restrict_connections},
{16#FFFFFF, incoming_maxlen},
+ {true, strict_arities},
{true, strict_mbit},
+ {record, decode_format},
+ {true, traffic_counters},
{true, string_decode},
{[], spawn_opt}]),
@@ -755,17 +758,34 @@ opt(K, false = B)
K == use_shared_peers;
K == monitor;
K == restrict_connections;
+ K == strict_arities;
K == strict_mbit;
+ K == decode_format;
+ K == traffic_counters;
K == string_decode ->
B;
opt(K, true = B)
when K == share_peers;
K == use_shared_peers;
+ K == strict_arities;
K == strict_mbit;
+ K == traffic_counters;
K == string_decode ->
B;
+opt(decode_format, T)
+ when T == record;
+ T == list;
+ T == map;
+ T == record_from_map ->
+ T;
+
+opt(strict_arities, T)
+ when T == encode;
+ T == decode ->
+ T;
+
opt(restrict_connections, T)
when T == node;
T == nodes ->
diff --git a/lib/diameter/src/base/diameter_gen.erl b/lib/diameter/src/base/diameter_gen.erl
index e832832876..7a1a46ec52 100644
--- a/lib/diameter/src/base/diameter_gen.erl
+++ b/lib/diameter/src/base/diameter_gen.erl
@@ -26,6 +26,14 @@
-module(diameter_gen).
+-compile({inline, [incr/8,
+ incr/4,
+ field/1,
+ setopts/4,
+ avp_arity/5,
+ set_failed/2,
+ set_strict/3]}).
+
-export([encode_avps/3,
decode_avps/3,
grouped_avp/4,
@@ -46,17 +54,23 @@
-type grouped_avp() :: nonempty_improper_list(#diameter_avp{}, [avp()]).
-type avp() :: non_grouped_avp() | grouped_avp().
+%% The arbitrary arity returned from dictionary avp_arity functions.
+-define(ANY, {0, '*'}).
+
%% ---------------------------------------------------------------------------
%% # encode_avps/3
%% ---------------------------------------------------------------------------
--spec encode_avps(parent_name(), parent_record() | avp_values(), map())
+-spec encode_avps(parent_name(),
+ parent_record() | avp_values() | map(),
+ map())
-> iolist()
| no_return().
encode_avps(Name, Vals, #{module := Mod} = Opts) ->
+ Strict = mget(strict_arities, Opts, encode),
try
- encode(Name, Vals, Opts, Mod)
+ encode(Name, Vals, Opts, Strict, Mod)
catch
throw: {?MODULE, Reason} ->
diameter_lib:log({encode, error},
@@ -73,64 +87,109 @@ encode_avps(Name, Vals, #{module := Mod} = Opts) ->
erlang:error({encode_failure, Reason, Name, Stack})
end.
-%% encode/4
+%% encode/5
-encode(Name, Vals, #{ordered_encode := false} = Opts, Mod)
+encode(Name, Vals, Opts, Strict, Mod)
when is_list(Vals) ->
- lists:map(fun({F,V}) -> encode(Name, F, V, Opts, Mod) end, Vals);
+ case Opts of
+ #{ordered_encode := false} ->
+ lists:map(fun({F,V}) -> encode(Name, F, V, Opts, Strict, Mod) end,
+ Vals);
+ _ ->
+ Rec = Mod:'#set-'(Vals, newrec(Mod, Name)),
+ encode(Name, Rec, Opts, Strict, Mod)
+ end;
-encode(Name, Vals, Opts, Mod)
- when is_list(Vals) ->
- encode(Name, Mod:'#set-'(Vals, newrec(Mod, Name)), Opts, Mod);
+encode(Name, Map, Opts, Strict, Mod)
+ when is_map(Map) ->
+ [enc(Name, F, A, V, Opts, Strict, Mod) || {F,A} <- Mod:avp_arity(Name),
+ V <- [mget(F, Map, undefined)]];
-encode(Name, Rec, Opts, Mod) ->
- [encode(Name, F, V, Opts, Mod) || {F,V} <- Mod:'#get-'(Rec)].
+encode(Name, Rec, Opts, Strict, Mod) ->
+ [encode(Name, F, V, Opts, Strict, Mod) || {F,V} <- Mod:'#get-'(Rec)].
-%% encode/5
+%% encode/6
+
+encode(Name, AvpName, Values, Opts, Strict, Mod)
+ when Strict /= encode ->
+ enc(Name, AvpName, ?ANY, Values, Opts, Strict, Mod);
-encode(Name, AvpName, Values, Opts, Mod) ->
- enc(Name, AvpName, Mod:avp_arity(Name, AvpName), Values, Opts, Mod).
+encode(Name, AvpName, Values, Opts, Strict, Mod) ->
+ Arity = Mod:avp_arity(Name, AvpName),
+ enc(Name, AvpName, Arity, Values, Opts, Strict, Mod).
-%% enc/6
+%% enc/7
-enc(_, AvpName, 1, undefined, _, _) ->
+enc(Name, AvpName, Arity, Values, Opts, Strict, Mod)
+ when Strict /= encode, Arity /= ?ANY ->
+ enc(Name, AvpName, ?ANY, Values, Opts, Strict, Mod);
+
+enc(_, AvpName, 1, undefined, _, _, _) ->
?THROW([mandatory_avp_missing, AvpName]);
-enc(Name, AvpName, 1, Value, Opts, Mod) ->
- enc(Name, AvpName, [Value], Opts, Mod);
+enc(Name, AvpName, 1, Value, Opts, _, Mod) ->
+ H = avp_header(AvpName, Mod),
+ enc1(Name, AvpName, H, Value, Opts, Mod);
+
+enc(_, _, {0,_}, [], _, _, _) ->
+ [];
-enc(_, _, {0,_}, [], _, _) ->
+enc(_, _, _, undefined, _, _, _) ->
[];
-enc(_, AvpName, _, T, _, _)
- when not is_list(T) ->
- ?THROW([repeated_avp_as_non_list, AvpName, T]);
+%% Be forgiving when a list of values is expected. If the value itself
+%% is a list then the user has to wrap it to avoid each member from
+%% being interpreted as an individual AVP value.
+enc(Name, AvpName, Arity, V, Opts, Strict, Mod)
+ when not is_list(V) ->
+ enc(Name, AvpName, Arity, [V], Opts, Strict, Mod);
-enc(_, AvpName, {Min, _}, L, _, _)
- when length(L) < Min ->
- ?THROW([repeated_avp_insufficient_arity, AvpName, Min, L]);
+enc(Name, AvpName, {Min, Max}, Values, Opts, Strict, Mod) ->
+ H = avp_header(AvpName, Mod),
+ enc(Name, AvpName, H, Min, 0, Max, Values, Opts, Strict, Mod).
-enc(_, AvpName, {_, Max}, L, _, _)
- when Max < length(L) ->
- ?THROW([repeated_avp_excessive_arity, AvpName, Max, L]);
+%% enc/10
-enc(Name, AvpName, _, Values, Opts, Mod) ->
- enc(Name, AvpName, Values, Opts, Mod).
+enc(Name, AvpName, H, Min, N, Max, Vs, Opts, Strict, Mod)
+ when Strict /= encode;
+ Max == '*', Min =< N ->
+ [enc1(Name, AvpName, H, V, Opts, Mod) || V <- Vs];
-%% enc/5
+enc(_, AvpName, _, Min, N, _, [], _, _, _)
+ when N < Min ->
+ ?THROW([repeated_avp_insufficient_arity, AvpName, Min, N]);
-enc(Name, 'AVP', Values, Opts, Mod) ->
- [enc_AVP(Name, A, Opts, Mod) || A <- Values];
+enc(_, _, _, _, _, _, [], _, _, _) ->
+ [];
-enc(_, AvpName, Values, Opts, Mod) ->
- enc(AvpName, Values, Opts, Mod).
+enc(_, AvpName, _, _, N, Max, _, _, _, _)
+ when Max =< N ->
+ ?THROW([repeated_avp_excessive_arity, AvpName, Max]);
-%% enc/4
+enc(Name, AvpName, H, Min, N, Max, [V|Vs], Opts, Strict, Mod) ->
+ [enc1(Name, AvpName, H, V, Opts, Mod)
+ | enc(Name, AvpName, H, Min, N+1, Max, Vs, Opts, Strict, Mod)].
-enc(AvpName, Values, Opts, Mod) ->
- H = Mod:avp_header(AvpName),
- [diameter_codec:pack_data(H, Mod:avp(encode, V, AvpName, Opts))
- || V <- Values].
+%% avp_header/2
+
+avp_header('AVP', _) ->
+ false;
+
+avp_header(AvpName, Mod) ->
+ {_,_,_} = Mod:avp_header(AvpName).
+
+%% enc1/6
+
+enc1(Name, 'AVP', false, Value, Opts, Mod) ->
+ enc_AVP(Name, Value, Opts, Mod);
+
+enc1(_, AvpName, Hdr, Value, Opts, Mod) ->
+ enc1(AvpName, Hdr, Value, Opts, Mod).
+
+%% enc1/5
+
+enc1(AvpName, {_,_,_} = Hdr, Value, Opts, Mod) ->
+ diameter_codec:pack_data(Hdr, Mod:avp(encode, Value, AvpName, Opts)).
%% enc_AVP/4
@@ -153,48 +212,190 @@ enc_AVP(_, #diameter_avp{name = N, value = V}, _, _)
enc_AVP(Name, #diameter_avp{name = AvpName, value = Data}, Opts, Mod) ->
0 == Mod:avp_arity(Name, AvpName)
orelse ?THROW([known_avp_as_AVP, Name, AvpName, Data]),
- enc(AvpName, [Data], Opts, Mod);
+ enc(AvpName, Data, Opts, Mod);
%% The backdoor ...
enc_AVP(_, {AvpName, Value}, Opts, Mod) ->
- enc(AvpName, [Value], Opts, Mod);
+ enc(AvpName, Value, Opts, Mod);
%% ... and the side door.
enc_AVP(_Name, {_Dict, _AvpName, _Data} = T, Opts, _) ->
diameter_codec:pack_avp(#diameter_avp{data = T}, Opts).
+%% enc/4
+
+enc(AvpName, Value, Opts, Mod) ->
+ enc1(AvpName, Mod:avp_header(AvpName), Value, Opts, Mod).
+
%% ---------------------------------------------------------------------------
%% # decode_avps/3
%% ---------------------------------------------------------------------------
--spec decode_avps(parent_name(), [#diameter_avp{}], map())
+-spec decode_avps(parent_name(), binary(), map())
-> {parent_record(), [avp()], Failed}
when Failed :: [{5000..5999, #diameter_avp{}}].
-decode_avps(Name, Recs, #{module := Mod} = Opts) ->
- {Avps, {Rec, Failed}}
- = mapfoldl(fun(T,A) -> decode(Name, Opts, Mod, T, A) end,
- {newrec(Mod, Name), []},
- Recs),
- {Rec, Avps, Failed ++ missing(Rec, Name, Failed, Opts, Mod)}.
-%% Append 5005 errors so that errors are reported in the order
+decode_avps(Name, Bin, #{module := Mod, decode_format := Fmt} = Opts) ->
+ Strict = mget(strict_arities, Opts, decode),
+ [AM, Avps, Failed | Rec]
+ = decode(Bin, Name, Mod, Fmt, Strict, Opts, #{}),
+ %% AM counts the number of top-level AVPs, which missing/5 then
+ %% uses when appending 5005 errors.
+ {reformat(Name, Rec, Strict, Mod, Fmt),
+ Avps,
+ Failed ++ missing(Name, Strict, Mod, Opts, AM)}.
+
+%% Append arity errors so that errors are reported in the order
%% encountered. Failed-AVP should typically contain the first
-%% encountered error accordg to the RFC.
+%% error encountered.
+
+%% decode/7
-%% mapfoldl/3
+decode(<<Code:32, V:1, M:1, P:1, _:5, Len:24, I:V/unit:32, Rest/binary>>,
+ Name,
+ Mod,
+ Fmt,
+ Strict,
+ Opts,
+ AM) ->
+ decode(Rest,
+ Code,
+ if 1 == V -> I; true -> undefined end,
+ Len - 8 - 4*V, %% possibly negative, causing case match to fail
+ (4 - (Len rem 4)) rem 4,
+ 1 == M,
+ 1 == P,
+ Name,
+ Mod,
+ Fmt,
+ Strict,
+ Opts,
+ AM);
+
+decode(<<>>, Name, Mod, Fmt, Strict, _, AM) ->
+ [AM, [], [] | newrec(Fmt, Mod, Name, Strict)];
+
+decode(Bin, Name, Mod, Fmt, Strict, _, AM) ->
+ Avp = #diameter_avp{data = Bin},
+ [AM, [Avp], [{5014, Avp}] | newrec(Fmt, Mod, Name, Strict)].
+
+%% decode/13
+
+decode(Bin, Code, Vid, DataLen, Pad, M, P, Name, Mod, Fmt, Strict, Opts0, AM0) ->
+ case Bin of
+ <<Data:DataLen/binary, _:Pad/binary, T/binary>> ->
+ {NameT, AvpName, Arity, {Idx, AM}}
+ = incr(Name, Code, Vid, M, Mod, Strict, Opts0, AM0),
+
+ Opts = setopts(NameT, Name, M, Opts0),
+ %% Not AvpName or else a failed Failed-AVP
+ %% decode is packed into 'AVP'.
+
+ Avp = #diameter_avp{code = Code,
+ vendor_id = Vid,
+ is_mandatory = M,
+ need_encryption = P,
+ data = Data,
+ name = name(NameT),
+ type = type(NameT),
+ index = Idx},
+
+ Dec = decode(Data, Name, NameT, Mod, Opts, Avp), %% decode
+ Acc = decode(T, Name, Mod, Fmt, Strict, Opts, AM), %% recurse
+ acc(Acc, Dec, Name, AvpName, Arity, Strict, Mod, Opts);
+ _ ->
+ {NameT, _AvpName, _Arity, {Idx, AM}}
+ = incr(Name, Code, Vid, M, Mod, Strict, Opts0, AM0),
+
+ Avp = #diameter_avp{code = Code,
+ vendor_id = Vid,
+ is_mandatory = M,
+ need_encryption = P,
+ data = Bin,
+ name = name(NameT),
+ type = type(NameT),
+ index = Idx},
+
+ [AM, [Avp], [{5014, Avp}] | newrec(Fmt, Mod, Name, Strict)]
+ end.
+
+%% incr/8
+
+incr(Name, Code, Vid, M, Mod, Strict, Opts, AM0) ->
+ NameT = Mod:avp_name(Code, Vid), %% {AvpName, Type} | 'AVP'
+ AvpName = field(NameT),
+ Arity = avp_arity(Name, AvpName, Mod, Opts, M),
+ {NameT, AvpName, Arity, incr(AvpName, Arity, Strict, AM0)}.
+
+%% Data is a truncated header if command_code = undefined, otherwise
+%% payload bytes. The former is padded to the length of a header if
+%% the AVP reaches an outgoing encode.
%%
-%% Like lists:mapfoldl/3, but don't reverse the list.
+%% RFC 6733 says that an AVP returned with 5014 can contain a minimal
+%% payload for the AVP's type, but don't always know the type.
-mapfoldl(F, Acc, List) ->
- mapfoldl(F, Acc, List, []).
+setopts('AVP', _, _, Opts) ->
+ Opts;
-mapfoldl(F, Acc0, [T|Rest], List) ->
- {B, Acc} = F(T, Acc0),
- mapfoldl(F, Acc, Rest, [B|List]);
-mapfoldl(_, Acc, [], List) ->
- {List, Acc}.
+setopts({_, Type}, Name, M, Opts) ->
+ set_failed(Name, set_strict(Type, M, Opts)).
-%% 3588:
+%% incr/4
+
+incr(F, A, SA, AM)
+ when F == 'AVP';
+ A == ?ANY;
+ A == 0;
+ SA /= decode ->
+ {undefined, AM};
+
+incr(AvpName, _, _, AM) ->
+ case AM of
+ #{AvpName := N} ->
+ {N, AM#{AvpName => N+1}};
+ _ ->
+ {0, AM#{AvpName => 1}}
+ end.
+
+%% mget/3
+%%
+%% Measurably faster than maps:get/3.
+
+mget(Key, Map, Def) ->
+ case Map of
+ #{Key := V} ->
+ V;
+ _ ->
+ Def
+ end.
+
+%% name/1
+
+name({Name, _}) ->
+ Name;
+name(_) ->
+ undefined.
+
+%% type/1
+
+type({_, Type}) ->
+ Type;
+type(_) ->
+ undefined.
+
+%% missing/5
+
+missing(Name, decode, Mod, Opts, AM) ->
+ [{5005, empty_avp(N, Opts, Mod)} || {N,A} <- Mod:avp_arity(Name),
+ N /= 'AVP',
+ Mn <- [min_arity(A)],
+ 0 < Mn,
+ mget(N, AM, 0) < Mn];
+
+missing(_, _, _, _, _) ->
+ [].
+
+%% 3588/6733:
%%
%% DIAMETER_MISSING_AVP 5005
%% The request did not contain an AVP that is required by the Command
@@ -204,57 +405,20 @@ mapfoldl(_, Acc, [], List) ->
%% Vendor-Id if applicable. The value field of the missing AVP
%% should be of correct minimum length and contain zeros.
-missing(Rec, Name, Failed, Opts, Mod) ->
- Avps = lists:foldl(fun({_, #diameter_avp{code = C, vendor_id = V}}, A) ->
- maps:put({C,V}, true, A)
- end,
- maps:new(),
- Failed),
- missing(Mod:avp_arity(Name), tl(tuple_to_list(Rec)), Avps, Opts, Mod, []).
-
-missing([{Name, Arity} | As], [Value | Vs], Avps, Opts, Mod, Acc) ->
- missing(As,
- Vs,
- Avps,
- Opts,
- Mod,
- case
- [H || missing_arity(Arity, Value),
- {C,_,V} = H <- [Mod:avp_header(Name)],
- not maps:is_key({C,V}, Avps)]
- of
- [H] ->
- [{5005, empty_avp(Name, H, Opts, Mod)} | Acc];
- [] ->
- Acc
- end);
-
-missing([], [], _, _, _, Acc) ->
- Acc.
-
-%% Maximum arities have already been checked in building the record.
-
-missing_arity(1, V) ->
- V == undefined;
-missing_arity({0, _}, _) ->
- false;
-missing_arity({1, _}, L) ->
- [] == L;
-missing_arity({Min, _}, L) ->
- not has_prefix(Min, L).
-
-%% Compare a non-negative integer and the length of a list without
-%% computing the length.
-has_prefix(0, _) ->
- true;
-has_prefix(_, []) ->
- false;
-has_prefix(N, [_|L]) ->
- has_prefix(N-1, L).
+%% min_arity/1
+
+min_arity(1) ->
+ 1;
+min_arity({Mn,_}) ->
+ Mn.
-%% empty_avp/4
+%% empty_avp/3
-empty_avp(Name, {Code, Flags, VId}, Opts, Mod) ->
+empty_avp('AVP', _, _) ->
+ #diameter_avp{data = <<0:64>>};
+
+empty_avp(Name, Opts, Mod) ->
+ {Code, Flags, VId} = Mod:avp_header(Name),
{Name, Type} = Mod:avp_name(Code, VId),
#diameter_avp{name = Name,
code = Code,
@@ -273,21 +437,18 @@ empty_avp(Name, {Code, Flags, VId}, Opts, Mod) ->
%% specific errors that can be described by this AVP are described in
%% the following section.
-%% decode/5
+%% field/1
-decode(Name,
- Opts,
- Mod,
- #diameter_avp{code = Code, vendor_id = Vid}
- = Avp,
- Acc) ->
- decode(Name, Opts, Mod, Mod:avp_name(Code, Vid), Avp, Acc).
+field({AvpName, _}) ->
+ AvpName;
+field(_) ->
+ 'AVP'.
%% decode/6
%% AVP not in dictionary.
-decode(Name, Opts, Mod, 'AVP', Avp, Acc) ->
- decode_AVP(Name, Avp, Opts, Mod, Acc);
+decode(_Data, _Name, 'AVP', _Mod, _Opts, Avp) ->
+ Avp;
%% 6733, 4.4:
%%
@@ -336,130 +497,70 @@ decode(Name, Opts, Mod, 'AVP', Avp, Acc) ->
%% defined the RFC's "unrecognized", which is slightly stronger than
%% "not defined".)
-decode(Name, Opts0, Mod, {AvpName, Type}, Avp, Acc) ->
- #diameter_avp{data = Data, is_mandatory = M}
- = Avp,
-
- %% Whether or not to ignore an M-bit on an encapsulated AVP, or on
- %% all AVPs with the service_opt() strict_mbit.
- Opts1 = set_strict(Type, M, Opts0),
-
- %% Whether or not we're decoding within Failed-AVP and should
- %% ignore decode errors.
+decode(Data, Name, {AvpName, Type}, Mod, Opts, Avp) ->
#{dictionary := AppMod, failed_avp := Failed}
- = Opts
- = set_failed(Name, Opts1), %% Not AvpName or else a failed Failed-AVP
- %% decode is packed into 'AVP'.
+ = Opts,
%% Reset the dictionary for best-effort decode of Failed-AVP.
- DecMod = if Failed ->
- AppMod;
- true ->
- Mod
+ DecMod = if Failed -> AppMod;
+ true -> Mod
end,
- %% On decode, a Grouped AVP is represented as a #diameter_avp{}
- %% list with AVP as head and component AVPs as tail. On encode,
- %% data can be a list of component AVPs.
+ %% A Grouped AVP is represented as a #diameter_avp{} list with AVP
+ %% as head and component AVPs as tail. On encode, data can be a
+ %% list of component AVPs.
try avp_decode(Data, AvpName, Opts, DecMod, Mod) of
{Rec, As} when Type == 'Grouped' ->
- A = Avp#diameter_avp{name = AvpName,
- value = Rec,
- type = Type},
- {[A|As], pack_avp(Name, A, Opts, Mod, Acc)};
-
+ A = Avp#diameter_avp{value = Rec},
+ [A | As];
V when Type /= 'Grouped' ->
- A = Avp#diameter_avp{name = AvpName,
- value = V,
- type = Type},
- {A, pack_avp(Name, A, Opts, Mod, Acc)}
+ Avp#diameter_avp{value = V}
catch
- throw: {?MODULE, {grouped, Error, ComponentAvps}} ->
- decode_error(Name,
- Error,
- ComponentAvps,
- Opts,
- Mod,
- Avp#diameter_avp{name = AvpName,
- data = trim(Avp#diameter_avp.data),
- type = Type},
- Acc);
-
+ throw: {?MODULE, T} ->
+ decode_error(Failed, T, Avp);
error: Reason ->
- decode_error(Name,
- Reason,
- Opts,
- Mod,
- Avp#diameter_avp{name = AvpName,
- data = trim(Avp#diameter_avp.data),
- type = Type},
- Acc)
+ decode_error(Failed, Reason, Name, Mod, Opts, Avp)
end.
-%% avp_decode/5
-
-avp_decode(Data, AvpName, Opts, Mod, Mod) ->
- Mod:avp(decode, Data, AvpName, Opts);
-
-avp_decode(Data, AvpName, Opts, Mod, _) ->
- Mod:avp(decode, Data, AvpName, Opts, Mod).
-
-%% trim/1
+%% decode_error/3
%%
-%% Remove any extra bit that was added in diameter_codec to induce a
-%% 5014 error.
-
-trim(#diameter_avp{data = Data} = Avp) ->
- Avp#diameter_avp{data = trim(Data)};
+%% Error when decoding a grouped AVP.
-trim({5014, Bin}) ->
- Bin;
+decode_error(true, {Rec, _, _}, Avp) ->
+ Avp#diameter_avp{value = Rec};
-trim(Avps)
- when is_list(Avps) ->
- lists:map(fun trim/1, Avps);
+decode_error(false, {_, ComponentAvps, [{RC,A} | _]}, Avp) ->
+ {RC, [Avp | ComponentAvps], Avp#diameter_avp{data = [A]}}.
-trim(Avp) ->
- Avp.
-
-%% decode_error/7
-
-decode_error(Name, [_ | Rec], _, #{failed_avp := true} = Opts, Mod, Avp, Acc) ->
- decode_AVP(Name, Avp#diameter_avp{value = Rec}, Opts, Mod, Acc);
-
-decode_error(Name, _, _, #{failed_avp := true} = Opts, Mod, Avp, Acc) ->
- decode_AVP(Name, Avp, Opts, Mod, Acc);
-
-decode_error(_, [Error | _], ComponentAvps, _, _, Avp, Acc) ->
- decode_error(Error, Avp, Acc, ComponentAvps);
-
-decode_error(_, Error, ComponentAvps, _, _, Avp, Acc) ->
- decode_error(Error, Avp, Acc, ComponentAvps).
-
-%% decode_error/5
+%% decode_error/6
+%%
+%% Error when decoding a non-grouped AVP.
-decode_error(Name, _Reason, #{failed_avp := true} = Opts, Mod, Avp, Acc) ->
- decode_AVP(Name, Avp, Opts, Mod, Acc);
+decode_error(true, _, _, _, _, Avp) ->
+ Avp;
-decode_error(Name, Reason, Opts, Mod, Avp, {Rec, Failed}) ->
+decode_error(false, Reason, Name, Mod, Opts, Avp) ->
Stack = diameter_lib:get_stacktrace(),
diameter_lib:log(decode_error,
?MODULE,
?LINE,
{Reason, Name, Avp#diameter_avp.name, Mod, Stack}),
- {Avp, {Rec, [rc(Reason, Avp, Opts, Mod) | Failed]}}.
+ rc(Reason, Avp, Opts, Mod).
-%% decode_error/4
+%% avp_decode/5
-decode_error({RC, ErrorData}, Avp, {Rec, Failed}, ComponentAvps) ->
- E = Avp#diameter_avp{data = [ErrorData]},
- {[Avp | trim(ComponentAvps)], {Rec, [{RC, E} | Failed]}}.
+avp_decode(Data, AvpName, Opts, Mod, Mod) ->
+ Mod:avp(decode, Data, AvpName, Opts);
-%% set_strict/3
+avp_decode(Data, AvpName, Opts, Mod, _) ->
+ Mod:avp(decode, Data, AvpName, Opts, Mod).
+%% set_strict/3
+%%
%% Set false as soon as we see a Grouped AVP that doesn't set the
%% M-bit, to ignore the M-bit on an encapsulated AVP.
+
set_strict('Grouped', false = M, #{strict_mbit := true} = Opts) ->
Opts#{strict_mbit := M};
set_strict(_, _, Opts) ->
@@ -476,102 +577,82 @@ set_failed('Failed-AVP', #{failed_avp := false} = Opts) ->
set_failed(_, Opts) ->
Opts.
-%% decode_AVP/5
-%%
-%% Don't know this AVP: see if it can be packed in an 'AVP' field
-%% undecoded. Note that the type field is 'undefined' in this case.
+%% acc/8
-decode_AVP(Name, Avp, Opts, Mod, Acc) ->
- {trim(Avp), pack_AVP(Name, Avp, Opts, Mod, Acc)}.
-
-%% rc/2
-
-%% diameter_types will raise an error of this form to communicate
-%% DIAMETER_INVALID_AVP_LENGTH (5014). A module specified to a
-%% @custom_types tag in a dictionary file can also raise an error of
-%% this form.
-rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = Avp, Opts, Mod) ->
- {RC, Avp#diameter_avp{data = Mod:empty_value(AvpName, Opts)}};
-
-%% 3588:
-%%
-%% DIAMETER_INVALID_AVP_VALUE 5004
-%% The request contained an AVP with an invalid value in its data
-%% portion. A Diameter message indicating this error MUST include
-%% the offending AVPs within a Failed-AVP AVP.
-rc(_, Avp, _, _) ->
- {5004, Avp}.
+acc([AM | Acc], As, Name, AvpName, Arity, Strict, Mod, Opts) ->
+ [AM | acc1(Acc, As, Name, AvpName, Arity, Strict, Mod, Opts)].
-%% pack_avp/5
+%% acc1/8
-pack_avp(Name, #diameter_avp{name = AvpName} = Avp, Opts, Mod, Acc) ->
- pack_avp(Name, Mod:avp_arity(Name, AvpName), Avp, Opts, Mod, Acc).
+%% Faulty AVP, not grouped.
+acc1(Acc, {_RC, Avp} = E, _, _, _, _, _, _) ->
+ [Avps, Failed | Rec] = Acc,
+ [[Avp | Avps], [E | Failed] | Rec];
-%% pack_avp/6
+%% Faulty component in grouped AVP.
+acc1(Acc, {RC, As, Avp}, _, _, _, _, _, _) ->
+ [Avps, Failed | Rec] = Acc,
+ [[As | Avps], [{RC, Avp} | Failed] | Rec];
-pack_avp(Name, 0, Avp, Opts, Mod, Acc) ->
- pack_AVP(Name, Avp, Opts, Mod, Acc);
+%% Grouped AVP ...
+acc1([Avps | Acc], [Avp|_] = As, Name, AvpName, Arity, Strict, Mod, Opts) ->
+ [[As|Avps] | acc2(Acc, Avp, Name, AvpName, Arity, Strict, Mod, Opts)];
-pack_avp(_, Arity, #diameter_avp{name = AvpName} = Avp, _Opts, Mod, Acc) ->
- pack(Arity, AvpName, Avp, Mod, Acc).
+%% ... or not.
+acc1([Avps | Acc], Avp, Name, AvpName, Arity, Strict, Mod, Opts) ->
+ [[Avp|Avps] | acc2(Acc, Avp, Name, AvpName, Arity, Strict, Mod, Opts)].
-%% pack_AVP/5
+%% acc2/8
-%% Length failure was induced because of a header/payload length
-%% mismatch. The AVP Length is reset to match the received data if
-%% this AVP is encoded in an answer message, since the length is
-%% computed.
-%%
-%% Data is a truncated header if command_code = undefined, otherwise
-%% payload bytes. The former is padded to the length of a header if
-%% the AVP reaches an outgoing encode in diameter_codec.
-%%
-%% RFC 6733 says that an AVP returned with 5014 can contain a minimal
-%% payload for the AVP's type, but in this case we don't know the
-%% type.
+%% No errors, but nowhere to pack.
+acc2(Acc, Avp, _, 'AVP', 0, _, _, _) ->
+ [Failed | Rec] = Acc,
+ [[{rc(Avp), Avp} | Failed] | Rec];
-pack_AVP(_, #diameter_avp{data = {5014 = RC, Data}} = Avp, _, _, Acc) ->
- {Rec, Failed} = Acc,
- {Rec, [{RC, Avp#diameter_avp{data = Data}} | Failed]};
+%% No AVP of this name: try to pack as 'AVP'.
+acc2(Acc, Avp, Name, AvpName, 0, Strict, Mod, Opts) ->
+ M = Avp#diameter_avp.is_mandatory,
+ Arity = pack_arity(Name, AvpName, Opts, Mod, M),
+ acc2(Acc, Avp, Name, 'AVP', Arity, Strict, Mod, Opts);
-pack_AVP(Name, Avp, Opts, Mod, Acc) ->
- pack_arity(Name, pack_arity(Name, Opts, Mod, Avp), Avp, Mod, Acc).
+%% Relaxed arities.
+acc2(Acc, Avp, _, AvpName, Arity, Strict, Mod, _)
+ when Strict /= decode ->
+ pack(Arity, AvpName, Avp, Mod, Acc);
-%% pack_arity/5
+%% No maximum arity.
+acc2(Acc, Avp, _, AvpName, {_,'*'} = Arity, _, Mod, _) ->
+ pack(Arity, AvpName, Avp, Mod, Acc);
-pack_arity(_, 0, #diameter_avp{is_mandatory = M} = Avp, _, Acc) ->
- {Rec, Failed} = Acc,
- {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]};
+%% Or check.
+acc2(Acc, Avp, _, AvpName, Arity, _, Mod, _) ->
+ Mx = max_arity(Arity),
+ if Mx =< Avp#diameter_avp.index ->
+ [Failed | Rec] = Acc,
+ [[{5009, Avp} | Failed] | Rec];
+ true ->
+ pack(Arity, AvpName, Avp, Mod, Acc)
+ end.
-pack_arity(_, Arity, Avp, Mod, Acc) ->
- pack(Arity, 'AVP', Avp, Mod, Acc).
+%% 3588/6733:
+%%
+%% DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009
+%% A message was received that included an AVP that appeared more
+%% often than permitted in the message definition. The Failed-AVP
+%% AVP MUST be included and contain a copy of the first instance of
+%% the offending AVP that exceeded the maximum number of occurrences
-%% Give Failed-AVP special treatment since (1) it'll contain any
-%% unrecognized mandatory AVP's and (2) the RFC 3588 grammar failed to
-%% allow for Failed-AVP in an answer-message.
+%% max_arity/1
-pack_arity(Name,
- #{strict_mbit := Strict,
- failed_avp := Failed},
- Mod,
- #diameter_avp{is_mandatory = M,
- name = AvpName}) ->
+max_arity(1) ->
+ 1;
+max_arity({_,Mx}) ->
+ Mx.
- %% Not testing just Name /= 'Failed-AVP' means we're changing the
- %% packing of AVPs nested within Failed-AVP, but the point of
- %% ignoring errors within Failed-AVP is to decode as much as
- %% possible, and failing because a mandatory AVP couldn't be
- %% packed into a dedicated field defeats that point.
+%% rc/1
- if Failed == true;
- Name == 'Failed-AVP';
- Name == 'answer-message', AvpName == 'Failed-AVP';
- not M;
- not Strict ->
- Mod:avp_arity(Name, 'AVP');
- true ->
- 0
- end.
+rc(#diameter_avp{is_mandatory = M}) ->
+ if M -> 5001; true -> 5008 end.
%% 3588:
%%
@@ -586,75 +667,114 @@ pack_arity(Name,
%% Failed-AVP AVP MUST be included and contain a copy of the
%% offending AVP.
-%% pack/5
+%% pack_arity/5
+
+%% Give Failed-AVP special treatment since (1) it'll contain any
+%% unrecognized mandatory AVP's and (2) the RFC 3588 grammar failed to
+%% allow for Failed-AVP in an answer-message.
+
+pack_arity(Name, AvpName, _, Mod, M)
+ when Name == 'Failed-AVP';
+ Name == 'answer-message', AvpName == 'Failed-AVP';
+ not M ->
+ Mod:avp_arity(Name, 'AVP');
+%% Not testing just Name /= 'Failed-AVP' means we're changing the
+%% packing of AVPs nested within Failed-AVP, but the point of
+%% ignoring errors within Failed-AVP is to decode as much as
+%% possible, and failing because a mandatory AVP couldn't be
+%% packed into a dedicated field defeats that point.
+
+pack_arity(Name, _, #{strict_mbit := Strict, failed_avp := Failed}, Mod, _)
+ when not Strict;
+ Failed ->
+ Mod:avp_arity(Name, 'AVP');
+
+pack_arity(_, _, _, _, _) ->
+ 0.
-pack(Arity, FieldName, Avp, Mod, {Rec, _} = Acc) ->
- pack(Mod:'#get-'(FieldName, Rec), Arity, FieldName, Avp, Mod, Acc).
+%% avp_arity/5
-%% pack/6
+avp_arity(Name, 'AVP' = AvpName, Mod, Opts, M) ->
+ pack_arity(Name, AvpName, Opts, Mod, M);
-pack(undefined, 1, 'AVP' = F, Avp, Mod, {Rec, Failed}) -> %% unlikely
- {Mod:'#set-'({F, Avp}, Rec), Failed};
+avp_arity(Name, AvpName, Mod, _, _) ->
+ Mod:avp_arity(Name, AvpName).
-pack(undefined, 1, F, #diameter_avp{value = V}, Mod, {Rec, Failed}) ->
- {Mod:'#set-'({F, V}, Rec), Failed};
+%% rc/4
+
+%% Length error communicated from diameter_types or a
+%% @custom_types/@codecs module.
+rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = A, Opts, Mod) ->
+ {RC, A#diameter_avp{data = Mod:empty_value(AvpName, Opts)}};
%% 3588:
%%
-%% DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009
-%% A message was received that included an AVP that appeared more
-%% often than permitted in the message definition. The Failed-AVP
-%% AVP MUST be included and contain a copy of the first instance of
-%% the offending AVP that exceeded the maximum number of occurrences
-%%
+%% DIAMETER_INVALID_AVP_VALUE 5004
+%% The request contained an AVP with an invalid value in its data
+%% portion. A Diameter message indicating this error MUST include
+%% the offending AVPs within a Failed-AVP AVP.
+rc(_, Avp, _, _) ->
+ {5004, Avp}.
-pack(_, 1, _, Avp, _, {Rec, Failed}) ->
- {Rec, [{5009, Avp} | Failed]};
-
-pack(L, {_, Max}, F, Avp, Mod, {Rec, Failed}) ->
- case '*' /= Max andalso has_prefix(Max+1, L) of
- true ->
- {Rec, [{5009, Avp} | Failed]};
- false when F == 'AVP' ->
- {Mod:'#set-'({F, [Avp | L]}, Rec), Failed};
- false ->
- {Mod:'#set-'({F, [Avp#diameter_avp.value | L]}, Rec), Failed}
- end.
+%% pack/5
+
+pack(Arity, F, Avp, Mod, [Failed | Rec]) ->
+ [Failed | set(Arity, F, value(F, Avp), Mod, Rec)].
+
+%% set/5
+
+set(_, _, _, _, false = No) ->
+ No;
+
+set(1, F, Value, _, Map)
+ when is_map(Map) ->
+ Map#{F => Value};
+
+set(_, F, V, _, Map)
+ when is_map(Map) ->
+ maps:update_with(F, fun(Vs) -> [V|Vs] end, [V], Map);
+
+set(1, F, Value, Mod, Rec) ->
+ Mod:'#set-'({F, Value}, Rec);
+
+set(_, F, V, Mod, Rec) ->
+ Vs = Mod:'#get-'(F, Rec),
+ Mod:'#set-'({F, [V|Vs]}, Rec).
+
+%% value/2
+
+value('AVP', Avp) ->
+ Avp;
+
+value(_, #diameter_avp{value = V}) ->
+ V.
%% ---------------------------------------------------------------------------
%% # grouped_avp/3
%% ---------------------------------------------------------------------------
--spec grouped_avp(decode, avp_name(), binary() | {5014, binary()}, term())
+%% Note that Grouped is the only AVP type that doesn't just return a
+%% decoded value, also returning the list of component diameter_avp
+%% records.
+
+-spec grouped_avp(decode, avp_name(), binary(), term())
-> {avp_record(), [avp()]};
(encode, avp_name(), avp_record() | avp_values(), term())
-> iolist()
| no_return().
-%% Length error induced by diameter_codec:collect_avps/1: the AVP
-%% length in the header was too short (insufficient for the extracted
-%% header) or too long (past the end of the message). An empty payload
-%% is sufficient according to the RFC text for 5014.
-grouped_avp(decode, _Name, {5014 = RC, _Bin}, _) ->
- ?THROW({grouped, {RC, []}, []});
-
-grouped_avp(decode, Name, Data, Opts) ->
- grouped_decode(Name, diameter_codec:collect_avps(Data), Opts);
+%% An error in decoding a component AVP throws the first faulty
+%% component, which a catch wraps in the Grouped AVP in question. A
+%% partially decoded record is only used when ignoring errors in
+%% Failed-AVP.
+grouped_avp(decode, Name, Bin, Opts) ->
+ {Rec, Avps, Es} = T = decode_avps(Name, Bin, Opts),
+ [] == Es orelse ?THROW(T),
+ {Rec, Avps};
grouped_avp(encode, Name, Data, Opts) ->
encode_avps(Name, Data, Opts).
-%% grouped_decode/2
-%%
-%% Note that Grouped is the only AVP type that doesn't just return a
-%% decoded value, also returning the list of component diameter_avp
-%% records.
-
-%% Length error in trailing component AVP.
-grouped_decode(_Name, {Error, Acc}, _) ->
- {5014, Avp} = Error,
- ?THROW({grouped, Error, [Avp | Acc]});
-
%% 7.5. Failed-AVP AVP
%% In the case where the offending AVP is embedded within a Grouped AVP,
@@ -665,15 +785,6 @@ grouped_decode(_Name, {Error, Acc}, _) ->
%% to the single offending AVP. This enables the recipient to detect
%% the location of the offending AVP when embedded in a group.
-%% An error in decoding a component AVP throws the first faulty
-%% component, which the catch in d/3 wraps in the Grouped AVP in
-%% question. A partially decoded record is only used when ignoring
-%% errors in Failed-AVP.
-grouped_decode(Name, ComponentAvps, Opts) ->
- {Rec, Avps, Es} = decode_avps(Name, ComponentAvps, Opts),
- [] == Es orelse ?THROW({grouped, [{_,_} = hd(Es) | Rec], Avps}),
- {Rec, Avps}.
-
%% ---------------------------------------------------------------------------
%% # empty_group/2
%% ---------------------------------------------------------------------------
@@ -705,5 +816,45 @@ empty(Name, #{module := Mod} = Opts) ->
%% ------------------------------------------------------------------------------
+%% newrec/4
+
+newrec(false = No, _, _, _) ->
+ No;
+
+newrec(record, Mod, Name, T)
+ when T /= decode ->
+ RecName = Mod:name2rec(Name),
+ Sz = Mod:'#info-'(RecName, size),
+ erlang:make_tuple(Sz, [], [{1, RecName}]);
+
+newrec(record, Mod, Name, _) ->
+ newrec(Mod, Name);
+
+newrec(_, _, _, _) ->
+ #{}.
+
+%% newrec/2
+
newrec(Mod, Name) ->
Mod:'#new-'(Mod:name2rec(Name)).
+
+%% reformat/5
+
+reformat(Name, Map, _Strict, Mod, list) ->
+ [{F,V} || {F,_} <- Mod:avp_arity(Name), #{F := V} <- [Map]];
+
+reformat(Name, Map, Strict, Mod, record_from_map) ->
+ RecName = Mod:name2rec(Name),
+ list_to_tuple([RecName | [mget(F, Map, def(A, Strict))
+ || {F,A} <- Mod:avp_arity(Name)]]);
+
+reformat(_, Rec, _, _, _) ->
+ Rec.
+
+%% def/2
+
+def(1, decode) ->
+ undefined;
+
+def(_, _) ->
+ [].
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 1b0dc417e5..9115630eb5 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -128,7 +128,9 @@
%% outgoing DPR; boolean says whether or not
%% the request was sent explicitly with
%% diameter:call/4.
- codec :: #{string_decode := boolean(),
+ codec :: #{decode_format := record,
+ string_decode := boolean(),
+ strict_arities => diameter:strict_arities(),
strict_mbit := boolean(),
rfc := 3588 | 6733,
ordered_encode := false},
@@ -253,11 +255,13 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) ->
length_errors = LengthErr,
strict = Strictness,
incoming_maxlen = Maxlen,
- codec = maps:with([string_decode,
+ codec = maps:with([decode_format,
+ string_decode,
strict_mbit,
rfc,
ordered_encode],
- SvcOpts#{ordered_encode => false})}.
+ SvcOpts#{ordered_encode => false,
+ decode_format => record})}.
%% The transport returns its local ip addresses so that different
%% transports on the same service can use different local addresses.
%% The local addresses are put into Host-IP-Address avps here when
@@ -542,11 +546,11 @@ put_route(Pid) ->
MRef = monitor(process, Pid),
put(Pid, MRef).
-%% get_route/2
+%% get_route/3
-%% incoming answer
-get_route(_, #diameter_packet{header = #diameter_header{is_request = false}}
- = Pkt) ->
+%% Incoming answer.
+get_route(_, _, #diameter_packet{header = #diameter_header{is_request = false}}
+ = Pkt) ->
Seqs = diameter_codec:sequence_numbers(Pkt),
case erase(Seqs) of
{Pid, Ref, MRef} ->
@@ -557,8 +561,14 @@ get_route(_, #diameter_packet{header = #diameter_header{is_request = false}}
false
end;
-%% incoming request
-get_route(Ack, _) ->
+%% Requests answered here ...
+get_route(_, N, _)
+ when N == 'CER';
+ N == 'DPR' ->
+ false;
+
+%% ... or not.
+get_route(Ack, _, _) ->
Ack.
%% erase_route/1
@@ -649,10 +659,6 @@ encode(Rec, Opts, Dict) ->
%% incoming/2
-incoming({recv = T, Name, Pkt}, #state{parent = Pid, ack = Ack} = S) ->
- Pid ! {T, self(), get_route(Ack, Pkt), Name, Pkt},
- rcv(Name, Pkt, S);
-
incoming(#diameter_header{is_request = R}, #state{transport = TPid,
ack = Ack}) ->
R andalso Ack andalso send(TPid, false),
@@ -670,98 +676,97 @@ incoming(T, _) ->
%% recv/2
-recv(#diameter_packet{header = #diameter_header{} = Hdr}
- = Pkt,
- #state{dictionary = Dict0}
- = S) ->
- recv1(diameter_codec:msg_name(Dict0, Hdr), Pkt, S);
-
-recv(#diameter_packet{header = undefined,
- bin = Bin}
- = Pkt,
- S) ->
- recv(diameter_codec:decode_header(Bin), Pkt, S);
+recv(#diameter_packet{bin = Bin} = Pkt, S) ->
+ recv(Bin, Pkt, S);
recv(Bin, S) ->
- recv(#diameter_packet{bin = Bin}, S).
+ recv(Bin, Bin, S).
+
+%% recv/3
-%% recv1/3
+recv(Bin, Msg, S) ->
+ recv(diameter_codec:decode_header(Bin), Bin, Msg, S).
-recv1(_,
- #diameter_packet{header = H, bin = Bin},
- #state{incoming_maxlen = M})
+%% recv/4
+
+recv(false, Bin, _, #state{length_errors = E}) ->
+ invalid(E, truncated_header, Bin),
+ Bin;
+
+recv(#diameter_header{length = Len} = H, Bin, Msg, #state{length_errors = E,
+ incoming_maxlen = M,
+ dictionary = Dict0}
+ = S)
+ when E == handle;
+ 0 == Len rem 4, bit_size(Bin) == 8*Len, size(Bin) =< M ->
+ recv1(diameter_codec:msg_name(Dict0, H), H, Msg, S);
+
+recv(H, Bin, _, #state{incoming_maxlen = M})
when M < size(Bin) ->
invalid(false, incoming_maxlen_exceeded, {size(Bin), H}),
H;
+recv(H, Bin, _, #state{length_errors = E}) ->
+ T = {size(Bin), bit_size(Bin) rem 8, H},
+ invalid(E, message_length_mismatch, T),
+ H.
+
+%% recv1/4
+
%% Ignore anything but an expected CER/CEA if so configured. This is
%% non-standard behaviour.
-recv1(Name, #diameter_packet{header = H}, #state{state = {'Wait-CEA', _, _},
- strict = false})
+recv1(Name, H, _, #state{state = {'Wait-CEA', _, _},
+ strict = false})
when Name /= 'CEA' ->
H;
-recv1(Name, #diameter_packet{header = H}, #state{state = recv_CER,
- strict = false})
+recv1(Name, H, _, #state{state = recv_CER,
+ strict = false})
when Name /= 'CER' ->
H;
%% Incoming request after outgoing DPR: discard. Don't discard DPR, so
%% both ends don't do so when sending simultaneously.
-recv1(Name,
- #diameter_packet{header = #diameter_header{is_request = true} = H},
- #state{dpr = {_,_,_}})
+recv1(Name, #diameter_header{is_request = true} = H, _, #state{dpr = {_,_,_}})
when Name /= 'DPR' ->
invalid(false, recv_after_outgoing_dpr, H),
H;
%% Incoming request after incoming DPR: discard.
-recv1(_,
- #diameter_packet{header = #diameter_header{is_request = true} = H},
- #state{dpr = true}) ->
+recv1(_, #diameter_header{is_request = true} = H, _, #state{dpr = true}) ->
invalid(false, recv_after_incoming_dpr, H),
H;
%% DPA with identifier mismatch, or in response to a DPR initiated by
%% the service.
-recv1('DPA' = N,
- #diameter_packet{header = #diameter_header{hop_by_hop_id = Hid,
- end_to_end_id = Eid}}
- = Pkt,
- #state{dpr = {X,H,E}}
+recv1('DPA' = Name,
+ #diameter_header{hop_by_hop_id = Hid, end_to_end_id = Eid}
+ = H,
+ Msg,
+ #state{dpr = {X,HI,EI}}
= S)
- when H /= Hid;
- E /= Eid;
+ when HI /= Hid;
+ EI /= Eid;
not X ->
- rcv(N, Pkt, S);
+ Pkt = pkt(H, Msg),
+ handle(Name, Pkt, S);
-%% Any other message with a header and no length errors: send to the
-%% parent.
-recv1(Name, Pkt, #state{}) ->
- {recv, Name, Pkt}.
+%% Any other message with a header and no length errors.
+recv1(Name, H, Msg, #state{parent = Pid, ack = Ack} = S) ->
+ Pkt = pkt(H, Msg),
+ Pid ! {recv, self(), get_route(Ack, Name, Pkt), Name, Pkt},
+ handle(Name, Pkt, S).
-%% recv/3
+%% pkt/2
-recv(#diameter_header{length = Len}
- = H,
- #diameter_packet{bin = Bin}
- = Pkt,
- #state{length_errors = E}
- = S)
- when E == handle;
- 0 == Len rem 4, bit_size(Bin) == 8*Len ->
- recv(Pkt#diameter_packet{header = H}, S);
+pkt(H, Bin)
+ when is_binary(Bin) ->
+ #diameter_packet{header = H,
+ bin = Bin};
-recv(#diameter_header{}
- = H,
- #diameter_packet{bin = Bin},
- #state{length_errors = E}) ->
- T = {size(Bin), bit_size(Bin) rem 8, H},
- invalid(E, message_length_mismatch, T),
- Bin;
+pkt(H, Pkt) ->
+ Pkt#diameter_packet{header = H}.
-recv(false, #diameter_packet{bin = Bin}, #state{length_errors = E}) ->
- invalid(E, truncated_header, Bin),
- Bin.
+%% invalid/3
%% Note that counters here only count discarded messages.
invalid(E, Reason, T) ->
@@ -770,39 +775,39 @@ invalid(E, Reason, T) ->
?LOG(Reason, T),
ok.
-%% rcv/3
+%% handle/3
%% Incoming CEA.
-rcv('CEA' = N,
- #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
- hop_by_hop_id = Hid}}
- = Pkt,
- #state{state = {'Wait-CEA', Hid, Eid}}
- = S) ->
+handle('CEA' = N,
+ #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
+ hop_by_hop_id = Hid}}
+ = Pkt,
+ #state{state = {'Wait-CEA', Hid, Eid}}
+ = S) ->
?LOG(recv, N),
handle_CEA(Pkt, S);
%% Incoming CER
-rcv('CER' = N, Pkt, #state{state = recv_CER} = S) ->
+handle('CER' = N, Pkt, #state{state = recv_CER} = S) ->
handle_request(N, Pkt, S);
%% Anything but CER/CEA in a non-Open state is an error, as is
%% CER/CEA in anything but recv_CER/Wait-CEA.
-rcv(Name, _, #state{state = PS})
+handle(Name, _, #state{state = PS})
when PS /= 'Open';
Name == 'CER';
Name == 'CEA' ->
{stop, {Name, PS}};
-rcv('DPR' = N, Pkt, S) ->
+handle('DPR' = N, Pkt, S) ->
handle_request(N, Pkt, S);
%% DPA in response to DPR, with the expected identifiers.
-rcv('DPA' = N,
- #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
- hop_by_hop_id = Hid}
- = H}
- = Pkt,
+handle('DPA' = N,
+ #diameter_packet{header = #diameter_header{end_to_end_id = Eid,
+ hop_by_hop_id = Hid}
+ = H}
+ = Pkt,
#state{dictionary = Dict0,
transport = TPid,
dpr = {X, Hid, Eid},
@@ -821,13 +826,13 @@ rcv('DPA' = N,
%% Ignore an unsolicited DPA in particular. Note that dpa_timeout
%% deals with the case in which the peer sends the wrong identifiers
%% in DPA.
-rcv('DPA' = N, #diameter_packet{header = H}, _) ->
+handle('DPA' = N, #diameter_packet{header = H}, _) ->
?LOG(ignored, N),
%% Note that these aren't counted in the normal recv counter.
diameter_stats:incr({diameter_codec:msg_id(H), recv, ignored}),
ok;
-rcv(_, _, _) ->
+handle(_, _, _) ->
ok.
%% incr/3
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index a976a8b998..208e2e8cb8 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -112,7 +112,10 @@
use_shared_peers := diameter:remotes(),%% use from
restrict_connections := diameter:restriction(),
incoming_maxlen := diameter:message_length(),
+ strict_arities => diameter:strict_arities(),
strict_mbit := boolean(),
+ decode_format := diameter:decode_format(),
+ traffic_counters := boolean(),
string_decode := boolean(),
spawn_opt := list() | {module(), atom(), list()}}}).
@@ -514,6 +517,13 @@ transition({tc_timeout, T}, S) ->
tc_timeout(T, S),
ok;
+transition({nodeup, Node, _}, S) ->
+ nodeup(Node, S),
+ ok;
+
+transition({nodedown, _Node, _}, _) ->
+ ok;
+
transition(Req, S) ->
unexpected(handle_info, [Req], S),
ok.
@@ -700,7 +710,7 @@ init_peers() ->
%% TPid}
service_options(Opts) ->
- maps:from_list(Opts).
+ maps:from_list(lists:delete({strict_arities, true}, Opts)).
mref(false = No) ->
No;
@@ -709,6 +719,8 @@ mref(P) ->
init_shared(#state{options = #{use_shared_peers := T},
service_name = Svc}) ->
+ T == false orelse net_kernel:monitor_nodes(true, [{node_type, visible},
+ nodedown_reason]),
notify(T, Svc, {service, self()}).
init_mod(#diameter_app{alias = Alias,
@@ -728,6 +740,11 @@ notify(Share, SvcName, T) ->
%% Test for the empty list for upgrade reasons: there's no
%% diameter_peer:notify/3 in old code.
+nodeup(Node, #state{options = #{share_peers := SP},
+ service_name = SvcName}) ->
+ lists:member(Node, remotes(SP))
+ andalso diameter_peer:notify([Node], SvcName, {service, self()}).
+
remotes(false) ->
[];
@@ -1400,9 +1417,15 @@ is_remote(Pid, T) ->
%% # remote_peer_up/4
%% ---------------------------------------------------------------------------
-remote_peer_up(TPid, Aliases, Caps, #state{options = #{use_shared_peers := T}}
+remote_peer_up(TPid, Aliases, Caps, #state{options = #{use_shared_peers := T},
+ remote = {PeerT, _, _}}
= S) ->
- is_remote(TPid, T) andalso rpu(TPid, Aliases, Caps, S).
+ is_remote(TPid, T)
+ andalso not ets:member(PeerT, TPid)
+ andalso rpu(TPid, Aliases, Caps, S).
+
+%% Notification can be duplicate since remote nodes push and the local
+%% node pulls.
rpu(TPid, Aliases, Caps, #state{service = Svc, remote = RT}) ->
#diameter_service{applications = Apps} = Svc,
@@ -1412,6 +1435,7 @@ rpu(TPid, Aliases, Caps, #state{service = Svc, remote = RT}) ->
rpu(_, [] = No, _, _) ->
No;
+
rpu(TPid, Aliases, Caps, {PeerT, _, _} = RT) ->
monitor(process, TPid),
ets:insert(PeerT, #peer{pid = TPid,
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index 85378babea..27a41d6eb0 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -70,13 +70,16 @@
timeout = 5000 :: 0..16#FFFFFFFF, %% for outgoing requests
detach = false :: boolean()}).
-%% Term passed back to receive_message/6 with every incoming message.
+%% Term passed back to receive_message/5 with every incoming message.
-record(recvdata,
{peerT :: ets:tid(),
service_name :: diameter:service_name(),
apps :: [#diameter_app{}],
sequence :: diameter:sequence(),
- codec :: #{string_decode := boolean(),
+ counters :: boolean(),
+ codec :: #{decode_format := diameter:decode_format(),
+ string_decode := boolean(),
+ strict_arities => diameter:strict_arities(),
strict_mbit := boolean(),
incoming_maxlen := diameter:message_length()}}).
%% Note that incoming_maxlen is currently handled in diameter_peer_fsm,
@@ -96,13 +99,16 @@
%% ---------------------------------------------------------------------------
make_recvdata([SvcName, PeerT, Apps, SvcOpts | _]) ->
- #{sequence := {_,_} = Mask, spawn_opt := Opts}
+ #{sequence := {_,_} = Mask, spawn_opt := Opts, traffic_counters := B}
= SvcOpts,
{Opts, #recvdata{service_name = SvcName,
peerT = PeerT,
apps = Apps,
sequence = Mask,
- codec = maps:with([string_decode,
+ counters = B,
+ codec = maps:with([decode_format,
+ string_decode,
+ strict_arities,
strict_mbit,
ordered_encode,
incoming_maxlen],
@@ -182,7 +188,7 @@ incr_error(Dir, Id, TPid) ->
%% ---------------------------------------------------------------------------
-spec incr_rc(send|recv, Pkt, TPid, DictT)
- -> {Counter, non_neg_integer()}
+ -> Counter
| Reason
when Pkt :: #diameter_packet{},
TPid :: pid(),
@@ -193,18 +199,26 @@ incr_error(Dir, Id, TPid) ->
| {'Experimental-Result', integer(), integer()},
Reason :: atom().
-incr_rc(Dir, Pkt, TPid, {_, AppDict, _} = DictT) ->
- try
- incr_result(Dir, Pkt, TPid, DictT)
+incr_rc(Dir, Pkt, TPid, {MsgDict, AppDict, Dict0}) ->
+ incr_rc(Dir, Pkt, TPid, MsgDict, AppDict, Dict0);
+
+incr_rc(Dir, Pkt, TPid, Dict0) ->
+ incr_rc(Dir, Pkt, TPid, Dict0, Dict0, Dict0).
+
+%% incr_rc/6
+
+incr_rc(Dir, Pkt, TPid, MsgDict, AppDict, Dict0) ->
+ try get_result(Dir, MsgDict, Dict0, Pkt) of
+ false ->
+ unknown;
+ Avp ->
+ incr_result(Dir, Avp, Pkt, TPid, AppDict)
catch
exit: {E,_} when E == no_result_code;
E == invalid_error_bit ->
incr(TPid, {msg_id(Pkt#diameter_packet.header, AppDict), Dir, E}),
E
- end;
-
-incr_rc(Dir, Pkt, TPid, Dict0) ->
- incr_rc(Dir, Pkt, TPid, {Dict0, Dict0, Dict0}).
+ end.
%% ---------------------------------------------------------------------------
%% receive_message/5
@@ -216,13 +230,13 @@ incr_rc(Dir, Pkt, TPid, Dict0) ->
-> pid() %% request handler
| boolean() %% answer, known request or not
| discard %% request discarded by MFA
- when Route :: {Handler, RequestRef, Seqs}
+ when Route :: {Handler, RequestRef, TPid}
| Ack,
RecvData :: {[SpawnOpt], #recvdata{}},
SpawnOpt :: term(),
Handler :: pid(),
RequestRef :: reference(),
- Seqs :: {0..16#FFFFFFFF, 0..16#FFFFFFFF},
+ TPid :: pid(),
Ack :: boolean().
receive_message(TPid, Route, Pkt, Dict0, RecvData) ->
@@ -303,14 +317,15 @@ recv_request(Ack,
= Pkt,
Dict0,
#recvdata{peerT = PeerT,
- apps = Apps}
+ apps = Apps,
+ counters = Count}
= RecvData) ->
Ack andalso (TPid ! {handler, self()}),
case diameter_service:find_incoming_app(PeerT, TPid, Id, Apps) of
{#diameter_app{id = Aid, dictionary = AppDict} = App, Caps} ->
- incr(recv, Pkt, TPid, AppDict),
+ Count andalso incr(recv, Pkt, TPid, AppDict),
DecPkt = decode(Aid, AppDict, RecvData, Pkt),
- incr_error(recv, DecPkt, TPid, AppDict),
+ Count andalso incr_error(recv, DecPkt, TPid, AppDict),
send_A(recv_R(App, TPid, Dict0, Caps, RecvData, DecPkt),
TPid,
App,
@@ -323,9 +338,7 @@ recv_request(Ack,
%% A request was sent for an application that is not
%% supported.
RC = 3007,
- Es = Pkt#diameter_packet.errors,
- DecPkt = Pkt#diameter_packet{avps = collect_avps(Pkt),
- errors = [RC | Es]},
+ DecPkt = diameter_codec:collect_avps(Pkt),
send_answer(answer_message(RC, Dict0, Caps, DecPkt),
TPid,
Dict0,
@@ -341,14 +354,6 @@ recv_request(Ack,
decode(Id, Dict, #recvdata{codec = Opts}, Pkt) ->
errors(Id, diameter_codec:decode(Id, Dict, Opts, Pkt)).
-collect_avps(Pkt) ->
- case diameter_codec:collect_avps(Pkt) of
- {_Error, Avps} ->
- Avps;
- Avps ->
- Avps
- end.
-
%% send_A/7
send_A([T | Fs], TPid, App, Dict0, RecvData, DecPkt, Caps) ->
@@ -541,6 +546,7 @@ send_A({call, Opts}, TPid, App, Dict0, RecvData, Pkt, Caps, Fs) ->
MsgDict,
AppDict,
Dict0,
+ RecvData#recvdata.counters,
Fs);
RC ->
send_answer(answer_message(RC, Dict0, Caps, Pkt),
@@ -584,14 +590,22 @@ send_answer(Ans, TPid, MsgDict, AppDict, Dict0, RecvData, DecPkt, Fs) ->
TPid,
RecvData#recvdata.codec,
make_answer_packet(Ans, DecPkt, MsgDict, Dict0)),
- send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, Fs).
+ send_answer(Pkt,
+ TPid,
+ MsgDict,
+ AppDict,
+ Dict0,
+ RecvData#recvdata.counters,
+ Fs).
-%% send_answer/6
+%% send_answer/7
-send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, [EvalPktFs | EvalFs]) ->
+send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, Count, [EvalPktFs | EvalFs]) ->
eval_packet(Pkt, EvalPktFs),
- incr(send, Pkt, TPid, AppDict),
- incr_rc(send, Pkt, TPid, {MsgDict, AppDict, Dict0}), %% count outgoing
+ Count andalso begin
+ incr(send, Pkt, TPid, AppDict),
+ incr_rc(send, Pkt, TPid, MsgDict, AppDict, Dict0)
+ end,
send(TPid, z(Pkt), _Route = self()),
lists:foreach(fun diameter_lib:eval/1, EvalFs).
@@ -619,7 +633,7 @@ is_answer_message(#diameter_packet{msg = Msg}, Dict0) ->
is_answer_message([#diameter_header{is_request = R, is_error = E} | _], _) ->
E andalso not R;
-%% Message sent as a tagged avp/value list.
+%% Message sent as a map or tagged avp/value list.
is_answer_message([Name | _], _) ->
Name == 'answer-message';
@@ -867,7 +881,10 @@ reset(Msg, [RC | Avps], Dict) ->
%% set/3
-%% Reply as name and tuple list ...
+%% Reply as name/values list ...
+set([Name|As], Avps, _)
+ when is_map(As) ->
+ [Name | maps:merge(As, maps:from_list(Avps))];
set([_|_] = Ans, Avps, _) ->
Ans ++ Avps; %% Values nearer tail take precedence.
@@ -900,33 +917,44 @@ failed_avp(_, [] = No, _) ->
failed_avp(Msg, [_|_] = Avps, Dict) ->
[failed(Msg, [{'AVP', Avps}], Dict)].
-%% Reply as name and tuple list ...
-failed([MsgName | Values], FailedAvp, Dict) ->
- RecName = Dict:msg2rec(MsgName),
+%% failed/3
+
+failed(Msg, FailedAvp, Dict) ->
+ RecName = msg2rec(Msg, Dict),
try
- Dict:'#info-'(RecName, {index, 'Failed-AVP'}),
+ Dict:'#info-'(RecName, {index, 'Failed-AVP'}), %% assert existence
{'Failed-AVP', [FailedAvp]}
catch
error: _ ->
- Avps = proplists:get_value('AVP', Values, []),
+ Avps = values(Msg, 'AVP', Dict),
A = #diameter_avp{name = 'Failed-AVP',
value = FailedAvp},
{'AVP', [A|Avps]}
+ end.
+
+%% msg2rec/2
+
+%% Message as name/values list ...
+msg2rec([MsgName | _], Dict) ->
+ Dict:msg2rec(MsgName);
+
+%% ... or record.
+msg2rec(Rec, _) ->
+ element(1, Rec).
+
+%% values/2
+
+%% Message as name/values list ...
+values([_ | Avps], F, _) ->
+ if is_map(Avps) ->
+ maps:get(F, Avps, []);
+ is_list(Avps) ->
+ proplists:get_value(F, Avps, [])
end;
%% ... or record.
-failed(Rec, FailedAvp, Dict) ->
- try
- RecName = element(1, Rec),
- Dict:'#info-'(RecName, {index, 'Failed-AVP'}),
- {'Failed-AVP', [FailedAvp]}
- catch
- error: _ ->
- Avps = Dict:'#get-'('AVP', Rec),
- A = #diameter_avp{name = 'Failed-AVP',
- value = FailedAvp},
- {'AVP', [A|Avps]}
- end.
+values(Rec, F, Dict) ->
+ Dict:'#get-'(F, Rec).
%% 3. Diameter Header
%%
@@ -1102,48 +1130,31 @@ find_avp(Code, VId, [_ | Avps]) ->
%% Message sent as a header/avps list.
incr_result(send = Dir,
- #diameter_packet{msg = [#diameter_header{} = H | _]}
- = Pkt,
+ Avp,
+ #diameter_packet{msg = [#diameter_header{} = H | _]},
TPid,
- DictT) ->
- incr_res(Dir, Pkt#diameter_packet{header = H}, TPid, DictT);
-
-%% Outgoing message as binary: don't count. (Sending binaries is only
-%% partially supported.)
-incr_result(send, #diameter_packet{header = undefined = No}, _, _) ->
- No;
+ AppDict) ->
+ incr_result(Dir, Avp, H, [], TPid, AppDict);
%% Incoming or outgoing. Outgoing with encode errors never gets here
%% since encode fails.
-incr_result(Dir, Pkt, TPid, DictT) ->
- incr_res(Dir, Pkt, TPid, DictT).
-
-incr_res(Dir,
- #diameter_packet{header = #diameter_header{is_error = E}
- = Hdr,
- errors = Es}
- = Pkt,
- TPid,
- DictT) ->
- {MsgDict, AppDict, Dict0} = DictT,
+incr_result(Dir, Avp, Pkt, TPid, AppDict) ->
+ #diameter_packet{header = H, errors = Es}
+ = Pkt,
+ incr_result(Dir, Avp, H, Es, TPid, AppDict).
+
+%% incr_result/6
+incr_result(Dir, Avp, Hdr, Es, TPid, AppDict) ->
Id = msg_id(Hdr, AppDict),
%% Could be {relay, 0}, in which case the R-bit is redundant since
%% only answers are being counted. Let it be however, so that the
%% same tuple is in both send/recv and result code counters.
%% Count incoming decode errors.
- recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict),
-
- %% Exit on a missing result code.
- T = rc_counter(MsgDict, Dir, Pkt),
- T == false andalso ?LOGX(no_result_code, {MsgDict, Dir, Hdr}),
- {Ctr, RC, Avp} = T,
-
- %% Or on an inappropriate value.
- is_result(RC, E, Dict0)
- orelse ?LOGX(invalid_error_bit, {MsgDict, Dir, Hdr, Avp}),
+ send == Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict),
+ Ctr = rcc(Avp),
incr(TPid, {Id, Dir, Ctr}),
Ctr.
@@ -1188,7 +1199,50 @@ is_result(RC, true, _) ->
incr(TPid, Counter) ->
diameter_stats:incr(Counter, TPid, 1).
-%% rc_counter/3
+%% rcc/1
+
+rcc(#diameter_avp{name = 'Result-Code' = Name, value = V}) ->
+ {Name, head(V)};
+
+rcc(#diameter_avp{name = 'Experimental-Result', value = V}) ->
+ head(V).
+
+%% head/1
+
+head([V|_]) ->
+ V;
+head(V) ->
+ V.
+
+%% rcv/1
+
+rcv(#diameter_avp{name = N, value = V}) ->
+ rcv(N, head(V)).
+
+%% rcv/2
+
+rcv('Experimental-Result', {_,_,N}) ->
+ N;
+
+rcv('Result-Code', N) ->
+ N.
+
+%% get_result/4
+
+%% Message sent as binary: no checks or counting.
+get_result(_, _, _, #diameter_packet{header = undefined}) ->
+ false;
+
+get_result(Dir, MsgDict, Dict0, Pkt) ->
+ Avp = get_result(MsgDict, msg(Dir, Pkt)),
+ Hdr = Pkt#diameter_packet.header,
+ %% Exit on a missing result code or inappropriate value.
+ Avp == false
+ andalso ?LOGX(no_result_code, {MsgDict, Dir, Hdr}),
+ E = Hdr#diameter_header.is_error,
+ is_result(rcv(Avp), E, Dict0)
+ orelse ?LOGX(invalid_error_bit, {MsgDict, Dir, Hdr, Avp}),
+ Avp.
%% RFC 3588, 7.6:
%%
@@ -1196,46 +1250,29 @@ incr(TPid, Counter) ->
%% applications MUST include either one Result-Code AVP or one
%% Experimental-Result AVP.
-rc_counter(Dict, Dir, #diameter_packet{header = H,
- avps = As,
- msg = Msg})
+%% msg/2
+
+msg(Dir, #diameter_packet{header = H,
+ avps = As,
+ msg = Msg})
when Dir == recv; %% decoded incoming
Msg == undefined -> %% relayed outgoing
- rc_counter(Dict, [H|As]);
-
-rc_counter(Dict, _, #diameter_packet{msg = Msg}) ->
- rc_counter(Dict, Msg).
-
-rc_counter(Dict, Msg) ->
- rcc(get_result(Dict, Msg)).
+ [H|As];
-rcc(#diameter_avp{name = 'Result-Code' = Name, value = N} = A)
- when is_integer(N) ->
- {{Name, N}, N, A};
-
-rcc(#diameter_avp{name = 'Result-Code' = Name, value = [N|_]} = A)
- when is_integer(N) ->
- {{Name, N}, N, A};
-
-rcc(#diameter_avp{name = 'Experimental-Result', value = {_,_,N} = T} = A)
- when is_integer(N) ->
- {T, N, A};
-
-rcc(#diameter_avp{name = 'Experimental-Result', value = [{_,_,N} = T|_]} = A)
- when is_integer(N) ->
- {T, N, A};
-
-rcc(_) ->
- false.
+msg(_, #diameter_packet{msg = Msg}) ->
+ Msg.
%% get_result/2
get_result(Dict, Msg) ->
try
[throw(A) || N <- ['Result-Code', 'Experimental-Result'],
- #diameter_avp{} = A <- [get_avp(Dict, N, Msg)]]
+ #diameter_avp{} = A <- [get_avp(Dict, N, Msg)],
+ is_integer(catch rcv(A))],
+ false
catch
- #diameter_avp{} = A -> A
+ #diameter_avp{} = A ->
+ A
end.
x(T) ->
@@ -1359,7 +1396,7 @@ make_opts([T | _], _, _, _, _, _) ->
send_request({{TPid, _Caps} = TC, App}
= Transport,
- #{sequence := Mask}
+ #{sequence := Mask, traffic_counters := Count}
= SvcOpts,
Msg0,
CallOpts,
@@ -1375,9 +1412,15 @@ send_request({{TPid, _Caps} = TC, App}
SvcOpts,
ReqPkt),
eval_packet(EncPkt, Fs),
- T = send_R(ReqPkt, EncPkt, Transport, CallOpts, Caller, SvcName),
+ T = send_R(ReqPkt,
+ EncPkt,
+ Transport,
+ CallOpts,
+ Caller,
+ Count,
+ SvcName),
Ans = recv_answer(SvcName, App, CallOpts, T),
- handle_answer(SvcName, SvcOpts, App, Ans);
+ handle_answer(SvcName, Count, SvcOpts, App, Ans);
{discard, Reason} ->
{error, Reason};
discard ->
@@ -1520,6 +1563,7 @@ send_R(ReqPkt,
{{TPid, _Caps} = TC, #diameter_app{dictionary = AppDict}},
#options{timeout = Timeout},
{Pid, Ref},
+ Count,
SvcName) ->
Req = #request{ref = Ref,
caller = Pid,
@@ -1527,7 +1571,7 @@ send_R(ReqPkt,
peer = TC,
packet = ReqPkt},
- incr(send, EncPkt, TPid, AppDict),
+ Count andalso incr(send, EncPkt, TPid, AppDict),
{TRef, MRef} = zend_requezt(TPid, EncPkt, Req, SvcName, Timeout),
Pid ! Ref, %% tell caller a send has been attempted
{TRef, MRef, Req}.
@@ -1559,15 +1603,16 @@ failover(SvcName, App, Req, CallOpts) ->
CallOpts,
SvcName).
-%% handle_answer/4
+%% handle_answer/5
-handle_answer(SvcName, _, App, {error, Req, Reason}) ->
+handle_answer(SvcName, _, _, App, {error, Req, Reason}) ->
#request{packet = Pkt,
peer = {_TPid, _Caps} = TC}
= Req,
cb(App, handle_error, [Reason, msg(Pkt), SvcName, TC]);
handle_answer(SvcName,
+ Count,
SvcOpts,
#diameter_app{id = Id,
dictionary = AppDict,
@@ -1581,43 +1626,50 @@ handle_answer(SvcName,
#request{peer = {TPid, _}}
= Req,
- incr(recv, DecPkt, TPid, AppDict),
-
- AnsPkt = try
- incr_result(recv, DecPkt, TPid, {MsgDict, AppDict, Dict0})
- of
- _ -> DecPkt
- catch
- exit: {no_result_code, _} ->
- %% RFC 6733 requires one of Result-Code or
- %% Experimental-Result, but the decode will have
- %% detected a missing AVP. If both are optional in
- %% the dictionary then this isn't a decode error:
- %% just continue on.
- DecPkt;
- exit: {invalid_error_bit, {_, _, _, Avp}} ->
- #diameter_packet{errors = Es}
- = DecPkt,
- E = {5004, Avp},
- DecPkt#diameter_packet{errors = [E|Es]}
- end,
-
- handle_answer(AnsPkt, SvcName, App, AE, Req).
+ answer(answer(DecPkt, TPid, MsgDict, AppDict, Dict0, Count),
+ SvcName,
+ App,
+ AE,
+ Req).
+
+%% answer/6
+
+answer(DecPkt, TPid, MsgDict, AppDict, Dict0, Count) ->
+ Count andalso incr(recv, DecPkt, TPid, AppDict),
+ try get_result(recv, MsgDict, Dict0, DecPkt) of
+ Avp ->
+ Count andalso false /= Avp
+ andalso incr_result(recv, Avp, DecPkt, TPid, AppDict),
+ DecPkt
+ catch
+ exit: {no_result_code, _} ->
+ %% RFC 6733 requires one of Result-Code or
+ %% Experimental-Result, but the decode will have
+ %% detected a missing AVP. If both are optional in
+ %% the dictionary then this isn't a decode error:
+ %% just continue on.
+ DecPkt;
+ exit: {invalid_error_bit, {_, _, _, Avp}} ->
+ #diameter_packet{errors = Es}
+ = DecPkt,
+ E = {5004, Avp},
+ DecPkt#diameter_packet{errors = [E|Es]}
+ end.
-%% handle_answer/5
+%% answer/5
-handle_answer(#diameter_packet{errors = Es}
- = Pkt,
- SvcName,
- App,
- AE,
- #request{peer = {_TPid, _Caps} = TC,
- packet = P})
+answer(#diameter_packet{errors = Es}
+ = Pkt,
+ SvcName,
+ App,
+ AE,
+ #request{peer = {_TPid, _Caps} = TC,
+ packet = P})
when callback == AE;
[] == Es ->
cb(App, handle_answer, [Pkt, msg(P), SvcName, TC]);
-handle_answer(#diameter_packet{header = H}, SvcName, _, AE, _) ->
+answer(#diameter_packet{header = H}, SvcName, _, AE, _) ->
handle_error(H, SvcName, AE).
%% handle_error/3
@@ -1830,10 +1882,8 @@ get_destination(Dict, Msg) ->
[str(get_avp_value(Dict, D, Msg)) || D <- ['Destination-Realm',
'Destination-Host']].
-%% This is not entirely correct. The avp could have an arity 1, in
-%% which case an empty list is a DiameterIdentity of length 0 rather
-%% than the list of no values we treat it as by mapping to undefined.
-%% This behaviour is documented.
+%% A DiameterIdentity has length at least one, so an empty list is not
+%% a Realm/Host.
str([]) ->
undefined;
str(T) ->
@@ -1859,29 +1909,27 @@ str(T) ->
get_avp(?RELAY, Name, Msg) ->
get_avp(?BASE, Name, Msg);
-%% Message as a header/avps list.
+%% Message is a header/avps list.
get_avp(Dict, Name, [#diameter_header{} | Avps]) ->
try
{Code, _, VId} = Dict:avp_header(Name),
- find_avp(Code, VId, Avps)
- of
- A ->
- (avp_decode(Dict, Name, ungroup(A)))#diameter_avp{name = Name}
+ A = find_avp(Code, VId, Avps),
+ (avp_decode(Dict, Name, ungroup(A)))#diameter_avp{name = Name}
catch
error: _ ->
undefined
end;
-%% Outgoing message as a name/values list.
+%% Message as name/values list ...
get_avp(_, Name, [_MsgName | Avps]) ->
- case lists:keyfind(Name, 1, Avps) of
+ case find(Name, Avps) of
{_, V} ->
#diameter_avp{name = Name, value = V};
_ ->
undefined
end;
-%% Message is typically a record but not necessarily.
+%% ... or record (but not necessarily).
get_avp(Dict, Name, Rec) ->
try
#diameter_avp{name = Name, value = Dict:'#get-'(Name, Rec)}
@@ -1890,6 +1938,16 @@ get_avp(Dict, Name, Rec) ->
undefined
end.
+%% find/2
+
+find(Key, Map)
+ when is_map(Map) ->
+ maps:find(Key, Map);
+
+find(Key, List)
+ when is_list(List) ->
+ lists:keyfind(Key, 1, List).
+
%% get_avp_value/3
get_avp_value(Dict, Name, Msg) ->
@@ -1911,14 +1969,10 @@ ungroup(Avp) ->
avp_decode(Dict, Name, #diameter_avp{value = undefined,
data = Bin}
- = Avp) ->
- try Dict:avp(decode, Bin, Name, decode_opts(Dict)) of
- V ->
- Avp#diameter_avp{value = V}
- catch
- error:_ ->
- Avp
- end;
+ = Avp)
+ when is_binary(Bin) ->
+ V = Dict:avp(decode, Bin, Name, decode_opts(Dict)),
+ Avp#diameter_avp{value = V};
avp_decode(_, _, #diameter_avp{} = Avp) ->
Avp.
@@ -1933,7 +1987,8 @@ choose(false, _, X) -> X.
%% Decode options sufficient for AVP extraction.
decode_opts(Dict) ->
- #{string_decode => false,
+ #{decode_format => record,
+ string_decode => false,
strict_mbit => false,
failed_avp => false,
dictionary => Dict}.
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index a63425d92a..b2172356ee 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -72,7 +72,9 @@
restrict := boolean(),
suspect := non_neg_integer(), %% OKAY -> SUSPECT
okay := non_neg_integer()}, %% REOPEN -> OKAY
- codec :: #{string_decode := false,
+ codec :: #{decode_format := false,
+ string_decode := false,
+ strict_arities => diameter:strict_arities(),
strict_mbit := boolean(),
failed_avp := false,
rfc := 3588 | 6733,
@@ -135,7 +137,9 @@ i({Ack, T, Pid, {Opts,
putr(restart, {T, Opts, Svc, SvcOpts}), %% save seeing it in trace
putr(dwr, dwr(Caps)), %%
Nodes = restrict_nodes(Restrict),
- CodecKeys = [string_decode,
+ CodecKeys = [decode_format,
+ string_decode,
+ strict_arities,
strict_mbit,
incoming_maxlen,
spawn_opt,
@@ -150,13 +154,15 @@ i({Ack, T, Pid, {Opts,
receive_data = RecvData,
dictionary = Dict0,
config =
- maps:without(CodecKeys,
+ maps:without([traffic_counters | CodecKeys],
config(SvcOpts#{restrict => restrict(Nodes),
suspect => 1,
okay => 3},
Opts)),
- codec = maps:with(CodecKeys, SvcOpts#{string_decode := false,
- ordered_encode => false})}.
+ codec = maps:with(CodecKeys -- [strict_arities],
+ SvcOpts#{decode_format := false,
+ string_decode := false,
+ ordered_encode => false})}.
wait(Ref, Pid) ->
receive
diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl
index f56e4a5249..4e6fe32d69 100644
--- a/lib/diameter/src/compiler/diameter_codegen.erl
+++ b/lib/diameter/src/compiler/diameter_codegen.erl
@@ -21,15 +21,14 @@
-module(diameter_codegen).
%%
-%% This module generates erl/hrl files for encode/decode modules
-%% from the orddict parsed from a dictionary file (.dia) by
-%% diameter_dict_util. The generated code is simple (one-liners),
-%% the generated functions being called by code included iin the
-%% generated modules from diameter_gen.hrl. The orddict itself is
-%% returned by dict/0 in the generated module and diameter_dict_util
-%% calls this function when importing dictionaries as a consequence
-%% of @inherits sections. That is, @inherits introduces a dependency
-%% on the beam file of another dictionary.
+%% This module generates erl/hrl files for encode/decode modules from
+%% the orddict parsed from a dictionary file by diameter_dict_util.
+%% The generated code is simple (one-liners), and is called from
+%% diameter_gen. The orddict itself is returned by dict/0 in the
+%% generated module and diameter_dict_util calls this function when
+%% importing dictionaries as a consequence of @inherits sections. That
+%% is, @inherits introduces a dependency on the beam file of another
+%% dictionary.
%%
-export([from_dict/4,
diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl
index 9a0cb6baf2..143dede037 100644
--- a/lib/diameter/src/compiler/diameter_exprecs.erl
+++ b/lib/diameter/src/compiler/diameter_exprecs.erl
@@ -110,9 +110,9 @@
%% parse_transform/2
parse_transform(Forms, _Options) ->
- Rs = [R || {attribute, _, record, R} <- Forms],
- Es = lists:append([E || {attribute, _, export_records, E} <- Forms]),
{H,T} = lists:splitwith(fun is_head/1, Forms),
+ Rs = [R || {attribute, _, record, R} <- H],
+ Es = lists:append([E || {attribute, _, export_records, E} <- H]),
H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T.
is_head(T) ->
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index 6a9f1f940b..a0104fac6e 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -112,7 +112,7 @@
{transport :: pid(),
ack = false :: boolean(),
socket :: gen_sctp:sctp_socket(),
- assoc_id :: gen_sctp:assoc_id()}). %% next output stream
+ assoc_id :: gen_sctp:assoc_id()}).
%% Listener process state.
-record(listener,
@@ -565,7 +565,7 @@ transition(Msg, S)
%% Deferred actions from a message_cb.
transition({actions, Dir, Acts}, S) ->
- actions(Acts, Dir, S);
+ setopts(ok, actions(Acts, Dir, S));
%% Request to close the transport connection.
transition({diameter, {close, Pid}}, #transport{parent = Pid}) ->
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index a2f393d5d4..5d7bca059a 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -87,8 +87,7 @@
module :: module() | undefined}).
-type length() :: 0..16#FFFFFF. %% message length from Diameter header
--type size() :: non_neg_integer(). %% accumulated binary size
--type frag() :: {length(), size(), binary(), list(binary())}
+-type frag() :: maybe_improper_list(length(), binary())
| binary().
-type connect_option() :: {raddr, inet:ip_address()}
@@ -599,11 +598,12 @@ t(T,S) ->
%% Incoming packets.
transition({P, Sock, Bin}, #transport{socket = Sock,
- ssl = B}
+ ssl = B,
+ frag = Frag}
= S)
when P == ssl, true == B;
P == tcp ->
- recv(Bin, S#transport{active = false});
+ recv(acc(Frag, Bin), S);
%% Capabilties exchange has decided on whether or not to run over TLS.
transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid}
@@ -640,7 +640,7 @@ transition(Msg, S)
%% Deferred actions from a message_cb.
transition({actions, Dir, Acts}, S) ->
- actions(Acts, Dir, S);
+ setopts(actions(Acts, Dir, S));
%% Request to close the transport connection.
transition({diameter, {close, Pid}}, #transport{parent = Pid,
@@ -720,86 +720,77 @@ tls(accept, Sock, Opts) ->
%% using Nagle.
%% Receive packets until a full message is received,
-recv(Bin, #transport{frag = Head} = S) ->
- case rcv(Head, Bin) of
- {Msg, B} -> %% have a complete message ...
- message(recv, Msg, S#transport{frag = B});
- Frag -> %% read more on the socket
- start_fragment_timer(setopts(S#transport{frag = Frag,
- flush = false}))
- end.
-%% rcv/2
+recv({Msg, Rest}, S) -> %% have a complete message ...
+ recv(acc(Rest), message(recv, Msg, S));
+
+recv(Frag, #transport{recv = B,
+ socket = Sock,
+ module = M}
+ = S) -> %% or not
+ B andalso setopts(M, Sock),
+ start_fragment_timer(S#transport{frag = Frag,
+ flush = false,
+ active = B}).
-%% No previous fragment.
-rcv(<<>>, Bin) ->
- rcv(Bin);
+%% acc/2
-%% Not even the first four bytes of the header.
-rcv(Head, Bin)
- when is_binary(Head) ->
- rcv(<<Head/binary, Bin/binary>>);
+%% Know how many bytes to extract.
+acc([Len | Acc], Bin) ->
+ acc1(Len, <<Acc/binary, Bin/binary>>);
-%% Or enough to know how many bytes to extract.
-rcv({Len, N, Head, Acc}, Bin) ->
- rcv(Len, N + size(Bin), Head, [Bin | Acc]).
+%% Or not.
+acc(Head, Bin) ->
+ acc(<<Head/binary, Bin/binary>>).
-%% rcv/4
+%% acc1/3
%% Extract a message for which we have all bytes.
-rcv(Len, N, Head, Acc)
- when Len =< N ->
- recv1(Len, bin(Head, Acc));
+acc1(Len, Bin)
+ when Len =< byte_size(Bin) ->
+ split_binary(Bin, Len);
%% Wait for more packets.
-rcv(Len, N, Head, Acc) ->
- {Len, N, Head, Acc}.
-
-%% rcv/1
-
-%% Nothing left.
-rcv(<<>> = Bin) ->
- Bin;
-
-%% The Message Length isn't even sufficient for a header. Chances are
-%% things will go south from here but if we're lucky then the bytes we
-%% have extend to an intended message boundary and we can recover by
-%% simply receiving them. Make it so.
-rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
- when Len < 20 ->
- {Bin, <<>>};
-
-%% Enough bytes to extract a message.
-rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
- when Len =< size(Bin) ->
- recv1(Len, Bin);
-
-%% Or not: wait for more packets.
-rcv(<<_:1/binary, Len:24, _/binary>> = Head) ->
- {Len, size(Head), Head, []};
+acc1(Len, Bin) ->
+ [Len | Bin].
+
+%% acc/1
+
+%% Don't match on Bin since this results in it being copied at the
+%% next append according to the Efficiency Guide. This is also the
+%% reason that the Len is extracted and maintained when accumulating
+%% messages. The simplest implementation is just to accumulate a
+%% binary and match <<_, Len:24, _/binary>> each time the length is
+%% required, but the performance of this decays quadratically with the
+%% message length, since the binary is then copied with each append of
+%% additional bytes from gen_tcp.
+
+acc(Bin)
+ when 3 < byte_size(Bin) ->
+ {Head, _} = split_binary(Bin, 4),
+ [_,A,B,C] = binary_to_list(Head),
+ Len = (A bsl 16) bor (B bsl 8) bor C,
+ if Len < 20 ->
+ %% Message length isn't sufficient for a Diameter Header.
+ %% Chances are things will go south from here but if we're
+ %% lucky then the bytes we have extend to an intended
+ %% message boundary and we can recover by simply receiving
+ %% them. Make it so.
+ {Bin, <<>>};
+ true ->
+ acc1(Len, Bin)
+ end;
%% Not even 4 bytes yet.
-rcv(Head) ->
- Head.
-
-%% recv1/2
-
-recv1(Len, Bin) ->
- <<Msg:Len/binary, Rest/binary>> = Bin,
- {Msg, Rest}.
-
-%% bin/2
-
-bin(Head, Acc) ->
- list_to_binary([Head | lists:reverse(Acc)]).
+acc(Bin) ->
+ Bin.
%% bin/1
-bin({_, _, Head, Acc}) ->
- bin(Head, Acc);
+bin([_ | Bin]) ->
+ Bin;
-bin(Bin)
- when is_binary(Bin) ->
+bin(Bin) ->
Bin.
%% flush/1
@@ -911,14 +902,20 @@ setopts(#transport{socket = Sock,
module = M}
= S)
when B, not A ->
- case setopts(M, Sock, [{active, once}]) of
- ok -> S#transport{active = true};
- X -> x({setopts, Sock, M, X}) %% possibly on peer disconnect
- end;
+ setopts(M, Sock),
+ S#transport{active = true};
setopts(S) ->
S.
+%% setopts/2
+
+setopts(M, Sock) ->
+ case setopts(M, Sock, [{active, once}]) of
+ ok -> ok;
+ X -> x({setopts, Sock, M, X}) %% possibly on peer disconnect
+ end.
+
%% portnr/2
portnr(gen_tcp, Sock) ->
@@ -988,7 +985,7 @@ message(ack, _, #transport{message_cb = false} = S) ->
S;
message(Dir, Msg, #transport{message_cb = CB} = S) ->
- recv(<<>>, actions(cb(CB, Dir, Msg), Dir, S)).
+ setopts(actions(cb(CB, Dir, Msg), Dir, S)).
%% actions/3
diff --git a/lib/diameter/test/diameter_codec_SUITE.erl b/lib/diameter/test/diameter_codec_SUITE.erl
index 9f08f49f9f..c79b642c09 100644
--- a/lib/diameter/test/diameter_codec_SUITE.erl
+++ b/lib/diameter/test/diameter_codec_SUITE.erl
@@ -292,6 +292,7 @@ recode(Msg, Dict) ->
opts(Mod) ->
#{dictionary => Mod,
+ decode_format => record,
string_decode => false,
strict_mbit => true,
rfc => 6733,
diff --git a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
index 700910878c..735339ebb9 100644
--- a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
+++ b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
@@ -78,6 +78,7 @@ dec('BR', #diameter_packet
opts(Mod) ->
#{dictionary => Mod,
+ decode_format => record,
string_decode => true,
strict_mbit => true,
rfc => 6733,
diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl
index b548f85cb8..22fb0550ea 100644
--- a/lib/diameter/test/diameter_codec_test.erl
+++ b/lib/diameter/test/diameter_codec_test.erl
@@ -219,7 +219,8 @@ opts(Mod) ->
dictionary => Mod}.
opts() ->
- #{string_decode => true,
+ #{decode_format => record,
+ string_decode => true,
strict_mbit => true,
rfc => 6733,
failed_avp => false}.
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 84b41f14b7..8b0ce9710a 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -27,15 +27,18 @@
-export([suite/0,
all/0,
groups/0,
+ init_per_suite/0,
init_per_suite/1,
end_per_suite/1,
+ init_per_group/1,
init_per_group/2,
end_per_group/2,
init_per_testcase/2,
end_per_testcase/2]).
%% testcases
--export([start/1,
+-export([rfc4005/1,
+ start/1,
start_services/1,
add_transports/1,
result_codes/1,
@@ -63,6 +66,7 @@
send_invalid_reject/1,
send_unexpected_mandatory_decode/1,
send_unexpected_mandatory/1,
+ send_too_many/1,
send_long/1,
send_maxlen/1,
send_nopeer/1,
@@ -98,14 +102,14 @@
stop/1]).
%% diameter callbacks
--export([peer_up/3,
- peer_down/3,
- pick_peer/6, pick_peer/7,
- prepare_request/5, prepare_request/6,
- prepare_retransmit/5,
- handle_answer/6, handle_answer/7,
- handle_error/6,
- handle_request/3]).
+-export([peer_up/4,
+ peer_down/4,
+ pick_peer/7, pick_peer/8,
+ prepare_request/6, prepare_request/7,
+ prepare_retransmit/6,
+ handle_answer/7, handle_answer/8,
+ handle_error/7,
+ handle_request/4]).
%% diameter_{tcp,sctp} callbacks
-export([message/3]).
@@ -119,13 +123,21 @@
%% ===========================================================================
+%% Fraction of shuffle/parallel groups to randomly skip.
+-define(SKIP, 0.25).
+
+%% Positive number of testcases from which to select (randomly) from
+%% tc(), the list of testcases to run, or [] to run all. The random
+%% selection is to limit the time it takes for the suite to run.
+-define(LIMIT, #{tcp => 42, sctp => 5}).
+
-define(util, diameter_util).
-define(A, list_to_atom).
-define(L, atom_to_list).
%% Don't use is_record/2 since dictionary hrl's aren't included.
-%% (Since they define conflicting reqcords with the same names.)
+%% (Since they define conflicting records with the same names.)
-define(is_record(Rec, Name), (Name == element(1, Rec))).
-define(ADDR, {127,0,0,1}).
@@ -138,14 +150,14 @@
%% Sequence mask for End-to-End and Hop-by-Hop identifiers.
-define(CLIENT_MASK, {1,26}). %% 1 in top 6 bits
-%% How to construct messages, as record or list.
--define(ENCODINGS, [list, record]).
+%% How to construct outgoing messages.
+-define(ENCODINGS, [list, record, map]).
-%% How to send answers, in a diameter_packet or not.
--define(CONTAINERS, [pkt, msg]).
+%% How to decode incoming messages.
+-define(DECODINGS, [record, false, map, list, record_from_map]).
-%% Which common dictionary to use in the clients.
--define(RFCS, [rfc3588, rfc6733]).
+%% Which dictionary to use in the clients.
+-define(RFCS, [rfc3588, rfc6733, rfc4005]).
%% Whether to decode stringish Diameter types to strings, or leave
%% them as binary.
@@ -163,13 +175,12 @@
-record(group,
{transport,
strings,
+ encoding,
client_service,
- client_encoding,
- client_dict0,
+ client_dict,
client_sender,
server_service,
- server_encoding,
- server_container,
+ server_decoding,
server_sender,
server_throttle}).
@@ -182,34 +193,36 @@
%% A common match when receiving answers in a client.
-define(answer_message(SessionId, ResultCode),
- ['answer-message',
- {'Session-Id', SessionId},
- {'Origin-Host', _},
- {'Origin-Realm', _},
- {'Result-Code', ResultCode}
- | _]).
+ ['answer-message' | #{'Session-Id' := SessionId,
+ 'Origin-Host' := _,
+ 'Origin-Realm' := _,
+ 'Result-Code' := ResultCode}]).
-define(answer_message(ResultCode),
- ?answer_message(_, ResultCode)).
+ ['answer-message' | #{'Origin-Host' := _,
+ 'Origin-Realm' := _,
+ 'Result-Code' := ResultCode}]).
%% Config for diameter:start_service/2.
--define(SERVICE(Name, Decode),
+-define(SERVICE(Name, Grp),
[{'Origin-Host', Name ++ "." ++ ?REALM},
{'Origin-Realm', ?REALM},
{'Host-IP-Address', [?ADDR]},
{'Vendor-Id', 12345},
{'Product-Name', "OTP/diameter"},
- {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]},
- {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]},
+ {'Auth-Application-Id', [0]}, %% common messages
+ {'Acct-Application-Id', [3]}, %% base accounting
{restrict_connections, false},
- {string_decode, Decode},
+ {string_decode, Grp#group.strings},
{incoming_maxlen, 1 bsl 21}
| [{application, [{dictionary, D},
- {module, ?MODULE},
+ {module, [?MODULE, Grp]},
{answer_errors, callback}]}
|| D <- [diameter_gen_base_rfc3588,
diameter_gen_base_accounting,
diameter_gen_base_rfc6733,
- diameter_gen_acct_rfc6733]]]).
+ diameter_gen_acct_rfc6733,
+ nas4005],
+ D /= nas4005 orelse have_nas()]]).
-define(SUCCESS,
?'DIAMETER_BASE_RESULT-CODE_SUCCESS').
@@ -227,6 +240,8 @@
?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED').
-define(UNSUPPORTED_VERSION,
?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION').
+-define(TOO_MANY,
+ ?'DIAMETER_BASE_RESULT-CODE_AVP_OCCURS_TOO_MANY_TIMES').
-define(REALM_NOT_SERVED,
?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED').
-define(UNABLE_TO_DELIVER,
@@ -254,64 +269,75 @@ suite() ->
[{timetrap, {seconds, 10}}].
all() ->
- [start, result_codes, {group, traffic}, empty, stop].
+ [rfc4005, start, result_codes, {group, traffic}, empty, stop].
+
+%% Redefine this to run one or more groups for debugging purposes.
+-define(GROUPS, []).
+%-define(GROUPS, [[tcp,rfc6733,record,map,false,false,false,false]]).
+%% Issues with gen_sctp sporadically cause huge numbers of failed
+%% testcases when running testcases in parallel.
groups() ->
- [{P, [P], Ts} || Ts <- [tc(tc())], P <- [shuffle, parallel]]
+ Names = names(),
+ [{P, [P], Ts} || Ts <- [tc()], P <- [shuffle, parallel]]
++
- [{?util:name([T,R,D,A,C,S,SS,ST,CS]),
- [],
- [{group, if S -> shuffle; not S -> parallel end}]}
- || T <- ?TRANSPORTS,
- R <- ?ENCODINGS,
- D <- ?RFCS,
- A <- ?ENCODINGS,
- C <- ?CONTAINERS,
- S <- ?STRING_DECODES,
- SS <- ?SENDERS,
- ST <- ?CALLBACKS,
- CS <- ?SENDERS]
+ [{?util:name(N), [], [{group, if T == sctp; S -> shuffle;
+ true -> parallel end}]}
+ || [T,_,_,_,S|_] = N <- Names]
++
- [{T, [], groups([[T,R,D,A,C,S,SS,ST,CS]
- || R <- ?ENCODINGS,
- D <- ?RFCS,
- A <- ?ENCODINGS,
- C <- ?CONTAINERS,
- S <- ?STRING_DECODES,
- SS <- ?SENDERS,
- ST <- ?CALLBACKS,
- CS <- ?SENDERS,
- SS orelse CS])} %% avoid deadlock
+ [{T, [], [{group, ?util:name(N)} || N <- names(Names, ?GROUPS),
+ T == hd(N)]}
|| T <- ?TRANSPORTS]
++
[{traffic, [], [{group, T} || T <- ?TRANSPORTS]}].
-%groups(_) -> %% debug
-% Name = [sctp,record,rfc6733,record,pkt,false,false,false,false],
-% [{group, ?util:name(Name)}];
-groups(Names) ->
- [{group, ?util:name(L)} || L <- Names].
+names() ->
+ [[T,R,E,D,S,ST,SS,CS] || T <- ?TRANSPORTS,
+ R <- ?RFCS,
+ E <- ?ENCODINGS,
+ D <- ?DECODINGS,
+ S <- ?STRING_DECODES,
+ ST <- ?CALLBACKS,
+ SS <- ?SENDERS,
+ CS <- ?SENDERS].
-%tc([N|_]) -> %% debug
-% [N];
-tc(L) ->
- L.
+names(Names, []) ->
+ [N || N <- Names,
+ [CS,SS|_] <- [lists:reverse(N)],
+ SS orelse CS]; %% avoid deadlock
+
+names(_, Names) ->
+ Names.
%% --------------------
+init_per_suite() ->
+ [{timetrap, {seconds, 60}}].
+
init_per_suite(Config) ->
- [{sctp, ?util:have_sctp()} | Config].
+ [{rfc4005, compile_and_load()}, {sctp, ?util:have_sctp()} | Config].
end_per_suite(_Config) ->
+ code:delete(nas4005),
+ code:purge(nas4005),
ok.
%% --------------------
+init_per_group(_) ->
+ [{timetrap, {seconds, 30}}].
+
init_per_group(Name, Config)
when Name == shuffle;
Name == parallel ->
- start_services(Config),
- add_transports(Config);
+ case rand:uniform() < ?SKIP of
+ true ->
+ {skip, random};
+ false ->
+ start_services(Config),
+ add_transports(Config),
+ replace({sleep, Name == parallel}, Config)
+ end;
init_per_group(sctp = Name, Config) ->
{_, Sctp} = lists:keyfind(Name, 1, Config),
@@ -322,24 +348,22 @@ init_per_group(sctp = Name, Config) ->
end;
init_per_group(Name, Config) ->
+ Nas = proplists:get_value(rfc4005, Config, false),
case ?util:name(Name) of
- [T,R,D,A,C,S,SS,ST,CS] ->
+ [_,R,_,_,_,_,_,_] when R == rfc4005, true /= Nas ->
+ {skip, rfc4005};
+ [T,R,E,D,S,ST,SS,CS] ->
G = #group{transport = T,
strings = S,
+ encoding = E,
client_service = [$C|?util:unique_string()],
- client_encoding = R,
- client_dict0 = dict0(D),
+ client_dict = appdict(R),
client_sender = CS,
server_service = [$S|?util:unique_string()],
- server_encoding = A,
- server_container = C,
+ server_decoding = D,
server_sender = SS,
server_throttle = ST},
- %% Limit the number of testcase, since the number of
- %% groups is large.
- All = ?util:scramble(tc()),
- TCs = lists:sublist(All, rand:uniform(32)),
- [{group, G}, {runlist, TCs} | Config];
+ replace([{group, G}, {runlist, select(T)}], Config);
_ ->
Config
end.
@@ -353,6 +377,14 @@ end_per_group(Name, Config)
end_per_group(_, _) ->
ok.
+select(T) ->
+ try maps:get(T, ?LIMIT) of
+ N ->
+ lists:sublist(?util:scramble(tc()), max(5, rand:uniform(N)))
+ catch
+ error:_ -> ?LIMIT
+ end.
+
%% --------------------
%% Skip testcases that can reasonably fail under SCTP.
@@ -368,12 +400,23 @@ init_per_testcase(Name, Config) ->
_ when not Run ->
{skip, random};
_ ->
+ proplists:get_value(sleep, Config, false)
+ andalso timer:sleep(rand:uniform(200)),
[{testcase, Name} | Config]
end.
end_per_testcase(_, _) ->
ok.
+%% replace/2
+
+replace(Pairs, Config)
+ when is_list(Pairs) ->
+ lists:foldl(fun replace/2, Config, Pairs);
+
+replace({Key, _} = T, Config) ->
+ [T | lists:keydelete(Key, 1, Config)].
+
%% --------------------
%% Testcases to run when services are started and connections
@@ -403,6 +446,7 @@ tc() ->
send_invalid_reject,
send_unexpected_mandatory_decode,
send_unexpected_mandatory,
+ send_too_many,
send_long,
send_maxlen,
send_nopeer,
@@ -440,16 +484,25 @@ start(_Config) ->
ok = diameter:start().
start_services(Config) ->
- #group{strings = S,
- client_service = CN,
- server_service = SN}
+ #group{client_service = CN,
+ server_service = SN,
+ server_decoding = SD}
+ = Grp
= group(Config),
- ok = diameter:start_service(SN, ?SERVICE(SN, S)),
- ok = diameter:start_service(CN, [{sequence, ?CLIENT_MASK}
- | ?SERVICE(CN, S)]).
+ ok = diameter:start_service(SN, [{traffic_counters, bool()},
+ {decode_format, SD}
+ | ?SERVICE(SN, Grp)]),
+ ok = diameter:start_service(CN, [{traffic_counters, bool()},
+ {sequence, ?CLIENT_MASK},
+ {strict_arities, decode}
+ | ?SERVICE(CN, Grp)]).
+
+bool() ->
+ 0.5 =< rand:uniform().
add_transports(Config) ->
#group{transport = T,
+ encoding = E,
client_service = CN,
client_sender = CS,
server_service = SN,
@@ -459,30 +512,46 @@ add_transports(Config) ->
LRef = ?util:listen(SN,
[T,
{sender, SS},
- {message_cb, ST andalso {?MODULE, message, [4]}}
+ {message_cb, ST andalso {?MODULE, message, [0]}}
| [{packet, hd(?util:scramble([false, raw]))}
|| T == sctp andalso CS]],
[{capabilities_cb, fun capx/2},
- {pool_size, 8},
- {applications, apps(rfc3588)}]
+ {pool_size, 8}
+ | server_apps()]
++ [{spawn_opt, {erlang, spawn, []}} || CS]),
Cs = [?util:connect(CN,
[T, {sender, CS}],
LRef,
- [{id, Id},
- {capabilities, [{'Origin-State-Id', origin(Id)}]},
- {applications, apps(D)}])
- || A <- ?ENCODINGS,
- C <- ?CONTAINERS,
- D <- ?RFCS,
- Id <- [{A,C}]],
- %% The server uses the client's Origin-State-Id to decide how to
- %% answer.
+ [{id, Id}
+ | client_apps(R, [{'Origin-State-Id', origin(Id)}])])
+ || D <- ?DECODINGS, %% for multiple candidate peers
+ R <- ?RFCS,
+ R /= rfc4005 orelse have_nas(),
+ Id <- [{D,E}]],
?util:write_priv(Config, "transport", [LRef | Cs]).
-apps(D0) ->
- D = dict0(D0),
- [acct(D), D].
+server_apps() ->
+ B = have_nas(),
+ [{applications, [diameter_gen_base_rfc3588,
+ diameter_gen_base_accounting]
+ ++ [nas4005 || B]},
+ {capabilities, [{'Auth-Application-Id', [0] ++ [1 || B]}, %% common, NAS
+ {'Acct-Application-Id', [3]}]}]. %% accounting
+
+client_apps(D, Caps) ->
+ if D == rfc4005 ->
+ [{applications, [nas4005]},
+ {capabilities, [{'Auth-Application-Id', [1]}, %% NAS
+ {'Acct-Application-Id', []}
+ | Caps]}];
+ true ->
+ D0 = dict0(D),
+ [{applications, [acct(D0), D0]},
+ {capabilities, Caps}]
+ end.
+
+have_nas() ->
+ false /= code:is_loaded(nas4005).
remove_transports(Config) ->
#group{client_service = CN,
@@ -515,9 +584,16 @@ capx(_, #diameter_caps{origin_host = {OH,DH}}) ->
%% ===========================================================================
+%% Fail only this testcase if the RFC 4005 dictionary hasn't been
+%% successfully compiled and loaded.
+rfc4005(Config) ->
+ true = proplists:get_value(rfc4005, Config).
+
%% Ensure that result codes have the expected values.
result_codes(_Config) ->
- {2001, 3001, 3002, 3003, 3004, 3007, 3008, 3009, 5001, 5011, 5014}
+ {2001,
+ 3001, 3002, 3003, 3004, 3007, 3008, 3009,
+ 5001, 5009, 5011, 5014}
= {?SUCCESS,
?COMMAND_UNSUPPORTED,
?UNABLE_TO_DELIVER,
@@ -527,6 +603,7 @@ result_codes(_Config) ->
?INVALID_HDR_BITS,
?INVALID_AVP_BITS,
?AVP_UNSUPPORTED,
+ ?TOO_MANY,
?UNSUPPORTED_VERSION,
?INVALID_AVP_LENGTH}.
@@ -535,7 +612,8 @@ send_ok(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 1}],
- ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['ACA' | #{'Result-Code' := ?SUCCESS,
+ 'Session-Id' := _}]
= call(Config, Req).
%% Send an accounting ACR that the server answers badly to.
@@ -551,7 +629,8 @@ send_eval(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 3}],
- ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['ACA' | #{'Result-Code' := ?SUCCESS,
+ 'Session-Id' := _}]
= call(Config, Req).
%% Send an accounting ACR that the server tries to answer with an
@@ -577,7 +656,7 @@ send_protocol_error(Config) ->
send_experimental_result(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 5}],
- ['ACA', {'Session-Id', _} | _]
+ ['ACA' | #{'Session-Id' := _}]
= call(Config, Req).
%% Send an ASR with an arbitrary non-mandatory AVP and expect success
@@ -585,11 +664,11 @@ send_experimental_result(Config) ->
send_arbitrary(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name',
value = "XXX"}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS,
+ 'AVP' := [#diameter_avp{name = 'Product-Name',
+ value = V}]}]
= call(Config, Req),
- {'AVP', [#diameter_avp{name = 'Product-Name',
- value = V}]}
- = lists:last(Avps),
"XXX" = string(V, Config).
%% Send an unknown AVP (to some client) and check that it comes back.
@@ -597,12 +676,12 @@ send_unknown(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = false,
data = <<17>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps]
- = call(Config, Req),
- {'AVP', [#diameter_avp{code = 999,
- is_mandatory = false,
- data = <<17>>}]}
- = lists:last(Avps).
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS,
+ 'AVP' := [#diameter_avp{code = 999,
+ is_mandatory = false,
+ data = <<17>>}]}]
+ = call(Config, Req).
%% Ditto, and point the AVP length past the end of the message. Expect
%% 5014.
@@ -613,28 +692,28 @@ send_unknown_short(Config, M, RC) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = M,
data = <<17>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', RC} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := RC,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{code = 999,
- is_mandatory = M,
- data = <<17, _/binary>>}] %% extra bits from padding
- = As.
+ [[#diameter_avp{code = 999,
+ is_mandatory = M,
+ data = <<17, _/binary>>}]] %% extra bits from padding
+ = failed_avps(Avps, Config).
%% Ditto but set the M flag.
send_unknown_mandatory(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = true,
data = <<17>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?AVP_UNSUPPORTED,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{code = 999,
- is_mandatory = true,
- data = <<17>>}]
- = As.
+ [[#diameter_avp{code = 999,
+ is_mandatory = true,
+ data = <<17>>}]]
+ = failed_avps(Avps, Config).
%% Ditto, and point the AVP length past the end of the message. Expect
%% 5014 instead of 5001.
@@ -647,15 +726,27 @@ send_unexpected_mandatory_decode(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout
is_mandatory = true,
data = <<12:32>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?AVP_UNSUPPORTED,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{code = 27,
- is_mandatory = true,
- value = 12,
- data = <<12:32>>}]
- = As.
+ [[#diameter_avp{code = 27,
+ is_mandatory = true,
+ value = 12,
+ data = <<12:32>>}]]
+ = failed_avps(Avps, Config).
+
+%% Try to two Auth-Application-Id in ASR expect 5009.
+send_too_many(Config) ->
+ Req = ['ASR', {'Auth-Application-Id', [?APP_ID, 44]}],
+
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?TOO_MANY,
+ 'Failed-AVP' := Avps}]
+ = call(Config, Req),
+ [[#diameter_avp{name = 'Auth-Application-Id',
+ value = 44}]]
+ = failed_avps(Avps, Config).
%% Send an containing a faulty Grouped AVP (empty Proxy-Host in
%% Proxy-Info) and expect that only the faulty AVP is sent in
@@ -665,15 +756,13 @@ send_unexpected_mandatory_decode(Config) ->
send_grouped_error(Config) ->
Req = ['ASR', {'Proxy-Info', [[{'Proxy-Host', "abcd"},
{'Proxy-State', ""}]]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?INVALID_AVP_LENGTH} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?INVALID_AVP_LENGTH,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{name = 'Proxy-Info',
- value = #'diameter_base_Proxy-Info'
- {'Proxy-Host' = Empty,
- 'Proxy-State' = undefined}}]
- = As,
+ [[#diameter_avp{name = 'Proxy-Info', value = V}]]
+ = failed_avps(Avps, Config),
+ {Empty, undefined, []} = proxy_info(V, Config),
<<0>> = iolist_to_binary(Empty).
%% Send an STR that the server ignores.
@@ -702,7 +791,8 @@ send_error_bit(Config) ->
%% Send a bad version and check that we get 5011.
send_unsupported_version(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?UNSUPPORTED_VERSION} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?UNSUPPORTED_VERSION}]
= call(Config, Req).
%% Send a request containing an AVP length > data size.
@@ -722,17 +812,13 @@ send_zero_avp_length(Config) ->
send_invalid_avp_length(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _},
- {'Result-Code', ?INVALID_AVP_LENGTH},
- {'Origin-Host', _},
- {'Origin-Realm', _},
- {'User-Name', _},
- {'Class', _},
- {'Error-Message', _},
- {'Error-Reporting-Host', _},
- {'Failed-AVP', [#'diameter_base_Failed-AVP'{'AVP' = [_]}]}
- | _]
- = call(Config, Req).
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?INVALID_AVP_LENGTH,
+ 'Origin-Host' := _,
+ 'Origin-Realm' := _,
+ 'Failed-AVP' := Avps}]
+ = call(Config, Req),
+ [[_]] = failed_avps(Avps, Config).
%% Send a request containing 5xxx errors that the server rejects with
%% 3xxx.
@@ -747,14 +833,16 @@ send_invalid_reject(Config) ->
send_unexpected_mandatory(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?AVP_UNSUPPORTED}]
= call(Config, Req).
%% Send something long that will be fragmented by TCP.
send_long(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'User-Name', [binary:copy(<<$X>>, 1 bsl 20)]}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req).
%% Send something longer than the configure incoming_maxlen.
@@ -797,7 +885,8 @@ send_any_2(Config) ->
send_all_1(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM),
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req, [{filter, {all, [{host, any},
{realm, Realm}]}}]).
send_all_2(Config) ->
@@ -826,13 +915,13 @@ send_detach(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
Ref = make_ref(),
ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
- Ans = receive {Ref, T} -> T end,
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
- = Ans.
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
+ = receive {Ref, T} -> T end.
%% Send a request which can't be encoded and expect {error, encode}.
send_encode_error(Config) ->
- {error, encode} = call(Config, ['STR']). %% No Termination-Cause
+ {error, encode} = call(Config, ['STR', {'Termination-Cause', huh}]).
%% Send with filtering and expect success.
send_destination_1(Config) ->
@@ -840,25 +929,27 @@ send_destination_1(Config) ->
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, ?REALM)]}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req, [{filter, {all, [host, realm]}}]).
send_destination_2(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req, [{filter, {all, [host, realm]}}]).
%% Send with filtering on and expect failure when specifying an
%% unknown host or realm.
send_destination_3(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
- {'Destination-Realm', "unknown.org"}],
+ {'Destination-Realm', <<"unknown.org">>}],
{error, no_connection}
= call(Config, Req, [{filter, {all, [host, realm]}}]).
send_destination_4(Config) ->
#group{server_service = SN}
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
- {'Destination-Host', [?HOST(SN, "unknown.org")]}],
+ {'Destination-Host', [?HOST(SN, ["unknown.org"])]}],
{error, no_connection}
= call(Config, Req, [{filter, {all, [host, realm]}}]).
@@ -866,7 +957,7 @@ send_destination_4(Config) ->
%% an unknown host or realm.
send_destination_5(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
- {'Destination-Realm', "unknown.org"}],
+ {'Destination-Realm', [<<"unknown.org">>]}],
?answer_message(?REALM_NOT_SERVED)
= call(Config, Req).
send_destination_6(Config) ->
@@ -908,7 +999,8 @@ send_bad_filter(Config, F) ->
%% Specify multiple filter options and expect them be conjunctive.
send_multiple_filters_1(Config) ->
Fun = fun(#diameter_caps{}) -> true end,
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= send_multiple_filters(Config, [host, {eval, Fun}]).
send_multiple_filters_2(Config) ->
E = {erlang, is_tuple, []},
@@ -919,7 +1011,8 @@ send_multiple_filters_3(Config) ->
E2 = {erlang, is_tuple, []},
E3 = {erlang, is_record, [diameter_caps]},
E4 = [{erlang, is_record, []}, diameter_caps],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]).
send_multiple_filters(Config, Fs) ->
@@ -930,11 +1023,35 @@ send_multiple_filters(Config, Fs) ->
%% only the return value from the prepare_request callback being
%% significant.
send_anything(Config) ->
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, anything).
%% ===========================================================================
+failed_avps(Avps, Config) ->
+ #group{client_dict = D} = proplists:get_value(group, Config),
+ [failed_avp(D, T) || T <- Avps].
+
+failed_avp(nas4005, {'nas_Failed-AVP', As}) ->
+ As;
+failed_avp(_, #'diameter_base_Failed-AVP'{'AVP' = As}) ->
+ As.
+
+proxy_info(Rec, Config) ->
+ #group{client_dict = D} = proplists:get_value(group, Config),
+ if D == nas4005 ->
+ {'nas_Proxy-Info', H, S, As}
+ = Rec,
+ {H,S,As};
+ true ->
+ #'diameter_base_Proxy-Info'{'Proxy-Host' = H,
+ 'Proxy-State' = S,
+ 'AVP' = As}
+ = Rec,
+ {H,S,As}
+ end.
+
group(Config) ->
#group{} = proplists:get_value(group, Config).
@@ -954,58 +1071,135 @@ call(Config, Req) ->
call(Config, Req, Opts) ->
Name = proplists:get_value(testcase, Config),
- #group{client_service = CN,
- client_encoding = ReqEncoding,
- client_dict0 = Dict0}
- = Group
+ #group{encoding = Enc,
+ client_service = CN,
+ client_dict = Dict0}
= group(Config),
diameter:call(CN,
dict(Req, Dict0),
- msg(Req, ReqEncoding, Dict0),
- [{extra, [{Name, Group}, diameter_lib:now()]} | Opts]).
+ msg(Req, Enc, Dict0),
+ [{extra, [Name, diameter_lib:now()]} | Opts]).
-origin({A,C}) ->
- 2*codec(A) + container(C);
+origin({D,E}) ->
+ 4*decode(D) + encode(E);
origin(N) ->
- {codec(N band 2), container(N rem 2)}.
-
-%% Map booleans, but the readable atoms are part of (constructed)
-%% group names, so it's good that they're readable.
-
-codec(record) -> 0;
-codec(list) -> 1;
-codec(0) -> record;
-codec(_) -> list.
-
-container(pkt) -> 0;
-container(msg) -> 1;
-container(0) -> pkt;
-container(_) -> msg.
+ {decode(N bsr 2), encode(N rem 4)}.
+
+%% Map atoms. The atoms are part of (constructed) group names, so it's
+%% good that they're readable.
+
+decode(record) -> 0;
+decode(list) -> 1;
+decode(map) -> 2;
+decode(false) -> 3;
+decode(record_from_map) -> 4;
+decode(0) -> record;
+decode(1) -> list;
+decode(2) -> map;
+decode(3) -> false;
+decode(4) -> record_from_map.
+
+encode(record) -> 0;
+encode(list) -> 1;
+encode(map) -> 2;
+encode(0) -> record;
+encode(1) -> list;
+encode(2) -> map.
msg([H|_] = Msg, record = E, diameter_gen_base_rfc3588)
when H == 'ACR';
H == 'ACA' ->
msg(Msg, E, diameter_gen_base_accounting);
+
msg([H|_] = Msg, record = E, diameter_gen_base_rfc6733)
when H == 'ACR';
H == 'ACA' ->
msg(Msg, E, diameter_gen_acct_rfc6733);
+
msg([H|T], record, Dict) ->
Dict:'#new-'(Dict:msg2rec(H), T);
+
+msg([H|As], map, _)
+ when is_list(As) ->
+ [H | maps:from_list(As)];
+
msg(Msg, _, _) ->
Msg.
+to_map(#diameter_packet{msg = [_MsgName | Avps] = Msg},
+ #group{server_decoding = map})
+ when is_map(Avps) ->
+ Msg;
+
+to_map(#diameter_packet{msg = [MsgName | Avps]},
+ #group{server_decoding = list}) ->
+ [MsgName | maps:from_list(Avps)];
+
+to_map(#diameter_packet{header = H, msg = Rec},
+ #group{server_decoding = D})
+ when D == record;
+ D == record_from_map ->
+ rec_to_map(Rec, dict(H));
+
+%% No record decode: do it ourselves.
+to_map(#diameter_packet{header = H,
+ msg = false,
+ bin = Bin},
+ #group{server_decoding = false,
+ strings = B}) ->
+ Opts = #{decode_format => map,
+ string_decode => B,
+ strict_mbit => true,
+ rfc => 6733},
+ #diameter_packet{msg = [_MsgName | _Map] = Msg}
+ = diameter_codec:decode(dict(H), Opts, Bin),
+ Msg.
+
+dict(#diameter_header{application_id = Id,
+ cmd_code = Code}) ->
+ if Id == 1 ->
+ nas4005;
+ Code == 271 ->
+ diameter_gen_base_accounting;
+ true ->
+ diameter_gen_base_rfc3588
+ end.
+
+rec_to_map(Rec, Dict) ->
+ [R | Vs] = Dict:'#get-'(Rec),
+ [Dict:rec2msg(R) | maps:from_list([T || {_,V} = T <- Vs,
+ V /= undefined,
+ V /= []])].
+
+appdict(rfc4005) ->
+ nas4005;
+appdict(D) ->
+ dict0(D).
+
dict0(D) ->
?A("diameter_gen_base_" ++ ?L(D)).
-dict(Msg, Dict0)
- when 'ACR' == hd(Msg);
- 'ACA' == hd(Msg);
- ?is_record(Msg, diameter_base_accounting_ACR);
- ?is_record(Msg, diameter_base_accounting_ACA) ->
+dict(Msg, Dict) ->
+ d(name(Msg), Dict).
+
+d(N, nas4005 = D) ->
+ if N == {list, 'answer-message'};
+ N == {map, 'answer-message'};
+ N == {record, 'diameter_base_answer-message'} ->
+ diameter_gen_base_rfc3588;
+ true ->
+ D
+ end;
+d(N, Dict0)
+ when N == {list, 'ACR'};
+ N == {list, 'ACA'};
+ N == {map, 'ACR'};
+ N == {map, 'ACA'};
+ N == {record, diameter_base_accounting_ACR};
+ N == {record, diameter_base_accounting_ACA} ->
acct(Dict0);
-dict(_, Dict0) ->
+d(_, Dict0) ->
Dict0.
acct(diameter_gen_base_rfc3588) ->
@@ -1014,53 +1208,60 @@ acct(diameter_gen_base_rfc6733) ->
diameter_gen_acct_rfc6733.
%% Set only values that aren't already.
-set(_, [H|T], Vs) ->
- [H | Vs ++ T];
-set(#group{client_dict0 = Dict0} = _Group, Rec, Vs) ->
+
+set(_, [N | As], Vs) ->
+ [N | if is_map(As) ->
+ maps:merge(maps:from_list(Vs), As);
+ is_list(As) ->
+ Vs ++ As
+ end];
+
+set(#group{client_dict = Dict0} = _Group, Rec, Vs) ->
Dict = dict(Rec, Dict0),
lists:foldl(fun({F,_} = FV, A) ->
- set(Dict, Dict:'#get-'(F, A), FV, A)
+ reset(Dict, Dict:'#get-'(F, A), FV, A)
end,
Rec,
Vs).
-set(Dict, E, FV, Rec)
+reset(Dict, E, FV, Rec)
when E == undefined;
E == [] ->
Dict:'#set-'(FV, Rec);
-set(_, _, _, Rec) ->
+
+reset(_, _, _, Rec) ->
Rec.
%% ===========================================================================
%% diameter callbacks
-%% peer_up/3
+%% peer_up/4
-peer_up(_SvcName, _Peer, State) ->
+peer_up(_SvcName, _Peer, State, _Group) ->
State.
%% peer_down/3
-peer_down(_SvcName, _Peer, State) ->
+peer_down(_SvcName, _Peer, State, _Group) ->
State.
-%% pick_peer/6-7
+%% pick_peer/7-8
-pick_peer(Peers, _, [$C|_], _State, {Name, Group}, _)
+pick_peer(Peers, _, [$C|_], _State, Group, Name, _)
when Name /= send_detach ->
find(Group, Peers).
-pick_peer(_Peers, _, [$C|_], _State, {send_nopeer, _}, _, ?EXTRA) ->
+pick_peer(_Peers, _, [$C|_], _State, _Group, send_nopeer, _, ?EXTRA) ->
false;
-pick_peer(Peers, _, [$C|_], _State, {send_detach, Group}, _, {_,_}) ->
+pick_peer(Peers, _, [$C|_], _State, Group, send_detach, _, {_,_}) ->
find(Group, Peers).
-find(#group{client_service = CN,
- server_encoding = A,
- server_container = C},
+find(#group{encoding = E,
+ client_service = CN,
+ server_decoding = D},
[_|_] = Peers) ->
- Id = {A,C},
+ Id = {D,E},
[P] = [P || P <- Peers, id(Id, P, CN)],
{ok, P}.
@@ -1069,15 +1270,15 @@ id(Id, {Pid, _Caps}, SvcName) ->
= diameter:service_info(SvcName, Pid),
lists:member({id, Id}, Opts).
-%% prepare_request/5-6
+%% prepare_request/6-7
-prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, {send_discard, _}, _) ->
+prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, _, send_discard, _) ->
{discard, unprepared};
-prepare_request(Pkt, [$C|_], {_Ref, Caps}, {Name, Group}, _) ->
+prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, Name, _) ->
{send, prepare(Pkt, Caps, Name, Group)}.
-prepare_request(Pkt, [$C|_], {_Ref, Caps}, {send_detach, Group}, _, _) ->
+prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, send_detach, _, _) ->
{eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}.
log(#diameter_packet{bin = Bin} = P, T)
@@ -1086,7 +1287,7 @@ log(#diameter_packet{bin = Bin} = P, T)
%% prepare/4
-prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_unknown_short_mandatory;
N == send_unknown_short ->
Req = prepare(Pkt, Caps, Group),
@@ -1106,7 +1307,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
<<H:Offset/binary, Len:24, T/binary>> = Bin,
E#diameter_packet{bin = <<H/binary, (Len+9):24, T/binary>>};
-prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_long_avp_length;
N == send_short_avp_length;
N == send_zero_avp_length ->
@@ -1132,7 +1333,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
T/binary,
Hdr/binary, AL:24, Data/binary>>};
-prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_invalid_avp_length;
N == send_invalid_reject ->
Req = prepare(Pkt, Caps, Group),
@@ -1147,7 +1348,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
<<V, L:24, H/binary>> = H0, %% assert
E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>};
-prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0}
+prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<V, Len:24, T/binary>>}
@@ -1157,7 +1358,7 @@ prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0}
Avp = <<Code:32, Flags, 8:24>>,
E#diameter_packet{bin = <<V, (Len+8):24, T/binary, Avp/binary>>};
-prepare(Pkt, Caps, send_grouped_error, #group{client_dict0 = Dict0}
+prepare(Pkt, Caps, send_grouped_error, #group{client_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = Bin}
@@ -1189,14 +1390,14 @@ prepare(Pkt, Caps, send_grouped_error, #group{client_dict0 = Dict0}
Payload/binary,
T/binary>>};
-prepare(Pkt, Caps, send_unsupported, #group{client_dict0 = Dict0} = Group) ->
+prepare(Pkt, Caps, send_unsupported, #group{client_dict = Dict0} = Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
E#diameter_packet{bin = <<H/binary, 42:24, T/binary>>};
-prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0}
+prepare(Pkt, Caps, send_unsupported_app, #group{client_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>}
@@ -1223,77 +1424,105 @@ prepare(Pkt, Caps, _Name, Group) ->
%% prepare/3
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_accounting_ACR);
- 'ACR' == hd(Req) ->
+prepare(#diameter_packet{msg = Req} = Pkt, Caps, Group) ->
+ set(name(Req), Pkt, Caps, Group).
+
+%% set/4
+
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_accounting_ACR};
+ N == {record, nas_ACR};
+ N == {map, 'ACR'};
+ N == {list, 'ACR'} ->
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, DR}}
= Caps,
- set(Group, Req, [{'Session-Id', diameter:session_id(OH)},
- {'Origin-Host', OH},
- {'Origin-Realm', OR},
- {'Destination-Realm', DR}]);
+ set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
+ {'Origin-Host', [OH]},
+ {'Origin-Realm', [OR]},
+ {'Destination-Realm', [DR]}]);
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_ASR);
- 'ASR' == hd(Req) ->
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_ASR};
+ N == {record, nas_ASR};
+ N == {map, 'ASR'};
+ N == {list, 'ASR'} ->
#diameter_caps{origin_host = {OH, DH},
origin_realm = {OR, DR}}
= Caps,
- set(Group, Req, [{'Session-Id', diameter:session_id(OH)},
- {'Origin-Host', OH},
- {'Origin-Realm', OR},
- {'Destination-Host', DH},
- {'Destination-Realm', DR},
+ set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
+ {'Origin-Host', [OH]},
+ {'Origin-Realm', [OR]},
+ {'Destination-Host', [DH]},
+ {'Destination-Realm', [DR]},
{'Auth-Application-Id', ?APP_ID}]);
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_STR);
- 'STR' == hd(Req) ->
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_STR};
+ N == {record, nas_STR};
+ N == {map, 'STR'};
+ N == {list, 'STR'} ->
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, DR}}
= Caps,
- set(Group, Req, [{'Session-Id', diameter:session_id(OH)},
- {'Origin-Host', OH},
- {'Origin-Realm', OR},
- {'Destination-Realm', DR},
+ set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
+ {'Origin-Host', [OH]},
+ {'Origin-Realm', [OR]},
+ {'Destination-Realm', [DR]},
{'Auth-Application-Id', ?APP_ID}]);
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_RAR);
- 'RAR' == hd(Req) ->
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_RAR};
+ N == {record, nas_RAR};
+ N == {map, 'RAR'};
+ N == {list, 'RAR'} ->
#diameter_caps{origin_host = {OH, DH},
origin_realm = {OR, DR}}
= Caps,
- set(Group, Req, [{'Session-Id', diameter:session_id(OH)},
- {'Origin-Host', OH},
- {'Origin-Realm', OR},
- {'Destination-Host', DH},
- {'Destination-Realm', DR},
+ set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
+ {'Origin-Host', [OH]},
+ {'Origin-Realm', [OR]},
+ {'Destination-Host', [DH]},
+ {'Destination-Realm', [DR]},
{'Auth-Application-Id', ?APP_ID}]).
-%% prepare_retransmit/5
+%% name/1
+
+name([H|#{}]) ->
+ {map, H};
-prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) ->
+name([H|_]) ->
+ {list, H};
+
+name(Rec) ->
+ try
+ {record, element(1, Rec)}
+ catch
+ error: badarg ->
+ false
+ end.
+
+%% prepare_retransmit/6
+
+prepare_retransmit(_Pkt, false, _Peer, _Group, _Name, _) ->
discard.
-%% handle_answer/6-7
+%% handle_answer/7-8
-handle_answer(Pkt, Req, [$C|_], Peer, {Name, Group}, _) ->
+handle_answer(Pkt, Req, [$C|_], Peer, Group, Name, _) ->
answer(Pkt, Req, Peer, Name, Group).
-handle_answer(Pkt, Req, [$C|_], Peer, {send_detach = Name, Group}, _, X) ->
+handle_answer(Pkt, Req, [$C|_], Peer, Group, send_detach = Name, _, X) ->
{Pid, Ref} = X,
Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}.
-answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) ->
+answer(Pkt, Req, _Peer, Name, #group{client_dict = Dict0}) ->
#diameter_packet{header = H, msg = Ans, errors = Es} = Pkt,
ApplId = app(Req, Name, Dict0),
#diameter_header{application_id = ApplId} = H, %% assert
Dict = dict(Ans, Dict0),
- [R | Vs] = Dict:'#get-'(answer(Ans, Es, Name)),
- [Dict:rec2msg(R) | Vs].
+ rec_to_map(answer(Ans, Es, Name), Dict).
%% Missing Result-Code and inappropriate Experimental-Result-Code.
answer(Rec, Es, send_experimental_result) ->
@@ -1317,25 +1546,29 @@ app(Req, _, Dict0) ->
Dict = dict(Req, Dict0),
Dict:id().
-%% handle_error/6
+%% handle_error/7
-handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, Time) ->
+handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, _, Time) ->
Now = diameter_lib:now(),
{Reason, {diameter_lib:timestamp(Time),
diameter_lib:timestamp(Now),
diameter_lib:micro_diff(Now, Time)}};
-handle_error(Reason, _Req, [$C|_], _Peer, _, _Time) ->
+handle_error(Reason, _Req, [$C|_], _Peer, _, _, _Time) ->
{error, Reason}.
-%% handle_request/3
+%% handle_request/4
%% Note that diameter will set Result-Code and Failed-AVPs if
%% #diameter_packet.errors is non-null.
-handle_request(#diameter_packet{header = H, msg = M, avps = As},
+handle_request(#diameter_packet{header = H, avps = As}
+ = Pkt,
_,
- {_Ref, Caps}) ->
+ {_Ref, Caps},
+ #group{encoding = E,
+ server_decoding = D}
+ = Grp) ->
#diameter_header{end_to_end_id = EI,
hop_by_hop_id = HI}
= H,
@@ -1343,24 +1576,62 @@ handle_request(#diameter_packet{header = H, msg = M, avps = As},
V = EI bsr B, %% assert
V = HI bsr B, %%
#diameter_caps{origin_state_id = {_,[Id]}} = Caps,
- answer(origin(Id), request(M, [H|As], Caps)).
+ {D,E} = T = origin(Id), %% assert
+ wrap(T, H, request(to_map(Pkt, Grp), [H|As], Caps)).
+
+wrap(Id, H, {Tag, Action, Post}) ->
+ {Tag, wrap(Id, H, Action), Post};
-answer(T, {Tag, Action, Post}) ->
- {Tag, answer(T, Action), Post};
-answer(_, {reply, [#diameter_header{} | _]} = T) ->
+wrap(_, _, {reply, [#diameter_header{} | _]} = T) ->
T;
-answer({A,C}, {reply, Ans}) ->
- answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)});
-answer(pkt, {reply, Ans})
- when not is_record(Ans, diameter_packet) ->
- {reply, #diameter_packet{msg = Ans}};
-answer(_, T) ->
+
+wrap({_,E}, H, {reply, Ans}) ->
+ Msg = base_to_nas(msg(Ans, E, diameter_gen_base_rfc3588), H),
+ {reply, wrap(Msg)};
+
+wrap(_, _, T) ->
T.
+%% Randomly wrap the answer in a diameter_packet.
+
+wrap(#diameter_packet{} = Pkt) ->
+ Pkt;
+
+wrap(Msg) ->
+ case rand:uniform(2) of
+ 1 -> #diameter_packet{msg = Msg};
+ 2 -> Msg
+ end.
+
+%% base_to_nas/2
+
+base_to_nas(#diameter_packet{msg = Msg} = Pkt, H) ->
+ Pkt#diameter_packet{msg = base_to_nas(Msg, H)};
+
+base_to_nas(Rec, #diameter_header{application_id = 1})
+ when is_tuple(Rec), not ?is_record(Rec, 'diameter_base_answer-message') ->
+ D = case element(1, Rec) of
+ diameter_base_accounting_ACA ->
+ diameter_gen_base_accounting;
+ _ ->
+ diameter_gen_base_rfc3588
+ end,
+ [R | Values] = D:'#get-'(Rec),
+ "diameter_base_" ++ N = ?L(R),
+ Name = ?A("nas_" ++ if N == "accounting_ACA" ->
+ "ACA";
+ true ->
+ N
+ end),
+ nas4005:'#new-'([Name | Values]);
+
+base_to_nas(Msg, _) ->
+ Msg.
+
%% request/3
%% send_experimental_result
-request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 5},
+request(['ACR' | #{'Accounting-Record-Number' := 5}],
[Hdr | Avps],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
@@ -1393,14 +1664,14 @@ request(Msg, _Avps, Caps) ->
%% request/2
%% send_nok
-request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 0},
+request(['ACR' | #{'Accounting-Record-Number' := 0}],
_) ->
{eval_packet, {protocol_error, ?INVALID_AVP_BITS}, [fun log/2, invalid]};
%% send_bad_answer
-request(#diameter_base_accounting_ACR{'Session-Id' = SId,
- 'Accounting-Record-Type' = RT,
- 'Accounting-Record-Number' = 2 = RN},
+request(['ACR' | #{'Session-Id' := SId,
+ 'Accounting-Record-Type' := RT,
+ 'Accounting-Record-Number' := 2 = RN}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
Ans = ['ACA', {'Result-Code', ?SUCCESS},
@@ -1414,9 +1685,9 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId,
msg = Ans}};
%% send_eval
-request(#diameter_base_accounting_ACR{'Session-Id' = SId,
- 'Accounting-Record-Type' = RT,
- 'Accounting-Record-Number' = 3 = RN},
+request(['ACR' | #{'Session-Id' := SId,
+ 'Accounting-Record-Type' := RT,
+ 'Accounting-Record-Number' := 3 = RN}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
Ans = ['ACA', {'Result-Code', ?SUCCESS},
@@ -1428,9 +1699,9 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId,
{eval, {reply, Ans}, {erlang, now, []}};
%% send_ok
-request(#diameter_base_accounting_ACR{'Session-Id' = SId,
- 'Accounting-Record-Type' = RT,
- 'Accounting-Record-Number' = 1 = RN},
+request(['ACR' | #{'Session-Id' := SId,
+ 'Accounting-Record-Type' := RT,
+ 'Accounting-Record-Number' := 1 = RN}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
{reply, ['ACA', {'Result-Code', ?SUCCESS},
@@ -1441,7 +1712,7 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId,
{'Accounting-Record-Number', RN}]};
%% send_protocol_error
-request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 4},
+request(['ACR' | #{'Accounting-Record-Number' := 4}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
Ans = ['answer-message', {'Result-Code', ?TOO_BUSY},
@@ -1449,40 +1720,39 @@ request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 4},
{'Origin-Realm', OR}],
{reply, Ans};
-request(#diameter_base_ASR{'Session-Id' = SId,
- 'AVP' = Avps},
+request(['ASR' | #{'Session-Id' := SId} = Avps],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
{reply, ['ASA', {'Result-Code', ?SUCCESS},
{'Session-Id', SId},
{'Origin-Host', OH},
{'Origin-Realm', OR},
- {'AVP', Avps}]};
+ {'AVP', maps:get('AVP', Avps, [])}]};
%% send_invalid_reject
-request(#diameter_base_STR{'Termination-Cause' = ?USER_MOVED},
+request(['STR' | #{'Termination-Cause' := ?USER_MOVED}],
_Caps) ->
{protocol_error, ?TOO_BUSY};
%% send_noreply
-request(#diameter_base_STR{'Termination-Cause' = T},
+request(['STR' | #{'Termination-Cause' := T}],
_Caps)
when T /= ?LOGOUT ->
discard;
%% send_destination_5
-request(#diameter_base_STR{'Destination-Realm' = R},
+request(['STR' | #{'Destination-Realm' := R}],
#diameter_caps{origin_realm = {OR, _}})
when R /= undefined, R /= OR ->
{protocol_error, ?REALM_NOT_SERVED};
%% send_destination_6
-request(#diameter_base_STR{'Destination-Host' = [H]},
+request(['STR' | #{'Destination-Host' := [H]}],
#diameter_caps{origin_host = {OH, _}})
when H /= OH ->
{protocol_error, ?UNABLE_TO_DELIVER};
-request(#diameter_base_STR{'Session-Id' = SId},
+request(['STR' | #{'Session-Id' := SId}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
{reply, ['STA', {'Result-Code', ?SUCCESS},
@@ -1491,7 +1761,7 @@ request(#diameter_base_STR{'Session-Id' = SId},
{'Origin-Realm', OR}]};
%% send_error/send_timeout
-request(#diameter_base_RAR{}, _Caps) ->
+request(['RAR' | #{}], _Caps) ->
receive after 2000 -> {protocol_error, ?TOO_BUSY} end.
%% message/3
@@ -1505,8 +1775,8 @@ message(Dir, #diameter_packet{bin = Bin}, N) ->
message(Dir, Bin, N);
%% incoming request
-message(recv, <<_:32, 1, _/bits>> = Bin, N) ->
- [Bin, 1 < N, fun ?MODULE:message/3, N-1];
+message(recv, <<_:32, 1:1, _/bits>> = Bin, N) ->
+ [Bin, N < 16, fun ?MODULE:message/3, N+1];
%% incoming answer
message(recv, Bin, _) ->
@@ -1517,9 +1787,35 @@ message(send, Bin, _) ->
[Bin];
%% sent request
-message(ack, <<_:32, 1, _/bits>>, _) ->
+message(ack, <<_:32, 1:1, _/bits>>, _) ->
[];
%% sent answer or discarded request
message(ack, _, N) ->
- [0 =< N, fun ?MODULE:message/3, N+1].
+ [N =< 16, fun ?MODULE:message/3, N-1].
+
+%% ------------------------------------------------------------------------
+
+compile_and_load() ->
+ try
+ Path = hd([P || H <- [[here(), ".."], [code:lib_dir(diameter)]],
+ P <- [filename:join(H ++ ["examples",
+ "dict",
+ "rfc4005_nas.dia"])],
+ {ok, _} <- [file:read_file_info(P)]]),
+ {ok, [Forms]}
+ = diameter_make:codec(Path, [return,
+ forms,
+ {name, "nas4005"},
+ {prefix, "nas"},
+ {inherits, "common/diameter_gen_base_rfc3588"}]),
+ {ok, nas4005, Bin, []} = compile:forms(Forms, [debug_info, return]),
+ {module, nas4005} = code:load_binary(nas4005, "nas4005", Bin),
+ true
+ catch
+ E:R ->
+ {E, R, erlang:get_stacktrace()}
+ end.
+
+here() ->
+ filename:dirname(code:which(?MODULE)).
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
index 03f79096ac..d249b0e4fa 100644
--- a/lib/diameter/test/diameter_util.erl
+++ b/lib/diameter/test/diameter_util.erl
@@ -32,7 +32,8 @@
foldl/3,
scramble/1,
unique_string/0,
- have_sctp/0]).
+ have_sctp/0,
+ eprof/1]).
%% diameter-specific
-export([lport/2,
@@ -48,6 +49,16 @@
-define(L, atom_to_list).
+%% ---------------------------------------------------------------------------
+
+eprof(start) ->
+ eprof:start(),
+ eprof:start_profiling([self()]);
+
+eprof(stop) ->
+ eprof:stop_profiling(),
+ eprof:analyze(),
+ eprof:stop().
%% ---------------------------------------------------------------------------
%% name/2
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index 66ec6cabd8..29e4b22632 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -408,7 +408,7 @@
<c>{self, once}</c>, the first message has an extra
element, that is, <c>{http, {RequestId, stream_start, Headers, Pid}}</c>.
This is the process id to be used as an argument to
- <c>http:stream_next/1</c> to trigger the next message to be sent to
+ <c>httpc:stream_next/1</c> to trigger the next message to be sent to
the calling process.</p>
<p>Notice that chunked encoding can add
headers so that there are more headers in the <c>stream_end</c>
diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl
index 3be5f2dd74..2023546f01 100644
--- a/lib/inets/src/http_server/mod_disk_log.erl
+++ b/lib/inets/src/http_server/mod_disk_log.erl
@@ -363,17 +363,21 @@ create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList) ->
%%----------------------------------------------------------------------
open(Filename, MaxBytes, MaxFiles, internal) ->
- Opts = [{format, internal}, {repair, truncate}],
- open1(Filename, MaxBytes, MaxFiles, Opts);
+ Opt0 = {format, internal},
+ Opts1 = [Opt0, {repair, true}],
+ Opts2 = [Opt0, {repair, truncate}],
+ open1(Filename, MaxBytes, MaxFiles, Opts1, Opts2);
open(Filename, MaxBytes, MaxFiles, _) ->
Opts = [{format, external}],
- open1(Filename, MaxBytes, MaxFiles, Opts).
+ open1(Filename, MaxBytes, MaxFiles, Opts, Opts).
-open1(Filename, MaxBytes, MaxFiles, Opts0) ->
- Opts1 = [{name, Filename}, {file, Filename}, {type, wrap}] ++ Opts0,
- case open2(Opts1, {MaxBytes, MaxFiles}) of
+open1(Filename, MaxBytes, MaxFiles, Opts1, Opts2) ->
+ Opts0 = [{name, Filename}, {file, Filename}, {type, wrap}],
+ case open2(Opts0 ++ Opts1, Opts0 ++ Opts2, {MaxBytes, MaxFiles}) of
{ok, LogDB} ->
{ok, LogDB};
+ {repaired, LogDB, {recovered, _}, {badbytes, _}} ->
+ {ok, LogDB};
{error, Reason} ->
{error,
?NICE("Can't create " ++ Filename ++
@@ -382,11 +386,16 @@ open1(Filename, MaxBytes, MaxFiles, Opts0) ->
{error, ?NICE("Can't create "++Filename)}
end.
-open2(Opts, Size) ->
- case disk_log:open(Opts) of
+open2(Opts1, Opts2, Size) ->
+ case disk_log:open(Opts1) of
{error, {badarg, size}} ->
%% File did not exist, add the size option and try again
- disk_log:open([{size, Size} | Opts]);
+ disk_log:open([{size, Size} | Opts1]);
+ {error, {Reason, _}} when
+ Reason == not_a_log_file;
+ Reason == invalid_index_file ->
+ %% File was corrupt, add the truncate option and try again
+ disk_log:open([{size, Size} | Opts2]);
Else ->
Else
end.
diff --git a/lib/inets/src/http_server/mod_log.erl b/lib/inets/src/http_server/mod_log.erl
index ad7e9713d9..ec570504be 100644
--- a/lib/inets/src/http_server/mod_log.erl
+++ b/lib/inets/src/http_server/mod_log.erl
@@ -105,8 +105,8 @@ do(Info) ->
Code = proplists:get_value(code,Head,unknown),
transfer_log(Info, "-", AuthUser, Date, Code, Size),
{proceed, Info#mod.data};
- {_StatusCode, Response} ->
- transfer_log(Info,"-",AuthUser,Date,200,
+ {StatusCode, Response} ->
+ transfer_log(Info, "-", AuthUser, Date, StatusCode,
httpd_util:flatlength(Response)),
{proceed,Info#mod.data};
undefined ->
diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl
index 055b847319..b4f0f2aa7d 100644
--- a/lib/inets/test/httpd_SUITE.erl
+++ b/lib/inets/test/httpd_SUITE.erl
@@ -73,6 +73,7 @@ all() ->
{group, http_reload},
{group, https_reload},
{group, http_mime_types},
+ {group, http_logging},
mime_types_format
].
@@ -96,6 +97,7 @@ groups() ->
{https_htaccess, [], [{group, htaccess}]},
{http_security, [], [{group, security}]},
{https_security, [], [{group, security}]},
+ {http_logging, [], [{group, logging}]},
{http_reload, [], [{group, reload}]},
{https_reload, [], [{group, reload}]},
{http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]},
@@ -119,6 +121,8 @@ groups() ->
]},
{htaccess, [], [htaccess_1_1, htaccess_1_0, htaccess_0_9]},
{security, [], [security_1_1, security_1_0]}, %% Skip 0.9 as causes timing issus in test code
+ {logging, [], [disk_log_internal, disk_log_exists,
+ disk_log_bad_size, disk_log_bad_file]},
{http_1_1, [],
[host, chunked, expect, cgi, cgi_chunked_encoding_test,
trace, range, if_modified_since, mod_esi_chunk_timeout,
@@ -254,6 +258,11 @@ init_per_group(auth_api_dets, Config) ->
init_per_group(auth_api_mnesia, Config) ->
start_mnesia(proplists:get_value(node, Config)),
[{auth_prefix, "mnesia_"} | Config];
+init_per_group(http_logging, Config) ->
+ Config1 = [{http_version, "HTTP/1.1"} | Config],
+ ServerRoot = proplists:get_value(server_root, Config1),
+ Path = ServerRoot ++ "/httpd_log_transfer",
+ [{transfer_log, Path} | Config1];
init_per_group(_, Config) ->
Config.
@@ -310,10 +319,60 @@ init_per_testcase(range, Config) ->
create_range_data(DocRoot),
dbg(range, Config, init);
+init_per_testcase(disk_log_internal, Config0) ->
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
+init_per_testcase(disk_log_exists, Config0) ->
+ ServerRoot = proplists:get_value(server_root, Config0),
+ Filename = ServerRoot ++ "/httpd_log_transfer",
+ {ok, Log} = disk_log:open([{name, Filename}, {file, Filename},
+ {repair, truncate}, {format, internal},
+ {type, wrap}, {size, {1048576, 5}}]),
+ ok = disk_log:log(Log, {bogus, node(), self()}),
+ ok = disk_log:close(Log),
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
+init_per_testcase(disk_log_bad_size, Config0) ->
+ ServerRoot = proplists:get_value(server_root, Config0),
+ Filename = ServerRoot ++ "/httpd_log_transfer",
+ {ok, Log} = disk_log:open([{name, Filename}, {file, Filename},
+ {repair, truncate}, {format, internal},
+ {type, wrap}, {size, {1048576, 5}}]),
+ ok = disk_log:log(Log, {bogus, node(), self()}),
+ ok = disk_log:close(Log),
+ ok = file:delete(Filename ++ ".siz"),
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
+init_per_testcase(disk_log_bad_file, Config0) ->
+ ServerRoot = proplists:get_value(server_root, Config0),
+ Filename = ServerRoot ++ "/httpd_log_transfer",
+ ok = file:write_file(Filename ++ ".1", <<>>),
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
init_per_testcase(Case, Config) ->
ct:timetrap({seconds, 20}),
dbg(Case, Config, init).
+end_per_testcase(Case, Config) when
+ Case == disk_log_internal;
+ Case == disk_log_exists;
+ Case == disk_log_bad_size;
+ Case == disk_log_bad_file ->
+ inets:stop(),
+ dbg(Case, Config, 'end');
+
end_per_testcase(Case, Config) ->
dbg(Case, Config, 'end').
@@ -1257,6 +1316,63 @@ security(Config) ->
true = unblock_user(Node, "two", Port, OpenDir).
%%-------------------------------------------------------------------------
+
+disk_log_internal() ->
+ ["Test mod_disk_log"].
+
+disk_log_internal(Config) ->
+ Version = proplists:get_value(http_version, Config),
+ Request = "GET /" ++ integer_to_list(rand:uniform(1000000)) ++ " ",
+ ok = http_status(Request, Config, [{statuscode, 404}]),
+ Log = proplists:get_value(transfer_log, Config),
+ Match = list_to_binary(Request ++ Version),
+ disk_log_internal1(Log, Match, disk_log:chunk(Log, start)).
+disk_log_internal1(_, _, eof) ->
+ ct:fail(eof);
+disk_log_internal1(Log, Match, {Cont, [H | T]}) ->
+ case binary:match(H, Match) of
+ nomatch ->
+ disk_log_internal1(Log, Match, {Cont, T});
+ _ ->
+ ok
+ end;
+disk_log_internal1(Log, Match, {Cont, []}) ->
+ disk_log_internal1(Log, Match, disk_log:chunk(Log, Cont)).
+
+disk_log_exists() ->
+ ["Test mod_disk_log with existing logs"].
+
+disk_log_exists(Config) ->
+ Log = proplists:get_value(transfer_log, Config),
+ Self = self(),
+ Node = node(),
+ Log = proplists:get_value(transfer_log, Config),
+ {_, [{bogus, Node, Self} | _]} = disk_log:chunk(Log, start).
+
+disk_log_bad_size() ->
+ ["Test mod_disk_log with existing log, missing .siz"].
+
+disk_log_bad_size(Config) ->
+ Log = proplists:get_value(transfer_log, Config),
+ Self = self(),
+ Node = node(),
+ Log = proplists:get_value(transfer_log, Config),
+ {_, [{bogus, Node, Self} | _]} = disk_log:chunk(Log, start).
+
+disk_log_bad_file() ->
+ ["Test mod_disk_log with bad file"].
+
+disk_log_bad_file(Config) ->
+ Log = proplists:get_value(transfer_log, Config),
+ Version = proplists:get_value(http_version, Config),
+ Request = "GET /" ++ integer_to_list(rand:uniform(1000000)) ++ " ",
+ ok = http_status(Request, Config, [{statuscode, 404}]),
+ Log = proplists:get_value(transfer_log, Config),
+ Match = list_to_binary(Request ++ Version),
+ {_, [H | _]} = disk_log:chunk(Log, start),
+ {_, _} = binary:match(H, Match).
+
+%%-------------------------------------------------------------------------
non_disturbing_reconfiger_dies(Config) when is_list(Config) ->
do_reconfiger_dies([{http_version, "HTTP/1.1"} | Config], non_disturbing).
disturbing_reconfiger_dies(Config) when is_list(Config) ->
@@ -1567,6 +1683,7 @@ start_apps(Group) when Group == http_basic;
Group == http_auth_api_mnesia;
Group == http_htaccess;
Group == http_security;
+ Group == http_logging;
Group == http_reload;
Group == http_mime_types->
inets_test_lib:start_apps([inets]).
@@ -1662,6 +1779,8 @@ server_config(http_security, Config) ->
server_config(https_security, Config) ->
ServerRoot = proplists:get_value(server_root, Config),
tl(auth_conf(ServerRoot)) ++ security_conf(ServerRoot) ++ server_config(https, Config);
+server_config(http_logging, Config) ->
+ log_conf() ++ server_config(http, Config);
server_config(http_mime_types, Config0) ->
Config1 = basic_conf() ++ server_config(http, Config0),
ServerRoot = proplists:get_value(server_root, Config0),
@@ -1863,6 +1982,16 @@ mod_security_conf(SecFile, Dir) ->
{path, Dir} %% This is should not be needed, but is atm, awful design!
].
+log_conf() ->
+ [{modules, [mod_alias, mod_dir, mod_get, mod_head, mod_disk_log]},
+ {transfer_disk_log, "httpd_log_transfer"},
+ {security_disk_log, "httpd_log_security"},
+ {error_disk_log, "httpd_log_error"},
+ {transfer_disk_log_size, {1048576, 5}},
+ {error_disk_log_size, {1048576, 5}},
+ {error_disk_log_size, {1048576, 5}},
+ {security_disk_log_size, {1048576, 5}},
+ {disk_log_format, internal}].
http_status(Request, Config, Expected) ->
Version = proplists:get_value(http_version, Config),
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index b71e8a1e5d..169a76463b 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -222,11 +222,18 @@ fe80::204:acff:fe17:bf38
<name name="get_rc" arity="0"/>
<fsummary>Return a list of IP configuration parameters.</fsummary>
<desc>
- <p>Returns the state of the <c>Inet</c> configuration database in
+ <p>
+ Returns the state of the <c>Inet</c> configuration database in
form of a list of recorded configuration parameters. For more
information, see <seealso marker="erts:inet_cfg">ERTS User's Guide:
Inet Configuration</seealso>.
- Only parameters with other than default values are returned.</p>
+ </p>
+ <p>
+ Only actual parameters with other than default values
+ are returned, for example not directives that specify
+ other sources for configuration parameters nor
+ directives that clear parameters.
+ </p>
</desc>
</func>
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index ad92aafc2f..480db6814e 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -33,10 +33,10 @@
-export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2,
dump_monitors/1, dump_links/1, flat_size/1,
- get_internal_state/1, instructions/0, lock_counters/1,
+ get_internal_state/1, instructions/0,
map_info/1, same/2, set_internal_state/2,
- size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2,
- dirty/3]).
+ size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3,
+ lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0]).
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
@@ -142,12 +142,31 @@ ic(F) when is_function(F) ->
io:format("Total: ~w~n",[lists:sum([C||{_I,C}<-Is])]),
R.
--spec lock_counters(info) -> term();
- (clear) -> ok;
- ({copy_save, boolean()}) -> boolean();
- ({process_locks, boolean()}) -> boolean().
+-spec lcnt_control
+ (copy_save, boolean()) -> ok;
+ (mask, list(atom())) -> ok.
-lock_counters(_) ->
+lcnt_control(_Option, _Value) ->
+ erlang:nif_error(undef).
+
+-spec lcnt_control
+ (copy_save) -> boolean();
+ (mask) -> list(atom()).
+
+lcnt_control(_Option) ->
+ erlang:nif_error(undef).
+
+-type lcnt_lock_info() :: {atom(), term(), atom(), term()}.
+
+-spec lcnt_collect() ->
+ list({duration, {non_neg_integer(), non_neg_integer()}} |
+ {locks, list(lcnt_lock_info())}).
+
+lcnt_collect() ->
+ erlang:nif_error(undef).
+
+-spec lcnt_clear() -> ok.
+lcnt_clear() ->
erlang:nif_error(undef).
-spec same(Term1, Term2) -> boolean() when
diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl
index 6aef5476f1..dc20c21c77 100644
--- a/lib/kernel/src/inet.erl
+++ b/lib/kernel/src/inet.erl
@@ -151,7 +151,8 @@
%%% ---------------------------------
--spec get_rc() -> [{Par :: any(), Val :: any()}].
+-spec get_rc() -> [{Par :: atom(), Val :: any()} |
+ {Par :: atom(), Val1 :: any(), Val2 :: any()}].
get_rc() ->
inet_db:get_rc().
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
index e150938487..2a11b04310 100644
--- a/lib/kernel/src/kernel.app.src
+++ b/lib/kernel/src/kernel.app.src
@@ -120,6 +120,6 @@
{applications, []},
{env, [{error_logger, tty}]},
{mod, {kernel, []}},
- {runtime_dependencies, ["erts-9.0", "stdlib-3.0", "sasl-3.0"]}
+ {runtime_dependencies, ["erts-9.1", "stdlib-3.0", "sasl-3.0"]}
]
}.
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index c7ee294719..8b6036f52a 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -297,6 +297,8 @@ to_str(No) when is_integer(No) ->
integer_to_list(No);
to_str(Float) when is_float(Float) ->
io_lib:format("~.3f", [Float]);
+to_str({trunc, Float}) when is_float(Float) ->
+ float_to_list(Float, [{decimals,0}]);
to_str(Term) ->
io_lib:format("~w", [Term]).
diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl
index db86c05bed..2e1af3ada9 100644
--- a/lib/observer/src/observer_sys_wx.erl
+++ b/lib/observer/src/observer_sys_wx.erl
@@ -48,7 +48,7 @@ start_link(Notebook, Parent, Config) ->
init([Notebook, Parent, Config]) ->
SysInfo = observer_backend:sys_info(),
- {Sys, Mem, Cpu, Stats} = info_fields(),
+ {Sys, Mem, Cpu, Stats, Limits} = info_fields(),
Panel = wxPanel:new(Notebook),
Sizer = wxBoxSizer:new(?wxVERTICAL),
HSizer0 = wxBoxSizer:new(?wxHORIZONTAL),
@@ -63,17 +63,26 @@ init([Notebook, Parent, Config]) ->
wxSizer:add(HSizer1, FPanel2, [{flag, ?wxEXPAND}, {proportion, 1}]),
wxSizer:add(HSizer1, FPanel3, [{flag, ?wxEXPAND}, {proportion, 1}]),
+ HSizer2 = wxBoxSizer:new(?wxHORIZONTAL),
+ {FPanel4, _FSizer4, Fields4} = observer_lib:display_info(Panel, observer_lib:fill_info(Limits, SysInfo)),
+ wxSizer:add(HSizer2, FPanel4, [{flag, ?wxEXPAND}, {proportion, 1}]),
+
+
BorderFlags = ?wxLEFT bor ?wxRIGHT,
wxSizer:add(Sizer, HSizer0, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
{proportion, 0}, {border, 5}]),
wxSizer:add(Sizer, HSizer1, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM},
{proportion, 0}, {border, 5}]),
+ wxSizer:add(Sizer, HSizer2, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM},
+ {proportion, 0}, {border, 5}]),
+
wxPanel:setSizer(Panel, Sizer),
Timer = observer_lib:start_timer(Config, 10),
{Panel, #sys_wx_state{parent=Parent,
parent_notebook=Notebook,
panel=Panel, sizer=Sizer,
- timer=Timer, fields=Fields0 ++ Fields1++Fields2++Fields3}}.
+ timer=Timer, fields=Fields0 ++ Fields1++Fields2++Fields3++Fields4}}.
+
create_sys_menu(Parent) ->
View = {"View", [#create_menu{id = ?ID_REFRESH, text = "Refresh\tCtrl-R"},
@@ -83,14 +92,40 @@ create_sys_menu(Parent) ->
update_syspage(#sys_wx_state{node = undefined}) -> ignore;
update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer}) ->
SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []),
- {Sys, Mem, Cpu, Stats} = info_fields(),
+ {Sys, Mem, Cpu, Stats, Limits} = info_fields(),
observer_lib:update_info(Fields,
observer_lib:fill_info(Sys, SysInfo) ++
observer_lib:fill_info(Mem, SysInfo) ++
observer_lib:fill_info(Cpu, SysInfo) ++
- observer_lib:fill_info(Stats, SysInfo)),
+ observer_lib:fill_info(Stats, SysInfo)++
+ observer_lib:fill_info(Limits, SysInfo)),
+
wxSizer:layout(Sizer).
+
+maybe_convert(undefined) -> "Not available";
+maybe_convert(V) -> observer_lib:to_str(V).
+
+get_dist_buf_busy_limit_info() ->
+ fun(Data) ->
+ maybe_convert(proplists:get_value(dist_buf_busy_limit, Data))
+ end.
+
+get_limit_count_info(Count, Limit) ->
+ fun(Data) ->
+ C = proplists:get_value(Count, Data),
+ L = proplists:get_value(Limit, Data),
+ lists:flatten(
+ io_lib:format("~s / ~s ~s",
+ [maybe_convert(C), maybe_convert(L),
+ if
+ C =:= undefined -> "";
+ L =:= undefined -> "";
+ true -> io_lib:format("(~s % used)",[observer_lib:to_str({trunc, (C / L) *100})])
+ end]))
+ end.
+
+
info_fields() ->
Sys = [{"System and Architecture",
[{"System Version", otp_release},
@@ -122,14 +157,20 @@ info_fields() ->
]}],
Stats = [{"Statistics", right,
[{"Up time", {time_ms, uptime}},
- {"Max Processes", process_limit},
- {"Processes", process_count},
{"Run Queue", run_queue},
{"IO Input", {bytes, io_input}},
{"IO Output", {bytes, io_output}}
]}
],
- {Sys, Mem, Cpu, Stats}.
+ Limits = [{"System statistics / limit",
+ [{"Atoms", get_limit_count_info(atom_count, atom_limit)},
+ {"Processes", get_limit_count_info(process_count, process_limit)},
+ {"Ports", get_limit_count_info(port_count, port_limit)},
+ {"ETS", get_limit_count_info(ets_count, ets_limit)},
+ {"Distribution buffer busy limit", get_dist_buf_busy_limit_info()}
+ ]}],
+ {Sys, Mem, Cpu, Stats, Limits}.
+
%%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index 04966ffb9c..942203bd12 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -129,18 +129,31 @@
<p><c>| 'rsa_no_padding'</c></p>
</item>
+ <tag><c>public_sign_options() =</c></tag>
+ <item><p><c>[{rsa_pad, rsa_sign_padding()} | {rsa_pss_saltlen, integer()}]</c></p></item>
+
+ <tag><c>rsa_sign_padding() =</c></tag>
+ <item>
+ <p><c>'rsa_pkcs1_padding'</c></p>
+ <p><c>| 'rsa_pkcs1_pss_padding'</c></p>
+ </item>
+
<tag><c>digest_type() = </c></tag>
<item><p>Union of <c>rsa_digest_type()</c>, <c>dss_digest_type()</c>,
and <c>ecdsa_digest_type()</c>.</p></item>
<tag><c>rsa_digest_type() = </c></tag>
- <item><p><c>'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
+ <item><p><c>'md5' | 'ripemd160' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
<tag><c>dss_digest_type() = </c></tag>
- <item><p><c>'sha'</c></p></item>
+ <item><p><c>'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p>
+ <p>Note that the actual supported dss_digest_type depends on the underlying crypto library.
+ In OpenSSL version >= 1.0.1 the listed digest are supported, while in 1.0.0 only
+ sha, sha224 and sha256 are supported. In version 0.9.8 only sha is supported.</p>
+ </item>
<tag><c>ecdsa_digest_type() = </c></tag>
- <item><p><c>'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
+ <item><p><c>'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
<tag><c>crl_reason() = </c></tag>
<item>
@@ -621,8 +634,8 @@ fun(OtpCert :: #'OTPCertificate'{},
<v>OTPCertificate = #'OTPCertificate'{}</v>
<v>DPAndCRLs = [{DP::#'DistributionPoint'{}, {DerCRL::der_encoded(), CRL::#'CertificateList'{}}}] </v>
<v>Options = proplists:proplist()</v>
- <v>CRLStatus() = valid | {bad_cert, revocation_status_undetermined} |
- {bad_cert, {revoked, crl_reason()}}</v>
+ <v>CRLStatus() = valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revocation_status_undetermined,
+ {bad_crls, Details::term()}}} | {bad_cert, {revoked, crl_reason()}}</v>
</type>
<desc>
<p>Performs CRL validation. It is intended to be called from
@@ -650,7 +663,7 @@ fun(OtpCert :: #'OTPCertificate'{},
<tag>{issuer_fun, fun()}</tag>
<item>
<p>The fun has the following type specification:</p>
-
+
<code>
fun(#'DistributionPoint'{}, #'CertificateList'{},
{rdnSequence,[#'AttributeTypeAndValue'{}]}, term()) ->
@@ -660,7 +673,15 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
that has signed the CRL.
</p>
<code> fun(DP, CRL, Issuer, UserState) -> {ok, RootCert, CertChain}</code>
- </item>
+ </item>
+
+ <tag>{undetermined_details, boolean()}</tag>
+ <item>
+ <p>Defaults to false. When revocation status can not be
+ determined, and this option is set to true, details of why no
+ CRLs where accepted are included in the return value.</p>
+ </item>
+
</taglist>
</desc>
</func>
@@ -795,6 +816,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<func>
<name>sign(Msg, DigestType, Key) -> binary()</name>
+ <name>sign(Msg, DigestType, Key, Options) -> binary()</name>
<fsummary>Creates a digital signature.</fsummary>
<type>
<v>Msg = binary() | {digest,binary()}</v>
@@ -803,6 +825,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
digest.</d>
<v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Key = rsa_private_key() | dsa_private_key() | ec_private_key()</v>
+ <v>Options = public_sign_options()</v>
</type>
<desc>
<p>Creates a digital signature.</p>
@@ -895,6 +918,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<func>
<name>verify(Msg, DigestType, Signature, Key) -> boolean()</name>
+ <name>verify(Msg, DigestType, Signature, Key, Options) -> boolean()</name>
<fsummary>Verifies a digital signature.</fsummary>
<type>
<v>Msg = binary() | {digest,binary()}</v>
@@ -903,6 +927,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Signature = binary()</v>
<v>Key = rsa_public_key() | dsa_public_key() | ec_public_key()</v>
+ <v>Options = public_sign_options()</v>
</type>
<desc>
<p>Verifies a digital signature.</p>
diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl
index a1e7dd31bc..663e1856ac 100644
--- a/lib/public_key/include/public_key.hrl
+++ b/lib/public_key/include/public_key.hrl
@@ -70,7 +70,8 @@
reasons_mask,
cert_status,
interim_reasons_mask,
- valid_ext
+ valid_ext,
+ details
}).
-record('ECPoint', {
diff --git a/lib/public_key/src/pubkey_crl.erl b/lib/public_key/src/pubkey_crl.erl
index 33bef91827..3621e9c0da 100644
--- a/lib/public_key/src/pubkey_crl.erl
+++ b/lib/public_key/src/pubkey_crl.erl
@@ -58,7 +58,8 @@ validate(OtpCert, OtherDPCRLs, DP, {DerCRL, CRL}, {DerDeltaCRL, DeltaCRL},
init_revokation_state() ->
#revoke_state{reasons_mask = sets:new(),
interim_reasons_mask = sets:new(),
- cert_status = unrevoked}.
+ cert_status = unrevoked,
+ details = []}.
fresh_crl(_, {undefined, undefined}, _) ->
%% Typically happens when there is no delta CRL that covers a CRL
@@ -152,9 +153,10 @@ verify_crl(OtpCert, DP, CRL, DerCRL, DeltaCRL, DerDeltaCRL, OtherDPCRLs,
RevokedState,
CRL, DerCRL, DeltaCRL, DerDeltaCRL,
IssuerFun, TrustedOtpCert, Path, OtherDPCRLs, IDP);
- _ ->
- {invalid, State0#revoke_state{valid_ext = ValidExt}}
- end;
+ _ ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{valid_ext = ValidExt, details = [{{bad_crl, no_issuer_cert_chain}, CRL} | Details]}}
+ end;
{error, issuer_not_found} ->
case Fun(DP, CRL, issuer_not_found, AdditionalArgs) of
{ok, TrustedOtpCert, Path} ->
@@ -163,13 +165,16 @@ verify_crl(OtpCert, DP, CRL, DerCRL, DeltaCRL, DerDeltaCRL, OtherDPCRLs,
DerDeltaCRL, IssuerFun,
TrustedOtpCert, Path, OtherDPCRLs, IDP);
_ ->
- {invalid, {skip, State0}}
- end
+ Details = State0#revoke_state.details,
+ {invalid, {skip, State0#revoke_state{details = [{{bad_crl, no_issuer_cert_chain}, CRL} | Details] }}}
+ end
catch
- throw:{bad_crl, invalid_issuer} ->
- {invalid, {skip, State0}};
- throw:_ ->
- {invalid, State0#revoke_state{valid_ext = ValidExt}}
+ throw:{bad_crl, invalid_issuer} = Reason ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, {skip, RevokedState#revoke_state{details = [{Reason, CRL} | Details]}}};
+ throw:Reason ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{details = [{Reason, CRL} | Details]}}
end.
verify_mask_and_signatures(Revoked, DeltaRevoked, RevokedState, CRL, DerCRL, DeltaCRL, DerDeltaCRL,
@@ -183,10 +188,12 @@ verify_mask_and_signatures(Revoked, DeltaRevoked, RevokedState, CRL, DerCRL, Del
TrustedOtpCert, Path, IssuerFun, OtherDPCRLs, IDP),
{valid, Revoked, DeltaRevoked, RevokedState#revoke_state{reasons_mask = ReasonsMask}, IDP}
catch
- throw:_ ->
- {invalid, RevokedState};
+ throw:Reason ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{details = [{Reason, CRL} | Details]}};
error:{badmatch, _} ->
- {invalid, RevokedState}
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{details = [{{bad_crl, invalid_signature}, CRL} | Details]}}
end.
@@ -356,7 +363,7 @@ verify_scope(#'OTPCertificate'{tbsCertificate = TBSCert}, #'DistributionPoint'{c
verify_scope(DPName, IDPName, Names, TBSCert, IDP).
verify_scope(asn1_NOVALUE, _, asn1_NOVALUE, _, _) ->
- throw({bad_crl, scope_error1});
+ throw({bad_crl, scope_error});
verify_scope(asn1_NOVALUE, IDPName, DPIssuerNames, TBSCert, IDP) ->
verify_dp_name(IDPName, DPIssuerNames),
verify_dp_bools(TBSCert, IDP);
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 6651e9510e..c2060c144c 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -37,7 +37,7 @@
decrypt_public/2, decrypt_public/3,
dh_gex_group/4,
dh_gex_group_sizes/0,
- sign/3, verify/4,
+ sign/3, sign/4, verify/4, verify/5,
generate_key/1,
compute_key/2, compute_key/3,
pkix_sign/2, pkix_verify/2,
@@ -90,10 +90,12 @@
auth_keys.
-type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding'
| 'rsa_no_padding'.
+-type rsa_sign_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_pss_padding'.
-type public_crypt_options() :: [{rsa_pad, rsa_padding()}].
--type rsa_digest_type() :: 'md5' | 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'.
--type dss_digest_type() :: 'none' | 'sha'. %% None is for backwards compatibility
--type ecdsa_digest_type() :: 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'.
+-type rsa_digest_type() :: 'md5' | 'ripemd160' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'.
+-type dss_digest_type() :: 'none' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'. %% None is for backwards compatibility
+-type ecdsa_digest_type() :: 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'.
+-type public_sign_options() :: [{rsa_pad, rsa_sign_padding()} | {rsa_pss_saltlen, integer()}].
-type digest_type() :: rsa_digest_type() | dss_digest_type() | ecdsa_digest_type().
-type crl_reason() :: unspecified | keyCompromise | cACompromise | affiliationChanged | superseded
| cessationOfOperation | certificateHold | privilegeWithdrawn | aACompromise.
@@ -417,7 +419,7 @@ generate_key({rsa, ModulusSize, PublicExponent}) ->
{[E, N], [E, N, D, P, Q, D_mod_P_1, D_mod_Q_1, InvQ_mod_P]} ->
Nint = crypto:bytes_to_integer(N),
Eint = crypto:bytes_to_integer(E),
- #'RSAPrivateKey'{version = 0, % Two-factor (I guess since otherPrimeInfos is not given)
+ #'RSAPrivateKey'{version = 'two-prime', % Two-factor (I guess since otherPrimeInfos is not given)
modulus = Nint,
publicExponent = Eint,
privateExponent = crypto:bytes_to_integer(D),
@@ -435,7 +437,7 @@ generate_key({rsa, ModulusSize, PublicExponent}) ->
% 1976.
Nint = crypto:bytes_to_integer(N),
Eint = crypto:bytes_to_integer(E),
- #'RSAPrivateKey'{version = 0, % Two-factor (I guess since otherPrimeInfos is not given)
+ #'RSAPrivateKey'{version = 'two-prime', % Two-factor (I guess since otherPrimeInfos is not given)
modulus = Nint,
publicExponent = Eint,
privateExponent = crypto:bytes_to_integer(D),
@@ -498,35 +500,67 @@ pkix_sign_types(?'ecdsa-with-SHA512') ->
{sha512, ecdsa}.
%%--------------------------------------------------------------------
--spec sign(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
- rsa_private_key() |
- dsa_private_key() | ec_private_key()) -> Signature :: binary().
-%% Description: Create digital signature.
-%%--------------------------------------------------------------------
-sign(DigestOrPlainText, DigestType, Key = #'RSAPrivateKey'{}) ->
- crypto:sign(rsa, DigestType, DigestOrPlainText, format_rsa_private_key(Key));
+-spec sign(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ rsa_private_key() | dsa_private_key() | ec_private_key()
+ ) -> Signature :: binary().
-sign(DigestOrPlainText, sha, #'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) ->
- crypto:sign(dss, sha, DigestOrPlainText, [P, Q, G, X]);
+-spec sign(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ rsa_private_key() | dsa_private_key() | ec_private_key(),
+ public_sign_options()
+ ) -> Signature :: binary().
-sign(DigestOrPlainText, DigestType, #'ECPrivateKey'{privateKey = PrivKey,
- parameters = Param}) ->
- ECCurve = ec_curve_spec(Param),
- crypto:sign(ecdsa, DigestType, DigestOrPlainText, [PrivKey, ECCurve]);
+%% Description: Create digital signature.
+%%--------------------------------------------------------------------
+sign(DigestOrPlainText, DigestType, Key) ->
+ sign(DigestOrPlainText, DigestType, Key, []).
%% Backwards compatible
-sign(Digest, none, #'DSAPrivateKey'{} = Key) ->
- sign({digest,Digest}, sha, Key).
+sign(Digest, none, Key = #'DSAPrivateKey'{}, Options) when is_binary(Digest) ->
+ sign({digest, Digest}, sha, Key, Options);
+sign(DigestOrPlainText, DigestType, Key, Options) ->
+ case format_sign_key(Key) of
+ badarg ->
+ erlang:error(badarg, [DigestOrPlainText, DigestType, Key, Options]);
+ {Algorithm, CryptoKey} ->
+ crypto:sign(Algorithm, DigestType, DigestOrPlainText, CryptoKey, Options)
+ end.
%%--------------------------------------------------------------------
--spec verify(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
- Signature :: binary(), rsa_public_key()
- | dsa_public_key() | ec_public_key()) -> boolean().
+-spec verify(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ Signature :: binary(),
+ rsa_public_key() | dsa_public_key() | ec_public_key()
+ | rsa_private_key() | dsa_private_key() | ec_private_key()
+ ) -> boolean().
+
+-spec verify(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ Signature :: binary(),
+ rsa_public_key() | dsa_public_key() | ec_public_key()
+ | rsa_private_key() | dsa_private_key() | ec_private_key(),
+ public_sign_options()
+ ) -> boolean().
+
%% Description: Verifies a digital signature.
%%--------------------------------------------------------------------
-verify(DigestOrPlainText, DigestType, Signature, Key) when is_binary(Signature) ->
- do_verify(DigestOrPlainText, DigestType, Signature, Key);
-verify(_,_,_,_) ->
+verify(DigestOrPlainText, DigestType, Signature, Key) ->
+ verify(DigestOrPlainText, DigestType, Signature, Key, []).
+
+%% Backwards compatible
+verify(Digest, none, Signature, Key = {_, #'Dss-Parms'{}}, Options) when is_binary(Digest) ->
+ verify({digest, Digest}, sha, Signature, Key, Options);
+verify(Digest, none, Signature, Key = #'DSAPrivateKey'{}, Options) when is_binary(Digest) ->
+ verify({digest, Digest}, sha, Signature, Key, Options);
+verify(DigestOrPlainText, DigestType, Signature, Key, Options) when is_binary(Signature) ->
+ case format_verify_key(Key) of
+ badarg ->
+ erlang:error(badarg, [DigestOrPlainText, DigestType, Signature, Key, Options]);
+ {Algorithm, CryptoKey} ->
+ crypto:verify(Algorithm, DigestType, DigestOrPlainText, Signature, CryptoKey, Options)
+ end;
+verify(_,_,_,_,_) ->
%% If Signature is a bitstring and not a binary we know already at this
%% point that the signature is invalid.
false.
@@ -789,8 +823,9 @@ pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options)
%--------------------------------------------------------------------
-spec pkix_crls_validate(#'OTPCertificate'{},
[{DP::#'DistributionPoint'{}, {DerCRL::binary(), CRL::#'CertificateList'{}}}],
- Options :: proplists:proplist()) -> valid | {bad_cert, revocation_status_undetermined}
- | {bad_cert, {revoked, crl_reason()}}.
+ Options :: proplists:proplist()) -> valid | {bad_cert, revocation_status_undetermined} |
+ {bad_cert, {revocation_status_undetermined, Reason::term()}} |
+ {bad_cert, {revoked, crl_reason()}}.
%% Description: Performs a CRL validation according to RFC 5280.
%%--------------------------------------------------------------------
@@ -993,22 +1028,32 @@ short_name_hash({rdnSequence, _Attributes} = Name) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-do_verify(DigestOrPlainText, DigestType, Signature,
- #'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) ->
- crypto:verify(rsa, DigestType, DigestOrPlainText, Signature,
- [Exp, Mod]);
-
-do_verify(DigestOrPlaintext, DigestType, Signature, {#'ECPoint'{point = Point}, Param}) ->
- ECCurve = ec_curve_spec(Param),
- crypto:verify(ecdsa, DigestType, DigestOrPlaintext, Signature, [Point, ECCurve]);
-
-%% Backwards compatibility
-do_verify(Digest, none, Signature, {_, #'Dss-Parms'{}} = Key ) ->
- verify({digest,Digest}, sha, Signature, Key);
-
-do_verify(DigestOrPlainText, sha = DigestType, Signature, {Key, #'Dss-Parms'{p = P, q = Q, g = G}})
- when is_integer(Key), is_binary(Signature) ->
- crypto:verify(dss, DigestType, DigestOrPlainText, Signature, [P, Q, G, Key]).
+format_sign_key(Key = #'RSAPrivateKey'{}) ->
+ {rsa, format_rsa_private_key(Key)};
+format_sign_key(#'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) ->
+ {dss, [P, Q, G, X]};
+format_sign_key(#'ECPrivateKey'{privateKey = PrivKey, parameters = Param}) ->
+ {ecdsa, [PrivKey, ec_curve_spec(Param)]};
+format_sign_key(_) ->
+ badarg.
+
+format_verify_key(#'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) ->
+ {rsa, [Exp, Mod]};
+format_verify_key({#'ECPoint'{point = Point}, Param}) ->
+ {ecdsa, [Point, ec_curve_spec(Param)]};
+format_verify_key({Key, #'Dss-Parms'{p = P, q = Q, g = G}}) ->
+ {dss, [P, Q, G, Key]};
+%% Convert private keys to public keys
+format_verify_key(#'RSAPrivateKey'{modulus = Mod, publicExponent = Exp}) ->
+ format_verify_key(#'RSAPublicKey'{modulus = Mod, publicExponent = Exp});
+format_verify_key(#'ECPrivateKey'{parameters = Param, publicKey = {_, Point}}) ->
+ format_verify_key({#'ECPoint'{point = Point}, Param});
+format_verify_key(#'ECPrivateKey'{parameters = Param, publicKey = Point}) ->
+ format_verify_key({#'ECPoint'{point = Point}, Param});
+format_verify_key(#'DSAPrivateKey'{y=Y, p=P, q=Q, g=G}) ->
+ format_verify_key({Y, #'Dss-Parms'{p=P, q=Q, g=G}});
+format_verify_key(_) ->
+ badarg.
do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password) ->
Der = der_encode(Asn1Type, Entity),
@@ -1121,8 +1166,13 @@ der_cert(#'OTPCertificate'{} = Cert) ->
der_cert(Der) when is_binary(Der) ->
Der.
-pkix_crls_validate(_, [],_, _, _) ->
- {bad_cert, revocation_status_undetermined};
+pkix_crls_validate(_, [],_, Options, #revoke_state{details = Details}) ->
+ case proplists:get_value(undetermined_details, Options, false) of
+ false ->
+ {bad_cert, revocation_status_undetermined};
+ true ->
+ {bad_cert, {revocation_status_undetermined, {bad_crls, format_details(Details)}}}
+ end;
pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, RevokedState0) ->
CallBack = proplists:get_value(update_crl, Options, fun(_, CurrCRL) ->
CurrCRL
@@ -1142,9 +1192,14 @@ pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, Revoked
do_pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, RevokedState0) ->
OtherDPCRLs = All -- [{DP, CRL, DeltaCRL}],
case pubkey_crl:validate(OtpCert, OtherDPCRLs, DP, CRL, DeltaCRL, Options, RevokedState0) of
- {undetermined, _, _} when Rest == []->
- {bad_cert, revocation_status_undetermined};
- {undetermined, _, RevokedState} when Rest =/= []->
+ {undetermined, unrevoked, #revoke_state{details = Details}} when Rest == []->
+ case proplists:get_value(undetermined_details, Options, false) of
+ false ->
+ {bad_cert, revocation_status_undetermined};
+ true ->
+ {bad_cert, {revocation_status_undetermined, {bad_crls, Details}}}
+ end;
+ {undetermined, unrevoked, RevokedState} when Rest =/= []->
pkix_crls_validate(OtpCert, Rest, All, Options, RevokedState);
{finished, unrevoked} ->
valid;
@@ -1417,3 +1472,7 @@ to_lower_ascii(C) -> C.
to_string(S) when is_list(S) -> S;
to_string(B) when is_binary(B) -> binary_to_list(B).
+format_details([]) ->
+ no_relevant_crls;
+format_details(Details) ->
+ Details.
diff --git a/lib/reltool/src/reltool.erl b/lib/reltool/src/reltool.erl
index f6ce5578bc..feb6925044 100644
--- a/lib/reltool/src/reltool.erl
+++ b/lib/reltool/src/reltool.erl
@@ -80,7 +80,7 @@ get_server(WinPid) ->
{ok, _ServerPid} = OK ->
OK;
{error, Reason} ->
- {error, lists:flatten(io_lib:format("~p", [Reason]))}
+ {error, lists:flatten(io_lib:format("~tp", [Reason]))}
end.
%% Stop a server or window process
@@ -93,7 +93,7 @@ stop(Pid) when is_pid(Pid) ->
{'DOWN', Ref, _, _, shutdown} ->
ok;
{'DOWN', Ref, _, _, Reason} ->
- {error, lists:flatten(io_lib:format("~p", [Reason]))}
+ {error, lists:flatten(io_lib:format("~tp", [Reason]))}
end.
%% Internal library function
diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl
index 8b4898570b..9c8aae6b7e 100644
--- a/lib/reltool/src/reltool.hrl
+++ b/lib/reltool/src/reltool.hrl
@@ -119,7 +119,7 @@
| {archive, base_file(), [archive_opt()], [target_spec()]}
| {copy_file, base_file()}
| {copy_file, base_file(), top_file()}
- | {write_file, base_file(), iolist()}
+ | {write_file, base_file(), binary()}
| {strip_beam_file, base_file()}.
-type target_dir() :: dir().
-type incl_defaults() :: boolean().
diff --git a/lib/reltool/src/reltool_app_win.erl b/lib/reltool/src/reltool_app_win.erl
index 468ba297bb..663144861f 100644
--- a/lib/reltool/src/reltool_app_win.erl
+++ b/lib/reltool/src/reltool_app_win.erl
@@ -174,7 +174,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) ->
S#state.mod_wins)},
?MODULE:loop(S2);
Msg ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end.
@@ -182,7 +182,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) ->
exit_warning({'EXIT', _Pid, shutdown}) ->
ok;
exit_warning({'EXIT', _Pid, _Reason} = Msg) ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]).
create_window(#state{app = App} = S) ->
@@ -629,7 +629,7 @@ handle_event(#state{sys = Sys, app = App} = S, Wx) ->
handle_mod_button(S, Items, Action);
_ ->
error_logger:format("~w~w got unexpected app event from "
- "wx:\n\t~p\n",
+ "wx:\n\t~tp\n",
[?MODULE, self(), Wx]),
S
end.
@@ -676,7 +676,7 @@ move_mod(App, {_ItemNo, ModStr}, Action) ->
undefined;
_ ->
error_logger:format("~w~w got unexpected mod "
- "button event: ~w\n\t ~p\n",
+ "button event: ~w\n\t ~tp\n",
[?MODULE, self(), ModName, Action]),
M#mod.incl_cond
end,
diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl
index 915330794c..a10a2281db 100644
--- a/lib/reltool/src/reltool_fgraph_win.erl
+++ b/lib/reltool/src/reltool_fgraph_win.erl
@@ -526,7 +526,7 @@ loop(S, G) ->
exit(Reason);
Other ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Other]),
loop(S, G)
end.
diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl
index 8cd63bdda1..2d56d74563 100644
--- a/lib/reltool/src/reltool_mod_win.erl
+++ b/lib/reltool/src/reltool_mod_win.erl
@@ -171,7 +171,7 @@ loop(#state{xref_pid = Xref, common = C, mod = Mod} = S) ->
S2 = handle_event(S, Wx),
?MODULE:loop(S2);
_ ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end
@@ -487,7 +487,7 @@ handle_event(#state{xref_pid = Xref} = S, Wx) ->
S;
_ ->
error_logger:format("~w~w got unexpected mod event from "
- "wx:\n\t~p\n",
+ "wx:\n\t~tp\n",
[?MODULE, self(), Wx]),
S
end.
@@ -667,7 +667,7 @@ goto_function(S, Editor) ->
wxStyledTextCtrl:setSelection(Editor, Left2, Right2),
Text = wxStyledTextCtrl:getSelectedText(Editor),
S2 = add_pos_to_history(S, CurrentPos),
- do_goto_function(S2, string:tokens(Text, ":"));
+ do_goto_function(S2, string:lexemes(Text, ":"));
_ ->
%% No function call
wxStyledTextCtrl:hideSelection(Editor, false),
diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl
index 89e90670cf..853191c696 100644
--- a/lib/reltool/src/reltool_server.erl
+++ b/lib/reltool/src/reltool_server.erl
@@ -225,12 +225,12 @@ parse_options([{Key, Val} | KeyVals], S, C, Sys) ->
Sys2 = read_config(Sys, {sys, Val}),
parse_options(KeyVals, S, C, Sys2);
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end;
parse_options([], S, C, Sys) ->
S#state{common = C, sys = Sys};
parse_options(KeyVals, _S, _C, _Sys) ->
- reltool_utils:throw_error("Illegal option: ~p", [KeyVals]).
+ reltool_utils:throw_error("Illegal option: ~tp", [KeyVals]).
loop(#state{sys = Sys} = S) ->
receive
@@ -400,12 +400,12 @@ loop(#state{sys = Sys} = S) ->
{'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid ->
exit(Reason);
{call, ReplyTo, Ref, Msg} when is_pid(ReplyTo), is_reference(Ref) ->
- error_logger:format("~w~w got unexpected call:\n\t~p\n",
+ error_logger:format("~w~w got unexpected call:\n\t~tp\n",
[?MODULE, self(), Msg]),
reltool_utils:reply(ReplyTo, Ref, {error, {invalid_call, Msg}}),
?MODULE:loop(S);
Msg ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end.
@@ -1232,7 +1232,7 @@ parse_app_info(File, [{Key, Val} | KeyVals], AI, Status) ->
Status);
_ ->
Status2 =
- reltool_utils:add_warning("Unexpected item ~p in app file ~tp.",
+ reltool_utils:add_warning("Unexpected item ~tp in app file ~tp.",
[Key,File],
Status),
parse_app_info(File, KeyVals, AI, Status2)
@@ -1417,9 +1417,12 @@ shrink_app(A) ->
do_save_config(S, Filename, InclDef, InclDeriv) ->
{ok, Config} = do_get_config(S, InclDef, InclDeriv),
- IoList = io_lib:format("%% config generated at ~w ~w\n~p.\n\n",
- [date(), time(), Config]),
- file:write_file(Filename, IoList).
+ IoList = io_lib:format("%% ~s\n"
+ "%% config generated at ~w ~w\n"
+ "~tp.\n\n",
+ [epp:encoding_to_string(utf8),date(), time(), Config]),
+ Bin = unicode:characters_to_binary(IoList),
+ file:write_file(Filename, Bin).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1455,7 +1458,7 @@ read_config(OldSys, {sys, KeyVals}) ->
[NewSys2#sys.boot_rel])
end;
read_config(_OldSys, BadConfig) ->
- reltool_utils:throw_error("Illegal content: ~p", [BadConfig]).
+ reltool_utils:throw_error("Illegal content: ~tp", [BadConfig]).
decode(#sys{apps = Apps} = Sys, [{erts = Name, AppKeyVals} | SysKeyVals])
when is_atom(Name), is_list(AppKeyVals) ->
@@ -1565,7 +1568,7 @@ decode(#sys{} = Sys, [{Key, Val} | KeyVals]) ->
debug_info when Val =:= keep; Val =:= strip ->
Sys#sys{debug_info = Val};
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end,
decode(Sys3, KeyVals);
decode(#app{} = App, [{Key, Val} | KeyVals]) ->
@@ -1620,14 +1623,14 @@ decode(#app{} = App, [{Key, Val} | KeyVals]) ->
active_dir = Dir,
sorted_dirs = [Dir]};
false ->
- reltool_utils:throw_error("Illegal lib dir for ~w: ~p",
+ reltool_utils:throw_error("Illegal lib dir for ~w: ~tp",
[App#app.name, Val])
end;
SelectVsn when SelectVsn=:=vsn; SelectVsn=:=lib_dir ->
reltool_utils:throw_error("Mutual exclusive options "
"'vsn' and 'lib_dir'",[]);
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end,
decode(App2, KeyVals);
decode(#app{mods = Mods} = App, [{mod, Name, ModKeyVals} | AppKeyVals]) ->
@@ -1641,7 +1644,7 @@ decode(#mod{} = Mod, [{Key, Val} | KeyVals]) ->
debug_info when Val =:= keep; Val =:= strip ->
Mod#mod{debug_info = Val};
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end,
decode(Mod2, KeyVals);
decode(#rel{rel_apps = RelApps} = Rel, [RelApp | KeyVals]) ->
@@ -1666,12 +1669,12 @@ decode(#rel{rel_apps = RelApps} = Rel, [RelApp | KeyVals]) ->
true ->
decode(Rel#rel{rel_apps = RelApps ++ [RA]}, KeyVals);
false ->
- reltool_utils:throw_error("Illegal option: ~p", [RelApp])
+ reltool_utils:throw_error("Illegal option: ~tp", [RelApp])
end;
decode(Acc, []) ->
Acc;
decode(_Acc, KeyVal) ->
- reltool_utils:throw_error("Illegal option: ~p", [KeyVal]).
+ reltool_utils:throw_error("Illegal option: ~tp", [KeyVal]).
is_type(Type) ->
case Type of
@@ -1866,7 +1869,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) ->
{ok, AF} ->
AF;
{error, Reason1} ->
- reltool_utils:throw_error("Illegal escript ~tp: ~p",
+ reltool_utils:throw_error("Illegal escript ~tp: ~tp",
[Escript,Reason1])
end,
@@ -1950,7 +1953,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) ->
Status2),
escripts_to_apps(Escripts, Apps2, Status3);
{error, Reason2} ->
- reltool_utils:throw_error("Illegal escript ~tp: ~p",
+ reltool_utils:throw_error("Illegal escript ~tp: ~tp",
[Escript,Reason2])
end;
escripts_to_apps([], Apps, Status) ->
@@ -2013,7 +2016,7 @@ init_escript_app(AppName, EscriptAppName, Dir, Info, Mods, Apps, Status) ->
case lists:keymember(AppName, #app.name, Apps) of
true ->
reltool_utils:throw_error(
- "~w: Application name clash. Escript ~tp contains application ~tp.",
+ "~w: Application name clash. Escript ~tp contains application ~w.",
[AppName,Dir,AppName]);
false ->
{App2, Status}
diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl
index ba0d90ef5f..92df270752 100644
--- a/lib/reltool/src/reltool_sys_win.erl
+++ b/lib/reltool/src/reltool_sys_win.erl
@@ -136,7 +136,7 @@ init(Options) ->
do_init(Options)
catch
error:Reason ->
- io:format("~p: ~p~n",[Reason, erlang:get_stacktrace()]),
+ io:format("~tp: ~tp~n",[Reason, erlang:get_stacktrace()]),
exit({Reason, erlang:get_stacktrace()})
end.
@@ -182,7 +182,7 @@ do_init([{safe_config, Safe}, {parent, Parent} | Options]) ->
end.
restart_server_safe_config(true,Parent,Reason) ->
- io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]),
+ io:format("~w(~w): <ERROR> ~tp\n", [?MODULE, ?LINE, Reason]),
proc_lib:init_ack(Parent, {error,Reason});
restart_server_safe_config(false,Parent,Reason) ->
wx:new(),
@@ -199,7 +199,7 @@ restart_server_safe_config(false,Parent,Reason) ->
?wxID_OK ->
do_init([{safe_config,true},{parent,Parent},?safe_config]);
?wxID_CANCEL ->
- io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]),
+ io:format("~w(~w): <ERROR> ~tp\n", [?MODULE, ?LINE, Reason]),
proc_lib:init_ack(Parent,{error,Reason})
end.
@@ -251,7 +251,7 @@ loop(S) ->
?MODULE:loop(S#state{warning_wins = WWs2});
false ->
error_logger:format("~w~w got unexpected "
- "message:\n\t~p\n",
+ "message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end
@@ -292,7 +292,7 @@ loop(S) ->
S#state.app_wins),
?MODULE:loop(S#state{fgraph_wins = FWs, app_wins = AWs});
Msg ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end.
@@ -316,7 +316,7 @@ handle_child_exit({'EXIT', Pid, _Reason} = Exit, FWs, AWs) ->
msg_warning({'EXIT', _Pid, shutdown}, Type) when Type =/= unknown ->
ok;
msg_warning(Exit, Type) ->
- error_logger:format("~w~w got unexpected message (~w):\n\t~p\n",
+ error_logger:format("~w~w got unexpected message (~w):\n\t~tp\n",
[?MODULE, self(), Type, Exit]).
create_window(S) ->
@@ -1163,12 +1163,12 @@ handle_system_event(#state{sys = Sys} = S,
do_set_sys(S#state{sys = Sys2});
handle_system_event(S, Event, ObjRef, UserData) ->
error_logger:format("~w~w got unexpected wx sys event to ~p "
- "with user data: ~p\n\t ~p\n",
+ "with user data: ~tp\n\t ~tp\n",
[?MODULE, self(), ObjRef, UserData, Event]),
S.
handle_release_event(S, _Event, _ObjRef, UserData) ->
- io:format("Release data: ~p\n", [UserData]),
+ io:format("Release data: ~tp\n", [UserData]),
S.
handle_source_event(S,
@@ -1225,7 +1225,7 @@ handle_app_event(S,
handle_app_button(S, Items, Action);
handle_app_event(S, Event, ObjRef, UserData) ->
error_logger:format("~w~w got unexpected wx app event to "
- "~p with user data: ~p\n\t ~p\n",
+ "~p with user data: ~tp\n\t ~tp\n",
[?MODULE, self(), ObjRef, UserData, Event]),
S.
@@ -1269,7 +1269,7 @@ move_app(S, {_ItemNo, AppBase}, Action) ->
undefined;
_ ->
error_logger:format("~w~w got unexpected app "
- "button event: ~p ~p\n",
+ "button event: ~tp ~tp\n",
[?MODULE, self(), Action, AppBase]),
OldApp#app.incl_cond
end,
@@ -1543,7 +1543,7 @@ check_and_refresh(S, Status) ->
display_message(Reason, ?wxICON_ERROR),
false;
{error, Reason} ->
- Msg = lists:flatten(io_lib:format("Error:\n\n~p\n", [Reason])),
+ Msg = lists:flatten(io_lib:format("Error:\n\n~tp\n", [Reason])),
display_message(Msg, ?wxICON_ERROR),
false
end,
diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl
index 1615a3e9b7..1b1461178e 100644
--- a/lib/reltool/src/reltool_target.erl
+++ b/lib/reltool/src/reltool_target.erl
@@ -787,16 +787,20 @@ do_spec_rel_files(#rel{name = RelName} = Rel, Sys) ->
{ok, BootBin} = gen_boot(Script),
Date = date(),
Time = time(),
- RelIoList = io_lib:format("%% rel generated at ~w ~w\n~p.\n\n",
+ RelIoList = io_lib:format("%% rel generated at ~w ~w\n~tp.\n\n",
[Date, Time, GenRel]),
- ScriptIoList = io_lib:format("%% script generated at ~w ~w\n~p.\n\n",
+ ScriptIoList = io_lib:format("%% script generated at ~w ~w\n~tp.\n\n",
[Date, Time, Script]),
[
- {write_file, RelFile, RelIoList},
- {write_file, ScriptFile, ScriptIoList},
+ {write_file, RelFile, to_utf8_bin_with_enc_comment(RelIoList)},
+ {write_file, ScriptFile, to_utf8_bin_with_enc_comment(ScriptIoList)},
{write_file, BootFile, BootBin}
].
+to_utf8_bin_with_enc_comment(IoList) when is_list(IoList) ->
+ unicode:characters_to_binary("%% " ++ epp:encoding_to_string(utf8) ++ "\n"
+ ++ IoList).
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Generate a complete target system
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1001,7 +1005,8 @@ spec_start_file(#sys{boot_rel = BootRelName,
{value, Erts} = lists:keysearch(erts, #app.name, Apps),
{value, BootRel} = lists:keysearch(BootRelName, #rel.name, Rels),
Data = Erts#app.vsn ++ " " ++ BootRel#rel.vsn ++ "\n",
- {BootRel#rel.vsn, {write_file, "start_erl.data", Data}}.
+ {BootRel#rel.vsn, {write_file, "start_erl.data",
+ unicode:characters_to_binary(Data)}}.
lookup_spec(Prefix, Specs) ->
lists:filter(fun(S) -> lists:prefix(Prefix, element(2, S)) end, Specs).
@@ -1183,18 +1188,18 @@ spec_app_file(#app{name = Name,
Info#app_info.modules)],
App2 = App#app{info = Info#app_info{modules = ModNames}},
Contents = gen_app(App2),
- AppIoList = io_lib:format("%% app generated at ~w ~w\n~p.\n\n",
+ AppIoList = io_lib:format("%% app generated at ~w ~w\n~tp.\n\n",
[date(), time(), Contents]),
- [{write_file, AppFilename, AppIoList}];
+ [{write_file, AppFilename, to_utf8_bin_with_enc_comment(AppIoList)}];
all ->
%% Include all included modules
%% Generate new file
ModNames = [M#mod.name || M <- Mods, M#mod.is_included],
App2 = App#app{info = Info#app_info{modules = ModNames}},
Contents = gen_app(App2),
- AppIoList = io_lib:format("%% app generated at ~w ~w\n~p.\n\n",
+ AppIoList = io_lib:format("%% app generated at ~w ~w\n~tp.\n\n",
[date(), time(), Contents]),
- [{write_file, AppFilename, AppIoList}]
+ [{write_file, AppFilename, to_utf8_bin_with_enc_comment(AppIoList)}]
end.
@@ -1285,7 +1290,7 @@ do_eval_spec({archive, Archive, Options, Files},
{ok, _} ->
ok;
{error, Reason} ->
- reltool_utils:throw_error("create archive ~ts failed: ~p",
+ reltool_utils:throw_error("create archive ~ts failed: ~tp",
[ArchiveFile, Reason])
end;
do_eval_spec({copy_file, File}, _OrigSourceDir, SourceDir, TargetDir) ->
@@ -1299,12 +1304,12 @@ do_eval_spec({copy_file, File, OldFile},
SourceFile = filename:join([OrigSourceDir, OldFile]),
TargetFile = filename:join([TargetDir, File]),
reltool_utils:copy_file(SourceFile, TargetFile);
-do_eval_spec({write_file, File, IoList},
+do_eval_spec({write_file, File, Bin},
_OrigSourceDir,
_SourceDir,
TargetDir) ->
TargetFile = filename:join([TargetDir, File]),
- reltool_utils:write_file(TargetFile, IoList);
+ reltool_utils:write_file(TargetFile, Bin);
do_eval_spec({strip_beam, File}, _OrigSourceDir, SourceDir, TargetDir) ->
SourceFile = filename:join([SourceDir, File]),
TargetFile = filename:join([TargetDir, File]),
@@ -1336,7 +1341,7 @@ cleanup_spec({copy_file, File}, TargetDir) ->
cleanup_spec({copy_file, NewFile, _OldFile}, TargetDir) ->
TargetFile = filename:join([TargetDir, NewFile]),
file:delete(TargetFile);
-cleanup_spec({write_file, File, _IoList}, TargetDir) ->
+cleanup_spec({write_file, File, _}, TargetDir) ->
TargetFile = filename:join([TargetDir, File]),
file:delete(TargetFile);
cleanup_spec({strip_beam, File}, TargetDir) ->
@@ -1406,7 +1411,7 @@ do_filter_spec(Path,
ExclRegexps) ->
Path2 = opt_join(Path, NewFile),
match(Path2, InclRegexps, ExclRegexps);
-do_filter_spec(Path, {write_file, File, _IoList}, InclRegexps, ExclRegexps) ->
+do_filter_spec(Path, {write_file, File, _}, InclRegexps, ExclRegexps) ->
Path2 = opt_join(Path, File),
match(Path2, InclRegexps, ExclRegexps);
do_filter_spec(Path, {strip_beam, File}, InclRegexps, ExclRegexps) ->
@@ -1448,7 +1453,7 @@ do_install(RelName, TargetDir) ->
RelDir = filename:join([TargetDir2, "releases"]),
DataFile = filename:join([RelDir, "start_erl.data"]),
Bin = reltool_utils:read_file(DataFile),
- case string:tokens(binary_to_list(Bin), " \n") of
+ case string:lexemes(unicode:characters_to_list(Bin), " \n") of
[ErlVsn, RelVsn | _] ->
ErtsBinDir = filename:join([TargetDir2, "erts-" ++ ErlVsn, "bin"]),
BinDir = filename:join([TargetDir2, "bin"]),
@@ -1501,8 +1506,8 @@ subst_src_script(Script, SrcDir, DestDir, Vars, Opts) ->
subst_file(Src, Dest, Vars, Opts) ->
Bin = reltool_utils:read_file(Src),
- Chars = subst(binary_to_list(Bin), Vars),
- reltool_utils:write_file(Dest, Chars),
+ Chars = subst(unicode:characters_to_list(Bin), Vars),
+ reltool_utils:write_file(Dest, unicode:characters_to_binary(Chars)),
case lists:member(preserve, Opts) of
true ->
FileInfo = reltool_utils:read_file_info(Src),
diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl
index 60edc9f3ca..3891b5ae4d 100644
--- a/lib/reltool/src/reltool_utils.erl
+++ b/lib/reltool/src/reltool_utils.erl
@@ -55,7 +55,7 @@ root_dir() ->
code:root_dir().
erl_libs() ->
- string:tokens(os:getenv("ERL_LIBS", ""), ":;").
+ string:lexemes(os:getenv("ERL_LIBS", ""), ":;").
lib_dirs(Dir) ->
case erl_prim_loader:list_dir(Dir) of
@@ -286,7 +286,7 @@ split_app_dir(Dir) ->
{Name, Vsn} = split_app_name(Base),
Vsn2 =
try
- [list_to_integer(N) || N <- string:tokens(Vsn, ".")]
+ [list_to_integer(N) || N <- string:lexemes(Vsn, ".")]
catch
_:_ ->
Vsn
@@ -427,7 +427,7 @@ scroll_size(ObjRef) ->
safe_keysearch(Key, Pos, List, Mod, Line) ->
case lists:keysearch(Key, Pos, List) of
false ->
- io:format("~w(~w): lists:keysearch(~p, ~w, ~p) -> false\n",
+ io:format("~w(~w): lists:keysearch(~tp, ~w, ~tp) -> false\n",
[Mod, Line, Key, Pos, List]),
erlang:error({Mod, Line, lists, keysearch, [Key, Pos, List]});
{value, Val} ->
@@ -498,8 +498,8 @@ read_file(File) ->
throw_error("read file ~ts: ~ts", [File, Text])
end.
-write_file(File, IoList) ->
- case file:write_file(File, IoList) of
+write_file(File, Bin) ->
+ case file:write_file(File, Bin) of
ok ->
ok;
{error, Reason} ->
@@ -601,7 +601,7 @@ do_decode_regexps(Key, [Regexp | Regexps], Acc) ->
Regexps,
[#regexp{source = Regexp, compiled = MP} | Acc]);
_ ->
- Text = lists:flatten(io_lib:format("~p", [{Key, Regexp}])),
+ Text = lists:flatten(io_lib:format("~tp", [{Key, Regexp}])),
throw({error, "Illegal option: " ++ Text})
end;
do_decode_regexps(_Key, [], Acc) ->
diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
index d36af257ce..7f0c1ac6e4 100644
--- a/lib/runtime_tools/src/observer_backend.erl
+++ b/lib/runtime_tools/src/observer_backend.erl
@@ -63,9 +63,7 @@ sys_info() ->
end,
{{_,Input},{_,Output}} = erlang:statistics(io),
- [{process_count, erlang:system_info(process_count)},
- {process_limit, erlang:system_info(process_limit)},
- {uptime, element(1, erlang:statistics(wall_clock))},
+ [{uptime, element(1, erlang:statistics(wall_clock))},
{run_queue, erlang:statistics(run_queue)},
{io_input, Input},
{io_output, Output},
@@ -86,7 +84,17 @@ sys_info() ->
{thread_pool_size, erlang:system_info(thread_pool_size)},
{wordsize_internal, erlang:system_info({wordsize, internal})},
{wordsize_external, erlang:system_info({wordsize, external})},
- {alloc_info, alloc_info()}
+ {alloc_info, alloc_info()},
+ {process_count, erlang:system_info(process_count)},
+ {atom_limit, erlang:system_info(atom_limit)},
+ {atom_count, erlang:system_info(atom_count)},
+ {process_limit, erlang:system_info(process_limit)},
+ {process_count, erlang:system_info(process_count)},
+ {port_limit, erlang:system_info(port_limit)},
+ {port_count, erlang:system_info(port_count)},
+ {ets_limit, erlang:system_info(ets_limit)},
+ {ets_count, length(ets:all())},
+ {dist_buf_busy_limit, erlang:system_info(dist_buf_busy_limit)}
| MemInfo].
alloc_info() ->
diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl
index 1f3c6877d5..d0a7c7332d 100644
--- a/lib/sasl/src/release_handler.erl
+++ b/lib/sasl/src/release_handler.erl
@@ -1143,8 +1143,9 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) ->
Config2 = replace_config(stdlib,Config1,Stdlib),
Config3 = replace_config(sasl,Config2,Sasl),
- ConfigStr = io_lib:format("~p.~n",[Config3]),
- write_file(TmpFile,ConfigStr,Masters).
+ ConfigStr = io_lib:format("%% ~s~n~tp.~n",
+ [epp:encoding_to_string(utf8),Config3]),
+ write_file(TmpFile,unicode:characters_to_binary(ConfigStr),Masters).
%% Take the configuration for application App from the new config and
%% insert in the old config.
@@ -1874,9 +1875,10 @@ write_releases_1(Dir, NewReleases, Masters) ->
write_releases_m(Dir, NewReleases, Masters).
do_write_release(Dir, RELEASES, NewReleases) ->
- case file:open(filename:join(Dir, RELEASES), [write]) of
+ case file:open(filename:join(Dir, RELEASES), [write,{encoding,utf8}]) of
{ok, Fd} ->
- ok = io:format(Fd, "~p.~n", [NewReleases]),
+ ok = io:format(Fd, "%% ~s~n~tp.~n",
+ [epp:encoding_to_string(utf8),NewReleases]),
ok = file:close(Fd);
{error, Reason} ->
{error, Reason}
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index b1523dcbb7..391b1fb5cc 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1152,10 +1152,10 @@ generate_script(Output, Release, Appls, Flags) ->
},
ScriptFile = Output ++ ".script",
- case file:open(ScriptFile, [write]) of
+ case file:open(ScriptFile, [write,{encoding,utf8}]) of
{ok, Fd} ->
- io:format(Fd, "%% script generated at ~w ~w\n~p.\n",
- [date(), time(), Script]),
+ io:format(Fd, "%% ~s\n%% script generated at ~w ~w\n~tp.\n",
+ [epp:encoding_to_string(utf8), date(), time(), Script]),
case file:close(Fd) of
ok ->
BootFile = Output ++ ".boot",
diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl
index 706ae7d631..e836d57670 100644
--- a/lib/sasl/src/systools_relup.erl
+++ b/lib/sasl/src/systools_relup.erl
@@ -535,9 +535,9 @@ to_list(X) when is_list(X) -> X.
write_relup_file(Relup, Opts) ->
Filename = filename:join(filename:absname(get_opt(outdir,Opts)),
"relup"),
- case file:open(Filename, [write]) of
+ case file:open(Filename, [write,{encoding,utf8}]) of
{ok, Fd} ->
- io:format(Fd, "~p.~n", [Relup]),
+ io:format(Fd, "%% ~s~n~tp.~n", [epp:encoding_to_string(utf8),Relup]),
case file:close(Fd) of
ok -> ok;
{error,Reason} ->
diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl
index 7093158502..50932e89e4 100644
--- a/lib/sasl/test/release_handler_SUITE.erl
+++ b/lib/sasl/test/release_handler_SUITE.erl
@@ -66,7 +66,7 @@ cases() ->
supervisor_which_children_timeout,
release_handler_which_releases, install_release_syntax_check,
upgrade_supervisor, upgrade_supervisor_fail, otp_9864,
- otp_10463_upgrade_script_regexp, no_dot_erlang].
+ otp_10463_upgrade_script_regexp, no_dot_erlang, unicode_upgrade].
groups() ->
[{release,[],
@@ -1875,6 +1875,86 @@ no_dot_erlang(Conf) ->
ok
end.
+%%%-----------------------------------------------------------------
+%%% Test unicode handling. Make sure that release name, application
+%%% description, and application environment variables may contain
+%%% unicode characters.
+unicode_upgrade(Conf) ->
+ %% Set some paths
+ DataDir = ?config(data_dir, Conf),
+ PrivDir = priv_dir(Conf),
+ Dir = filename:join(PrivDir,"unicode"),
+ LibDir0 = filename:join(DataDir, "unicode"),
+ LibDir =
+ case {file:native_name_encoding(),os:type()} of
+ {utf8,{Os,_}} when Os =/= win32 ->
+ LD = filename:join(DataDir,"unicode_αβ"),
+ file:make_symlink("unicode",LD),
+ LD;
+ _ ->
+ LibDir0
+ end,
+
+ %% Create the releases
+ RelName = "unicode_rel_αβ",
+ Rel1 = create_and_install_fake_first_release(Dir,{RelName,"1"},
+ [{u,"1.0",LibDir}]),
+ Rel2 = create_fake_upgrade_release(Dir,
+ {RelName,"2"},
+ [{u,"1.1",LibDir}],
+ {[Rel1],[Rel1],[LibDir]}),
+ Rel1Dir = filename:dirname(Rel1),
+ Rel2Dir = filename:dirname(Rel2),
+
+ %% Start a slave node
+ {ok, Node} = t_start_node(unicode_upgrade, Rel1,
+ filename:join(Rel1Dir,"sys.config"), "+pc unicode"),
+
+ %% Check
+ Dir1 = filename:join([LibDir, "u-1.0"]),
+ Dir1 = rpc:call(Node, code, lib_dir, [u]),
+ UBeam1 = filename:join([Dir1,"ebin","u.beam"]),
+ UBeam1 = rpc:call(Node,code,which,[u]),
+ {RelName,"1"} = rpc:call(Node,init,script_id,[]),
+ {Env,state} = rpc:call(Node,u,u,[]),
+ 'val_αβ' = proplists:get_value('key_αβ',Env),
+ [{RelName,"1",_,permanent}|_] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ {ok,ReleasesDir} = rpc:call(Node,application,get_env,[sasl,releases_dir]),
+ {ok,[[{release,RelName,"1",_,_,permanent}|_]]} =
+ file:consult(filename:join(ReleasesDir,"RELEASES")),
+
+ %% Install second release
+ {ok, RelVsn2} =
+ rpc:call(Node, release_handler, set_unpacked,
+ [Rel2++".rel", [{u,"1.1",LibDir}]]),
+ ok = rpc:call(Node, release_handler, install_file,
+ [RelVsn2, filename:join(Rel2Dir, "relup")]),
+ ok = rpc:call(Node, release_handler, install_file,
+ [RelVsn2, filename:join(Rel2Dir, "start.boot")]),
+ ok = rpc:call(Node, release_handler, install_file,
+ [RelVsn2, filename:join(Rel2Dir, "sys.config")]),
+
+ {ok, _RelVsn1, []} =
+ rpc:call(Node, release_handler, install_release, [RelVsn2]),
+
+ %% And check
+ Dir2 = filename:join([LibDir, "u-1.1"]),
+ Dir2 = rpc:call(Node, code, lib_dir, [u]),
+ UBeam2 = filename:join([Dir2,"ebin","u.beam"]),
+ {file,UBeam2} = rpc:call(Node,code,is_loaded,[u]),
+ {RelName,"1"} = rpc:call(Node,init,script_id,[]),
+ {Env,{state,'αβ'}} = rpc:call(Node,u,u,[]),
+ [{RelName,"2",_,current}|_] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ {ok,ReleasesDir2} = rpc:call(Node,application,get_env,[sasl,releases_dir]),
+ {ok,<<"%% coding: utf-8\n[{release,\"unicode_rel_αβ\",\"2\""/utf8,_/binary>>}=
+ file:read_file(filename:join(ReleasesDir2,"RELEASES")),
+ ok.
+
+unicode_upgrade(cleanup,_Conf) ->
+ stop_node(node_name(unicode_upgrade)).
+
%%%=================================================================
%%% Misceleaneous functions
@@ -2002,6 +2082,8 @@ are_names_reg_gg(Node, Names, N) ->
t_start_node(Name, Boot, SysConfig) ->
+ t_start_node(Name, Boot, SysConfig, "").
+t_start_node(Name, Boot, SysConfig, ArgStr) ->
Args =
case Boot of
[] -> [];
@@ -2010,8 +2092,9 @@ t_start_node(Name, Boot, SysConfig) ->
case SysConfig of
[] -> [];
_ -> " -config " ++ SysConfig
- end,
- test_server:start_node(Name, slave, [{args, Args}]).
+ end ++
+ " " ++ ArgStr,
+ test_server:start_node(Name, peer, [{args, Args}]).
stop_node(Node) ->
?t:stop_node(Node).
@@ -2460,7 +2543,9 @@ create_rel_file(RelFile,RelName,RelVsn,Erts,ExtraApps) ->
%% Insert a term in a file, which can be read with file:consult/1.
write_term_file(File,Term) ->
- ok = file:write_file(File,io_lib:format("~p.~n",[Term])).
+ Str = io_lib:format("%% ~s~n~tp.~n",[epp:encoding_to_string(utf8),Term]),
+ Bin = unicode:characters_to_binary(Str),
+ ok = file:write_file(File,Bin).
%% Check that global group info is correct - try again for a maximum of 5 sec
@@ -2719,8 +2804,8 @@ cover_fun(Node,Func) ->
%% and possibly other applications if they are listed in AppDirs =
%% [{App,Vsn,LibDir}]
create_and_install_fake_first_release(Dir,AppDirs) ->
- %% Create the first release
- {RelName,RelVsn} = init:script_id(),
+ create_and_install_fake_first_release(Dir,init:script_id(),AppDirs).
+create_and_install_fake_first_release(Dir,{RelName,RelVsn},AppDirs) ->
{Rel,_} = create_fake_release(Dir,RelName,RelVsn,AppDirs),
ReleasesDir = filename:join(Dir, "releases"),
RelDir = filename:dirname(Rel),
@@ -2744,9 +2829,11 @@ create_and_install_fake_first_release(Dir,AppDirs) ->
%% be upgraded to from the release created by
%% create_and_install_fake_first_release/2. Unpack first by calls to
%% release_handler:set_unpacked and release_handler:install_file.
-create_fake_upgrade_release(Dir,RelVsn,AppDirs,{UpFrom,DownTo,ExtraLibs}) ->
- %% Create a new release
+create_fake_upgrade_release(Dir,RelVsn,AppDirs,UpgrInstr) when not is_tuple(RelVsn) ->
{RelName,_} = init:script_id(),
+ create_fake_upgrade_release(Dir,{RelName,RelVsn},AppDirs,UpgrInstr);
+create_fake_upgrade_release(Dir,{RelName,RelVsn},AppDirs,{UpFrom,DownTo,ExtraLibs}) ->
+ %% Create a new release
{Rel,Paths} = create_fake_release(Dir,RelName,RelVsn,AppDirs),
RelDir = filename:dirname(Rel),
diff --git a/lib/sasl/test/release_handler_SUITE_data/Makefile.src b/lib/sasl/test/release_handler_SUITE_data/Makefile.src
index b794aa0e6f..113d3e2290 100644
--- a/lib/sasl/test/release_handler_SUITE_data/Makefile.src
+++ b/lib/sasl/test/release_handler_SUITE_data/Makefile.src
@@ -76,7 +76,13 @@ SUP= \
release_handler_timeouts/dummy-0.1/ebin/dummy_sup.@EMULATOR@ \
release_handler_timeouts/dummy-0.1/ebin/dummy_sup_2.@EMULATOR@
-all: $(LIB) $(APP) $(OTP2740) $(C) $(SUP)
+UNICODE= \
+ unicode/u-1.0/ebin/u.@EMULATOR@ \
+ unicode/u-1.0/ebin/u_sup.@EMULATOR@ \
+ unicode/u-1.1/ebin/u.@EMULATOR@ \
+ unicode/u-1.1/ebin/u_sup.@EMULATOR@
+
+all: $(LIB) $(APP) $(OTP2740) $(C) $(SUP) $(UNICODE)
lib/a-1.0/ebin/a.@EMULATOR@: lib/a-1.0/src/a.erl
erlc $(EFLAGS) -olib/a-1.0/ebin lib/a-1.0/src/a.erl
@@ -236,3 +242,13 @@ release_handler_timeouts/dummy-0.1/ebin/dummy_sup.@EMULATOR@: release_handler_ti
erlc $(EFLAGS) -orelease_handler_timeouts/dummy-0.1/ebin release_handler_timeouts/dummy-0.1/src/dummy_sup.erl
release_handler_timeouts/dummy-0.1/ebin/dummy_sup_2.@EMULATOR@: release_handler_timeouts/dummy-0.1/src/dummy_sup_2.erl
erlc $(EFLAGS) -orelease_handler_timeouts/dummy-0.1/ebin release_handler_timeouts/dummy-0.1/src/dummy_sup_2.erl
+
+unicode/u-1.0/ebin/u.@EMULATOR@: unicode/u-1.0/src/u.erl
+ erlc $(EFLAGS) -ounicode/u-1.0/ebin unicode/u-1.0/src/u.erl
+unicode/u-1.0/ebin/u_sup.@EMULATOR@: unicode/u-1.0/src/u_sup.erl
+ erlc $(EFLAGS) -ounicode/u-1.0/ebin unicode/u-1.0/src/u_sup.erl
+
+unicode/u-1.1/ebin/u.@EMULATOR@: unicode/u-1.1/src/u.erl
+ erlc $(EFLAGS) -ounicode/u-1.1/ebin unicode/u-1.1/src/u.erl
+unicode/u-1.1/ebin/u_sup.@EMULATOR@: unicode/u-1.1/src/u_sup.erl
+ erlc $(EFLAGS) -ounicode/u-1.1/ebin unicode/u-1.1/src/u_sup.erl
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app
new file mode 100644
index 0000000000..fea4f9992e
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app
@@ -0,0 +1,8 @@
+{application, u,
+ [{description, "This app shall test unicode handling αβ"},
+ {vsn, "1.0"},
+ {modules, [u, u_sup]},
+ {registered, [u_sup]},
+ {applications, [kernel, stdlib]},
+ {env, [{'key_αβ', 'val_αβ'}]},
+ {mod, {u_sup, []}}]}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl
new file mode 100644
index 0000000000..45fe098c0e
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl
@@ -0,0 +1,50 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u).
+
+
+-behaviour(gen_server).
+
+-vsn(1).
+
+%% External exports
+-export([start_link/0, u/0]).
+%% Internal exports
+-export([init/1, handle_call/3, handle_info/2, terminate/2]).
+
+start_link() -> gen_server:start_link({local, uu}, u, [], []).
+
+u() -> gen_server:call(uu, u).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, state}.
+
+handle_call(u, _From, State) ->
+ X = application:get_all_env(u),
+ {reply, {X,State}, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl
new file mode 100644
index 0000000000..b0d4a7b58f
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl
@@ -0,0 +1,38 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u_sup).
+
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_, _) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+init([]) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Config = {u,
+ {u, start_link, []},
+ permanent, 2000, worker, [u]},
+ {ok, {SupFlags, [Config]}}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app
new file mode 100644
index 0000000000..8fcc3bba42
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app
@@ -0,0 +1,8 @@
+{application, u,
+ [{description, "This app shall test unicode handling αβ"},
+ {vsn, "1.1"},
+ {modules, [u, u_sup]},
+ {registered, [u_sup]},
+ {applications, [kernel, stdlib]},
+ {env, [{'key_αβ', 'val_αβ'}]},
+ {mod, {u_sup, []}}]}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup
new file mode 100644
index 0000000000..0344ce92ab
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup
@@ -0,0 +1,3 @@
+{"1.1",
+ [{"1.0",[{update,u,{advanced,'αβ'}}]}],
+ [{"1.0",[{update,u,{advanced,'αβ'}}]}]}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl
new file mode 100644
index 0000000000..d2544d6fc1
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl
@@ -0,0 +1,55 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u).
+
+
+-behaviour(gen_server).
+
+-vsn(1).
+
+%% External exports
+-export([start_link/0, u/0]).
+%% Internal exports
+-export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]).
+
+start_link() -> gen_server:start_link({local, uu}, u, [], []).
+
+u() -> gen_server:call(uu, u).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, {state,'αβ'}}.
+
+handle_call(u, _From, State) ->
+ X = application:get_all_env(u),
+ {reply, {X,State}, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+code_change({down,_}, {State,_}, _Extra) ->
+ {ok, State};
+code_change(_, State, Extra) ->
+ {ok, {State, Extra}}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl
new file mode 100644
index 0000000000..b0d4a7b58f
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl
@@ -0,0 +1,38 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u_sup).
+
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_, _) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+init([]) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Config = {u,
+ {u, start_link, []},
+ permanent, 2000, worker, [u]},
+ {ok, {SupFlags, [Config]}}.
diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl
index 8ba759ad60..a7cd1daeec 100644
--- a/lib/ssh/src/ssh_io.erl
+++ b/lib/ssh/src/ssh_io.erl
@@ -31,8 +31,8 @@ read_line(Prompt, Opts) ->
format("~s", [listify(Prompt)]),
?GET_INTERNAL_OPT(user_pid, Opts) ! {self(), question},
receive
- Answer when is_list(Answer) ->
- Answer
+ Answer when is_list(Answer) or is_binary(Answer) ->
+ unicode:characters_to_list(Answer)
end.
yes_no(Prompt, Opts) ->
@@ -44,7 +44,7 @@ yes_no(Prompt, Opts) ->
y -> yes;
n -> no;
- Answer when is_list(Answer) ->
+ Answer when is_list(Answer) or is_binary(Answer) ->
case trim(Answer) of
"y" -> yes;
"n" -> no;
@@ -60,7 +60,7 @@ read_password(Prompt, Opts) ->
format("~s", [listify(Prompt)]),
?GET_INTERNAL_OPT(user_pid, Opts) ! {self(), user_password},
receive
- Answer when is_list(Answer) ->
+ Answer when is_list(Answer) or is_binary(Answer) ->
case trim(Answer) of
"" ->
read_password(Prompt, Opts);
diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl
index c1558a19b1..9e1229dc85 100644
--- a/lib/ssh/src/ssh_sftp.erl
+++ b/lib/ssh/src/ssh_sftp.erl
@@ -1050,7 +1050,7 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) ->
#file_info{
size = A#ssh_xfer_attr.size,
type = A#ssh_xfer_attr.type,
- access = read_write, %% FIXME: read/write/read_write/none
+ access = file_mode_to_owner_access(A#ssh_xfer_attr.permissions),
atime = unix_to_datetime(A#ssh_xfer_attr.atime),
mtime = unix_to_datetime(A#ssh_xfer_attr.mtime),
ctime = unix_to_datetime(A#ssh_xfer_attr.createtime),
@@ -1062,6 +1062,28 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) ->
uid = A#ssh_xfer_attr.owner,
gid = A#ssh_xfer_attr.group}.
+file_mode_to_owner_access(FileMode)
+ when is_integer(FileMode) ->
+ %% The file mode contains the access permissions.
+ %% The read and write access permission of file owner
+ %% are located in 8th and 7th bit of file mode respectively.
+
+ ReadPermission = ((FileMode bsr 8) band 1),
+ WritePermission = ((FileMode bsr 7) band 1),
+ case {ReadPermission, WritePermission} of
+ {1, 1} ->
+ read_write;
+ {1, 0} ->
+ read;
+ {0, 1} ->
+ write;
+ {0, 0} ->
+ none;
+ _ ->
+ undefined
+ end;
+file_mode_to_owner_access(_) ->
+ undefined.
unix_to_datetime(undefined) ->
undefined;
diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl
index 680a8ef52e..7aa3d8a00a 100644
--- a/lib/ssh/test/ssh_sftp_SUITE.erl
+++ b/lib/ssh/test/ssh_sftp_SUITE.erl
@@ -92,7 +92,7 @@ groups() ->
{write_read_tests, [], [open_close_file, open_close_dir, read_file, read_dir,
write_file, write_file_iolist, write_big_file, sftp_read_big_file,
rename_file, mk_rm_dir, remove_file, links,
- retrieve_attributes, set_attributes, async_read,
+ retrieve_attributes, set_attributes, file_owner_access, async_read,
async_write, position, pos_read, pos_write,
start_channel_sock
]}
@@ -521,7 +521,36 @@ set_attributes(Config) when is_list(Config) ->
ok = file:write_file(FileName, "hello again").
%%--------------------------------------------------------------------
+file_owner_access() ->
+ [{doc,"Test file user access validity"}].
+file_owner_access(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, _} ->
+ {skip, "Not a relevant test on Windows"};
+ _ ->
+ FileName = proplists:get_value(filename, Config),
+ {Sftp, _} = proplists:get_value(sftp, Config),
+
+ {ok, #file_info{mode = InitialMode}} = ssh_sftp:read_file_info(Sftp, FileName),
+
+ ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#000}),
+ {ok, #file_info{access = none}} = ssh_sftp:read_file_info(Sftp, FileName),
+
+ ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}),
+ {ok, #file_info{access = read}} = ssh_sftp:read_file_info(Sftp, FileName),
+
+ ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#200}),
+ {ok, #file_info{access = write}} = ssh_sftp:read_file_info(Sftp, FileName),
+ ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}),
+ {ok, #file_info{access = read_write}} = ssh_sftp:read_file_info(Sftp, FileName),
+
+ ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=InitialMode}),
+
+ ok
+ end.
+
+%%--------------------------------------------------------------------
async_read() ->
[{doc,"Test API aread/3"}].
async_read(Config) when is_list(Config) ->
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index e8cfbbe2e3..b6aafc3fa4 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -48,7 +48,7 @@
select_sni_extension/1]).
%% Alert and close handling
--export([encode_alert/3,send_alert/2, close/5]).
+-export([encode_alert/3,send_alert/2, close/5, protocol_name/0]).
%% Data handling
@@ -208,6 +208,9 @@ setopts(Transport, Socket, Other) ->
getopts(Transport, Socket, Tag) ->
dtls_socket:getopts(Transport, Socket, Tag).
+protocol_name() ->
+ "DTLS".
+
%%====================================================================
%% tls_connection_sup API
%%====================================================================
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 75eb308ba5..801aa8f256 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -569,7 +569,7 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
%%--------------------------------------------------------------------
-spec prf(#sslsocket{}, binary() | 'master_secret', binary(),
- binary() | prf_random(), non_neg_integer()) ->
+ [binary() | prf_random()], non_neg_integer()) ->
{ok, binary()} | {error, reason()}.
%%
%% Description: use a ssl sessions TLS PRF to generate key material
diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl
index 696a55e4b9..b923785e17 100644
--- a/lib/ssl/src/ssl_alert.erl
+++ b/lib/ssl/src/ssl_alert.erl
@@ -57,16 +57,16 @@ decode(Bin) ->
reason_code(#alert{description = ?CLOSE_NOTIFY}, _) ->
closed;
reason_code(#alert{description = Description}, _) ->
- {tls_alert, description_txt(Description)}.
+ {tls_alert, string:to_lower(description_txt(Description))}.
%%--------------------------------------------------------------------
-spec alert_txt(#alert{}) -> string().
%%
%% Description: Returns the error string for given alert.
%%--------------------------------------------------------------------
-alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined}) ->
- Mod ++ ":" ++ integer_to_list(Line) ++ ":" ++
- level_txt(Level) ++" "++ description_txt(Description);
+alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined, role = Role}) ->
+ "at " ++ Mod ++ ":" ++ integer_to_list(Line) ++ " " ++ string:to_upper(atom_to_list(Role)) ++ " ALERT: " ++
+ level_txt(Level) ++ description_txt(Description);
alert_txt(#alert{reason = Reason} = Alert) ->
BaseTxt = alert_txt(Alert#alert{reason = undefined}),
FormatDepth = 9, % Some limit on printed representation of an error
@@ -93,73 +93,73 @@ decode(<<>>, Acc, _) ->
lists:reverse(Acc, []).
level_txt(?WARNING) ->
- "Warning:";
+ "Warning - ";
level_txt(?FATAL) ->
- "Fatal error:".
+ "Fatal - ".
description_txt(?CLOSE_NOTIFY) ->
- "close notify";
+ "Close Notify";
description_txt(?UNEXPECTED_MESSAGE) ->
- "unexpected message";
+ "Unexpected Message";
description_txt(?BAD_RECORD_MAC) ->
- "bad record mac";
+ "Bad Record MAC";
description_txt(?DECRYPTION_FAILED) ->
- "decryption failed";
+ "Decryption Failed";
description_txt(?RECORD_OVERFLOW) ->
- "record overflow";
+ "Record Overflow";
description_txt(?DECOMPRESSION_FAILURE) ->
- "decompression failure";
+ "Decompression Failure";
description_txt(?HANDSHAKE_FAILURE) ->
- "handshake failure";
+ "Handshake Failure";
description_txt(?NO_CERTIFICATE_RESERVED) ->
- "No certificate reserved";
+ "No Certificate Reserved";
description_txt(?BAD_CERTIFICATE) ->
- "bad certificate";
+ "Bad Certificate";
description_txt(?UNSUPPORTED_CERTIFICATE) ->
- "unsupported certificate";
+ "Unsupported Certificate";
description_txt(?CERTIFICATE_REVOKED) ->
- "certificate revoked";
+ "Certificate Revoked";
description_txt(?CERTIFICATE_EXPIRED) ->
- "certificate expired";
+ "Certificate Expired";
description_txt(?CERTIFICATE_UNKNOWN) ->
- "certificate unknown";
+ "Certificate Unknown";
description_txt(?ILLEGAL_PARAMETER) ->
- "illegal parameter";
+ "Illegal Parameter";
description_txt(?UNKNOWN_CA) ->
- "unknown ca";
+ "Unknown CA";
description_txt(?ACCESS_DENIED) ->
- "access denied";
+ "Access Denied";
description_txt(?DECODE_ERROR) ->
- "decode error";
+ "Decode Error";
description_txt(?DECRYPT_ERROR) ->
- "decrypt error";
+ "Decrypt Error";
description_txt(?EXPORT_RESTRICTION) ->
- "export restriction";
+ "Export Restriction";
description_txt(?PROTOCOL_VERSION) ->
- "protocol version";
+ "Protocol Version";
description_txt(?INSUFFICIENT_SECURITY) ->
- "insufficient security";
+ "Insufficient Security";
description_txt(?INTERNAL_ERROR) ->
- "internal error";
+ "Internal Error";
description_txt(?USER_CANCELED) ->
- "user canceled";
+ "User Canceled";
description_txt(?NO_RENEGOTIATION) ->
- "no renegotiation";
+ "No Renegotiation";
description_txt(?UNSUPPORTED_EXTENSION) ->
- "unsupported extension";
+ "Unsupported Extension";
description_txt(?CERTIFICATE_UNOBTAINABLE) ->
- "certificate unobtainable";
+ "Certificate Unobtainable";
description_txt(?UNRECOGNISED_NAME) ->
- "unrecognised name";
+ "Unrecognised Name";
description_txt(?BAD_CERTIFICATE_STATUS_RESPONSE) ->
- "bad certificate status response";
+ "Bad Certificate Status Response";
description_txt(?BAD_CERTIFICATE_HASH_VALUE) ->
- "bad certificate hash value";
+ "Bad Certificate Hash Value";
description_txt(?UNKNOWN_PSK_IDENTITY) ->
- "unknown psk identity";
+ "Unknown Psk Identity";
description_txt(?INAPPROPRIATE_FALLBACK) ->
- "inappropriate fallback";
+ "Inappropriate Fallback";
description_txt(?NO_APPLICATION_PROTOCOL) ->
- "no application protocol";
+ "No application protocol";
description_txt(Enum) ->
lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])).
diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl
index f3743ba0f0..1aabb6c55a 100644
--- a/lib/ssl/src/ssl_alert.hrl
+++ b/lib/ssl/src/ssl_alert.hrl
@@ -118,6 +118,7 @@
level,
description,
where = {?FILE, ?LINE},
+ role,
reason
}).
-endif. % -ifdef(ssl_alert).
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index bd60197c88..50c5f0d755 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -335,7 +335,9 @@ all_suites(Version) ->
anonymous_suites({3, N}) ->
anonymous_suites(N);
-
+anonymous_suites({254, _} = Version) ->
+ anonymous_suites(dtls_v1:corresponding_tls_version(Version))
+ -- [?TLS_DH_anon_WITH_RC4_128_MD5];
anonymous_suites(N)
when N >= 3 ->
[?TLS_DH_anon_WITH_AES_128_GCM_SHA256,
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index fb87662c7b..1afc4ad2af 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -264,7 +264,7 @@ renegotiation(ConnectionPid) ->
%%--------------------------------------------------------------------
-spec prf(pid(), binary() | 'master_secret', binary(),
- binary() | ssl:prf_random(), non_neg_integer()) ->
+ [binary() | ssl:prf_random()], non_neg_integer()) ->
{ok, binary()} | {error, reason()} | {'EXIT', term()}.
%%
%% Description: use a ssl sessions TLS PRF to generate key material
@@ -1143,7 +1143,7 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName,
port = Port, session = Session, user_application = {_Mon, Pid},
role = Role, socket_options = Opts, tracker = Tracker}) ->
invalidate_session(Role, Host, Port, Session),
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection),
{stop, normal};
@@ -1153,15 +1153,16 @@ handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
{stop, {shutdown, peer_close}};
handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
- #state{ssl_options = SslOpts, renegotiation = {true, internal}} = State) ->
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) ->
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
handle_normal_shutdown(Alert, StateName, State),
{stop, {shutdown, peer_close}};
handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
- #state{ssl_options = SslOpts, renegotiation = {true, From},
+ #state{role = Role,
+ ssl_options = SslOpts, renegotiation = {true, From},
protocol_cb = Connection} = State0) ->
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
gen_statem:reply(From, {error, renegotiation_rejected}),
{Record, State} = Connection:next_record(State0),
%% Go back to connection!
@@ -1169,8 +1170,8 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert,
%% Gracefully log and ignore all other warning alerts
handle_alert(#alert{level = ?WARNING} = Alert, StateName,
- #state{ssl_options = SslOpts, protocol_cb = Connection} = State0) ->
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ #state{ssl_options = SslOpts, protocol_cb = Connection, role = Role} = State0) ->
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
{Record, State} = Connection:next_record(State0),
Connection:next_event(StateName, Record, State).
@@ -2370,18 +2371,19 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio
Transport, Socket, Connection, Tracker), ReasonCode})
end.
-log_alert(true, Info, Alert) ->
+log_alert(true, ProtocolName, StateName, Alert) ->
Txt = ssl_alert:alert_txt(Alert),
- error_logger:format("SSL: ~p: ~s\n", [Info, Txt]);
-log_alert(false, _, _) ->
+ error_logger:format("~s: In state ~p ~s\n", [ProtocolName, StateName, Txt]);
+log_alert(false, _, _, _) ->
ok.
handle_own_alert(Alert, Version, StateName,
- #state{transport_cb = Transport,
- socket = Socket,
- protocol_cb = Connection,
- connection_states = ConnectionStates,
- ssl_options = SslOpts} = State) ->
+ #state{role = Role,
+ transport_cb = Transport,
+ socket = Socket,
+ protocol_cb = Connection,
+ connection_states = ConnectionStates,
+ ssl_options = SslOpts} = State) ->
try %% Try to tell the other side
{BinMsg, _} =
Connection:encode_alert(Alert, Version, ConnectionStates),
@@ -2390,7 +2392,7 @@ handle_own_alert(Alert, Version, StateName,
ignore
end,
try %% Try to tell the local user
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = Role}),
handle_normal_shutdown(Alert,StateName, State)
catch _:_ ->
ok
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 3cf466e78f..b1661624b5 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -415,9 +415,11 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
path_validation_alert(Reason)
end
catch
- error:_ ->
+ error:{badmatch,{asn1, Asn1Reason}} ->
%% ASN-1 decode of certificate somehow failed
- ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, failed_to_decode_certificate)
+ ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, {failed_to_decode_certificate, Asn1Reason});
+ error:OtherReason ->
+ ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {unexpected_error, OtherReason})
end.
%%--------------------------------------------------------------------
@@ -1611,8 +1613,11 @@ path_validation_alert({bad_cert, unknown_critical_extension}) ->
?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE);
path_validation_alert({bad_cert, {revoked, _}}) ->
?ALERT_REC(?FATAL, ?CERTIFICATE_REVOKED);
-path_validation_alert({bad_cert, revocation_status_undetermined}) ->
- ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
+%%path_validation_alert({bad_cert, revocation_status_undetermined}) ->
+%% ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
+path_validation_alert({bad_cert, {revocation_status_undetermined, Details}}) ->
+ Alert = ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE),
+ Alert#alert{reason = Details};
path_validation_alert({bad_cert, selfsigned_peer}) ->
?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
path_validation_alert({bad_cert, unknown_ca}) ->
@@ -2189,7 +2194,8 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, C
ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath,
DBInfo})
end, {CertDbHandle, CertDbRef}}},
- {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end}
+ {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end},
+ {undetermined_details, true}
],
case dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) of
no_dps ->
@@ -2199,7 +2205,7 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, C
DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed
%% but could not be retrived, will result in {bad_cert, revocation_status_undetermined}
case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of
- {bad_cert, revocation_status_undetermined} ->
+ {bad_cert, {revocation_status_undetermined, _}} ->
crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback,
CRLDbHandle, same_issuer), Options);
Other ->
@@ -2209,7 +2215,7 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, C
crl_check_same_issuer(OtpCert, best_effort, Dps, Options) ->
case public_key:pkix_crls_validate(OtpCert, Dps, Options) of
- {bad_cert, revocation_status_undetermined} ->
+ {bad_cert, {revocation_status_undetermined, _}} ->
valid;
Other ->
Other
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 352874c77d..e3ffbea3d3 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -56,7 +56,7 @@
reinit_handshake_data/1, select_sni_extension/1]).
%% Alert and close handling
--export([send_alert/2, close/5]).
+-export([send_alert/2, close/5, protocol_name/0]).
%% Data handling
-export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3,
@@ -164,6 +164,8 @@ encode_data(Data, Version, ConnectionStates0)->
encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
tls_record:encode_alert_record(Alert, Version, ConnectionStates).
+protocol_name() ->
+ "TLS".
%%====================================================================
%% tls_connection_sup API
%%====================================================================
@@ -719,7 +721,7 @@ close(downgrade, _,_,_,_) ->
%% Other
close(_, Socket, Transport, _,_) ->
Transport:close(Socket).
-
+
convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") ->
State#state{ssl_options = convert_options_partial_chain(Options, up)};
convert_state(#state{ssl_options = Options} = State, down, "5.3.6", "5.3.5") ->
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 558be6d642..c7e2f402af 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -56,7 +56,6 @@ MODULES = \
ssl_upgrade_SUITE\
ssl_sni_SUITE \
make_certs\
- erl_make_certs\
x509_test
diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl
deleted file mode 100644
index 3ab6222780..0000000000
--- a/lib/ssl/test/erl_make_certs.erl
+++ /dev/null
@@ -1,477 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2011-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%% Create test certificates
-
--module(erl_make_certs).
--include_lib("public_key/include/public_key.hrl").
-
--export([make_cert/1, gen_rsa/1, verify_signature/3, write_pem/3]).
--compile(export_all).
-
-%%--------------------------------------------------------------------
-%% @doc Create and return a der encoded certificate
-%% Option Default
-%% -------------------------------------------------------
-%% digest sha1
-%% validity {date(), date() + week()}
-%% version 3
-%% subject [] list of the following content
-%% {name, Name}
-%% {email, Email}
-%% {city, City}
-%% {state, State}
-%% {org, Org}
-%% {org_unit, OrgUnit}
-%% {country, Country}
-%% {serial, Serial}
-%% {title, Title}
-%% {dnQualifer, DnQ}
-%% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created)
-%% (obs IssuerKey migth be {Key, Password}
-%% key = KeyFile|KeyBin|rsa|dsa|ec Subject PublicKey rsa, dsa or ec generates key
-%%
-%%
-%% (OBS: The generated keys are for testing only)
-%% @spec ([{::atom(), ::term()}]) -> {Cert::binary(), Key::binary()}
-%% @end
-%%--------------------------------------------------------------------
-
-make_cert(Opts) ->
- SubjectPrivateKey = get_key(Opts),
- {TBSCert, IssuerKey} = make_tbs(SubjectPrivateKey, Opts),
- Cert = public_key:pkix_sign(TBSCert, IssuerKey),
- true = verify_signature(Cert, IssuerKey, undef), %% verify that the keys where ok
- {Cert, encode_key(SubjectPrivateKey)}.
-
-%%--------------------------------------------------------------------
-%% @doc Writes pem files in Dir with FileName ++ ".pem" and FileName ++ "_key.pem"
-%% @spec (::string(), ::string(), {Cert,Key}) -> ok
-%% @end
-%%--------------------------------------------------------------------
-write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) ->
- ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"),
- [{'Certificate', Cert, not_encrypted}]),
- ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]).
-
-%%--------------------------------------------------------------------
-%% @doc Creates a rsa key (OBS: for testing only)
-%% the size are in bytes
-%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
-%% @end
-%%--------------------------------------------------------------------
-gen_rsa(Size) when is_integer(Size) ->
- Key = gen_rsa2(Size),
- {Key, encode_key(Key)}.
-
-%%--------------------------------------------------------------------
-%% @doc Creates a dsa key (OBS: for testing only)
-%% the sizes are in bytes
-%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
-%% @end
-%%--------------------------------------------------------------------
-gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) ->
- Key = gen_dsa2(LSize, NSize),
- {Key, encode_key(Key)}.
-
-%%--------------------------------------------------------------------
-%% @doc Creates a ec key (OBS: for testing only)
-%% the sizes are in bytes
-%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
-%% @end
-%%--------------------------------------------------------------------
-gen_ec(Curve) when is_atom(Curve) ->
- Key = gen_ec2(Curve),
- {Key, encode_key(Key)}.
-
-%%--------------------------------------------------------------------
-%% @doc Verifies cert signatures
-%% @spec (::binary(), ::tuple()) -> ::boolean()
-%% @end
-%%--------------------------------------------------------------------
-verify_signature(DerEncodedCert, DerKey, _KeyParams) ->
- Key = decode_key(DerKey),
- case Key of
- #'RSAPrivateKey'{modulus=Mod, publicExponent=Exp} ->
- public_key:pkix_verify(DerEncodedCert,
- #'RSAPublicKey'{modulus=Mod, publicExponent=Exp});
- #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} ->
- public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}});
- #'ECPrivateKey'{version = _Version, privateKey = _PrivKey,
- parameters = Params, publicKey = PubKey} ->
- public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-get_key(Opts) ->
- case proplists:get_value(key, Opts) of
- undefined -> make_key(rsa, Opts);
- rsa -> make_key(rsa, Opts);
- dsa -> make_key(dsa, Opts);
- ec -> make_key(ec, Opts);
- Key ->
- Password = proplists:get_value(password, Opts, no_passwd),
- decode_key(Key, Password)
- end.
-
-decode_key({Key, Pw}) ->
- decode_key(Key, Pw);
-decode_key(Key) ->
- decode_key(Key, no_passwd).
-
-
-decode_key(#'RSAPublicKey'{} = Key,_) ->
- Key;
-decode_key(#'RSAPrivateKey'{} = Key,_) ->
- Key;
-decode_key(#'DSAPrivateKey'{} = Key,_) ->
- Key;
-decode_key(#'ECPrivateKey'{} = Key,_) ->
- Key;
-decode_key(PemEntry = {_,_,_}, Pw) ->
- public_key:pem_entry_decode(PemEntry, Pw);
-decode_key(PemBin, Pw) ->
- [KeyInfo] = public_key:pem_decode(PemBin),
- decode_key(KeyInfo, Pw).
-
-encode_key(Key = #'RSAPrivateKey'{}) ->
- {ok, Der} = 'OTP-PUB-KEY':encode('RSAPrivateKey', Key),
- {'RSAPrivateKey', Der, not_encrypted};
-encode_key(Key = #'DSAPrivateKey'{}) ->
- {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key),
- {'DSAPrivateKey', Der, not_encrypted};
-encode_key(Key = #'ECPrivateKey'{}) ->
- {ok, Der} = 'OTP-PUB-KEY':encode('ECPrivateKey', Key),
- {'ECPrivateKey', Der, not_encrypted}.
-
-make_tbs(SubjectKey, Opts) ->
- Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))),
-
- IssuerProp = proplists:get_value(issuer, Opts, true),
- {Issuer, IssuerKey} = issuer(IssuerProp, Opts, SubjectKey),
-
- {Algo, Parameters} = sign_algorithm(IssuerKey, Opts),
-
- SignAlgo = #'SignatureAlgorithm'{algorithm = Algo,
- parameters = Parameters},
- Subject = case IssuerProp of
- true -> %% Is a Root Ca
- Issuer;
- _ ->
- subject(proplists:get_value(subject, Opts),false)
- end,
-
- {#'OTPTBSCertificate'{serialNumber = trunc(rand:uniform()*100000000)*10000 + 1,
- signature = SignAlgo,
- issuer = Issuer,
- validity = validity(Opts),
- subject = Subject,
- subjectPublicKeyInfo = publickey(SubjectKey),
- version = Version,
- extensions = extensions(Opts)
- }, IssuerKey}.
-
-issuer(true, Opts, SubjectKey) ->
- %% Self signed
- {subject(proplists:get_value(subject, Opts), true), SubjectKey};
-issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) ->
- {issuer_der(Issuer), decode_key(IssuerKey)};
-issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) ->
- {ok, [{cert, Cert, _}|_]} = pem_to_der(File),
- {issuer_der(Cert), decode_key(IssuerKey)}.
-
-issuer_der(Issuer) ->
- Decoded = public_key:pkix_decode_cert(Issuer, otp),
- #'OTPCertificate'{tbsCertificate=Tbs} = Decoded,
- #'OTPTBSCertificate'{subject=Subject} = Tbs,
- Subject.
-
-subject(undefined, IsRootCA) ->
- User = if IsRootCA -> "RootCA"; true -> os:getenv("USER", "test_user") end,
- Opts = [{email, User ++ "@erlang.org"},
- {name, User},
- {city, "Stockholm"},
- {country, "SE"},
- {org, "erlang"},
- {org_unit, "testing dep"}],
- subject(Opts);
-subject(Opts, _) ->
- subject(Opts).
-
-subject(SubjectOpts) when is_list(SubjectOpts) ->
- Encode = fun(Opt) ->
- {Type,Value} = subject_enc(Opt),
- [#'AttributeTypeAndValue'{type=Type, value=Value}]
- end,
- {rdnSequence, [Encode(Opt) || Opt <- SubjectOpts]}.
-
-%% Fill in the blanks
-subject_enc({name, Name}) -> {?'id-at-commonName', {printableString, Name}};
-subject_enc({email, Email}) -> {?'id-emailAddress', Email};
-subject_enc({city, City}) -> {?'id-at-localityName', {printableString, City}};
-subject_enc({state, State}) -> {?'id-at-stateOrProvinceName', {printableString, State}};
-subject_enc({org, Org}) -> {?'id-at-organizationName', {printableString, Org}};
-subject_enc({org_unit, OrgUnit}) -> {?'id-at-organizationalUnitName', {printableString, OrgUnit}};
-subject_enc({country, Country}) -> {?'id-at-countryName', Country};
-subject_enc({serial, Serial}) -> {?'id-at-serialNumber', Serial};
-subject_enc({title, Title}) -> {?'id-at-title', {printableString, Title}};
-subject_enc({dnQualifer, DnQ}) -> {?'id-at-dnQualifier', DnQ};
-subject_enc(Other) -> Other.
-
-
-extensions(Opts) ->
- case proplists:get_value(extensions, Opts, []) of
- false ->
- asn1_NOVALUE;
- Exts ->
- lists:flatten([extension(Ext) || Ext <- default_extensions(Exts)])
- end.
-
-default_extensions(Exts) ->
- Def = [{key_usage,undefined},
- {subject_altname, undefined},
- {issuer_altname, undefined},
- {basic_constraints, default},
- {name_constraints, undefined},
- {policy_constraints, undefined},
- {ext_key_usage, undefined},
- {inhibit_any, undefined},
- {auth_key_id, undefined},
- {subject_key_id, undefined},
- {policy_mapping, undefined}],
- Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end,
- Exts ++ lists:foldl(Filter, Def, Exts).
-
-extension({_, undefined}) -> [];
-extension({basic_constraints, Data}) ->
- case Data of
- default ->
- #'Extension'{extnID = ?'id-ce-basicConstraints',
- extnValue = #'BasicConstraints'{cA=true},
- critical=true};
- false ->
- [];
- Len when is_integer(Len) ->
- #'Extension'{extnID = ?'id-ce-basicConstraints',
- extnValue = #'BasicConstraints'{cA=true, pathLenConstraint=Len},
- critical=true};
- _ ->
- #'Extension'{extnID = ?'id-ce-basicConstraints',
- extnValue = Data}
- end;
-extension({Id, Data, Critical}) ->
- #'Extension'{extnID = Id, extnValue = Data, critical = Critical}.
-
-
-publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) ->
- Public = #'RSAPublicKey'{modulus=N, publicExponent=E},
- Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters='NULL'},
- #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
- subjectPublicKey = Public};
-publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) ->
- Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa',
- parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}},
- #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y};
-publickey(#'ECPrivateKey'{version = _Version,
- privateKey = _PrivKey,
- parameters = Params,
- publicKey = PubKey}) ->
- Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params},
- #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
- subjectPublicKey = #'ECPoint'{point = PubKey}}.
-
-validity(Opts) ->
- DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1),
- DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7),
- {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}),
- Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end,
- #'Validity'{notBefore={generalTime, Format(DefFrom)},
- notAfter ={generalTime, Format(DefTo)}}.
-
-sign_algorithm(#'RSAPrivateKey'{}, Opts) ->
- Type = case proplists:get_value(digest, Opts, sha1) of
- sha1 -> ?'sha1WithRSAEncryption';
- sha512 -> ?'sha512WithRSAEncryption';
- sha384 -> ?'sha384WithRSAEncryption';
- sha256 -> ?'sha256WithRSAEncryption';
- md5 -> ?'md5WithRSAEncryption';
- md2 -> ?'md2WithRSAEncryption'
- end,
- {Type, 'NULL'};
-sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) ->
- {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}};
-sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) ->
- Type = case proplists:get_value(digest, Opts, sha1) of
- sha1 -> ?'ecdsa-with-SHA1';
- sha512 -> ?'ecdsa-with-SHA512';
- sha384 -> ?'ecdsa-with-SHA384';
- sha256 -> ?'ecdsa-with-SHA256'
- end,
- {Type, Parms}.
-
-make_key(rsa, _Opts) ->
- %% (OBS: for testing only)
- gen_rsa2(64);
-make_key(dsa, _Opts) ->
- gen_dsa2(128, 20); %% Bytes i.e. {1024, 160}
-make_key(ec, _Opts) ->
- %% (OBS: for testing only)
- CurveOid = hd(tls_v1:ecc_curves(0)),
- NamedCurve = pubkey_cert_records:namedCurves(CurveOid),
- gen_ec2(NamedCurve).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% RSA key generation (OBS: for testing only)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--define(SMALL_PRIMES, [65537,97,89,83,79,73,71,67,61,59,53,
- 47,43,41,37,31,29,23,19,17,13,11,7,5,3]).
-
-gen_rsa2(Size) ->
- P = prime(Size),
- Q = prime(Size),
- N = P*Q,
- Tot = (P - 1) * (Q - 1),
- [E|_] = lists:dropwhile(fun(Candidate) -> (Tot rem Candidate) == 0 end, ?SMALL_PRIMES),
- {D1,D2} = extended_gcd(E, Tot),
- D = erlang:max(D1,D2),
- case D < E of
- true ->
- gen_rsa2(Size);
- false ->
- {Co1,Co2} = extended_gcd(Q, P),
- Co = erlang:max(Co1,Co2),
- #'RSAPrivateKey'{version = 'two-prime',
- modulus = N,
- publicExponent = E,
- privateExponent = D,
- prime1 = P,
- prime2 = Q,
- exponent1 = D rem (P-1),
- exponent2 = D rem (Q-1),
- coefficient = Co
- }
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% DSA key generation (OBS: for testing only)
-%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm
-%% and the fips_186-3.pdf
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-gen_dsa2(LSize, NSize) ->
- Q = prime(NSize), %% Choose N-bit prime Q
- X0 = prime(LSize),
- P0 = prime((LSize div 2) +1),
-
- %% Choose L-bit prime modulus P such that p-1 is a multiple of q.
- case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of
- error ->
- gen_dsa2(LSize, NSize);
- P ->
- G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q.
- %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used.
-
- X = prime(20), %% Choose x by some random method, where 0 < x < q.
- Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p.
-
- #'DSAPrivateKey'{version=0, p = P, q = Q,
- g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X}
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% EC key generation (OBS: for testing only)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-gen_ec2(CurveId) ->
- {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId),
-
- #'ECPrivateKey'{version = 1,
- privateKey = PrivKey,
- parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)},
- publicKey = PubKey}.
-
-%% See fips_186-3.pdf
-dsa_search(T, P0, Q, Iter) when Iter > 0 ->
- P = 2*T*Q*P0 + 1,
- case is_prime(P, 50) of
- true -> P;
- false -> dsa_search(T+1, P0, Q, Iter-1)
- end;
-dsa_search(_,_,_,_) ->
- error.
-
-
-%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-prime(ByteSize) ->
- Rand = odd_rand(ByteSize),
- prime_odd(Rand, 0).
-
-prime_odd(Rand, N) ->
- case is_prime(Rand, 50) of
- true ->
- Rand;
- false ->
- prime_odd(Rand+2, N+1)
- end.
-
-%% see http://en.wikipedia.org/wiki/Fermat_primality_test
-is_prime(_, 0) -> true;
-is_prime(Candidate, Test) ->
- CoPrime = odd_rand(10000, Candidate),
- Result = crypto:mod_pow(CoPrime, Candidate, Candidate) ,
- is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test).
-
-is_prime(CoPrime, CoPrime, Candidate, Test) ->
- is_prime(Candidate, Test-1);
-is_prime(_,_,_,_) ->
- false.
-
-odd_rand(Size) ->
- Min = 1 bsl (Size*8-1),
- Max = (1 bsl (Size*8))-1,
- odd_rand(Min, Max).
-
-odd_rand(Min,Max) ->
- Rand = crypto:rand_uniform(Min,Max),
- case Rand rem 2 of
- 0 ->
- Rand + 1;
- _ ->
- Rand
- end.
-
-extended_gcd(A, B) ->
- case A rem B of
- 0 ->
- {0, 1};
- N ->
- {X, Y} = extended_gcd(B, N),
- {Y, X-Y*(A div B)}
- end.
-
-pem_to_der(File) ->
- {ok, PemBin} = file:read_file(File),
- public_key:pem_decode(PemBin).
-
-der_to_pem(File, Entries) ->
- PemBin = public_key:pem_encode(Entries),
- file:write_file(File, PemBin).
-
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 407152aa75..aeb4897d7e 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -360,6 +360,8 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites;
TestCase == psk_with_hint_cipher_suites;
TestCase == ciphers_rsa_signed_certs;
TestCase == ciphers_rsa_signed_certs_openssl_names;
+ TestCase == ciphers_ecdh_rsa_signed_certs_openssl_names;
+ TestCase == ciphers_ecdh_rsa_signed_certs;
TestCase == ciphers_dsa_signed_certs;
TestCase == ciphers_dsa_signed_certs_openssl_names;
TestCase == anonymous_cipher_suites;
@@ -368,6 +370,11 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites;
TestCase == anonymous_cipher_suites;
TestCase == psk_anon_cipher_suites;
TestCase == psk_anon_with_hint_cipher_suites;
+ TestCase == srp_cipher_suites,
+ TestCase == srp_anon_cipher_suites,
+ TestCase == srp_dsa_cipher_suites,
+ TestCase == des_rsa_cipher_suites,
+ TestCase == des_ecdh_rsa_cipher_suites,
TestCase == versions_option,
TestCase == tls_tcp_connect_big ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
@@ -386,22 +393,27 @@ init_per_testcase(reuse_session, Config) ->
init_per_testcase(rizzo, Config) ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
+ Config;
+
+init_per_testcase(no_rizzo_rc4, Config) ->
+ ssl_test_lib:ct_log_supported_protocol_versions(Config),
+ ct:timetrap({seconds, 60}),
Config;
init_per_testcase(rizzo_one_n_minus_one, Config) ->
ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
rizzo_add_mitigation_option(one_n_minus_one, Config);
init_per_testcase(rizzo_zero_n, Config) ->
ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
rizzo_add_mitigation_option(zero_n, Config);
init_per_testcase(rizzo_disabled, Config) ->
ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
rizzo_add_mitigation_option(disabled, Config);
init_per_testcase(prf, Config) ->
@@ -2308,20 +2320,16 @@ tls_shutdown_error(Config) when is_list(Config) ->
ciphers_rsa_signed_certs() ->
[{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}].
-ciphers_rsa_signed_certs(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
+ciphers_rsa_signed_certs(Config) when is_list(Config) ->
Ciphers = ssl_test_lib:rsa_suites(crypto),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, rsa).
+ run_suites(Ciphers, Config, rsa).
%%-------------------------------------------------------------------
ciphers_rsa_signed_certs_openssl_names() ->
[{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:openssl_rsa_suites(crypto),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, rsa).
+ Ciphers = ssl_test_lib:openssl_rsa_suites(),
+ run_suites(Ciphers, Config, rsa).
%%-------------------------------------------------------------------
ciphers_dsa_signed_certs() ->
@@ -2329,120 +2337,104 @@ ciphers_dsa_signed_certs() ->
ciphers_dsa_signed_certs(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:dsa_suites(NVersion),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, dsa).
+ run_suites(Ciphers, Config, dsa).
%%-------------------------------------------------------------------
ciphers_dsa_signed_certs_openssl_names() ->
[{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:openssl_dsa_suites(),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, dsa).
+ run_suites(Ciphers, Config, dsa).
%%-------------------------------------------------------------------
anonymous_cipher_suites()->
[{doc,"Test the anonymous ciphersuites"}].
anonymous_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:anonymous_suites(Version),
- run_suites(Ciphers, Version, Config, anonymous).
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = ssl_test_lib:anonymous_suites(NVersion),
+ run_suites(Ciphers, Config, anonymous).
%%-------------------------------------------------------------------
psk_cipher_suites() ->
[{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk).
+ run_suites(Ciphers, Config, psk).
%%-------------------------------------------------------------------
psk_with_hint_cipher_suites()->
[{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}].
psk_with_hint_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk_with_hint).
+ run_suites(Ciphers, Config, psk_with_hint).
%%-------------------------------------------------------------------
psk_anon_cipher_suites() ->
[{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_anon_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk_anon).
+ run_suites(Ciphers, Config, psk_anon).
%%-------------------------------------------------------------------
psk_anon_with_hint_cipher_suites()->
[{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}].
psk_anon_with_hint_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk_anon_with_hint).
+ run_suites(Ciphers, Config, psk_anon_with_hint).
%%-------------------------------------------------------------------
srp_cipher_suites()->
[{doc, "Test the SRP ciphersuites"}].
srp_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:srp_suites(),
- run_suites(Ciphers, Version, Config, srp).
+ run_suites(Ciphers, Config, srp).
%%-------------------------------------------------------------------
srp_anon_cipher_suites()->
[{doc, "Test the anonymous SRP ciphersuites"}].
srp_anon_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:srp_anon_suites(),
- run_suites(Ciphers, Version, Config, srp_anon).
+ run_suites(Ciphers, Config, srp_anon).
%%-------------------------------------------------------------------
srp_dsa_cipher_suites()->
[{doc, "Test the SRP DSA ciphersuites"}].
srp_dsa_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:srp_dss_suites(),
- run_suites(Ciphers, Version, Config, srp_dsa).
+ run_suites(Ciphers, Config, srp_dsa).
%%-------------------------------------------------------------------
rc4_rsa_cipher_suites()->
[{doc, "Test the RC4 ciphersuites"}].
rc4_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:rc4_suites(NVersion),
- run_suites(Ciphers, Version, Config, rc4_rsa).
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
+ run_suites(Ciphers, Config, rc4_rsa).
%-------------------------------------------------------------------
rc4_ecdh_rsa_cipher_suites()->
[{doc, "Test the RC4 ciphersuites"}].
rc4_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:rc4_suites(NVersion),
- run_suites(Ciphers, Version, Config, rc4_ecdh_rsa).
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = [S || {ecdh_rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
+ run_suites(Ciphers, Config, rc4_ecdh_rsa).
%%-------------------------------------------------------------------
rc4_ecdsa_cipher_suites()->
[{doc, "Test the RC4 ciphersuites"}].
rc4_ecdsa_cipher_suites(Config) when is_list(Config) ->
NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:rc4_suites(NVersion),
- run_suites(Ciphers, Version, Config, rc4_ecdsa).
+ Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
+ run_suites(Ciphers, Config, rc4_ecdsa).
%%-------------------------------------------------------------------
des_rsa_cipher_suites()->
[{doc, "Test the des_rsa ciphersuites"}].
des_rsa_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:des_suites(Config),
- run_suites(Ciphers, Version, Config, des_rsa).
+ run_suites(Ciphers, Config, des_rsa).
%-------------------------------------------------------------------
des_ecdh_rsa_cipher_suites()->
[{doc, "Test ECDH rsa signed ciphersuites"}].
des_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:des_suites(NVersion),
- run_suites(Ciphers, Version, Config, des_dhe_rsa).
+ run_suites(Ciphers, Config, des_dhe_rsa).
%%--------------------------------------------------------------------
default_reject_anonymous()->
@@ -2476,38 +2468,30 @@ ciphers_ecdsa_signed_certs() ->
ciphers_ecdsa_signed_certs(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:ecdsa_suites(NVersion),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, ecdsa).
+ run_suites(Ciphers, Config, ecdsa).
%%--------------------------------------------------------------------
ciphers_ecdsa_signed_certs_openssl_names() ->
[{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:openssl_ecdsa_suites(),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, ecdsa).
+ run_suites(Ciphers, Config, ecdsa).
%%--------------------------------------------------------------------
ciphers_ecdh_rsa_signed_certs() ->
[{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, ecdh_rsa).
+ run_suites(Ciphers, Config, ecdh_rsa).
%%--------------------------------------------------------------------
ciphers_ecdh_rsa_signed_certs_openssl_names() ->
[{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:openssl_ecdh_rsa_suites(),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, ecdh_rsa).
+ run_suites(Ciphers, Config, ecdh_rsa).
%%--------------------------------------------------------------------
reuse_session() ->
[{doc,"Test reuse of sessions (short handshake)"}].
@@ -3024,37 +3008,6 @@ der_input_opts(Opts) ->
{Cert, {Asn1Type, Key}, CaCerts, DHParams}.
%%--------------------------------------------------------------------
-%% different_ca_peer_sign() ->
-%% ["Check that a CA can have a different signature algorithm than the peer cert."];
-
-%% different_ca_peer_sign(Config) when is_list(Config) ->
-%% ClientOpts = ssl_test_lib:ssl_options(client_mix_opts, Config),
-%% ServerOpts = ssl_test_lib:ssl_options(server_mix_verify_opts, Config),
-
-%% {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-%% Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
-%% {from, self()},
-%% {mfa, {ssl_test_lib, send_recv_result_active_once, []}},
-%% {options, [{active, once},
-%% {verify, verify_peer} | ServerOpts]}]),
-%% Port = ssl_test_lib:inet_port(Server),
-
-%% Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
-%% {host, Hostname},
-%% {from, self()},
-%% {mfa, {ssl_test_lib,
-%% send_recv_result_active_once,
-%% []}},
-%% {options, [{active, once},
-%% {verify, verify_peer}
-%% | ClientOpts]}]),
-
-%% ssl_test_lib:check_result(Server, ok, Client, ok),
-%% ssl_test_lib:close(Server),
-%% ssl_test_lib:close(Client).
-
-
-%%--------------------------------------------------------------------
no_reuses_session_server_restart_new_cert() ->
[{doc,"Check that a session is not reused if the server is restarted with a new cert."}].
no_reuses_session_server_restart_new_cert(Config) when is_list(Config) ->
@@ -3122,14 +3075,14 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) ->
DsaServerOpts = ssl_test_lib:ssl_options(server_dsa_opts, Config),
PrivDir = proplists:get_value(priv_dir, Config),
- NewServerOpts = new_config(PrivDir, ServerOpts),
+ NewServerOpts0 = new_config(PrivDir, ServerOpts),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server =
ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
{mfa, {ssl_test_lib, session_info_result, []}},
- {options, NewServerOpts}]),
+ {options, NewServerOpts0}]),
Port = ssl_test_lib:inet_port(Server),
Client0 =
ssl_test_lib:start_client([{node, ClientNode},
@@ -3150,13 +3103,13 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) ->
ssl:clear_pem_cache(),
- NewServerOpts = new_config(PrivDir, DsaServerOpts),
+ NewServerOpts1 = new_config(PrivDir, DsaServerOpts),
Server1 =
ssl_test_lib:start_server([{node, ServerNode}, {port, Port},
{from, self()},
{mfa, {ssl_test_lib, no_result, []}},
- {options, NewServerOpts}]),
+ {options, NewServerOpts1}]),
Client1 =
ssl_test_lib:start_client([{node, ClientNode},
{port, Port}, {host, Hostname},
@@ -3807,8 +3760,10 @@ no_rizzo_rc4() ->
no_rizzo_rc4(Config) when is_list(Config) ->
Prop = proplists:get_value(tc_group_properties, Config),
Version = proplists:get_value(name, Prop),
- Ciphers = [ssl_cipher:erl_suite_definition(Suite) ||
- Suite <- ssl_test_lib:rc4_suites(tls_record:protocol_version(Version))],
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ %% Test uses RSA certs
+ Ciphers = ssl_test_lib:rc4_suites(NVersion) -- [{ecdhe_ecdsa,rc4_128,sha},
+ {ecdh_ecdsa,rc4_128,sha}],
run_send_recv_rizzo(Ciphers, Config, Version,
{?MODULE, send_recv_result_active_no_rizzo, []}).
@@ -3818,7 +3773,8 @@ rizzo_one_n_minus_one() ->
rizzo_one_n_minus_one(Config) when is_list(Config) ->
Prop = proplists:get_value(tc_group_properties, Config),
Version = proplists:get_value(name, Prop),
- AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ AllSuites = ssl_test_lib:available_suites(NVersion),
Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128],
run_send_recv_rizzo(Ciphers, Config, Version,
{?MODULE, send_recv_result_active_rizzo, []}).
@@ -3829,7 +3785,8 @@ rizzo_zero_n() ->
rizzo_zero_n(Config) when is_list(Config) ->
Prop = proplists:get_value(tc_group_properties, Config),
Version = proplists:get_value(name, Prop),
- AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ AllSuites = ssl_test_lib:available_suites(NVersion),
Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128],
run_send_recv_rizzo(Ciphers, Config, Version,
{?MODULE, send_recv_result_active_no_rizzo, []}).
@@ -4631,7 +4588,10 @@ client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa ->
{ssl_test_lib:ssl_options(client_opts, Config),
ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}.
-run_suites(Ciphers, Version, Config, Type) ->
+run_suites(Ciphers, Config, Type) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Version = ssl_test_lib:protocol_version(Config),
+ ct:log("Running cipher suites ~p~n", [Ciphers]),
{ClientOpts, ServerOpts} =
case Type of
rsa ->
@@ -4643,23 +4603,24 @@ run_suites(Ciphers, Version, Config, Type) ->
anonymous ->
%% No certs in opts!
{ssl_test_lib:ssl_options(client_verification_opts, Config),
- [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(Version)}]};
+ [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(NVersion)} |
+ ssl_test_lib:ssl_options([], Config)]};
psk ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk, Config)]};
psk_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk_hint, Config)
]};
psk_anon ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk_anon, Config)]};
psk_anon_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]};
srp ->
{ssl_test_lib:ssl_options(client_srp, Config),
diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl
index e293d183f7..668c76e38d 100644
--- a/lib/ssl/test/ssl_crl_SUITE.erl
+++ b/lib/ssl/test/ssl_crl_SUITE.erl
@@ -155,9 +155,15 @@ init_per_testcase(Case, Config0) ->
DataDir = proplists:get_value(data_dir, Config),
CertDir = filename:join(proplists:get_value(priv_dir, Config0), idp_crl),
{CertOpts, Config} = init_certs(CertDir, idp_crl, Config),
- {ok, _} = make_certs:all(DataDir, CertDir, CertOpts),
- ct:timetrap({seconds, 6}),
- [{cert_dir, CertDir} | Config];
+ case make_certs:all(DataDir, CertDir, CertOpts) of
+ {ok, _} ->
+ ct:timetrap({seconds, 6}),
+ [{cert_dir, CertDir} | Config];
+ _ ->
+ end_per_testcase(Case, Config0),
+ ssl_test_lib:clean_start(),
+ {skip, "Unable to create IDP crls"}
+ end;
false ->
end_per_testcase(Case, Config0),
ssl_test_lib:clean_start(),
diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl
index 4e916a7f03..4a8027edda 100644
--- a/lib/ssl/test/ssl_sni_SUITE.erl
+++ b/lib/ssl/test/ssl_sni_SUITE.erl
@@ -42,9 +42,18 @@ init_per_suite(Config0) ->
try crypto:start() of
ok ->
ssl_test_lib:clean_start(),
- {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0),
- proplists:get_value(priv_dir, Config0)),
- ssl_test_lib:cert_options(Config0)
+ Config = ssl_test_lib:make_rsa_cert(Config0),
+ RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ [{sni_server_opts, [{sni_hosts, [
+ {"a.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]},
+ {"b.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]}
+ ]}]} | Config]
catch _:_ ->
{skip, "Crypto did not start"}
end.
@@ -66,22 +75,22 @@ end_per_testcase(_TestCase, Config) ->
%% Test Cases --------------------------------------------------------
%%--------------------------------------------------------------------
no_sni_header(Config) ->
- run_handshake(Config, undefined, undefined, "server").
+ run_handshake(Config, undefined, undefined, "server Peer cert").
no_sni_header_fun(Config) ->
- run_sni_fun_handshake(Config, undefined, undefined, "server").
+ run_sni_fun_handshake(Config, undefined, undefined, "server Peer cert").
sni_match(Config) ->
- run_handshake(Config, "a.server", "a.server", "a.server").
+ run_handshake(Config, "a.server", "a.server", "server Peer cert").
sni_match_fun(Config) ->
- run_sni_fun_handshake(Config, "a.server", "a.server", "a.server").
+ run_sni_fun_handshake(Config, "a.server", "a.server", "server Peer cert").
sni_no_match(Config) ->
- run_handshake(Config, "c.server", undefined, "server").
+ run_handshake(Config, "c.server", undefined, "server Peer cert").
sni_no_match_fun(Config) ->
- run_sni_fun_handshake(Config, "c.server", undefined, "server").
+ run_sni_fun_handshake(Config, "c.server", undefined, "server Peer cert").
%%--------------------------------------------------------------------
@@ -141,13 +150,13 @@ run_sni_fun_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
[Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
[{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config),
SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end,
- ServerOptions = proplists:get_value(server_opts, Config) ++ [{sni_fun, SNIFun}],
+ ServerOptions = ssl_test_lib:ssl_options(server_rsa_opts, Config) ++ [{sni_fun, SNIFun}],
ClientOptions =
case SNIHostname of
undefined ->
- proplists:get_value(client_opts, Config);
+ proplists:get_value(client_rsa_opts, Config);
_ ->
- [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_opts, Config)
+ [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_rsa_opts, Config)
end,
ct:log("Options: ~p", [[ServerOptions, ClientOptions]]),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -167,14 +176,14 @@ run_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, "
"ExpectedSNIHostname: ~p, ExpectedCN: ~p",
[Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
- ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_opts, Config),
+ ServerOptions = proplists:get_value(sni_server_opts, Config) ++ ssl_test_lib:ssl_options(server_rsa_opts, Config),
ClientOptions =
- case SNIHostname of
- undefined ->
- proplists:get_value(client_opts, Config);
- _ ->
- [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_opts, Config)
- end,
+ case SNIHostname of
+ undefined ->
+ proplists:get_value(client_rsa_opts, Config);
+ _ ->
+ [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_rsa_opts, Config)
+ end,
ct:log("Options: ~p", [[ServerOptions, ClientOptions]]),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 77c21d9b57..f627ebce2e 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -384,10 +384,6 @@ cert_options(Config) ->
"badkey.pem"]),
PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>,
- SNIServerACertFile = filename:join([proplists:get_value(priv_dir, Config), "a.server", "cert.pem"]),
- SNIServerAKeyFile = filename:join([proplists:get_value(priv_dir, Config), "a.server", "key.pem"]),
- SNIServerBCertFile = filename:join([proplists:get_value(priv_dir, Config), "b.server", "cert.pem"]),
- SNIServerBKeyFile = filename:join([proplists:get_value(priv_dir, Config), "b.server", "key.pem"]),
[{client_opts, [{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile},
{keyfile, ClientKeyFile}]},
@@ -445,46 +441,34 @@ cert_options(Config) ->
{server_bad_cert, [{ssl_imp, new},{cacertfile, ServerCaCertFile},
{certfile, BadCertFile}, {keyfile, ServerKeyFile}]},
{server_bad_key, [{ssl_imp, new},{cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, BadKeyFile}]},
- {sni_server_opts, [{sni_hosts, [
- {"a.server", [
- {certfile, SNIServerACertFile},
- {keyfile, SNIServerAKeyFile}
- ]},
- {"b.server", [
- {certfile, SNIServerBCertFile},
- {keyfile, SNIServerBKeyFile}
- ]}
- ]}]}
+ {certfile, ServerCertFile}, {keyfile, BadKeyFile}]}
| Config].
-make_dsa_cert(Config) ->
- {ServerCaCertFile, ServerCertFile, ServerKeyFile} =
- make_cert_files("server", Config, dsa, dsa, "", []),
- {ClientCaCertFile, ClientCertFile, ClientKeyFile} =
- make_cert_files("client", Config, dsa, dsa, "", []),
- [{server_dsa_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
- {server_dsa_verify_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ClientCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {verify, verify_peer}]},
- {client_dsa_opts, [{ssl_imp, new},
- {cacertfile, ClientCaCertFile},
- {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]},
- {server_srp_dsa, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {user_lookup_fun, {fun user_lookup/3, undefined}},
- {ciphers, srp_dss_suites()}]},
- {client_srp_dsa, [{ssl_imp, new},
- {srp_identity, {"Test-User", "secret"}},
- {cacertfile, ClientCaCertFile},
- {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
- | Config].
-
+make_dsa_cert(Config) ->
+ CryptoSupport = crypto:supports(),
+ case proplists:get_bool(dss, proplists:get_value(public_keys, CryptoSupport)) of
+ true ->
+ ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa"]),
+ ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa"]),
+ KeyGenSpec = key_gen_info(dsa, dsa),
+
+ GenCertData = x509_test:gen_test_certs([{digest, sha} | KeyGenSpec]),
+ [{server_config, ServerConf},
+ {client_config, ClientConf}] =
+ x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase),
+
+ [{server_dsa_opts, ServerConf},
+ {server_dsa_verify_opts, [{verify, verify_peer} | ServerConf]},
+ {client_dsa_opts, ClientConf},
+ {server_srp_dsa, [{user_lookup_fun, {fun user_lookup/3, undefined}},
+ {ciphers, srp_dss_suites()} | ServerConf]},
+ {client_srp_dsa, [{srp_identity, {"Test-User", "secret"}}
+ | ClientConf]}
+ | Config];
+ false ->
+ Config
+ end.
make_rsa_cert_chains(ChainConf, Config, Suffix) ->
CryptoSupport = crypto:supports(),
KeyGenSpec = key_gen_info(rsa, rsa),
@@ -541,6 +525,11 @@ key_gen_spec(Role, rsa) ->
[{list_to_atom(Role ++ "_key_gen"), hardcode_rsa_key(1)},
{list_to_atom(Role ++ "_key_gen_chain"), [hardcode_rsa_key(2),
hardcode_rsa_key(3)]}
+ ];
+key_gen_spec(Role, dsa) ->
+ [{list_to_atom(Role ++ "_key_gen"), hardcode_dsa_key(1)},
+ {list_to_atom(Role ++ "_key_gen_chain"), [hardcode_dsa_key(2),
+ hardcode_dsa_key(3)]}
].
make_ecdsa_cert(Config) ->
CryptoSupport = crypto:supports(),
@@ -638,41 +627,6 @@ make_ecdh_rsa_cert(Config) ->
Config
end.
-make_mix_cert(Config) ->
- {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa,
- rsa, "mix", []),
- {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa,
- rsa, "mix", []),
- [{server_mix_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
- {server_mix_verify_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ClientCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {verify, verify_peer}]},
- {client_mix_opts, [{ssl_imp, new},
- {cacertfile, ClientCaCertFile},
- {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
- | Config].
-
-make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix, Opts) ->
- Alg1Str = atom_to_list(Alg1),
- Alg2Str = atom_to_list(Alg2),
- CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}| Opts]),
- {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo} | Opts]),
- CaCertFile = filename:join([proplists:get_value(priv_dir, Config),
- RoleStr, Prefix ++ Alg1Str ++ "_cacerts.pem"]),
- CertFile = filename:join([proplists:get_value(priv_dir, Config),
- RoleStr, Prefix ++ Alg2Str ++ "_cert.pem"]),
- KeyFile = filename:join([proplists:get_value(priv_dir, Config),
- RoleStr, Prefix ++ Alg2Str ++ "_key.pem"]),
-
- der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]),
- der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]),
- der_to_pem(KeyFile, [CertKey]),
- {CaCertFile, CertFile, KeyFile}.
-
-
start_upgrade_server(Args) ->
Result = spawn_link(?MODULE, run_upgrade_server, [Args]),
receive
@@ -983,16 +937,10 @@ ecdh_rsa_suites(Version) ->
end,
available_suites(Version)).
-openssl_rsa_suites(CounterPart) ->
+openssl_rsa_suites() ->
Ciphers = ssl:cipher_suites(openssl),
- Names = case is_sane_ecc(CounterPart) of
- true ->
- "DSS | ECDSA";
- false ->
- "DSS | ECDHE | ECDH"
- end,
- lists:filter(fun(Str) -> string_regex_filter(Str, Names)
- end, Ciphers).
+ lists:filter(fun(Str) -> string_regex_filter(Str, "RSA")
+ end, Ciphers) -- openssl_ecdh_rsa_suites().
openssl_dsa_suites() ->
Ciphers = ssl:cipher_suites(openssl),
@@ -1026,11 +974,11 @@ string_regex_filter(_Str, _Search) ->
false.
anonymous_suites(Version) ->
- Suites = ssl_cipher:anonymous_suites(Version),
+ Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)],
ssl_cipher:filter_suites(Suites).
psk_suites(Version) ->
- Suites = ssl_cipher:psk_suites(Version),
+ Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:psk_suites(Version)],
ssl_cipher:filter_suites(Suites).
psk_anon_suites(Version) ->
@@ -1062,7 +1010,7 @@ srp_dss_suites() ->
ssl_cipher:filter_suites(Suites).
rc4_suites(Version) ->
- Suites = ssl_cipher:rc4_suites(Version),
+ Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:rc4_suites(Version)],
ssl_cipher:filter_suites(Suites).
des_suites(Version) ->
@@ -1294,6 +1242,8 @@ check_sane_openssl_version(Version) ->
case supports_ssl_tls_version(Version) of
true ->
case {Version, os:cmd("openssl version")} of
+ {'sslv3', "OpenSSL 1.0.2" ++ _} ->
+ false;
{_, "OpenSSL 1.0.2" ++ _} ->
true;
{_, "OpenSSL 1.0.1" ++ _} ->
@@ -1365,6 +1315,12 @@ version_flag('dtlsv1.2') ->
version_flag('dtlsv1') ->
"-dtls1".
+filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_list(Cipher)->
+ filter_suites([ssl_cipher:openssl_suite(S) || S <- Ciphers],
+ AtomVersion);
+filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_binary(Cipher)->
+ filter_suites([ssl_cipher:erl_suite_definition(S) || S <- Ciphers],
+ AtomVersion);
filter_suites(Ciphers0, AtomVersion) ->
Version = tls_version(AtomVersion),
Supported0 = ssl_cipher:suites(Version)
@@ -1419,12 +1375,15 @@ supports_ssl_tls_version(sslv2 = Version) ->
case os:cmd("openssl version") of
"OpenSSL 1" ++ _ ->
false;
+ %% Appears to be broken
+ "OpenSSL 0.9.8.o" ++ _ ->
+ false;
_ ->
VersionFlag = version_flag(Version),
Exe = "openssl",
Args = ["s_client", VersionFlag],
Port = ssl_test_lib:portable_open_port(Exe, Args),
- do_supports_ssl_tls_version(Port)
+ do_supports_ssl_tls_version(Port, "")
end;
supports_ssl_tls_version(Version) ->
@@ -1432,23 +1391,26 @@ supports_ssl_tls_version(Version) ->
Exe = "openssl",
Args = ["s_client", VersionFlag],
Port = ssl_test_lib:portable_open_port(Exe, Args),
- do_supports_ssl_tls_version(Port).
+ do_supports_ssl_tls_version(Port, "").
-do_supports_ssl_tls_version(Port) ->
+do_supports_ssl_tls_version(Port, Acc) ->
receive
- {Port, {data, "u"}} ->
- false;
- {Port, {data, "unknown option" ++ _}} ->
- false;
- {Port, {data, Data}} ->
- case lists:member("error", string:tokens(Data, ":")) of
- true ->
- false;
- false ->
- do_supports_ssl_tls_version(Port)
- end
+ {Port, {data, Data}} ->
+ case Acc ++ Data of
+ "unknown option" ++ _ ->
+ false;
+ Error when length(Error) >= 11 ->
+ case lists:member("error", string:tokens(Data, ":")) of
+ true ->
+ false;
+ false ->
+ do_supports_ssl_tls_version(Port, Error)
+ end;
+ _ ->
+ do_supports_ssl_tls_version(Port, Acc ++ Data)
+ end
after 1000 ->
- true
+ true
end.
ssl_options(Option, Config) when is_atom(Option) ->
@@ -1535,7 +1497,7 @@ tls_version(Atom) ->
tls_record:protocol_version(Atom).
hardcode_rsa_key(1) ->
- {'RSAPrivateKey',0,
+ {'RSAPrivateKey', 'two-prime',
23995666614853919027835084074500048897452890537492185072956789802729257783422306095699263934587064480357348855732149402060270996295002843755712064937715826848741191927820899197493902093529581182351132392364214171173881547273475904587683433713767834856230531387991145055273426806331200574039205571401702219159773947658558490957010003143162250693492642996408861265758000254664396313741422909188635443907373976005987612936763564996605457102336549804831742940035613780926178523017685712710473543251580072875247250504243621640157403744718833162626193206685233710319205099867303242759099560438381385658382486042995679707669,
17,
11292078406990079542510627799764728892919007311761028269626724613049062486316379339152594792746853873109340637991599718616598115903530750002688030558925094987642913848386305504703012749896273497577003478759630198199473669305165131570674557041773098755873191241407597673069847908861741446606684974777271632545629600685952292605647052193819136445675100211504432575554351515262198132231537860917084269870590492135731720141577986787033006338680118008484613510063003323516659048210893001173583018220214626635609151105287049126443102976056146630518124476470236027123782297108342869049542023328584384300970694412006494684657,
@@ -1547,7 +1509,7 @@ hardcode_rsa_key(1) ->
asn1_NOVALUE};
hardcode_rsa_key(2) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
21343679768589700771839799834197557895311746244621307033143551583788179817796325695589283169969489517156931770973490560582341832744966317712674900833543896521418422508485833901274928542544381247956820115082240721897193055368570146764204557110415281995205343662628196075590438954399631753508888358737971039058298703003743872818150364935790613286541190842600031570570099801682794056444451081563070538409720109449780410837763602317050353477918147758267825417201591905091231778937606362076129350476690460157227101296599527319242747999737801698427160817755293383890373574621116766934110792127739174475029121017282777887777,
17,
18832658619343853622211588088997845201745658451136447382185486691577805721584993260814073385267196632785528033211903435807948675951440868570007265441362261636545666919252206383477878125774454042314841278013741813438699754736973658909592256273895837054592950290554290654932740253882028017801960316533503857992358685308186680144968293076156011747178275038098868263178095174694099811498968993700538293188879611375604635940554394589807673542938082281934965292051746326331046224291377703201248790910007232374006151098976879987912446997911775904329728563222485791845480864283470332826504617837402078265424772379987120023773,
@@ -1559,7 +1521,7 @@ hardcode_rsa_key(2) ->
asn1_NOVALUE};
hardcode_rsa_key(3) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
25089040456112869869472694987833070928503703615633809313972554887193090845137746668197820419383804666271752525807484521370419854590682661809972833718476098189250708650325307850184923546875260207894844301992963978994451844985784504212035958130279304082438876764367292331581532569155681984449177635856426023931875082020262146075451989132180409962870105455517050416234175675478291534563995772675388370042873175344937421148321291640477650173765084699931690748536036544188863178325887393475703801759010864779559318631816411493486934507417755306337476945299570726975433250753415110141783026008347194577506976486290259135429,
17,
8854955455098659953931539407470495621824836570223697404931489960185796768872145882893348383311931058684147950284994536954265831032005645344696294253579799360912014817761873358888796545955974191021709753644575521998041827642041589721895044045980930852625485916835514940558187965584358347452650930302268008446431977397918214293502821599497633970075862760001650736520566952260001423171553461362588848929781360590057040212831994258783694027013289053834376791974167294527043946669963760259975273650548116897900664646809242902841107022557239712438496384819445301703021164043324282687280801738470244471443835900160721870265,
@@ -1570,7 +1532,7 @@ hardcode_rsa_key(3) ->
15068630434698373319269196003209754243798959461311186548759287649485250508074064775263867418602372588394608558985183294561315208336731894947137343239541687540387209051236354318837334154993136528453613256169847839789803932725339395739618592522865156272771578671216082079933457043120923342632744996962853951612,
asn1_NOVALUE};
hardcode_rsa_key(4) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
28617237755030755643854803617273584643843067580642149032833640135949799721163782522787597288521902619948688786051081993247908700824196122780349730169173433743054172191054872553484065655968335396052034378669869864779940355219732200954630251223541048434478476115391643898092650304645086338265930608997389611376417609043761464100338332976874588396803891301015812818307951159858145399281035705713082131199940309445719678087542976246147777388465712394062188801177717719764254900022006288880246925156931391594131839991579403409541227225173269459173129377291869028712271737734702830877034334838181789916127814298794576266389,
17,
26933870828264240605980991639786903194205240075898493207372837775011576208154148256741268036255908348187001210401018346586267012540419880263858569570986761169933338532757527109161473558558433313931326474042230460969355628442100895016122589386862163232450330461545076609969553227901257730132640573174013751883368376011370428995523268034111482031427024082719896108094847702954695363285832195666458915142143884210891427766607838346722974883433132513540317964796373298134261669479023445911856492129270184781873446960437310543998533283339488055776892320162032014809906169940882070478200435536171854883284366514852906334641,
@@ -1581,7 +1543,7 @@ hardcode_rsa_key(4) ->
34340318160575773065401929915821192439103777558577109939078671096408836197675640654693301707202885840826672396546056002756167635035389371579540325327619480512374920136684787633921441576901246290213545161954865184290700344352088099063404416346968182170720521708773285279884132629954461545103181082503707725012,
asn1_NOVALUE};
hardcode_rsa_key(5) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
26363170152814518327068346871197765236382539835597898797762992537312221863402655353436079974302838986536256364057947538018476963115004626096654613827403121905035011992899481598437933532388248462251770039307078647864188314916665766359828262009578648593031111569685489178543405615478739906285223620987558499488359880003693226535420421293716164794046859453204135383236667988765227190694994861629971618548127529849059769249520775574008363789050621665120207265361610436965088511042779948238320901918522125988916609088415989475825860046571847719492980547438560049874493788767083330042728150253120940100665370844282489982633,
17,
10855423004100095781734025182257903332628104638187370093196526338893267826106975733767797636477639582691399679317978398007608161282648963686857782164224814902073240232370374775827384395689278778574258251479385325591136364965685903795223402003944149420659869469870495544106108194608892902588033255700759382142132115013969680562678811046675523365751498355532768935784747314021422035957153013494814430893022253205880275287307995039363642554998244274484818208792520243113824379110193356010059999642946040953102866271737127640405568982049887176990990501963784502429481034227543991366980671390566584211881030995602076468001,
@@ -1592,7 +1554,7 @@ hardcode_rsa_key(5) ->
40624877259097915043489529504071755460170951428490878553842519165800720914888257733191322215286203357356050737713125202129282154441426952501134581314792133018830748896123382106683994268028624341502298766844710276939303555637478596035491641473828661569958212421472263269629366559343208764012473880251174832392,
asn1_NOVALUE};
hardcode_rsa_key(6) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
22748888494866396715768692484866595111939200209856056370972713870125588774286266397044592487895293134537316190976192161177144143633669641697309689280475257429554879273045671863645233402796222694405634510241820106743648116753479926387434021380537483429927516962909367257212902212159798399531316965145618774905828756510318897899298783143203190245236381440043169622358239226123652592179006905016804587837199618842875361941208299410035232803124113612082221121192550063791073372276763648926636149384299189072950588522522800393261949880796214514243704858378436010975184294077063518776479282353562934591448646412389762167039,
17,
6690849557313646092873144848490175032923294179369428344403739373566349639495960705013115437616262686628622409110644753287395336362844012263914614494257428655751435080307550548130951000822418439531068973600535325512837681398082331290421770994275730420566916753796872722709677121223470117509210872101652580854566448661533030419787125312956120661097410038933324613372774190658239039998357548275441758790939430824924502690997433186652165055694361752689819209062683281242276039100201318203707142383491769671330743466041394101421674581185260900666085723130684175548215193875544802254923825103844262661010117443222587769713,
@@ -1603,6 +1565,27 @@ hardcode_rsa_key(6) ->
81173034184183681160439870161505779100040258708276674532866007896310418779840630960490793104541748007902477778658270784073595697910785917474138815202903114440800310078464142273778315781957021015333260021813037604142367434117205299831740956310682461174553260184078272196958146289378701001596552915990080834227,
asn1_NOVALUE}.
+hardcode_dsa_key(1) ->
+ {'DSAPrivateKey',0,
+ 99438313664986922963487511141216248076486724382260996073922424025828494981416579966171753999204426907349400798052572573634137057487829150578821328280864500098312146772602202702021153757550650696224643730869835650674962433068943942837519621267815961566259265204876799778977478160416743037274938277357237615491,
+ 1454908511695148818053325447108751926908854531909,
+ 20302424198893709525243209250470907105157816851043773596964076323184805650258390738340248469444700378962907756890306095615785481696522324901068493502141775433048117442554163252381401915027666416630898618301033737438756165023568220631119672502120011809327566543827706483229480417066316015458225612363927682579,
+ 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358,
+ 1457508827177594730669011716588605181448418352823};
+hardcode_dsa_key(2) ->
+ {'DSAPrivateKey',0,
+ 145447354557382582722944332987784622105075065624518040072393858097520305927329240484963764783346271194321683798321743658303478090647837211867389721684646254999291098347011037298359107547264573476540026676832159205689428125157386525591130716464335426605521884822982379206842523670736739023467072341958074788151,
+ 742801637799670234315651916144768554943688916729,
+ 79727684678125120155622004643594683941478642656111969487719464672433839064387954070113655822700268007902716505761008423792735229036965034283173483862273639257533568978482104785033927768441235063983341565088899599358397638308472931049309161811156189887217888328371767967629005149630676763492409067382020352505,
+ 35853727034965131665219275925554159789667905059030049940938124723126925435403746979702929280654735557166864135215989313820464108440192507913554896358611966877432546584986661291483639036057475682547385322659469460385785257933737832719745145778223672383438466035853830832837226950912832515496378486927322864228,
+ 801315110178350279541885862867982846569980443911};
+hardcode_dsa_key(3) ->
+ {'DSAPrivateKey',0,
+ 99438313664986922963487511141216248076486724382260996073922424025828494981416579966171753999204426907349400798052572573634137057487829150578821328280864500098312146772602202702021153757550650696224643730869835650674962433068943942837519621267815961566259265204876799778977478160416743037274938277357237615491,
+ 1454908511695148818053325447108751926908854531909,
+ 20302424198893709525243209250470907105157816851043773596964076323184805650258390738340248469444700378962907756890306095615785481696522324901068493502141775433048117442554163252381401915027666416630898618301033737438756165023568220631119672502120011809327566543827706483229480417066316015458225612363927682579,
+ 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358,
+ 1457508827177594730669011716588605181448418352823}.
dtls_hello() ->
[1,
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 5093ef3728..c9a1b8c735 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -142,12 +142,11 @@ init_per_suite(Config0) ->
catch crypto:stop(),
try crypto:start() of
ok ->
- ssl_test_lib:clean_start(),
- {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0),
- proplists:get_value(priv_dir, Config0)),
- Config1 = ssl_test_lib:make_dsa_cert(Config0),
- Config = ssl_test_lib:cert_options(Config1),
- ssl_test_lib:cipher_restriction(Config)
+ ssl_test_lib:clean_start(),
+
+ Config1 = ssl_test_lib:make_rsa_cert(Config0),
+ Config2 = ssl_test_lib:make_dsa_cert(Config1),
+ ssl_test_lib:cipher_restriction(Config2)
catch _:_ ->
{skip, "Crypto did not start"}
end
@@ -196,7 +195,7 @@ init_per_testcase(expired_session, Config) ->
init_per_testcase(TestCase, Config) when TestCase == ciphers_rsa_signed_certs;
TestCase == ciphers_dsa_signed_certs ->
- ct:timetrap({seconds, 45}),
+ ct:timetrap({seconds, 60}),
special_init(TestCase, Config);
init_per_testcase(TestCase, Config) ->
@@ -270,13 +269,24 @@ special_init(TestCase, Config)
check_openssl_npn_support(Config)
end;
-special_init(TestCase, Config)
+special_init(TestCase, Config0)
when TestCase == erlang_server_openssl_client_sni_match;
TestCase == erlang_server_openssl_client_sni_no_match;
TestCase == erlang_server_openssl_client_sni_no_header;
TestCase == erlang_server_openssl_client_sni_match_fun;
TestCase == erlang_server_openssl_client_sni_no_match_fun;
TestCase == erlang_server_openssl_client_sni_no_header_fun ->
+ RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config0),
+ Config = [{sni_server_opts, [{sni_hosts,
+ [{"a.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]},
+ {"b.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]}
+ ]}]} | Config0],
check_openssl_sni_support(Config);
special_init(_, Config) ->
@@ -295,8 +305,8 @@ basic_erlang_client_openssl_server() ->
[{doc,"Test erlang client with openssl server"}].
basic_erlang_client_openssl_server(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -335,10 +345,10 @@ basic_erlang_server_openssl_client() ->
[{doc,"Test erlang server with openssl client"}].
basic_erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
V2Compat = proplists:get_value(v2_hello_compatible, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
ct:pal("v2_hello_compatible: ~p", [V2Compat]),
@@ -351,7 +361,8 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port) | workaround_openssl_s_clinent()],
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++
+ ":" ++ integer_to_list(Port) | workaround_openssl_s_clinent()],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
@@ -368,8 +379,8 @@ erlang_client_openssl_server() ->
[{doc,"Test erlang client with openssl server"}].
erlang_client_openssl_server(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -408,9 +419,9 @@ erlang_server_openssl_client() ->
[{doc,"Test erlang server with openssl client"}].
erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -422,7 +433,7 @@ erlang_server_openssl_client(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost: " ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -441,7 +452,7 @@ erlang_client_openssl_server_dsa_cert() ->
erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ClientOpts = ssl_test_lib:ssl_options(client_dsa_opts, Config),
- ServerOpts = ssl_test_lib:ssl_options(server_dsa_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_dsa_verify_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -486,7 +497,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_dsa_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_dsa_verify_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
CaCertFile = proplists:get_value(cacertfile, ClientOpts),
@@ -500,7 +511,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost: " ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version),
"-cert", CertFile,
"-CAfile", CaCertFile,
@@ -523,9 +534,9 @@ erlang_server_openssl_client_reuse_session() ->
"same session id, to test reusing of sessions."}].
erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -538,7 +549,8 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname)
+ ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version),
"-reconnect"],
@@ -560,8 +572,8 @@ erlang_client_openssl_server_renegotiate() ->
[{doc,"Test erlang client when openssl server issuses a renegotiate"}].
erlang_client_openssl_server_renegotiate(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -610,8 +622,8 @@ erlang_client_openssl_server_nowrap_seqnum() ->
" to lower treashold substantially."}].
erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -653,9 +665,9 @@ erlang_server_openssl_client_nowrap_seqnum() ->
" to lower treashold substantially."}].
erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -669,7 +681,7 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client","-connect", "localhost: " ++ integer_to_list(Port),
+ Args = ["s_client","-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version),
"-msg"],
@@ -692,8 +704,8 @@ erlang_client_openssl_server_no_server_ca_cert() ->
"implicitly tested eleswhere."}].
erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -733,8 +745,8 @@ erlang_client_openssl_server_client_cert() ->
[{doc,"Test erlang client with openssl server when client sends cert"}].
erlang_client_openssl_server_client_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -776,10 +788,10 @@ erlang_server_openssl_client_client_cert() ->
[{doc,"Test erlang server with openssl client when client sends cert"}].
erlang_server_openssl_client_client_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -799,7 +811,7 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) ->
Exe = "openssl",
Args = ["s_client", "-cert", CertFile,
"-CAfile", CaCertFile,
- "-key", KeyFile,"-connect", "localhost:" ++ integer_to_list(Port),
+ "-key", KeyFile,"-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -817,8 +829,8 @@ erlang_server_erlang_client_client_cert() ->
[{doc,"Test erlang server with erlang client when client sends cert"}].
erlang_server_erlang_client_client_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = proplists:get_value(server_verification_opts, Config),
- ClientOpts = proplists:get_value(client_verification_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_verify_opts, Config),
+ ClientOpts = proplists:get_value(client_rsa_verify_opts, Config),
Version = ssl_test_lib:protocol_version(Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -871,8 +883,8 @@ erlang_client_bad_openssl_server() ->
[{doc,"Test what happens if openssl server sends garbage to erlang ssl client"}].
erlang_client_bad_openssl_server(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -926,8 +938,8 @@ expired_session() ->
"better code coverage of the ssl_manager module"}].
expired_session(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
Port = ssl_test_lib:inet_port(node()),
@@ -980,9 +992,9 @@ ssl2_erlang_server_openssl_client() ->
ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
{from, self()},
@@ -990,7 +1002,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
"-ssl2", "-msg"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1005,12 +1017,12 @@ ssl2_erlang_server_openssl_client_comp() ->
ssl2_erlang_server_openssl_client_comp(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
V2Compat = proplists:get_value(v2_hello_compatible, Config),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -1020,7 +1032,7 @@ ssl2_erlang_server_openssl_client_comp(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
"-ssl2", "-msg"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1248,22 +1260,22 @@ erlang_server_openssl_client_npn_only_client(Config) when is_list(Config) ->
ok.
%--------------------------------------------------------------------------
erlang_server_openssl_client_sni_no_header(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test(Config, undefined, undefined, "server").
+ erlang_server_openssl_client_sni_test(Config, undefined, undefined, "server Peer cert").
erlang_server_openssl_client_sni_no_header_fun(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test_sni_fun(Config, undefined, undefined, "server").
+ erlang_server_openssl_client_sni_test_sni_fun(Config, undefined, undefined, "server Peer cert").
-erlang_server_openssl_client_sni_match(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test(Config, "a.server", "a.server", "a.server").
+erlang_server_openssl_client_sni_match(Config) when is_list(Config) ->
+ erlang_server_openssl_client_sni_test(Config, "a.server", "a.server", "server Peer cert").
erlang_server_openssl_client_sni_match_fun(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test_sni_fun(Config, "a.server", "a.server", "a.server").
+ erlang_server_openssl_client_sni_test_sni_fun(Config, "a.server", "a.server", "server Peer cert").
erlang_server_openssl_client_sni_no_match(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test(Config, "c.server", undefined, "server").
+ erlang_server_openssl_client_sni_test(Config, "c.server", undefined, "server Peer cert").
erlang_server_openssl_client_sni_no_match_fun(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test_sni_fun(Config, "c.server", undefined, "server").
+ erlang_server_openssl_client_sni_test_sni_fun(Config, "c.server", undefined, "server Peer cert").
%%--------------------------------------------------------------------
@@ -1273,11 +1285,11 @@ run_suites(Ciphers, Version, Config, Type) ->
{ClientOpts, ServerOpts} =
case Type of
rsa ->
- {ssl_test_lib:ssl_options(client_opts, Config),
- ssl_test_lib:ssl_options(server_opts, Config)};
+ {ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ssl_test_lib:ssl_options(server_rsa_opts, Config)};
dsa ->
- {ssl_test_lib:ssl_options(client_opts, Config),
- ssl_test_lib:ssl_options(server_dsa_opts, Config)}
+ {ssl_test_lib:ssl_options(client_dsa_opts, Config),
+ ssl_test_lib:ssl_options(server_dsa_verify_opts, Config)}
end,
Result = lists:map(fun(Cipher) ->
@@ -1330,7 +1342,7 @@ send_and_hostname(SSLSocket) ->
erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
- ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_opts, Config),
+ ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_rsa_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()}, {mfa, {?MODULE, send_and_hostname, []}},
@@ -1344,11 +1356,7 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname,
openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname)
end,
ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs),
-
- %% Client check needs to be done befor server check,
- %% or server check might consume client messages
- ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"],
- client_check_result(ClientPort, ExpectedClientOutput),
+
ssl_test_lib:check_result(Server, ExpectedSNIHostname),
ssl_test_lib:close_port(ClientPort),
ssl_test_lib:close(Server),
@@ -1359,7 +1367,7 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo
ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
[{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config),
SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end,
- ServerOptions = proplists:get_value(server_opts, Config) ++ [{sni_fun, SNIFun}],
+ ServerOptions = proplists:get_value(server_rsa_opts, Config) ++ [{sni_fun, SNIFun}],
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()}, {mfa, {?MODULE, send_and_hostname, []}},
@@ -1375,10 +1383,6 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo
ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs),
- %% Client check needs to be done befor server check,
- %% or server check might consume client messages
- ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"],
- client_check_result(ClientPort, ExpectedClientOutput),
ssl_test_lib:check_result(Server, ExpectedSNIHostname),
ssl_test_lib:close_port(ClientPort),
ssl_test_lib:close(Server).
@@ -1442,8 +1446,8 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, OpensslServerOpts, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
ClientOpts = ErlangClientOpts ++ ClientOpts0,
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -1488,8 +1492,8 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens
start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = proplists:get_value(server_opts, Config),
- ClientOpts0 = proplists:get_value(client_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_opts, Config),
+ ClientOpts0 = proplists:get_value(client_rsa_opts, Config),
ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0],
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -1524,7 +1528,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba
start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = proplists:get_value(server_opts, Config),
+ ServerOpts0 = proplists:get_value(server_rsa_opts, Config),
ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]} | ServerOpts0],
{_, ServerNode, _} = ssl_test_lib:run_where(Config),
@@ -1553,8 +1557,8 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba
start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = proplists:get_value(server_opts, Config),
- ClientOpts0 = proplists:get_value(client_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_opts, Config),
+ ClientOpts0 = proplists:get_value(client_rsa_opts, Config),
ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]},
{client_preferred_next_protocols, {client, [<<"spdy/3">>, <<"http/1.1">>]}} | ClientOpts0],
@@ -1593,7 +1597,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca
start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = proplists:get_value(server_opts, Config),
+ ServerOpts0 = proplists:get_value(server_rsa_opts, Config),
ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]},
{next_protocols_advertised, [<<"spdy/3">>, <<"http/1.1">>]} | ServerOpts0],
@@ -1620,8 +1624,8 @@ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Ca
start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
ClientOpts = [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}} | ClientOpts0],
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -1658,10 +1662,10 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac
start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
ServerOpts = [{next_protocols_advertised, [<<"spdy/2">>]}, ServerOpts0],
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
@@ -1672,7 +1676,8 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-nextprotoneg", "http/1.0,spdy/2", "-msg", "-connect", "localhost:"
+ Args = ["s_client", "-nextprotoneg", "http/1.0,spdy/2", "-msg", "-connect",
+ hostname_format(Hostname) ++ ":"
++ integer_to_list(Port), ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1687,10 +1692,10 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac
start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenSSLClientOpts, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
ServerOpts = ErlangServerOpts ++ ServerOpts0,
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
@@ -1701,8 +1706,9 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client"] ++ OpenSSLClientOpts ++ ["-msg", "-connect", "localhost:" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version)],
+ Args = ["s_client"] ++ OpenSSLClientOpts ++ ["-msg", "-connect",
+ hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
+ ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1854,3 +1860,11 @@ consume_port_exit(OpenSSLPort) ->
{'EXIT', OpenSSLPort, _} ->
ok
end.
+
+hostname_format(Hostname) ->
+ case lists:member($., Hostname) of
+ true ->
+ Hostname;
+ false ->
+ "localhost"
+ end.
diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml
index 60dbae70c2..7efafedc82 100644
--- a/lib/stdlib/doc/src/lists.xml
+++ b/lib/stdlib/doc/src/lists.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -187,7 +187,7 @@
<desc>
<p>Calls <c><anno>Fun</anno>(<anno>Elem</anno>)</c> on successive
elements <c>Elem</c> of <c><anno>List1</anno></c>.
- <c><anno>Fun</anno>/2</c> must return either a Boolean or a tuple
+ <c><anno>Fun</anno>/1</c> must return either a Boolean or a tuple
<c>{true, <anno>Value</anno>}</c>. The function returns the list of
elements for which <c><anno>Fun</anno></c> returns a new value, where
a value of <c>true</c> is synonymous with
diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml
index e06d7e467d..a68fb7d55f 100644
--- a/lib/stdlib/doc/src/rand.xml
+++ b/lib/stdlib/doc/src/rand.xml
@@ -66,7 +66,7 @@
<p>Jump function: equivalent to 2^64 calls</p>
<p>
This is a corrected version of the previous default algorithm,
- that now has been superseeded by Xoroshiro116+ (<c>exrop</c>).
+ that now has been superseded by Xoroshiro116+ (<c>exrop</c>).
Since there is no native 58 bit rotate instruction this
algorithm executes a little (say &lt; 15%) faster than <c>exrop</c>.
See the
diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl
index 079b761463..a237eaa489 100644
--- a/lib/stdlib/src/array.erl
+++ b/lib/stdlib/src/array.erl
@@ -1603,7 +1603,7 @@ foldl_2(I, E, A, Ix, F, D, N, R, S) ->
Ix + S, F, D, N, R, S).
-spec foldl_3(pos_integer(), _, A, array_indx(),
- fun((array_indx, _, A) -> B), integer()) -> B.
+ fun((array_indx(), _, A) -> B), integer()) -> B.
foldl_3(I, E, A, Ix, F, N) when I =< N ->
foldl_3(I+1, E, F(Ix, element(I, E), A), Ix+1, F, N);
diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl
index 71e8471c45..64d5a71f3c 100644
--- a/lib/stdlib/src/edlin.erl
+++ b/lib/stdlib/src/edlin.erl
@@ -83,7 +83,7 @@ edit_line(Cs, {line,P,L,M}) ->
edit_line1(Cs, {line,P,L,{blink,N}}) ->
edit(Cs, P, L, none, [{move_rel,N}]);
edit_line1(Cs, {line,P,{[],[]},none}) ->
- {more_chars, {line,P,{lists:reverse(Cs),[]},none},[{put_chars, unicode, Cs}]};
+ {more_chars, {line,P,{string:reverse(Cs),[]},none},[{put_chars, unicode, Cs}]};
edit_line1(Cs, {line,P,L,M}) ->
edit(Cs, P, L, M, []).
@@ -93,14 +93,14 @@ edit([C|Cs], P, {Bef,Aft}, Prefix, Rs0) ->
case key_map(C, Prefix) of
meta ->
edit(Cs, P, {Bef,Aft}, meta, Rs0);
- meta_o ->
- edit(Cs, P, {Bef,Aft}, meta_o, Rs0);
- meta_csi ->
- edit(Cs, P, {Bef,Aft}, meta_csi, Rs0);
- meta_meta ->
- edit(Cs, P, {Bef,Aft}, meta_meta, Rs0);
- {csi, _} = Csi ->
- edit(Cs, P, {Bef,Aft}, Csi, Rs0);
+ meta_o ->
+ edit(Cs, P, {Bef,Aft}, meta_o, Rs0);
+ meta_csi ->
+ edit(Cs, P, {Bef,Aft}, meta_csi, Rs0);
+ meta_meta ->
+ edit(Cs, P, {Bef,Aft}, meta_meta, Rs0);
+ {csi, _} = Csi ->
+ edit(Cs, P, {Bef,Aft}, Csi, Rs0);
meta_left_sq_bracket ->
edit(Cs, P, {Bef,Aft}, meta_left_sq_bracket, Rs0);
search_meta ->
@@ -110,8 +110,8 @@ edit([C|Cs], P, {Bef,Aft}, Prefix, Rs0) ->
ctlx ->
edit(Cs, P, {Bef,Aft}, ctlx, Rs0);
new_line ->
- {done, reverse(Bef, Aft ++ "\n"), Cs,
- reverse(Rs0, [{move_rel,length(Aft)},{put_chars,unicode,"\n"}])};
+ {done, get_line(Bef, Aft ++ "\n"), Cs,
+ reverse(Rs0, [{move_rel,cp_len(Aft)},{put_chars,unicode,"\n"}])};
redraw_line ->
Rs1 = erase(P, Bef, Aft, Rs0),
Rs = redraw(P, Bef, Aft, Rs1),
@@ -157,7 +157,7 @@ edit([], P, L, {blink,N}, Rs) ->
edit([], P, L, Prefix, Rs) ->
{more_chars,{line,P,L,Prefix},reverse(Rs)};
edit(eof, _, {Bef,Aft}, _, Rs) ->
- {done,reverse(Bef, Aft),[],reverse(Rs, [{move_rel,length(Aft)}])}.
+ {done,get_line(Bef, Aft),[],reverse(Rs, [{move_rel,cp_len(Aft)}])}.
%% %% Assumes that arg is a string
%% %% Horizontal whitespace only.
@@ -279,11 +279,21 @@ key_map(C, search) -> {insert_search,C};
key_map(C, _) -> {undefined,C}.
%% do_op(Action, Before, After, Requests)
-
-do_op({insert,C}, Bef, [], Rs) ->
- {{[C|Bef],[]},[{put_chars, unicode,[C]}|Rs]};
-do_op({insert,C}, Bef, Aft, Rs) ->
- {{[C|Bef],Aft},[{insert_chars, unicode, [C]}|Rs]};
+%% Before and After are of lists of type string:grapheme_cluster()
+do_op({insert,C}, [], [], Rs) ->
+ {{[C],[]},[{put_chars, unicode,[C]}|Rs]};
+do_op({insert,C}, [Bef|Bef0], [], Rs) ->
+ case string:to_graphemes([Bef,C]) of
+ [GC] -> {{[GC|Bef0],[]},[{put_chars, unicode,[C]}|Rs]};
+ _ -> {{[C,Bef|Bef0],[]},[{put_chars, unicode,[C]}|Rs]}
+ end;
+do_op({insert,C}, [], Aft, Rs) ->
+ {{[C],Aft},[{insert_chars, unicode,[C]}|Rs]};
+do_op({insert,C}, [Bef|Bef0], Aft, Rs) ->
+ case string:to_graphemes([Bef,C]) of
+ [GC] -> {{[GC|Bef0],Aft},[{insert_chars, unicode,[C]}|Rs]};
+ _ -> {{[C,Bef|Bef0],Aft},[{insert_chars, unicode,[C]}|Rs]}
+ end;
%% Search mode prompt always looks like (search)`$TERMS': $RESULT.
%% the {insert_search, _} handlings allow to share this implementation
%% correctly with group.erl. This module provides $TERMS, and group.erl
@@ -299,13 +309,13 @@ do_op({insert_search, C}, Bef, [], Rs) ->
[{insert_chars, unicode, [C]++Aft}, {delete_chars,-3} | Rs],
search};
do_op({insert_search, C}, Bef, Aft, Rs) ->
- Offset= length(Aft),
+ Offset= cp_len(Aft),
NAft = "': ",
{{[C|Bef],NAft},
[{insert_chars, unicode, [C]++NAft}, {delete_chars,-Offset} | Rs],
search};
do_op({search, backward_delete_char}, [_|Bef], Aft, Rs) ->
- Offset= length(Aft)+1,
+ Offset= cp_len(Aft)+1,
NAft = "': ",
{{Bef,NAft},
[{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs],
@@ -314,13 +324,13 @@ do_op({search, backward_delete_char}, [], _Aft, Rs) ->
Aft="': ",
{{[],Aft}, Rs, search};
do_op({search, skip_up}, Bef, Aft, Rs) ->
- Offset= length(Aft),
+ Offset= cp_len(Aft),
NAft = "': ",
{{[$\^R|Bef],NAft}, % we insert ^R as a flag to whoever called us
[{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs],
search};
do_op({search, skip_down}, Bef, Aft, Rs) ->
- Offset= length(Aft),
+ Offset= cp_len(Aft),
NAft = "': ",
{{[$\^S|Bef],NAft}, % we insert ^S as a flag to whoever called us
[{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs],
@@ -328,12 +338,12 @@ do_op({search, skip_down}, Bef, Aft, Rs) ->
do_op({search, search_found}, _Bef, Aft, Rs) ->
"': "++NAft = Aft,
{{[],NAft},
- [{put_chars, unicode, "\n"}, {move_rel,-length(Aft)} | Rs],
+ [{put_chars, unicode, "\n"}, {move_rel,-cp_len(Aft)} | Rs],
search_found};
do_op({search, search_quit}, _Bef, Aft, Rs) ->
"': "++NAft = Aft,
{{[],NAft},
- [{put_chars, unicode, "\n"}, {move_rel,-length(Aft)} | Rs],
+ [{put_chars, unicode, "\n"}, {move_rel,-cp_len(Aft)} | Rs],
search_quit};
%% do blink after $$
do_op({blink,C,M}, Bef=[$$,$$|_], Aft, Rs) ->
@@ -361,14 +371,16 @@ do_op(auto_blink, Bef, Aft, Rs) ->
N -> {blink,N+1,{Bef,Aft},
[{move_rel,-(N+1)}|Rs]}
end;
-do_op(forward_delete_char, Bef, [_|Aft], Rs) ->
- {{Bef,Aft},[{delete_chars,1}|Rs]};
-do_op(backward_delete_char, [_|Bef], Aft, Rs) ->
- {{Bef,Aft},[{delete_chars,-1}|Rs]};
+do_op(forward_delete_char, Bef, [GC|Aft], Rs) ->
+ {{Bef,Aft},[{delete_chars,gc_len(GC)}|Rs]};
+do_op(backward_delete_char, [GC|Bef], Aft, Rs) ->
+ {{Bef,Aft},[{delete_chars,-gc_len(GC)}|Rs]};
do_op(transpose_char, [C1,C2|Bef], [], Rs) ->
- {{[C2,C1|Bef],[]},[{put_chars, unicode,[C1,C2]},{move_rel,-2}|Rs]};
+ Len = gc_len(C1)+gc_len(C2),
+ {{[C2,C1|Bef],[]},[{put_chars, unicode,[C1,C2]},{move_rel,-Len}|Rs]};
do_op(transpose_char, [C2|Bef], [C1|Aft], Rs) ->
- {{[C2,C1|Bef],Aft},[{put_chars, unicode,[C1,C2]},{move_rel,-1}|Rs]};
+ Len = gc_len(C2),
+ {{[C2,C1|Bef],Aft},[{put_chars, unicode,[C1,C2]},{move_rel,-Len}|Rs]};
do_op(kill_word, Bef, Aft0, Rs) ->
{Aft1,Kill0,N0} = over_non_word(Aft0, [], 0),
{Aft,Kill,N} = over_word(Aft1, Kill0, N0),
@@ -381,7 +393,7 @@ do_op(backward_kill_word, Bef0, Aft, Rs) ->
{{Bef,Aft},[{delete_chars,-N}|Rs]};
do_op(kill_line, Bef, Aft, Rs) ->
put(kill_buffer, Aft),
- {{Bef,[]},[{delete_chars,length(Aft)}|Rs]};
+ {{Bef,[]},[{delete_chars,cp_len(Aft)}|Rs]};
do_op(yank, Bef, [], Rs) ->
Kill = get(kill_buffer),
{{reverse(Kill, Bef),[]},[{put_chars, unicode,Kill}|Rs]};
@@ -389,9 +401,9 @@ do_op(yank, Bef, Aft, Rs) ->
Kill = get(kill_buffer),
{{reverse(Kill, Bef),Aft},[{insert_chars, unicode,Kill}|Rs]};
do_op(forward_char, Bef, [C|Aft], Rs) ->
- {{[C|Bef],Aft},[{move_rel,1}|Rs]};
+ {{[C|Bef],Aft},[{move_rel,gc_len(C)}|Rs]};
do_op(backward_char, [C|Bef], Aft, Rs) ->
- {{Bef,[C|Aft]},[{move_rel,-1}|Rs]};
+ {{Bef,[C|Aft]},[{move_rel,-gc_len(C)}|Rs]};
do_op(forward_word, Bef0, Aft0, Rs) ->
{Aft1,Bef1,N0} = over_non_word(Aft0, Bef0, 0),
{Aft,Bef,N} = over_word(Aft1, Bef1, N0),
@@ -401,16 +413,16 @@ do_op(backward_word, Bef0, Aft0, Rs) ->
{Bef,Aft,N} = over_word(Bef1, Aft1, N0),
{{Bef,Aft},[{move_rel,-N}|Rs]};
do_op(beginning_of_line, [C|Bef], Aft, Rs) ->
- {{[],reverse(Bef, [C|Aft])},[{move_rel,-(length(Bef)+1)}|Rs]};
+ {{[],reverse(Bef, [C|Aft])},[{move_rel,-(cp_len(Bef)+1)}|Rs]};
do_op(beginning_of_line, [], Aft, Rs) ->
{{[],Aft},Rs};
do_op(end_of_line, Bef, [C|Aft], Rs) ->
- {{reverse(Aft, [C|Bef]),[]},[{move_rel,length(Aft)+1}|Rs]};
+ {{reverse(Aft, [C|Bef]),[]},[{move_rel,cp_len(Aft)+1}|Rs]};
do_op(end_of_line, Bef, [], Rs) ->
{{Bef,[]},Rs};
do_op(ctlu, Bef, Aft, Rs) ->
put(kill_buffer, reverse(Bef)),
- {{[], Aft}, [{delete_chars, -length(Bef)} | Rs]};
+ {{[], Aft}, [{delete_chars, -cp_len(Bef)} | Rs]};
do_op(beep, Bef, Aft, Rs) ->
{{Bef,Aft},[beep|Rs]};
do_op(_, Bef, Aft, Rs) ->
@@ -436,7 +448,7 @@ over_word(Cs, Stack, N) ->
until_quote([$\'|Cs], Stack, N) ->
{Cs, [$\'|Stack], N+1};
until_quote([C|Cs], Stack, N) ->
- until_quote(Cs, [C|Stack], N+1).
+ until_quote(Cs, [C|Stack], N+gc_len(C)).
over_word1([$\'=C|Cs], Stack, N) ->
until_quote(Cs, [C|Stack], N+1);
@@ -445,7 +457,7 @@ over_word1(Cs, Stack, N) ->
over_word2([C|Cs], Stack, N) ->
case word_char(C) of
- true -> over_word2(Cs, [C|Stack], N+1);
+ true -> over_word2(Cs, [C|Stack], N+gc_len(C));
false -> {[C|Cs],Stack,N}
end;
over_word2([], Stack, N) when is_integer(N) ->
@@ -454,7 +466,7 @@ over_word2([], Stack, N) when is_integer(N) ->
over_non_word([C|Cs], Stack, N) ->
case word_char(C) of
true -> {[C|Cs],Stack,N};
- false -> over_non_word(Cs, [C|Stack], N+1)
+ false -> over_non_word(Cs, [C|Stack], N+gc_len(C))
end;
over_non_word([], Stack, N) ->
{[],Stack,N}.
@@ -465,6 +477,7 @@ word_char(C) when C >= $a, C =< $z -> true;
word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true;
word_char(C) when C >= $0, C =< $9 -> true;
word_char(C) when C =:= $_ -> true;
+word_char([_|_]) -> true; %% Is grapheme
word_char(_) -> false.
%% over_white(Chars, InitialStack, InitialCount) ->
@@ -488,8 +501,8 @@ over_paren(Chars, Paren, Match) ->
over_paren([C,$$,$$|Cs], Paren, Match, D, N, L) ->
over_paren([C|Cs], Paren, Match, D, N+2, L);
-over_paren([_,$$|Cs], Paren, Match, D, N, L) ->
- over_paren(Cs, Paren, Match, D, N+2, L);
+over_paren([GC,$$|Cs], Paren, Match, D, N, L) ->
+ over_paren(Cs, Paren, Match, D, N+1+gc_len(GC), L);
over_paren([Match|_], _Paren, Match, 1, N, _) ->
N;
over_paren([Match|Cs], Paren, Match, D, N, [Match|L]) ->
@@ -518,8 +531,8 @@ over_paren([$[|_], _, _, _, _, _) ->
over_paren([${|_], _, _, _, _, _) ->
beep;
-over_paren([_|Cs], Paren, Match, D, N, L) ->
- over_paren(Cs, Paren, Match, D, N+1, L);
+over_paren([GC|Cs], Paren, Match, D, N, L) ->
+ over_paren(Cs, Paren, Match, D, N+gc_len(GC), L);
over_paren([], _, _, _, _, _) ->
0.
@@ -529,8 +542,8 @@ over_paren_auto(Chars) ->
over_paren_auto([C,$$,$$|Cs], D, N, L) ->
over_paren_auto([C|Cs], D, N+2, L);
-over_paren_auto([_,$$|Cs], D, N, L) ->
- over_paren_auto(Cs, D, N+2, L);
+over_paren_auto([GC,$$|Cs], D, N, L) ->
+ over_paren_auto(Cs, D, N+1+gc_len(GC), L);
over_paren_auto([$(|_], _, N, []) ->
{N, $)};
@@ -553,8 +566,8 @@ over_paren_auto([$[|Cs], D, N, [$[|L]) ->
over_paren_auto([${|Cs], D, N, [${|L]) ->
over_paren_auto(Cs, D, N+1, L);
-over_paren_auto([_|Cs], D, N, L) ->
- over_paren_auto(Cs, D, N+1, L);
+over_paren_auto([GC|Cs], D, N, L) ->
+ over_paren_auto(Cs, D, N+gc_len(GC), L);
over_paren_auto([], _, _, _) ->
0.
@@ -574,28 +587,43 @@ erase_inp({line,_,{Bef,Aft},_}) ->
reverse(erase([], Bef, Aft, [])).
erase(Pbs, Bef, Aft, Rs) ->
- [{delete_chars,-length(Pbs)-length(Bef)},{delete_chars,length(Aft)}|Rs].
+ [{delete_chars,-cp_len(Pbs)-cp_len(Bef)},{delete_chars,cp_len(Aft)}|Rs].
redraw_line({line,Pbs,{Bef,Aft},_}) ->
reverse(redraw(Pbs, Bef, Aft, [])).
redraw(Pbs, Bef, Aft, Rs) ->
- [{move_rel,-length(Aft)},{put_chars, unicode,reverse(Bef, Aft)},{put_chars, unicode,Pbs}|Rs].
+ [{move_rel,-cp_len(Aft)},{put_chars, unicode,reverse(Bef, Aft)},{put_chars, unicode,Pbs}|Rs].
length_before({line,Pbs,{Bef,_Aft},_}) ->
- length(Pbs) + length(Bef).
+ cp_len(Pbs) + cp_len(Bef).
length_after({line,_,{_Bef,Aft},_}) ->
- length(Aft).
+ cp_len(Aft).
prompt({line,Pbs,_,_}) ->
Pbs.
current_line({line,_,{Bef, Aft},_}) ->
- reverse(Bef, Aft ++ "\n").
+ get_line(Bef, Aft ++ "\n").
current_chars({line,_,{Bef,Aft},_}) ->
- reverse(Bef, Aft).
+ get_line(Bef, Aft).
+
+get_line(Bef, Aft) ->
+ unicode:characters_to_list(reverse(Bef, Aft)).
+
+%% Grapheme length in codepoints
+gc_len(CP) when is_integer(CP) -> 1;
+gc_len(CPs) when is_list(CPs) -> length(CPs).
+
+%% String length in codepoints
+cp_len(Str) ->
+ cp_len(Str, 0).
+
+cp_len([GC|R], Len) ->
+ cp_len(R, Len + gc_len(GC));
+cp_len([], Len) -> Len.
%% %% expand(CurrentBefore) ->
%% %% {yes,Expansion} | no
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index fcfd0d8493..65ba343368 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -194,8 +194,6 @@ format_error({bad_nowarn_bif_clash,{F,A}}) ->
format_error(disallowed_nowarn_bif_clash) ->
io_lib:format("compile directive nowarn_bif_clash is no longer allowed,~n"
" - use explicit module names or -compile({no_auto_import, [F/A]})", []);
-format_error({bad_nowarn_deprecated_function,{M,F,A}}) ->
- io_lib:format("~tw:~tw/~w is not a deprecated function", [M,F,A]);
format_error({bad_on_load,Term}) ->
io_lib:format("badly formed on_load attribute: ~tw", [Term]);
format_error(multiple_on_loads) ->
@@ -856,14 +854,11 @@ not_deprecated(Forms, St0) ->
{nowarn_deprecated_function, MFAs0} <- lists:flatten([Args]),
MFA <- lists:flatten([MFAs0])],
Nowarn = [MFA || {MFA,_L} <- MFAsL],
- Bad = [MFAL || {{M,F,A},_L}=MFAL <- MFAsL,
- otp_internal:obsolete(M, F, A) =:= no],
- St1 = func_line_warning(bad_nowarn_deprecated_function, Bad, St0),
ML = [{M,L} || {{M,_F,_A},L} <- MFAsL, is_atom(M)],
- St3 = foldl(fun ({M,L}, St2) ->
+ St1 = foldl(fun ({M,L}, St2) ->
check_module_name(M, L, St2)
- end, St1, ML),
- St3#lint{not_deprecated = ordsets:from_list(Nowarn)}.
+ end, St0, ML),
+ St1#lint{not_deprecated = ordsets:from_list(Nowarn)}.
%% The nowarn_bif_clash directive is not only deprecated, it's actually an error from R14A
disallowed_compile_flags(Forms, St0) ->
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 9e9c0dc413..c59db903dc 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -63,9 +63,9 @@ obsolete_1(gen_fsm, start, 4) ->
{deprecated, {gen_statem, start, 4}};
obsolete_1(gen_fsm, start_link, 3) ->
- {deprecated, {gen_statem, start, 3}};
+ {deprecated, {gen_statem, start_link, 3}};
obsolete_1(gen_fsm, start_link, 4) ->
- {deprecated, {gen_statem, start, 4}};
+ {deprecated, {gen_statem, start_link, 4}};
obsolete_1(gen_fsm, stop, 1) ->
{deprecated, {gen_statem, stop, 1}};
@@ -83,9 +83,9 @@ obsolete_1(gen_fsm, reply, 2) ->
{deprecated, {gen_statem, reply, 2}};
obsolete_1(gen_fsm, send_event, 2) ->
- {deprecated, {gen_statem, cast, 1}};
+ {deprecated, {gen_statem, cast, 2}};
obsolete_1(gen_fsm, send_all_state_event, 2) ->
- {deprecated, {gen_statem, cast, 1}};
+ {deprecated, {gen_statem, cast, 2}};
obsolete_1(gen_fsm, sync_send_event, 2) ->
{deprecated, {gen_statem, call, 2}};
@@ -98,11 +98,11 @@ obsolete_1(gen_fsm, sync_send_all_state_event, 3) ->
{deprecated, {gen_statem, call, 3}};
obsolete_1(gen_fsm, start_timer, 2) ->
- {deprecated, {erlang, start_timer, 2}};
+ {deprecated, {erlang, start_timer, 3}};
obsolete_1(gen_fsm, cancel_timer, 1) ->
{deprecated, {erlang, cancel_timer, 1}};
obsolete_1(gen_fsm, send_event_after, 2) ->
- {deprecated, {erlang, send_after, 2}};
+ {deprecated, {erlang, send_after, 3}};
%% *** CRYPTO added in OTP 20 ***
@@ -112,7 +112,7 @@ obsolete_1(crypto, rand_uniform, 2) ->
%% *** CRYPTO added in OTP 19 ***
obsolete_1(crypto, rand_bytes, 1) ->
- {deprecated, {crypto, strong_rand_bytes, 1}};
+ {removed, {crypto, strong_rand_bytes, 1}, "20.0"};
%% *** CRYPTO added in R16B01 ***
@@ -485,10 +485,6 @@ obsolete_1(wxPaintDC, new, 0) ->
{deprecated,"deprecated function not available in wxWidgets-2.9 and later"};
obsolete_1(wxWindowDC, new, 0) ->
{deprecated,"deprecated function not available in wxWidgets-2.9 and later"};
-obsolete_1(wxGraphicsContext, createLinearGradientBrush, 7) ->
- {deprecated,"deprecated function not available in wxWidgets-2.9 and later"};
-obsolete_1(wxGraphicsContext, createRadialGradientBrush, 8) ->
- {deprecated,"deprecated function not available in wxWidgets-2.9 and later"};
obsolete_1(wxGraphicsRenderer, createLinearGradientBrush, 7) ->
{deprecated,"deprecated function not available in wxWidgets-2.9 and later"};
obsolete_1(wxGraphicsRenderer, createRadialGradientBrush, 8) ->
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index 6eafc7b209..26b3960f4f 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -727,7 +727,7 @@ result_will_be_saved() ->
used_record_defs(E, RT) ->
%% Be careful to return a list where used records come before
%% records that use them. The linter wants them ordered that way.
- UR = case used_records(E, [], RT) of
+ UR = case used_records(E, [], RT, []) of
[] ->
[];
L0 ->
@@ -737,13 +737,19 @@ used_record_defs(E, RT) ->
end,
record_defs(RT, UR).
-used_records(E, U0, RT) ->
+used_records(E, U0, RT, Skip) ->
case used_records(E) of
{name,Name,E1} ->
- U = used_records(ets:lookup(RT, Name), [Name | U0], RT),
- used_records(E1, U, RT);
+ U = case lists:member(Name, Skip) of
+ true ->
+ U0;
+ false ->
+ R = ets:lookup(RT, Name),
+ used_records(R, [Name | U0], RT, [Name | Skip])
+ end,
+ used_records(E1, U, RT, Skip);
{expr,[E1 | Es]} ->
- used_records(Es, used_records(E1, U0, RT), RT);
+ used_records(Es, used_records(E1, U0, RT, Skip), RT, Skip);
_ ->
U0
end.
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index 6a75eaa737..cb1cceb8db 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -66,7 +66,7 @@
otp_11851/1,otp_11879/1,otp_13230/1,
record_errors/1, otp_11879_cont/1,
non_latin1_module/1, otp_14323/1,
- get_stacktrace/1, otp_14285/1]).
+ get_stacktrace/1, otp_14285/1, otp_14378/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -87,7 +87,7 @@ all() ->
maps, maps_type, maps_parallel_match,
otp_11851, otp_11879, otp_13230,
record_errors, otp_11879_cont, non_latin1_module, otp_14323,
- get_stacktrace, otp_14285].
+ get_stacktrace, otp_14285, otp_14378].
groups() ->
[{unused_vars_warn, [],
@@ -2054,12 +2054,10 @@ otp_5362(Config) when is_list(Config) ->
spawn(A).
">>,
{[nowarn_unused_function]},
- {error,[{3,erl_lint,disallowed_nowarn_bif_clash},
- {4,erl_lint,disallowed_nowarn_bif_clash},
- {4,erl_lint,{bad_nowarn_bif_clash,{spawn,2}}}],
- [{5,erl_lint,{bad_nowarn_deprecated_function,{3,now,-1}}},
- {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,now,-1}}},
- {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},now,-1}}}]}
+ {errors,[{3,erl_lint,disallowed_nowarn_bif_clash},
+ {4,erl_lint,disallowed_nowarn_bif_clash},
+ {4,erl_lint,{bad_nowarn_bif_clash,{spawn,2}}}],
+ []}
},
{otp_5362_8,
@@ -3937,10 +3935,6 @@ non_latin1_module(Config) ->
UndefBehav = {undefined_behaviour,'кирилли́ческий атом'},
"behaviour 'кирилли́ческий атом' undefined" =
format_error(UndefBehav),
- BadDepr = {bad_nowarn_deprecated_function,
- {'кирилли́ческий атом','кирилли́ческий атом',18}},
- "'кирилли́ческий атом':'кирилли́ческий атом'/18 is not a deprecated "
- "function" = format_error(BadDepr),
Ts = [{non_latin1_module,
<<"
%% Report uses of module names with non-Latin-1 characters.
@@ -3951,9 +3945,6 @@ non_latin1_module(Config) ->
-callback 'кирилли́ческий атом':'кирилли́ческий атом'() -> a.
- -compile([{nowarn_deprecated_function,
- [{'кирилли́ческий атом','кирилли́ческий атом',18}]}]).
-
%% erl_lint:gexpr/3 is not extended to check module name here:
t1() when 'кирилли́ческий атом':'кирилли́ческий атом'(1) ->
b.
@@ -3977,16 +3968,14 @@ non_latin1_module(Config) ->
{6,erl_lint,non_latin1_module_unsupported},
{8,erl_lint,non_latin1_module_unsupported},
{8,erl_lint,BadCallback},
- {10,erl_lint,non_latin1_module_unsupported},
- {14,erl_lint,illegal_guard_expr},
- {18,erl_lint,non_latin1_module_unsupported},
+ {11,erl_lint,illegal_guard_expr},
+ {15,erl_lint,non_latin1_module_unsupported},
+ {17,erl_lint,non_latin1_module_unsupported},
{20,erl_lint,non_latin1_module_unsupported},
{23,erl_lint,non_latin1_module_unsupported},
- {26,erl_lint,non_latin1_module_unsupported},
- {28,erl_lint,non_latin1_module_unsupported}],
+ {25,erl_lint,non_latin1_module_unsupported}],
[{5,erl_lint,UndefBehav},
- {6,erl_lint,UndefBehav},
- {10,erl_lint,BadDepr}]}}],
+ {6,erl_lint,UndefBehav}]}}],
run(Config, Ts),
ok.
@@ -4000,6 +3989,22 @@ do_non_latin1_module(Mod) ->
ok.
+otp_14378(Config) ->
+ Ts = [
+ {otp_14378_1,
+ <<"-export([t/0]).
+ -compile({nowarn_deprecated_function,{erlang,now,1}}).
+ t() ->
+ erlang:now().">>,
+ [],
+ {warnings,[{4,erl_lint,
+ {deprecated,{erlang,now,0},
+ "Deprecated BIF. See the \"Time and Time Correction"
+ " in Erlang\" chapter of the ERTS User's Guide"
+ " for more information."}}]}}],
+ [] = run(Config, Ts),
+ ok.
+
%% OTP-14323: Check the dialyzer attribute.
otp_14323(Config) ->
Ts = [
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index 4f0fdc4c6a..217e8cc252 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -31,7 +31,7 @@
progex_lc/1, progex_funs/1,
otp_5990/1, otp_6166/1, otp_6554/1,
otp_7184/1, otp_7232/1, otp_8393/1, otp_10302/1, otp_13719/1,
- otp_14285/1, otp_14296/1]).
+ otp_14285/1, otp_14296/1, typed_records/1]).
-export([ start_restricted_from_shell/1,
start_restricted_on_command_line/1,restricted_local/1]).
@@ -74,10 +74,10 @@ suite() ->
{timetrap,{minutes,10}}].
all() ->
- [forget, records, known_bugs, otp_5226, otp_5327,
+ [forget, known_bugs, otp_5226, otp_5327,
otp_5435, otp_5195, otp_5915, otp_5916, {group, bits},
{group, refman}, {group, progex}, {group, tickets},
- {group, restricted}].
+ {group, restricted}, {group, records}].
groups() ->
[{restricted, [],
@@ -86,6 +86,8 @@ groups() ->
{bits, [],
[bs_match_misc_SUITE, bs_match_tail_SUITE,
bs_match_bin_SUITE, bs_construct_SUITE]},
+ {records, [],
+ [records, typed_records]},
{refman, [], [refman_bit_syntax]},
{progex, [],
[progex_bit_syntax, progex_records, progex_lc,
@@ -486,6 +488,48 @@ records(Config) when is_list(Config) ->
ok.
+%% Test of typed record support.
+typed_records(Config) when is_list(Config) ->
+ Test = filename:join(proplists:get_value(priv_dir, Config), "test.hrl"),
+ Contents = <<"-module(test).
+ -record(r0,{f :: any()}).
+ -record(r1,{f1 :: #r1{} | undefined, f2 :: #r0{} | atom()}).
+ -record(r2,{f :: #r2{} | undefined}).
+ ">>,
+ ok = file:write_file(Test, Contents),
+
+ RR1 = "rr(\"" ++ Test ++ "\"),
+ #r1{} = (#r1{f1=#r1{f1=undefined, f2=x}, f2 = #r0{}})#r1.f1,
+ ok.",
+ RR2 = "rr(\"" ++ Test ++ "\"),
+ #r0{} = (#r1{f1=#r1{f1=undefined, f2=x}, f2 = #r0{}})#r1.f2,
+ ok. ",
+ RR3 = "rr(\"" ++ Test ++ "\"),
+ #r1{f2=#r0{}} = (#r1{f1=#r1{f1=undefined, f2=#r0{}}, f2 = x})#r1.f1,
+ ok.",
+ RR4 = "rr(\"" ++ Test ++ "\"),
+ (#r1{f2 = #r0{}})#r1{f2 = x},
+ ok. ",
+ RR5 = "rr(\"" ++ Test ++ "\"),
+ (#r1{f2 = #r0{}})#r1{f1 = #r1{}},
+ ok. ",
+ RR6 = "rr(\"" ++ Test ++ "\"),
+ (#r2{f=#r2{f=undefined}})#r2.f,
+ ok.",
+ RR7 = "rr(\"" ++ Test ++ "\"),
+ #r2{} = (#r2{f=#r2{f=undefined}})#r2.f,
+ ok.",
+ [ok] = scan(RR1),
+ [ok] = scan(RR2),
+ [ok] = scan(RR3),
+ [ok] = scan(RR4),
+ [ok] = scan(RR5),
+ [ok] = scan(RR6),
+ [ok] = scan(RR7),
+
+ file:delete(Test),
+ ok.
+
%% Known bugs.
known_bugs(Config) when is_list(Config) ->
%% erl_eval:merge_bindings/2 cannot handle _removal_ of bindings.
diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl
index 1ca60ea73b..888cb71f51 100644
--- a/lib/syntax_tools/src/erl_tidy.erl
+++ b/lib/syntax_tools/src/erl_tidy.erl
@@ -301,6 +301,8 @@ file(Name, Opts) ->
{Child, ok} ->
ok;
{Child, {error, Reason}} ->
+ exit(Reason);
+ {'EXIT', Child, Reason} ->
exit(Reason)
end.
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl
index 868f43b8ee..ae2c67c03e 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl
@@ -239,6 +239,12 @@ t_erl_tidy(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
File = filename:join(DataDir,"erl_tidy_tilde.erl"),
ok = erl_tidy:file(File, [{stdout, true}]),
+
+ %% OTP-14471.
+ Old = process_flag(trap_exit, true),
+ NonExisting = filename:join(DataDir,"non_existing_file.erl"),
+ {'EXIT',{error,{0,file,enoent}}} = (catch erl_tidy:file(NonExisting)),
+ true = process_flag(trap_exit, Old),
ok.
test_comment_scan([],_) -> ok;
diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml
index 31e5c241e9..922c2ac0f4 100644
--- a/lib/tools/doc/src/lcnt.xml
+++ b/lib/tools/doc/src/lcnt.xml
@@ -109,14 +109,6 @@
statistics. If the server held any lock statistics data before the collect then
that data is lost.
</p>
- <note>
- <p>
- When collection occurs the runtime system transitions to a single thread,
- blocking all other threads. No other tasks will be scheduled during this
- operation. Depending on the size of the data this might take a long time
- (several seconds) and cause timeouts in the system.
- </p>
- </note>
</desc>
</func>
@@ -322,24 +314,22 @@
<func>
<name>apply(Fun) -> term()</name>
<fsummary>Same as <c>apply(Fun, [])</c>.</fsummary>
+ <type>
+ <v>Fun = fun()</v>
+ </type>
<desc>
<p>Same as <c>apply(Fun, [])</c>.</p>
</desc>
</func>
<func>
<name>apply(Fun, Args) -> term()</name>
- <fsummary>Clears counters, applies function and collects the profiling results.</fsummary>
+ <fsummary>Same as <c>apply(Module, Function, Args)</c>.</fsummary>
<type>
<v>Fun = fun()</v>
<v>Args = [term()]</v>
</type>
<desc>
- <p> Clears the lock counters and then setups the instrumentation to save all destroyed locks.
- After setup the fun is called, passing the elements in <c>Args</c> as arguments.
- When the fun returns the statistics are immediately collected to the server. After the
- collection the instrumentation is returned to its previous behavior.
- The result of the applied fun is returned.
- </p>
+ <p>Same as <c>apply(Module, Function, Args)</c>.</p>
</desc>
</func>
<func>
@@ -357,6 +347,13 @@
collection the instrumentation is returned to its previous behavior.
The result of the applied function is returned.
</p>
+ <warning>
+ <p>
+ This function should only be used for micro-benchmarks; it sets <c>copy_save</c>
+ to <c>true</c> for the duration of the call, which can quickly lead to running
+ out of memory.
+ </p>
+ </warning>
</desc>
</func>
@@ -429,6 +426,68 @@
<desc> <p>Clear the internal counters. Same as <c>lcnt:clear(Node)</c>.</p></desc>
</func>
+ <func>
+ <name>rt_mask() -> [category_atom()]</name>
+ <fsummary>Same as <c>rt_mask(node())</c>.</fsummary>
+ <desc><p>Same as <c>rt_mask(node())</c>.</p></desc>
+ </func>
+
+ <func>
+ <name>rt_mask(Node) -> [category_atom()]</name>
+ <fsummary>Returns the current lock category mask.</fsummary>
+ <type>
+ <v>Node = node()</v>
+ </type>
+ <desc>
+ <p>
+ Refer to <c>rt_mask/2</c> for a list of valid categories. All
+ categories are enabled by default.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>rt_mask(Categories) -> ok | {error, copy_save_enabled}</name>
+ <fsummary>Same as <c>rt_mask(node(), Categories)</c>.</fsummary>
+ <type>
+ <v>Categories = [atom()]</v>
+ </type>
+ <desc><p>Same as <c>rt_mask(node(), Categories)</c>.</p></desc>
+ </func>
+
+ <func>
+ <name>rt_mask(Node, Categories) -> ok | {error, copy_save_enabled}</name>
+ <fsummary>Changes the lock category mask.</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Categories = [atom()]</v>
+ </type>
+ <desc>
+ <p>
+ Sets the lock category mask to the given categories.
+ </p>
+ <p>
+ This will fail if the <c>copy_save</c> option is enabled; see
+ <c>lcnt:rt_opt/2</c>.
+ </p>
+ <p>Valid categories are:</p>
+ <taglist>
+ <item><c>allocator</c></item>
+ <item><c>db</c> (ETS tables)</item>
+ <item><c>debug</c></item>
+ <item><c>distribution</c></item>
+ <item><c>generic</c></item>
+ <item><c>io</c></item>
+ <item><c>process</c></item>
+ <item><c>scheduler</c></item>
+ </taglist>
+ <p>
+ This list is subject to change at any time, as is the category any given lock
+ may belong to.
+ </p>
+ </desc>
+ </func>
+
<func>
<name>rt_opt({Type, bool()}) -> bool()</name>
<fsummary>Same as <c>rt_opt(node(), {Type, Opt})</c>.</fsummary>
@@ -442,16 +501,25 @@
<v>Type = copy_save | process_locks</v>
</type>
<desc>
- <p>Changes the lock counter behavior and returns the previous behaviour.</p>
<p>Option description:</p>
<taglist>
<tag><c>{copy_save, bool()}</c></tag>
- <item>Enable statistics saving from destroyed locks by copying. This might consume a lot of memory.
+ <item>Retains the statistics of destroyed locks.
<br/>Default: <c>false</c>
+ <warning>
+ <p>
+ This option will use a lot of memory when enabled, which must be
+ reclaimed with <c>lcnt:rt_clear</c>. Note that it makes no distinction
+ between locks that were destroyed and locks for which counting was
+ disabled, so enabling this option will disable changes to the lock
+ category mask.
+ </p>
+ </warning>
</item>
<tag><c>{process_locks, bool()}</c></tag>
- <item>Profile process locks.
+ <item>Profile process locks, equal to adding <c>process</c> to the lock category mask;
+ see <c>lcnt:rt_mask/2</c>
<br/>Default: <c>true</c>
</item>
</taglist>
diff --git a/lib/tools/doc/src/lcnt_chapter.xml b/lib/tools/doc/src/lcnt_chapter.xml
index c73fcb31e0..24b58136aa 100644
--- a/lib/tools/doc/src/lcnt_chapter.xml
+++ b/lib/tools/doc/src/lcnt_chapter.xml
@@ -29,7 +29,7 @@
<approved>nobody</approved>
<checked>no</checked>
<date>2009-11-26</date>
- <rev>PA1</rev>
+ <rev>PA2</rev>
<file>lcnt_chapter.xml</file>
</header>
<p>
@@ -97,8 +97,11 @@ ok
ok
</pre>
<p>
- Another way to to profile a specific function is to use <c>lcnt:apply/3</c> or <c>lcnt:apply/1</c> which does <c>lcnt:clear/0</c> before the function and <c>lcnt:collect/0</c> after its invocation.
- It also sets <c>copy_save</c> to <c>true</c> for the duration of the function call
+ Another way to to profile a specific function is to use <c>lcnt:apply/3</c> or <c>lcnt:apply/1</c>
+ which does <c>lcnt:clear/0</c> before the function and <c>lcnt:collect/0</c> after its invocation.
+ This method should only be used in micro-benchmarks since it sets <c>copy_save</c> to <c>true</c>
+ for the duration of the function call, which may cause the emulator to run out of memory if
+ attempted under load.
</p>
<pre>
Erlang R13B03 (erts-5.7.4) [source] [smp:8:8] [rq:8] [async-threads:0] [hipe]
diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl
index d881fedbd5..139b3d8a4a 100644
--- a/lib/tools/src/lcnt.erl
+++ b/lib/tools/src/lcnt.erl
@@ -34,8 +34,11 @@
-export([start/0,
stop/0]).
-%% erts_debug:lock_counters api
--export([rt_collect/0,
+%% erts_debug:lcnt_xxx api
+-export([rt_mask/0,
+ rt_mask/1,
+ rt_mask/2,
+ rt_collect/0,
rt_collect/1,
rt_clear/0,
rt_clear/1,
@@ -134,27 +137,61 @@ start_internal() ->
%% -------------------------------------------------------------------- %%
%%
-%% API erts_debug:lock_counters
+%% API erts_debug:lcnt_xxx
%%
%% -------------------------------------------------------------------- %%
-rt_collect() ->
- erts_debug:lock_counters(info).
+rt_mask(Node, Categories) when is_atom(Node), is_list(Categories) ->
+ rpc:call(Node, lcnt, rt_mask, [Categories]).
+
+rt_mask(Node) when is_atom(Node) ->
+ rpc:call(Node, lcnt, rt_mask, []);
+
+rt_mask(Categories) when is_list(Categories) ->
+ case erts_debug:lcnt_control(copy_save) of
+ false ->
+ erts_debug:lcnt_control(mask, Categories);
+ true ->
+ {error, copy_save_enabled}
+ end.
+
+rt_mask() ->
+ erts_debug:lcnt_control(mask).
rt_collect(Node) ->
- rpc:call(Node, erts_debug, lock_counters, [info]).
+ rpc:call(Node, lcnt, rt_collect, []).
+rt_collect() ->
+ erts_debug:lcnt_collect().
+rt_clear(Node) ->
+ rpc:call(Node, lcnt, rt_clear, []).
rt_clear() ->
- erts_debug:lock_counters(clear).
+ erts_debug:lcnt_clear().
-rt_clear(Node) ->
- rpc:call(Node, erts_debug, lock_counters, [clear]).
+rt_opt(Node, Arg) ->
+ rpc:call(Node, lcnt, rt_opt, [Arg]).
-rt_opt({Type, Opt}) ->
- erts_debug:lock_counters({Type, Opt}).
+%% Compatibility shims for the "process/port_locks" options mentioned in the
+%% manual.
+rt_opt({process_locks, Enable}) ->
+ toggle_category(process, Enable);
+rt_opt({port_locks, Enable}) ->
+ toggle_category(io, Enable);
-rt_opt(Node, {Type, Opt}) ->
- rpc:call(Node, erts_debug, lock_counters, [{Type, Opt}]).
+rt_opt({Type, NewVal}) ->
+ PreviousVal = erts_debug:lcnt_control(Type),
+ erts_debug:lcnt_control(Type, NewVal),
+ PreviousVal.
+
+toggle_category(Category, true) ->
+ PreviousMask = erts_debug:lcnt_control(mask),
+ erts_debug:lcnt_control(mask, [Category | PreviousMask]),
+ lists:member(Category, PreviousMask);
+
+toggle_category(Category, false) ->
+ PreviousMask = erts_debug:lcnt_control(mask),
+ erts_debug:lcnt_control(mask, lists:delete(Category, PreviousMask)),
+ lists:member(Category, PreviousMask).
%% -------------------------------------------------------------------- %%
%%
@@ -192,13 +229,9 @@ call(Msg) -> gen_server:call(?MODULE, Msg, infinity).
%% -------------------------------------------------------------------- %%
apply(M,F,As) when is_atom(M), is_atom(F), is_list(As) ->
- ok = start_internal(),
- Opt = lcnt:rt_opt({copy_save, true}),
- lcnt:clear(),
- Res = erlang:apply(M,F,As),
- lcnt:collect(),
- lcnt:rt_opt({copy_save, Opt}),
- Res.
+ apply(fun() ->
+ erlang:apply(M,F,As)
+ end).
apply(Fun) when is_function(Fun) ->
lcnt:apply(Fun, []).
@@ -209,7 +242,9 @@ apply(Fun, As) when is_function(Fun) ->
lcnt:clear(),
Res = erlang:apply(Fun, As),
lcnt:collect(),
- lcnt:rt_opt({copy_save, Opt}),
+ %% _ is bound to silence a dialyzer warning; it used to fail silently and
+ %% we don't want to change the error semantics.
+ _ = lcnt:rt_opt({copy_save, Opt}),
Res.
all_conflicts() -> all_conflicts(time).
diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src
index 12f0cfd2df..8beef49bf9 100644
--- a/lib/tools/src/tools.app.src
+++ b/lib/tools/src/tools.app.src
@@ -41,6 +41,6 @@
]
},
{runtime_dependencies, ["stdlib-3.1","runtime_tools-1.8.14",
- "kernel-3.0","erts-7.0","compiler-5.0"]}
+ "kernel-5.4","erts-9.1","compiler-5.0"]}
]
}.
diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl
index af3ce88fdd..146c915087 100644
--- a/lib/tools/test/lcnt_SUITE.erl
+++ b/lib/tools/test/lcnt_SUITE.erl
@@ -151,10 +151,9 @@ t_swap_keys_file([File|Files]) ->
%% Simple smoke test of actual lock-counting, if running on
%% a run-time with lock-counting enabled.
-
smoke_lcnt(Config) ->
- case erlang:system_info(build_type) of
- lcnt ->
+ case catch erlang:system_info(lock_counting) of
+ true ->
do_smoke_lcnt(Config);
_ ->
{skip,"Lock counting is not enabled"}
diff --git a/lib/wx/api_gen/README b/lib/wx/api_gen/README
index dd0c49d227..200ef4c856 100644
--- a/lib/wx/api_gen/README
+++ b/lib/wx/api_gen/README
@@ -3,12 +3,13 @@ API GENERATION:
Users of wxErlang should not normally need to regenerate the generated code,
as it is checked in by wxErlang developers, when changes are made.
- Code checked in is currently generated from wxwidgets 2.8.10.
+ Code checked in is currently generated from wxwidgets 2.8.12.
REQUIREMENTS:
The code generation requires doxygen (1.4.6) which is
used to parse wxWidgets c++ headers and generate xml files (in
wx_xml/).
+ 2017-08-16 doxygen 1.8.11 is working with WXGTK_DIR=/ldisk/src/wxWidgets-2.8.12/include
2012-02-09 doxygen 1.7.4 is working fine
diff --git a/lib/wx/api_gen/wx_doxygen.conf b/lib/wx/api_gen/wx_doxygen.conf
index a96db00254..d6a0e9e6a1 100644
--- a/lib/wx/api_gen/wx_doxygen.conf
+++ b/lib/wx/api_gen/wx_doxygen.conf
@@ -71,12 +71,12 @@ WARN_LOGFILE =
#---------------------------------------------------------------------------
# configuration options related to the input files
#---------------------------------------------------------------------------
-INPUT = @WXGTK_DIR@/wx/ wx_extra/
+INPUT = @WXGTK_DIR@/wx/ @WXGTK_DIR@/../contrib/include/wx/stc/ wx_extra/
# FILE_PATTERNS = *.h
RECURSIVE = YES
EXCLUDE =
EXCLUDE_SYMLINKS = NO
-EXCLUDE_PATTERNS = mac/* mgl/* msw/* os2/* x11/* gtk1/* cocoa/* motif/* msdos/* palmos/* private/* vms_x_fix.h
+EXCLUDE_PATTERNS = */mac/* */dfb/* */mgl/* */msw/* */os2/* */x11/* */gtk1/* */cocoa/* */motif/* */msdos/* */palmos/* */private/* */univ/* */vms_x_fix.h
EXAMPLE_PATH =
EXAMPLE_PATTERNS =
EXAMPLE_RECURSIVE = NO
@@ -155,8 +155,6 @@ MAN_LINKS = NO
#---------------------------------------------------------------------------
GENERATE_XML = YES
XML_OUTPUT = ./wx_xml/
-XML_SCHEMA =
-XML_DTD =
XML_PROGRAMLISTING = NO
#---------------------------------------------------------------------------
# configuration options for the AutoGen Definitions output
diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl
index 6979a600f3..aadfe4b111 100644
--- a/lib/wx/api_gen/wx_gen.erl
+++ b/lib/wx/api_gen/wx_gen.erl
@@ -501,10 +501,11 @@ parse_member2(_, _,M0) ->
M0.
add_param(InParam, Opts, M0) ->
- Param0 = case InParam#param.name of
- undefined -> InParam#param{name="val"};
+ Param0 = case {InParam#param.name, InParam#param.type} of
+ {undefined, void} -> InParam#param{where=nowhere};
+ {undefined,_} -> InParam#param{name="val"};
_ -> InParam
- end,
+ end,
Param = case Param0#param.type of
#type{base={comp,_,_Comp}} -> Param0;
#type{base={class,_Class}} -> Param0;
diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf
index a0dfa61dd1..146c9fecc7 100644
--- a/lib/wx/api_gen/wxapi.conf
+++ b/lib/wx/api_gen/wxapi.conf
@@ -401,8 +401,8 @@
['~wxGraphicsContext',
'Create', %%CreateFromNative CreateFromNativeWindow
'CreatePen','CreateBrush',
- {'CreateRadialGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]},
- {'CreateLinearGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]},
+ 'CreateRadialGradientBrush',
+ 'CreateLinearGradientBrush',
'CreateFont','CreateMatrix',
'CreatePath','Clip','ResetClip',
'DrawBitmap','DrawEllipse','DrawIcon',
diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp
index 5425e9f3cb..a47d602337 100644
--- a/lib/wx/c_src/gen/wxe_funcs.cpp
+++ b/lib/wx/c_src/gen/wxe_funcs.cpp
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2016. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2017. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -6177,7 +6177,6 @@ case wxGraphicsContext_CreateBrush: { // wxGraphicsContext::CreateBrush
rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush");
break;
}
-#if !wxCHECK_VERSION(2,9,0)
case wxGraphicsContext_CreateRadialGradientBrush: { // wxGraphicsContext::CreateRadialGradientBrush
wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4;
bp += 4; /* Align */
@@ -6201,8 +6200,6 @@ case wxGraphicsContext_CreateRadialGradientBrush: { // wxGraphicsContext::Create
rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush");
break;
}
-#endif
-#if !wxCHECK_VERSION(2,9,0)
case wxGraphicsContext_CreateLinearGradientBrush: { // wxGraphicsContext::CreateLinearGradientBrush
wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4;
bp += 4; /* Align */
@@ -6225,7 +6222,6 @@ case wxGraphicsContext_CreateLinearGradientBrush: { // wxGraphicsContext::Create
rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush");
break;
}
-#endif
case wxGraphicsContext_CreateFont: { // wxGraphicsContext::CreateFont
wxColour col= *wxBLACK;
wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4;
diff --git a/lib/wx/c_src/gen/wxe_macros.h b/lib/wx/c_src/gen/wxe_macros.h
index f44fa57053..4c8e52def2 100644
--- a/lib/wx/c_src/gen/wxe_macros.h
+++ b/lib/wx/c_src/gen/wxe_macros.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2016. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2017. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -1540,10 +1540,10 @@
#define wxStaticBox_destroy 1637
#define wxStaticLine_new_2 1639
#define wxStaticLine_new_0 1640
-#define wxStaticLine_Create 1641
-#define wxStaticLine_IsVertical 1642
-#define wxStaticLine_GetDefaultSize 1643
-#define wxStaticLine_destroy 1644
+#define wxStaticLine_destruct 1641
+#define wxStaticLine_Create 1642
+#define wxStaticLine_IsVertical 1643
+#define wxStaticLine_GetDefaultSize 1644
#define wxListBox_new_3 1647
#define wxListBox_new_0 1648
#define wxListBox_destruct 1650
diff --git a/lib/wx/src/gen/wxGraphicsContext.erl b/lib/wx/src/gen/wxGraphicsContext.erl
index 2d0271ac48..5d371ecd7a 100644
--- a/lib/wx/src/gen/wxGraphicsContext.erl
+++ b/lib/wx/src/gen/wxGraphicsContext.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -41,8 +41,6 @@
-export([getRenderer/1,isNull/1,parent_class/1]).
-export_type([wxGraphicsContext/0]).
--deprecated([createLinearGradientBrush/7,createRadialGradientBrush/8]).
-
%% @hidden
parent_class(wxGraphicsObject) -> true;
parent_class(_Class) -> erlang:error({badtype, ?MODULE}).
diff --git a/lib/wx/src/gen/wxe_debug.hrl b/lib/wx/src/gen/wxe_debug.hrl
index 58cb5298e6..533f9f2df0 100644
--- a/lib/wx/src/gen/wxe_debug.hrl
+++ b/lib/wx/src/gen/wxe_debug.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1491,10 +1491,10 @@ wxdebug_table() ->
{1637, {wxStaticBox, 'Destroy', undefined}},
{1639, {wxStaticLine, new_2, 2}},
{1640, {wxStaticLine, new_0, 0}},
- {1641, {wxStaticLine, create, 2}},
- {1642, {wxStaticLine, isVertical, 0}},
- {1643, {wxStaticLine, getDefaultSize, 0}},
- {1644, {wxStaticLine, 'Destroy', undefined}},
+ {1641, {wxStaticLine, destruct, 0}},
+ {1642, {wxStaticLine, create, 2}},
+ {1643, {wxStaticLine, isVertical, 0}},
+ {1644, {wxStaticLine, getDefaultSize, 0}},
{1647, {wxListBox, new_3, 3}},
{1648, {wxListBox, new_0, 0}},
{1650, {wxListBox, destruct, 0}},
diff --git a/lib/wx/src/gen/wxe_funcs.hrl b/lib/wx/src/gen/wxe_funcs.hrl
index af0cee0dcd..14b5545676 100644
--- a/lib/wx/src/gen/wxe_funcs.hrl
+++ b/lib/wx/src/gen/wxe_funcs.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1488,10 +1488,10 @@
-define(wxStaticBox_destroy, 1637).
-define(wxStaticLine_new_2, 1639).
-define(wxStaticLine_new_0, 1640).
--define(wxStaticLine_Create, 1641).
--define(wxStaticLine_IsVertical, 1642).
--define(wxStaticLine_GetDefaultSize, 1643).
--define(wxStaticLine_destroy, 1644).
+-define(wxStaticLine_destruct, 1641).
+-define(wxStaticLine_Create, 1642).
+-define(wxStaticLine_IsVertical, 1643).
+-define(wxStaticLine_GetDefaultSize, 1644).
-define(wxListBox_new_3, 1647).
-define(wxListBox_new_0, 1648).
-define(wxListBox_destruct, 1650).
diff --git a/otp_versions.table b/otp_versions.table
index 266bca1698..b7594e71c3 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -2,6 +2,8 @@ OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1
OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 :
+OTP-19.3.6.2 : erts-8.3.5.2 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.3 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
+OTP-19.3.6.1 : erts-8.3.5.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.3 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6 : erts-8.3.5 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.3 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.5 : erts-8.3.4 xmerl-1.3.14 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.3 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 :
OTP-19.3.4 : inets-6.3.9 ssl-8.1.3 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.13 :
diff --git a/system/doc/design_principles/des_princ.xml b/system/doc/design_principles/des_princ.xml
index 8ab8661c2d..af5904ce78 100644
--- a/system/doc/design_principles/des_princ.xml
+++ b/system/doc/design_principles/des_princ.xml
@@ -225,10 +225,8 @@ free(Ch, {Alloc, Free} = Channels) ->
<list type="bulleted">
<item><p><seealso marker="gen_server_concepts">gen_server</seealso></p>
<p>For implementing the server of a client-server relation</p></item>
- <item><p><seealso marker="fsm">gen_fsm</seealso></p>
- <p>For implementing finite-state machines (Old)</p></item>
<item><p><seealso marker="statem">gen_statem</seealso></p>
- <p>For implementing state machines (New)</p></item>
+ <p>For implementing state machines</p></item>
<item><p><seealso marker="events">gen_event</seealso></p>
<p>For implementing event handling functionality</p></item>
<item><p><seealso marker="sup_princ">supervisor</seealso></p>
diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml
index 7febe31df3..a0611a46da 100644
--- a/system/doc/design_principles/statem.xml
+++ b/system/doc/design_principles/statem.xml
@@ -411,14 +411,6 @@ StateName(EventType, EventContent, Data) ->
<marker id="Example" />
<title>Example</title>
<p>
- This example starts off as equivalent to the example in section
- <seealso marker="fsm"><c>gen_fsm</c>&nbsp;Behavior</seealso>.
- In later sections, additions and tweaks are made
- using features in <c>gen_statem</c> that <c>gen_fsm</c> does not have.
- The end of this chapter provides the example again
- with all the added features.
- </p>
- <p>
A door with a code lock can be seen as a state machine.
Initially, the door is locked. When someone presses a button,
an event is generated.