aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Makefile.in2
-rw-r--r--aclocal.m44
-rw-r--r--erts/aclocal.m44
-rw-r--r--erts/configure.in57
-rw-r--r--erts/doc/src/erl.xml5
-rw-r--r--erts/doc/src/erlang.xml9
-rw-r--r--erts/doc/src/erts_alloc.xml14
-rw-r--r--erts/emulator/beam/atom.names2
-rw-r--r--erts/emulator/beam/bif.c7
-rw-r--r--erts/emulator/beam/bif.h118
-rw-r--r--erts/emulator/beam/bif.tab9
-rw-r--r--erts/emulator/beam/binary.c1157
-rw-r--r--erts/emulator/beam/erl_bif_binary.c11
-rw-r--r--[-rwxr-xr-x]erts/emulator/beam/erl_bif_info.c5
-rw-r--r--erts/emulator/beam/erl_binary.h2
-rw-r--r--erts/emulator/beam/erl_db.c62
-rw-r--r--erts/emulator/beam/erl_driver.h2
-rw-r--r--erts/emulator/beam/erl_init.c2
-rw-r--r--erts/emulator/beam/erl_lock_check.c4
-rw-r--r--erts/emulator/beam/erl_map.c16
-rw-r--r--erts/emulator/beam/erl_message.c37
-rw-r--r--erts/emulator/beam/erl_process.c9
-rw-r--r--erts/emulator/beam/erl_unicode.c2
-rw-r--r--erts/emulator/beam/external.c144
-rw-r--r--[-rwxr-xr-x]erts/emulator/beam/global.h53
-rw-r--r--erts/emulator/beam/utils.c490
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c7
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m413
-rw-r--r--[-rwxr-xr-x]erts/emulator/sys/win32/sys.c0
-rw-r--r--erts/emulator/test/binary_SUITE.erl272
-rw-r--r--erts/emulator/test/erts_debug_SUITE.erl6
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl12
-rw-r--r--erts/emulator/test/system_info_SUITE.erl1
-rw-r--r--erts/emulator/test/trace_SUITE.erl22
-rwxr-xr-xerts/emulator/utils/gen_git_version6
-rw-r--r--erts/epmd/src/Makefile.in2
-rw-r--r--erts/epmd/src/epmd_srv.c4
-rw-r--r--erts/etc/unix/etp-commands.in387
-rw-r--r--erts/include/internal/ethread.h33
-rw-r--r--erts/include/internal/win/ethr_membar.h8
-rw-r--r--erts/lib_src/common/erl_misc_utils.c7
-rw-r--r--erts/lib_src/common/ethr_aux.c6
-rw-r--r--erts/lib_src/common/ethr_mutex.c6
-rw-r--r--erts/preloaded/ebin/erlang.beambin98248 -> 97732 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin4276 -> 4176 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin48796 -> 48780 bytes
-rw-r--r--erts/preloaded/src/erlang.erl35
-rw-r--r--erts/preloaded/src/erts_internal.erl21
-rw-r--r--erts/preloaded/src/init.erl2
-rw-r--r--erts/vsn.mk2
-rw-r--r--lib/asn1/src/Makefile1
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl58
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl3
-rw-r--r--lib/asn1/src/asn1ct_func.erl12
-rw-r--r--lib/asn1/src/asn1ct_gen.erl354
-rw-r--r--lib/asn1/src/asn1ct_gen_ber_bin_v2.erl338
-rw-r--r--lib/asn1/src/asn1ct_gen_check.erl271
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl10
-rw-r--r--lib/asn1/src/asn1ct_imm.erl78
-rw-r--r--lib/asn1/src/asn1rtt_ber.erl221
-rw-r--r--lib/asn1/src/asn1rtt_check.erl300
-rw-r--r--lib/asn1/src/asn1rtt_per_common.erl13
-rw-r--r--lib/asn1/test/asn1_SUITE.erl22
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Constraints.py7
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Default.asn23
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Set.py4
-rw-r--r--lib/asn1/test/asn1_app_test.erl4
-rw-r--r--lib/asn1/test/asn1_test_lib.erl55
-rw-r--r--lib/asn1/test/testNBAPsystem.erl15
-rw-r--r--lib/asn1/test/testSeqSetDefaultVal.erl349
-rw-r--r--lib/asn1/test/testTcapsystem.erl78
-rw-r--r--[-rwxr-xr-x]lib/common_test/configure.in0
-rw-r--r--lib/common_test/doc/src/cover_chapter.xml25
-rw-r--r--[-rwxr-xr-x]lib/common_test/priv/run_test.in0
-rw-r--r--lib/common_test/src/ct.erl2
-rw-r--r--lib/common_test/src/ct_cover.erl30
-rw-r--r--lib/common_test/src/ct_framework.erl48
-rw-r--r--lib/common_test/src/ct_logs.erl20
-rw-r--r--lib/common_test/src/ct_run.erl191
-rw-r--r--lib/common_test/src/ct_telnet.erl11
-rw-r--r--lib/common_test/src/ct_util.erl25
-rw-r--r--lib/common_test/test/Makefile3
-rw-r--r--lib/common_test/test/ct_cover_SUITE.erl15
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE.erl221
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_local_SUITE.erl63
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_SUITE.erl75
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_nostop_SUITE.erl68
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_test_mod.erl4
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE_data/local.spec6
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE_data/remote.spec6
-rw-r--r--lib/common_test/test/ct_cover_nomerge_SUITE_data/remote_nostop.spec6
-rw-r--r--lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl42
-rw-r--r--lib/common_test/test/telnet_server.erl8
-rw-r--r--lib/compiler/src/cerl.erl23
-rw-r--r--lib/crypto/c_src/crypto.c37
-rw-r--r--lib/crypto/doc/src/crypto.xml4
-rw-r--r--lib/crypto/src/crypto.erl26
-rw-r--r--lib/crypto/test/crypto_SUITE.erl52
-rw-r--r--lib/debugger/src/dbg_ieval.erl4
-rw-r--r--lib/debugger/test/int_eval_SUITE.erl1
-rw-r--r--lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl5
-rw-r--r--lib/dialyzer/doc/src/dialyzer.xml109
-rw-r--r--lib/dialyzer/src/dialyzer_cl_parse.erl13
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl9
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/maps_difftype3
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl6
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl148
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl9
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl17
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl531
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl19
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl16
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl11
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/remote_field.erl11
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl17
-rw-r--r--lib/diameter/doc/src/diameter.xml2
-rw-r--r--lib/diameter/doc/src/notes.xml2
-rw-r--r--lib/diameter/examples/code/client.erl2
-rw-r--r--lib/diameter/examples/code/client_cb.erl14
-rw-r--r--lib/diameter/examples/code/redirect_cb.erl8
-rw-r--r--lib/diameter/examples/code/relay_cb.erl8
-rw-r--r--lib/diameter/examples/code/server_cb.erl53
-rw-r--r--lib/diameter/include/diameter.hrl5
-rw-r--r--lib/diameter/include/diameter_gen.hrl117
-rw-r--r--lib/diameter/src/base/diameter_codec.erl196
-rw-r--r--lib/diameter/src/base/diameter_config.erl4
-rw-r--r--lib/diameter/src/base/diameter_lib.erl56
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl158
-rw-r--r--lib/diameter/src/base/diameter_service.erl84
-rw-r--r--lib/diameter/src/base/diameter_traffic.erl215
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl89
-rw-r--r--lib/diameter/src/compiler/diameter_dict_util.erl9
-rw-r--r--lib/diameter/src/diameter.appup.src28
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl2
-rw-r--r--lib/diameter/test/diameter_compiler_SUITE.erl15
-rw-r--r--lib/diameter/test/diameter_dpr_SUITE.erl8
-rw-r--r--lib/diameter/test/diameter_examples_SUITE.erl85
-rw-r--r--lib/diameter/test/diameter_failover_SUITE.erl8
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl85
-rw-r--r--lib/diameter/vsn.mk2
-rw-r--r--lib/erl_interface/aclocal.m44
-rw-r--r--lib/erl_interface/include/ei.h2
-rw-r--r--lib/hipe/cerl/cerl_prettypr.erl24
-rw-r--r--lib/hipe/cerl/erl_types.erl62
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl139
-rw-r--r--lib/hipe/test/Makefile3
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl20
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl17
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl40
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl16
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl23
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl7
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_export.erl11
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl23
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl31
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl36
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl54
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl35
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_update.erl14
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl46
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_is_map.erl24
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl6
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_map_size.erl29
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl41
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl24
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl23
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl28
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl22
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_exact.erl32
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_literals.erl13
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl32
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_values.erl28
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl27
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl9
-rw-r--r--lib/inets/doc/src/notes.xml34
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl17
-rw-r--r--lib/inets/src/http_lib/http_internal.hrl4
-rw-r--r--lib/inets/src/http_server/httpd.erl12
-rw-r--r--lib/inets/src/http_server/httpd_manager.erl36
-rw-r--r--lib/inets/src/http_server/httpd_request.erl204
-rw-r--r--lib/inets/src/http_server/httpd_request_handler.erl31
-rw-r--r--lib/inets/src/inets_app/inets.appup.src13
-rw-r--r--lib/inets/test/http_format_SUITE.erl15
-rw-r--r--lib/inets/test/httpc_SUITE.erl70
-rw-r--r--lib/inets/test/httpd_basic_SUITE.erl317
-rw-r--r--lib/inets/test/httpd_block.erl6
-rw-r--r--lib/inets/test/httpd_test_lib.erl2
-rw-r--r--lib/inets/test/old_httpd_SUITE.erl34
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/doc/src/inet.xml2
-rw-r--r--lib/kernel/doc/src/kernel_app.xml43
-rw-r--r--lib/kernel/src/application_controller.erl31
-rw-r--r--lib/kernel/src/code_server.erl7
-rw-r--r--lib/kernel/src/erts_debug.erl21
-rw-r--r--lib/kernel/test/application_SUITE.erl31
-rw-r--r--lib/kernel/test/application_SUITE_data/t4.config1
-rw-r--r--lib/kernel/test/code_SUITE.erl74
-rw-r--r--lib/kernel/test/code_SUITE_data/calendar.erl23
-rw-r--r--lib/kernel/test/kernel_SUITE.erl12
-rw-r--r--lib/kernel/test/sendfile_SUITE.erl7
-rw-r--r--lib/megaco/aclocal.m44
-rw-r--r--lib/mnesia/src/mnesia_controller.erl9
-rw-r--r--lib/mnesia/src/mnesia_locker.erl29
-rw-r--r--lib/mnesia/test/mnesia_qlc_test.erl2
-rw-r--r--lib/mnesia/test/mnesia_test_lib.hrl35
-rw-r--r--lib/mnesia/test/mnesia_trans_access_test.erl7
-rw-r--r--lib/observer/src/cdv_timer_cb.erl7
-rw-r--r--lib/observer/src/cdv_virtual_list_wx.erl11
-rw-r--r--lib/observer/src/crashdump_viewer.erl40
-rw-r--r--lib/observer/src/crashdump_viewer.hrl1
-rw-r--r--lib/observer/src/observer_tv_table.erl4
-rw-r--r--lib/observer/src/observer_wx.erl4
-rw-r--r--lib/observer/test/crashdump_helper.erl4
-rw-r--r--lib/observer/test/crashdump_viewer_SUITE.erl10
-rw-r--r--lib/observer/test/observer_SUITE.erl40
-rw-r--r--lib/odbc/aclocal.m44
-rw-r--r--lib/reltool/test/reltool_server_SUITE.erl9
-rw-r--r--lib/reltool/test/reltool_test_lib.erl7
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl39
-rw-r--r--lib/sasl/test/sasl_SUITE.erl12
-rw-r--r--lib/sasl/test/systools_SUITE.erl24
-rw-r--r--lib/snmp/test/snmp_test_manager.erl6
-rw-r--r--lib/ssh/doc/src/notes.xml32
-rw-r--r--lib/ssh/doc/src/ssh.xml27
-rw-r--r--lib/ssh/src/ssh.appup.src16
-rw-r--r--lib/ssh/src/ssh.erl39
-rw-r--r--lib/ssh/src/ssh_acceptor.erl47
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl3
-rw-r--r--lib/ssh/src/ssh_io.erl2
-rw-r--r--lib/ssh/src/ssh_message.erl27
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl190
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/internal_doc/ssl-implementation.txt52
-rw-r--r--lib/ssl/src/Makefile3
-rw-r--r--lib/ssl/src/dtls_connection.erl3
-rw-r--r--lib/ssl/src/ssl.app.src1
-rw-r--r--lib/ssl/src/ssl.appup.src24
-rw-r--r--lib/ssl/src/ssl.erl351
-rw-r--r--lib/ssl/src/ssl_alert.erl29
-rw-r--r--lib/ssl/src/ssl_alert.hrl2
-rw-r--r--lib/ssl/src/ssl_cipher.erl13
-rw-r--r--lib/ssl/src/ssl_connection.erl248
-rw-r--r--lib/ssl/src/ssl_connection.hrl4
-rw-r--r--lib/ssl/src/ssl_dist_sup.erl16
-rw-r--r--lib/ssl/src/ssl_handshake.erl79
-rw-r--r--lib/ssl/src/ssl_internal.hrl17
-rw-r--r--lib/ssl/src/ssl_listen_tracker_sup.erl71
-rw-r--r--lib/ssl/src/ssl_manager.erl46
-rw-r--r--lib/ssl/src/ssl_record.erl2
-rw-r--r--lib/ssl/src/ssl_record.hrl2
-rw-r--r--lib/ssl/src/ssl_socket.erl209
-rw-r--r--lib/ssl/src/ssl_sup.erl19
-rw-r--r--lib/ssl/src/tls_connection.erl156
-rw-r--r--lib/ssl/src/tls_connection_sup.erl4
-rw-r--r--lib/ssl/src/tls_record.erl33
-rw-r--r--lib/ssl/src/tls_v1.erl52
-rw-r--r--lib/ssl/test/make_certs.erl5
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl294
-rw-r--r--lib/ssl/test/ssl_crl_SUITE.erl30
-rw-r--r--lib/ssl/test/ssl_handshake_SUITE.erl14
-rw-r--r--lib/ssl/test/ssl_test_lib.erl85
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl2
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/erl_tar.xml27
-rw-r--r--lib/stdlib/doc/src/gen_fsm.xml4
-rw-r--r--lib/stdlib/doc/src/gen_server.xml2
-rw-r--r--lib/stdlib/doc/src/maps.xml20
-rw-r--r--lib/stdlib/src/erl_eval.erl8
-rw-r--r--lib/stdlib/src/erl_lint.erl5
-rw-r--r--lib/stdlib/src/erl_parse.yrl21
-rw-r--r--lib/stdlib/src/erl_tar.erl38
-rw-r--r--lib/stdlib/src/filelib.erl2
-rw-r--r--lib/stdlib/src/maps.erl18
-rw-r--r--lib/stdlib/test/Makefile3
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl7
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl27
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl40
-rw-r--r--lib/stdlib/test/maps_SUITE.erl69
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl12
-rw-r--r--lib/stdlib/test/tar_SUITE.erl66
-rw-r--r--lib/syntax_tools/src/erl_syntax.erl4
-rw-r--r--lib/syntax_tools/test/syntax_tools_SUITE.erl14
-rw-r--r--lib/test_server/src/test_server.erl122
-rw-r--r--lib/test_server/src/test_server_ctrl.erl130
-rw-r--r--lib/test_server/src/test_server_internal.hrl9
-rw-r--r--lib/test_server/src/test_server_node.erl10
-rw-r--r--lib/test_server/src/ts.erl9
-rw-r--r--lib/tools/emacs/erlang.el2
-rw-r--r--lib/tools/test/xref_SUITE.erl2
-rw-r--r--lib/wx/aclocal.m44
-rw-r--r--[-rwxr-xr-x]lib/wx/configure.in0
-rw-r--r--otp_versions.table1
-rw-r--r--system/doc/reference_manual/expressions.xml238
-rw-r--r--system/doc/reference_manual/maps.xml274
-rw-r--r--system/doc/reference_manual/part.xml1
-rw-r--r--system/doc/reference_manual/xmlfiles.mk1
296 files changed, 10225 insertions, 4010 deletions
diff --git a/Makefile.in b/Makefile.in
index 4dc5ebac40..5c96c789dc 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -451,7 +451,7 @@ else
$(make_verbose)cd lib && \
ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \
$(MAKE) opt BUILD_ALL=true
- echo "OTP built" > $(ERL_TOP)/make/otp_built
+ $(V_at)echo "OTP built" > $(ERL_TOP)/make/otp_built
endif
kernel:
$(make_verbose)cd lib/kernel && \
diff --git a/aclocal.m4 b/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/erts/aclocal.m4
+++ b/erts/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/erts/configure.in b/erts/configure.in
index 9ebb56e3bc..f66110b98b 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -214,9 +214,6 @@ AC_ARG_ENABLE(native-libs,
AS_HELP_STRING([--enable-native-libs],
[compile Erlang libraries to native code]))
-AC_ARG_ENABLE(tsp,
-AS_HELP_STRING([--enable-tsp], [compile tsp app]))
-
AC_ARG_ENABLE(fp-exceptions,
AS_HELP_STRING([--enable-fp-exceptions],
[use hardware floating point exceptions (default if hipe enabled)]),
@@ -366,6 +363,11 @@ AC_DEFINE_UNQUOTED(ASSUMED_CACHE_LINE_SIZE,
$with_assumed_cache_line_size,
[Assumed cache-line size (in bytes)])
+AC_ARG_ENABLE(systemd,
+AS_HELP_STRING([--enable-systemd], [enable systemd support in epmd]),
+[],
+[enable_systemd=no])
+
dnl Magic test for clearcase.
OTP_RELEASE=
if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then
@@ -456,10 +458,10 @@ AS_HELP_STRING([--enable-static-drivers], [comma seperated list of linked-in dri
AC_SUBST(STATIC_DRIVERS)
AC_ARG_WITH(ets-write-concurrency-locks,
- AS_HELP_STRING([--with-ets-write-concurrency-locks={8,16,32,64,128,256}],
- [specify how many locks the write_concurrency option for ets should use.])
- AS_HELP_STRING([--without-ets-write-concurrency-locks],
- [use the default number of write_concurrency locks (default)]))
+AS_HELP_STRING([--with-ets-write-concurrency-locks={8|16|32|64|128|256}],
+ [specify how many locks the write_concurrency option for ets should use.])
+AS_HELP_STRING([--without-ets-write-concurrency-locks],
+ [use the default number of write_concurrency locks (default)]))
if test X"$with_ets_write_concurrency_locks" != X""; then
AC_DEFINE_UNQUOTED(ERTS_DB_HASH_LOCK_CNT,$with_ets_write_concurrency_locks,
@@ -671,6 +673,7 @@ case $chk_arch_ in
x86_64) ARCH=amd64;;
amd64) ARCH=amd64;;
macppc) ARCH=ppc;;
+ powerpc) ARCH=ppc;;
ppc) ARCH=ppc;;
ppc64) ARCH=ppc64;;
"Power Macintosh") ARCH=ppc;;
@@ -678,8 +681,10 @@ case $chk_arch_ in
armv5teb) ARCH=arm;;
armv5tel) ARCH=arm;;
armv5tejl) ARCH=arm;;
- armv6l) ARCH=arm;;
+ armv6l) ARCH=arm;;
+ armv6hl) ARCH=arm;;
armv7l) ARCH=arm;;
+ armv7hl) ARCH=arm;;
tile) ARCH=tile;;
*) ARCH=noarch;;
esac
@@ -1042,8 +1047,6 @@ AC_CHECK_LIB(dl, dlopen)
AC_CHECK_LIB(inet, main)
AC_CHECK_LIB(util, openpty)
-AC_CHECK_LIB(systemd-daemon, sd_listen_fds)
-
dnl Try to find a thread library.
dnl
dnl ETHR_LIB_NAME, ETHR_LIBS, ETHR_X_LIBS, ETHR_THR_LIB_BASE and ETHR_DEFS
@@ -1679,7 +1682,29 @@ AC_CHECK_MEMBERS([struct ifreq.ifr_enaddr], [], [],
#endif
])
-AC_CHECK_HEADERS(systemd/sd-daemon.h)
+dnl ----------------------------------------------------------------------
+dnl Check the availability of systemd
+dnl ----------------------------------------------------------------------
+if test x"$enable_systemd" != x"no"; then
+
+systemd_daemon_save_LIBS=$LIBS
+LIBS=
+AC_SEARCH_LIBS(sd_listen_fds,[systemd systemd-daemon],
+ [have_sd_listen_fds=yes],[have_sd_listen_fds=no],$systemd_daemon_save_LIBS)
+AC_CHECK_HEADERS(systemd/sd-daemon.h,
+ [have_systemd_sd_daemon_h=yes],[have_systemd_sd_daemon_h=no])
+
+if test x"$have_sd_listen_fds" = x"yes" && \
+ test x"$have_systemd_sd_daemon_h" = x"yes"; then
+ AC_DEFINE([HAVE_SYSTEMD_DAEMON],[1],[Define if you have systemd daemon])
+ SYSTEMD_DAEMON_LIBS=$LIBS
+elif test x"$enable_systemd" = x"yes"; then
+ AC_MSG_FAILURE([--enable-systemd was given, but test for systemd failed])
+fi
+LIBS=$systemd_daemon_save_LIBS
+fi
+AC_SUBST(SYSTEMD_DAEMON_LIBS)
+
dnl ----------------------------------------------------------------------
dnl Check the availability for libdlpi
@@ -3432,16 +3457,6 @@ dnl (using the --disable, --enable and --with switches).
dnl ----------------------------------------------------------------------
#
-# Check if we should compile TSP app
-#
-
-TSP_APP=
-if test X${enable_tsp} = Xyes; then
- TSP_APP=tsp
-fi
-AC_SUBST(TSP_APP)
-
-#
# Check if we should enable HiPE.
#
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index 9724a1345a..f8f4d14436 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -495,7 +495,7 @@
<c><![CDATA[werl]]></c>, not <c><![CDATA[erl]]></c> (<c><![CDATA[oldshell]]></c>). Note also that
<c><![CDATA[Ctrl-Break]]></c> is used instead of <c><![CDATA[Ctrl-C]]></c> on Windows.</p>
</item>
- <tag><c><![CDATA[+c]]></c></tag>
+ <tag><marker id="+c"><c><![CDATA[+c]]></c></marker></tag>
<item>
<p>Disable compensation for sudden changes of system time.</p>
<p>Normally, <c><![CDATA[erlang:now/0]]></c> will not immediately reflect
@@ -510,6 +510,9 @@
reflect the current system time. Note that timers are based
on <c><![CDATA[erlang:now/0]]></c>. If the system time jumps, timers
then time out at the wrong time.</p>
+ <p><em>NOTE</em>: You can check whether the adjustment is enabled or
+ disabled by calling
+ <seealso marker="erlang#system_info_tolerant_timeofday">erlang:system_info(tolerant_timeofday)</seealso>.</p>
</item>
<tag><c><![CDATA[+d]]></c></tag>
<item>
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index e7e9b218f2..9ad42374bf 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -4842,6 +4842,8 @@ true</pre>
<c><anno>Node</anno></c> does not exist, a useless pid is returned.
Otherwise works like
<seealso marker="#spawn_opt/4">spawn_opt/4</seealso>.</p>
+ <note><p>The <c>monitor</c> option is currently not supported by
+ <c>spawn_opt/5</c>.</p></note>
</desc>
</func>
<func>
@@ -6293,6 +6295,13 @@ ok
(<seealso marker="erts:erl_driver#driver_async">driver_async()</seealso>)
as an integer.</p>
</item>
+ <tag><marker id="system_info_tolerant_timeofday"><c>tolerant_timeofday</c></marker></tag>
+ <item>
+ <p>Returns whether compensation for sudden changes of system
+ time is <c>enabled</c> or <c>disabled</c>.</p>
+ <p>See also <seealso marker="erts:erl#+c">+c</seealso>
+ command line flag.</p>
+ </item>
<tag><c>trace_control_word</c></tag>
<item>
<p>Returns the value of the node's trace control word.
diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index c9eca39a99..1ade41f1aa 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -4,7 +4,7 @@
<cref>
<header>
<copyright>
- <year>2002</year><year>2013</year>
+ <year>2002</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -531,15 +531,9 @@
<p>Multiple, thread specific instances of the allocator.
This option will only have any effect on the runtime system
with SMP support. Default behaviour on the runtime system with
- SMP support:</p>
- <taglist>
- <tag><c>ll_alloc</c></tag>
- <item><c>1</c> instance.</item>
- <tag>Other allocators</tag>
- <item><c>NoSchedulers+1</c> instances. Each scheduler will use
- a lock-free instance of its own and other threads will use
- a common instance.</item>
- </taglist>
+ SMP support is <c>NoSchedulers+1</c> instances. Each scheduler will use
+ a lock-free instance of its own and other threads will use
+ a common instance.</p>
<p>It was previously (before ERTS version 5.9) possible to configure
a smaller amount of thread specific instances than schedulers.
This is, however, not possible any more.</p>
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index d28e519ae1..5d06a32941 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -116,6 +116,7 @@ atom binary_longest_prefix_trap
atom binary_longest_suffix_trap
atom binary_match_trap
atom binary_matches_trap
+atom binary_to_list_continue
atom binary_to_term_trap
atom block
atom blocked
@@ -315,6 +316,7 @@ atom line_length
atom linked_in_driver
atom links
atom list
+atom list_to_binary_continue
atom little
atom loaded
atom load_cancelled
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 06a1230ca0..fcbeb6cf5c 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1886,8 +1886,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
Eterm id = erts_whereis_name_to_id(p, to);
rp = erts_proc_lookup(id);
- if (rp)
+ if (rp) {
+ if (IS_TRACED(p))
+ trace_send(p, to, msg);
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
+ save_calls(p, &exp_send);
goto send_message;
+ }
pt = erts_port_lookup(id,
(erts_port_synchronous_ops
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index 51b77a95ed..72c55ccb55 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -124,12 +124,85 @@ do { \
return THE_NON_VALUE; \
} while(0)
+#define ERTS_BIF_ERROR_TRAPPED0(Proc, Reason, Bif) \
+do { \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ return THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_ERROR_TRAPPED1(Proc, Reason, Bif, A0) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ reg[0] = (Eterm) (A0); \
+ return THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_ERROR_TRAPPED2(Proc, Reason, Bif, A0, A1) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ return THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_ERROR_TRAPPED3(Proc, Reason, Bif, A0, A1, A2) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ return THE_NON_VALUE; \
+} while (0)
+
#define ERTS_BIF_PREP_ERROR(Ret, Proc, Reason) \
do { \
(Proc)->freason = (Reason); \
(Ret) = THE_NON_VALUE; \
} while (0)
+#define ERTS_BIF_PREP_ERROR_TRAPPED0(Ret, Proc, Reason, Bif) \
+do { \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_ERROR_TRAPPED1(Ret, Proc, Reason, Bif, A0) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ reg[0] = (Eterm) (A0); \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_ERROR_TRAPPED2(Ret, Proc, Reason, Bif, A0, A1) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_ERROR_TRAPPED3(Ret, Proc, Reason, Bif, A0, A1, A2) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = (Bif)->code; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \
do { \
@@ -392,6 +465,51 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
Eterm args[],
int nargs);
+#ifndef HIPE
+
+#define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY)
+
+#else
+
+#include "erl_fun.h"
+#include "hipe_mode_switch.h"
+
+/*
+ * Hipe wrappers used by native code for BIFs that disable GC while trapping.
+ * Also add usage of the wrapper in ../hipe/hipe_bif_list.m4
+ *
+ * Problem:
+ * When native code calls a BIF that traps, hipe_mode_switch will push a
+ * "trap frame" on the Erlang stack in order to find its way back from beam_emu
+ * back to native caller when finally done. If GC is disabled and stack/heap
+ * is full there is no place to push the "trap frame".
+ *
+ * Solution:
+ * We reserve space on stack for the "trap frame" here before the BIF is called.
+ * If the BIF does not trap, the space is reclaimed here before returning.
+ * If the BIF traps, hipe_push_beam_trap_frame() will detect that a "trap frame"
+ * already is reserved and use it.
+ */
+
+
+#define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) \
+BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \
+ Eterm* args); \
+BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \
+ Eterm* args) \
+{ \
+ BIF_RETTYPE res; \
+ hipe_reserve_beam_trap_frame(c_p, args, ARITY); \
+ res = BIF_NAME ## _ ## ARITY (c_p, args); \
+ if (is_value(res) || c_p->freason != TRAP) { \
+ hipe_unreserve_beam_trap_frame(c_p); \
+ } \
+ return res; \
+}
+
+#endif
+
+
#include "erl_bif_table.h"
#endif
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 2d888862bf..011e49f1fe 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -45,6 +45,7 @@ bif erlang:apply/3
bif erlang:atom_to_list/1
bif erlang:binary_to_list/1
bif erlang:binary_to_list/3
+bif erlang:binary_to_term/1
bif erlang:crc32/1
bif erlang:crc32/2
bif erlang:crc32_combine/3
@@ -151,12 +152,11 @@ bif erts_internal:port_command/3
bif erts_internal:port_control/3
bif erts_internal:port_close/1
bif erts_internal:port_connect/2
-bif erts_internal:binary_to_term/1
-bif erts_internal:binary_to_term/2
bif erts_internal:request_system_task/3
bif erts_internal:check_process_code/2
+bif erts_internal:map_to_tuple_keys/1
# inet_db support
bif erlang:port_set_data/2
@@ -480,6 +480,11 @@ bif erlang:call_on_load_function/1
bif erlang:finish_after_on_load/2
#
+# New Bifs in R13B04
+#
+bif erlang:binary_to_term/2
+
+#
# The binary match bifs (New in R14A - EEP9)
#
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index c7926f18af..f50d484576 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -31,12 +31,11 @@
#include "erl_binary.h"
#include "erl_bits.h"
-#ifdef DEBUG
-static int list_to_bitstr_buf(Eterm obj, char* buf, Uint len);
-#else
-static int list_to_bitstr_buf(Eterm obj, char* buf);
-#endif
-static int bitstr_list_len(Eterm obj, Uint* num_bytes);
+static Export binary_to_list_continue_export;
+static Export list_to_binary_continue_export;
+
+static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1);
+static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1);
void
erts_init_binary(void)
@@ -49,6 +48,15 @@ erts_init_binary(void)
"Internal error: Address of orig_bytes[0] of a Binary"
" is *not* 8-byte aligned\n");
}
+
+ erts_init_trap_export(&binary_to_list_continue_export,
+ am_erts_internal, am_binary_to_list_continue, 1,
+ &binary_to_list_continue);
+
+ erts_init_trap_export(&list_to_binary_continue_export,
+ am_erts_internal, am_list_to_binary_continue, 1,
+ &list_to_binary_continue);
+
}
/*
@@ -333,6 +341,132 @@ BIF_RETTYPE integer_to_binary_1(BIF_ALIST_1)
BIF_RET(res);
}
+#define ERTS_B2L_BYTES_PER_REDUCTION 256
+
+typedef struct {
+ Eterm res;
+ Eterm *hp;
+#ifdef DEBUG
+ Eterm *hp_end;
+#endif
+ byte *bytes;
+ Uint size;
+ Uint bitoffs;
+} ErtsB2LState;
+
+static void b2l_state_destructor(Binary *mbp)
+{
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor);
+}
+
+static BIF_RETTYPE
+binary_to_list_chunk(Process *c_p,
+ Eterm mb_eterm,
+ ErtsB2LState* sp,
+ int reds_left,
+ int gc_disabled)
+{
+ BIF_RETTYPE ret;
+ int bump_reds;
+ Uint size;
+ byte *bytes;
+
+ size = (reds_left + 1)*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (size > sp->size)
+ size = sp->size;
+ bytes = sp->bytes + (sp->size - size);
+
+ bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1;
+ BUMP_REDS(c_p, bump_reds);
+
+ ASSERT(is_list(sp->res) || is_nil(sp->res));
+
+ sp->res = erts_bin_bytes_to_list(sp->res,
+ sp->hp,
+ bytes,
+ size,
+ sp->bitoffs);
+ sp->size -= size;
+ sp->hp += 2*size;
+
+ if (sp->size > 0) {
+
+ if (!gc_disabled)
+ erts_set_gc_state(c_p, 0);
+
+ ASSERT(c_p->flags & F_DISABLE_GC);
+ ASSERT(is_value(mb_eterm));
+ ERTS_BIF_PREP_TRAP1(ret,
+ &binary_to_list_continue_export,
+ c_p,
+ mb_eterm);
+ }
+ else {
+
+ ASSERT(sp->hp == sp->hp_end);
+ ASSERT(sp->size == 0);
+
+ if (!gc_disabled || !erts_set_gc_state(c_p, 1))
+ ERTS_BIF_PREP_RET(ret, sp->res);
+ else
+ ERTS_BIF_PREP_YIELD_RETURN(ret, c_p, sp->res);
+ ASSERT(!(c_p->flags & F_DISABLE_GC));
+ }
+
+ return ret;
+}
+
+static ERTS_INLINE BIF_RETTYPE
+binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, Uint size, Uint bitoffs)
+{
+ int reds_left = ERTS_BIF_REDS_LEFT(c_p);
+ if (size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION) {
+ Eterm res;
+ BIF_RETTYPE ret;
+ int bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1;
+ BUMP_REDS(c_p, bump_reds);
+ res = erts_bin_bytes_to_list(tail, hp, bytes, size, bitoffs);
+ ERTS_BIF_PREP_RET(ret, res);
+ return ret;
+ }
+ else {
+ Binary *mbp = erts_create_magic_binary(sizeof(ErtsB2LState),
+ b2l_state_destructor);
+ ErtsB2LState *sp = ERTS_MAGIC_BIN_DATA(mbp);
+ Eterm mb;
+
+ sp->res = tail;
+ sp->hp = hp;
+#ifdef DEBUG
+ sp->hp_end = sp->hp + 2*size;
+#endif
+ sp->bytes = bytes;
+ sp->size = size;
+ sp->bitoffs = bitoffs;
+
+ hp = HAlloc(c_p, PROC_BIN_SIZE);
+ mb = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp);
+ return binary_to_list_chunk(c_p, mb, sp, reds_left, 0);
+ }
+}
+
+static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1)
+{
+ Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val;
+
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor);
+
+ ASSERT(BIF_P->flags & F_DISABLE_GC);
+
+ return binary_to_list_chunk(BIF_P,
+ BIF_ARG_1,
+ (ErtsB2LState*) ERTS_MAGIC_BIN_DATA(mbp),
+ ERTS_BIF_REDS_LEFT(BIF_P),
+ 1);
+}
+
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_list, 1)
+
BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
{
Eterm real_bin;
@@ -354,14 +488,15 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
} else {
Eterm* hp = HAlloc(BIF_P, 2 * size);
byte* bytes = binary_bytes(real_bin)+offset;
-
- BIF_RET(erts_bin_bytes_to_list(NIL, hp, bytes, size, bitoffs));
+ return binary_to_list(BIF_P, hp, NIL, bytes, size, bitoffs);
}
error:
BIF_ERROR(BIF_P, BADARG);
}
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_list, 3)
+
BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
{
byte* bytes;
@@ -387,12 +522,13 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
}
i = stop-start+1;
hp = HAlloc(BIF_P, 2*i);
- BIF_RET(erts_bin_bytes_to_list(NIL, hp, bytes+start-1, i, bitoffs));
-
+ return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, bitoffs);
error:
BIF_ERROR(BIF_P, BADARG);
}
+HIPE_WRAPPER_BIF_DISABLE_GC(bitstring_to_list, 1)
+
BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
{
Eterm real_bin;
@@ -431,124 +567,441 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
previous = CONS(hp, make_binary(last), previous);
hp += 2;
}
- BIF_RET(erts_bin_bytes_to_list(previous, hp, bytes, size, bitoffs));
+
+ return binary_to_list(BIF_P, hp, previous, bytes, size, bitoffs);
}
/* Turn a possibly deep list of ints (and binaries) into */
/* One large binary object */
-/*
- * This bif also exists in the binary module, under the name
- * binary:list_to_bin/1, why it's divided into interface and
- * implementation. Also the backend for iolist_to_binary_1.
- */
+typedef enum {
+ ERTS_L2B_OK,
+ ERTS_L2B_YIELD,
+ ERTS_L2B_TYPE_ERROR,
+ ERTS_L2B_OVERFLOW_ERROR
+} ErtsL2BResult;
-BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
-{
+#define ERTS_L2B_STATE_INITER(C_P, ARG, BIF, SZFunc, TBufFunc) \
+ {ERTS_IOLIST2BUF_STATE_INITER((C_P), (ARG)), \
+ (ARG), THE_NON_VALUE, (BIF), (SZFunc), (TBufFunc)}
+
+#define ERTS_L2B_STATE_MOVE(TO, FROM) \
+ sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsL2BState))
+
+typedef struct ErtsL2BState_ ErtsL2BState;
+
+struct ErtsL2BState_ {
+ ErtsIOList2BufState buf;
+ Eterm arg;
Eterm bin;
- Eterm h,t;
- ErlDrvSizeT size;
- byte* bytes;
-#ifdef DEBUG
- ErlDrvSizeT offset;
-#endif
+ Export *bif;
+ int (*iolist_to_buf_size)(ErtsIOListState *);
+ ErlDrvSizeT (*iolist_to_buf)(ErtsIOList2BufState *);
+};
+
+static ERTS_INLINE ErtsL2BResult
+list_to_binary_engine(ErtsL2BState *sp)
+{
+ ErlDrvSizeT res;
+ Process *c_p = sp->buf.iolist.c_p;
+
+ /*
+ * have_size == 0 while sp->iolist_to_buf_size()
+ * has not finished the calculation.
+ */
+
+ if (!sp->buf.iolist.have_size) {
+ switch (sp->iolist_to_buf_size(&sp->buf.iolist)) {
+ case ERTS_IOLIST_YIELD:
+ return ERTS_L2B_YIELD;
+ case ERTS_IOLIST_OVERFLOW:
+ return ERTS_L2B_OVERFLOW_ERROR;
+ case ERTS_IOLIST_TYPE:
+ return ERTS_L2B_TYPE_ERROR;
+ case ERTS_IOLIST_OK:
+ break;
+ default:
+ ASSERT(0);
+ break;
+ }
+
+ ASSERT(sp->buf.iolist.have_size);
+
+ /*
+ * Size calculated... Setup state for
+ * sp->iolist_to_buf_*()
+ */
+
+ sp->bin = new_binary(c_p,
+ (byte *) NULL,
+ sp->buf.iolist.size);
+
+ if (sp->buf.iolist.size == 0)
+ return ERTS_L2B_OK;
+
+ sp->buf.buf = (char *) binary_bytes(sp->bin);
+ sp->buf.len = sp->buf.iolist.size;
+ sp->buf.iolist.obj = sp->arg;
- if (is_nil(arg)) {
- BIF_RET(new_binary(p,(byte*)"",0));
+ if (sp->buf.iolist.reds_left <= 0) {
+ BUMP_ALL_REDS(c_p);
+ return ERTS_L2B_YIELD;
+ }
}
- if (is_not_list(arg)) {
- goto error;
+
+ ASSERT(sp->buf.iolist.size != 0);
+ ASSERT(is_value(sp->bin));
+ ASSERT(sp->buf.buf);
+
+ res = sp->iolist_to_buf(&sp->buf);
+
+ if (!ERTS_IOLIST_TO_BUF_FAILED(res)) {
+ ASSERT(res == 0);
+ return ERTS_L2B_OK;
}
- /* check for [binary()] case */
- h = CAR(list_val(arg));
- t = CDR(list_val(arg));
- if (is_binary(h) && is_nil(t) && !(
- HEADER_SUB_BIN == *(binary_val(h)) && (
- ((ErlSubBin *)binary_val(h))->bitoffs != 0 ||
- ((ErlSubBin *)binary_val(h))->bitsize != 0
- ))) {
- return h;
- }
- switch (erts_iolist_size(arg, &size)) {
- case ERTS_IOLIST_OVERFLOW: BIF_ERROR(p, SYSTEM_LIMIT);
- case ERTS_IOLIST_TYPE: goto error;
- default: ;
- }
- bin = new_binary(p, (byte *)NULL, size);
- bytes = binary_bytes(bin);
-#ifdef DEBUG
- offset =
-#endif
- erts_iolist_to_buf(arg, (char*) bytes, size);
- ASSERT(offset == 0);
- BIF_RET(bin);
+ switch (res) {
+ case ERTS_IOLIST_TO_BUF_YIELD:
+ return ERTS_L2B_YIELD;
+ case ERTS_IOLIST_TO_BUF_OVERFLOW:
+ return ERTS_L2B_OVERFLOW_ERROR;
+ case ERTS_IOLIST_TO_BUF_TYPE_ERROR:
+ return ERTS_L2B_TYPE_ERROR;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid return value from iolist_to_buf_yielding()");
+ return ERTS_L2B_TYPE_ERROR;
+ }
+}
+
+static void
+l2b_state_destructor(Binary *mbp)
+{
+ ErtsL2BState *sp = ERTS_MAGIC_BIN_DATA(mbp);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor);
+ DESTROY_SAVED_ESTACK(&sp->buf.iolist.estack);
+}
+
+static ERTS_INLINE Eterm
+l2b_final_touch(Process *c_p, ErtsL2BState *sp)
+{
+ Eterm *hp;
+ ErlSubBin* sbin;
+ if (sp->buf.offset == 0)
+ return sp->bin;
+
+ hp = HAlloc(c_p, ERL_SUB_BIN_SIZE);
+ ASSERT(sp->buf.offset > 0);
+ sbin = (ErlSubBin *) hp;
+ sbin->thing_word = HEADER_SUB_BIN;
+ sbin->size = sp->buf.iolist.size-1;
+ sbin->offs = 0;
+ sbin->orig = sp->bin;
+ sbin->bitoffs = 0;
+ sbin->bitsize = sp->buf.offset;
+ sbin->is_writable = 0;
+ return make_binary(sbin);
+}
+
+static BIF_RETTYPE
+list_to_binary_chunk(Eterm mb_eterm,
+ ErtsL2BState* sp,
+ int reds_left,
+ int gc_disabled)
+{
+ Eterm err = BADARG;
+ BIF_RETTYPE ret;
+ Process *c_p = sp->buf.iolist.c_p;
+
+ sp->buf.iolist.reds_left = reds_left;
- error:
- BIF_ERROR(p, BADARG);
+ switch (list_to_binary_engine(sp)) {
+
+ case ERTS_L2B_OK: {
+ Eterm result = l2b_final_touch(c_p, sp);
+ if (!gc_disabled || !erts_set_gc_state(c_p, 1))
+ ERTS_BIF_PREP_RET(ret, result);
+ else
+ ERTS_BIF_PREP_YIELD_RETURN(ret, c_p, result);
+ ASSERT(!(c_p->flags & F_DISABLE_GC));
+ break;
+ }
+ case ERTS_L2B_YIELD:
+ if (!gc_disabled) {
+ /* first yield... */
+ Eterm *hp;
+ Binary *mbp = erts_create_magic_binary(sizeof(ErtsL2BState),
+ l2b_state_destructor);
+ ErtsL2BState *new_sp = ERTS_MAGIC_BIN_DATA(mbp);
+
+ ERTS_L2B_STATE_MOVE(new_sp, sp);
+ sp = new_sp;
+
+ hp = HAlloc(c_p, PROC_BIN_SIZE);
+ mb_eterm = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp);
+
+ ASSERT(is_value(mb_eterm));
+
+ erts_set_gc_state(c_p, 0);
+ }
+
+ ASSERT(c_p->flags & F_DISABLE_GC);
+
+ ERTS_BIF_PREP_TRAP1(ret,
+ &list_to_binary_continue_export,
+ c_p,
+ mb_eterm);
+ break;
+
+ case ERTS_L2B_OVERFLOW_ERROR:
+ err = SYSTEM_LIMIT;
+ /* fall through */
+
+ case ERTS_L2B_TYPE_ERROR:
+ if (!gc_disabled)
+ ERTS_BIF_PREP_ERROR(ret, c_p, err);
+ else {
+ if (erts_set_gc_state(c_p, 1))
+ ERTS_VBUMP_ALL_REDS(c_p);
+
+ ERTS_BIF_PREP_ERROR_TRAPPED1(ret,
+ c_p,
+ err,
+ sp->bif,
+ sp->arg);
+ }
+
+ ASSERT(!(c_p->flags & F_DISABLE_GC));
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Invalid return value from list_to_binary_engine()");
+ ERTS_BIF_PREP_ERROR(ret,c_p, EXC_INTERNAL_ERROR);
+ break;
+ }
+ return ret;
}
+static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1)
+{
+ Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val;
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor);
+
+ ASSERT(BIF_P->flags & F_DISABLE_GC);
+
+ return list_to_binary_chunk(BIF_ARG_1,
+ ERTS_MAGIC_BIN_DATA(mbp),
+ ERTS_BIF_REDS_LEFT(BIF_P),
+ 1);
+}
+
+BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif)
+{
+ BIF_RETTYPE ret;
+
+ if (is_nil(arg))
+ ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) "", 0));
+ else if (is_not_list(arg))
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ else {
+ /* check for [binary()] case */
+ Eterm h = CAR(list_val(arg));
+ Eterm t = CDR(list_val(arg));
+ if (is_binary(h)
+ && is_nil(t)
+ && !(HEADER_SUB_BIN == *(binary_val(h))
+ && (((ErlSubBin *)binary_val(h))->bitoffs != 0
+ || ((ErlSubBin *)binary_val(h))->bitsize != 0))) {
+ ERTS_BIF_PREP_RET(ret, h);
+ }
+ else {
+ ErtsL2BState state = ERTS_L2B_STATE_INITER(c_p,
+ arg,
+ bif,
+ erts_iolist_size_yielding,
+ erts_iolist_to_buf_yielding);
+ int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p);
+
+ /*
+ * First try to do it all at once without having to use
+ * yielding iolist_to_buf().
+ */
+ state.buf.iolist.reds_left = orig_reds_left;
+ switch (erts_iolist_size_yielding(&state.buf.iolist)) {
+ case ERTS_IOLIST_OK: {
+ ErlDrvSizeT size = state.buf.iolist.size;
+ Eterm bin;
+ char *buf;
+
+ if (size == 0) {
+ ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) NULL, 0));
+ break; /* done */
+ }
+
+ bin = new_binary(c_p, (byte *) NULL, size);
+ buf = (char *) binary_bytes(bin);
+
+ if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) {
+ /* An (over) estimation of reductions needed */
+ int reds_left = state.buf.iolist.reds_left;
+ int to_buf_reds = orig_reds_left - reds_left;
+ to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED;
+ if (to_buf_reds <= reds_left) {
+ ErlDrvSizeT res;
+
+ res = erts_iolist_to_buf(arg, buf, size);
+ if (res == 0) {
+ BUMP_REDS(c_p, to_buf_reds);
+ ERTS_BIF_PREP_RET(ret, bin);
+ break; /* done */
+ }
+ if (!ERTS_IOLIST_TO_BUF_FAILED(res))
+ ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch");
+ if (res == ERTS_IOLIST_TO_BUF_OVERFLOW)
+ goto overflow;
+ goto type_error;
+ }
+ }
+ /*
+ * Since size has been computed list_to_binary_chunk() expects
+ * state prepared for iolist_to_buf.
+ */
+ state.bin = bin;
+ state.buf.buf = buf;
+ state.buf.len = size;
+ state.buf.iolist.obj = arg;
+ /* Fall through... */
+ }
+ case ERTS_IOLIST_YIELD:
+ ret = list_to_binary_chunk(THE_NON_VALUE,
+ &state,
+ state.buf.iolist.reds_left,
+ 0);
+ break;
+ case ERTS_IOLIST_OVERFLOW:
+ overflow:
+ ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT);
+ break;
+ case ERTS_IOLIST_TYPE:
+ type_error:
+ default:
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ break;
+ }
+ }
+ }
+ return ret;
+}
+
+HIPE_WRAPPER_BIF_DISABLE_GC(list_to_binary, 1)
+
BIF_RETTYPE list_to_binary_1(BIF_ALIST_1)
{
- return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_list_to_binary_1]);
}
-/* Turn a possibly deep list of ints (and binaries) into */
-/* One large binary object */
+HIPE_WRAPPER_BIF_DISABLE_GC(iolist_to_binary, 1)
BIF_RETTYPE iolist_to_binary_1(BIF_ALIST_1)
{
if (is_binary(BIF_ARG_1)) {
BIF_RET(BIF_ARG_1);
}
- return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_iolist_to_binary_1]);
}
+static int bitstr_list_len(ErtsIOListState *);
+static ErlDrvSizeT list_to_bitstr_buf_yielding(ErtsIOList2BufState *);
+static ErlDrvSizeT list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *);
+
+HIPE_WRAPPER_BIF_DISABLE_GC(list_to_bitstring, 1)
+
BIF_RETTYPE list_to_bitstring_1(BIF_ALIST_1)
{
- Eterm bin;
- Uint sz;
- int offset;
- byte* bytes;
- ErlSubBin* sb1;
- Eterm* hp;
-
- if (is_nil(BIF_ARG_1)) {
- BIF_RET(new_binary(BIF_P,(byte*)"",0));
- }
- if (is_not_list(BIF_ARG_1)) {
- error:
- BIF_ERROR(BIF_P, BADARG);
- }
- switch (bitstr_list_len(BIF_ARG_1, &sz)) {
- case ERTS_IOLIST_TYPE:
- goto error;
- case ERTS_IOLIST_OVERFLOW:
- BIF_ERROR(BIF_P, SYSTEM_LIMIT);
- }
- bin = new_binary(BIF_P, (byte *)NULL, sz);
- bytes = binary_bytes(bin);
-#ifdef DEBUG
- offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes, sz);
-#else
- offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes);
-#endif
- ASSERT(offset >= 0);
- if (offset > 0) {
- hp = HAlloc(BIF_P, ERL_SUB_BIN_SIZE);
- sb1 = (ErlSubBin *) hp;
- sb1->thing_word = HEADER_SUB_BIN;
- sb1->size = sz-1;
- sb1->offs = 0;
- sb1->orig = bin;
- sb1->bitoffs = 0;
- sb1->bitsize = offset;
- sb1->is_writable = 0;
- bin = make_binary(sb1);
+ BIF_RETTYPE ret;
+
+ if (is_nil(BIF_ARG_1))
+ ERTS_BIF_PREP_RET(ret, new_binary(BIF_P, (byte *) "", 0));
+ else if (is_not_list(BIF_ARG_1))
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ else {
+ /* check for [bitstring()] case */
+ Eterm h = CAR(list_val(BIF_ARG_1));
+ Eterm t = CDR(list_val(BIF_ARG_1));
+ if (is_binary(h) && is_nil(t)) {
+ ERTS_BIF_PREP_RET(ret, h);
+ }
+ else {
+ ErtsL2BState state = ERTS_L2B_STATE_INITER(BIF_P,
+ BIF_ARG_1,
+ bif_export[BIF_list_to_bitstring_1],
+ bitstr_list_len,
+ list_to_bitstr_buf_yielding);
+ int orig_reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+
+ /*
+ * First try to do it all at once without having to use
+ * yielding list_to_bitstr_buf().
+ */
+ state.buf.iolist.reds_left = orig_reds_left;
+ switch (bitstr_list_len(&state.buf.iolist)) {
+ case ERTS_IOLIST_OK: {
+ ErlDrvSizeT size = state.buf.iolist.size;
+
+ state.bin = new_binary(BIF_P, (byte *) NULL, size);
+ state.buf.buf = (char *) binary_bytes(state.bin);
+ state.buf.len = size;
+ state.buf.iolist.obj = BIF_ARG_1;
+
+ if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) {
+ /* An (over) estimation of reductions needed */
+ int reds_left = state.buf.iolist.reds_left;
+ int to_buf_reds = orig_reds_left - reds_left;
+ to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED;
+ if (to_buf_reds <= reds_left) {
+ ErlDrvSizeT res;
+
+ res = list_to_bitstr_buf_not_yielding(&state.buf);
+ if (res == 0) {
+ Eterm res_bin = l2b_final_touch(BIF_P, &state);
+ BUMP_REDS(BIF_P, to_buf_reds);
+ ERTS_BIF_PREP_RET(ret, res_bin);
+ break; /* done */
+ }
+ if (!ERTS_IOLIST_TO_BUF_FAILED(res))
+ ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch");
+ if (res == ERTS_IOLIST_TO_BUF_OVERFLOW)
+ goto overflow;
+ goto type_error;
+ }
+ }
+ /*
+ * Since size has been computed list_to_binary_chunk() expects
+ * the state prepared for list_to_bitstr_buf.
+ */
+
+ /* Fall through... */
+ }
+ case ERTS_IOLIST_YIELD:
+ ret = list_to_binary_chunk(THE_NON_VALUE,
+ &state,
+ state.buf.iolist.reds_left,
+ 0);
+ break;
+ case ERTS_IOLIST_OVERFLOW:
+ overflow:
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, SYSTEM_LIMIT);
+ break;
+ case ERTS_IOLIST_TYPE:
+ type_error:
+ default:
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ break;
+ }
+ }
}
-
- BIF_RET(bin);
+
+ return ret;
}
BIF_RETTYPE split_binary_2(BIF_ALIST_2)
@@ -605,123 +1058,353 @@ BIF_RETTYPE split_binary_2(BIF_ALIST_2)
* Local functions.
*/
+static int
+list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp);
+
/*
* The input list is assumed to be type-correct and the buffer is
* assumed to be of sufficient size. Those assumptions are verified in
* the DEBUG-built emulator.
*/
-static int
+static ErlDrvSizeT
+list_to_bitstr_buf(int yield_support, ErtsIOList2BufState *state)
+{
+
+#undef LIST_TO_BITSTR_BUF_BCOPY_DBG
+#undef LIST_TO_BITSTR_BUF_BCOPY
#ifdef DEBUG
-list_to_bitstr_buf(Eterm obj, char* buf, Uint len)
+#define LIST_TO_BITSTR_BUF_BCOPY_DBG \
+ len -= size + (offset>7);
#else
-list_to_bitstr_buf(Eterm obj, char* buf)
+#define LIST_TO_BITSTR_BUF_BCOPY_DBG
#endif
-{
- Eterm* objp;
- int offset = 0;
+#define LIST_TO_BITSTR_BUF_BCOPY(CONSP) \
+ do { \
+ byte* bptr; \
+ Uint bitsize; \
+ Uint bitoffs; \
+ Uint num_bits; \
+ size_t size = binary_size(obj); \
+ if (yield_support) { \
+ size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ if (yield_count > 0) \
+ max_size *= yield_count+1; \
+ if (size > max_size) { \
+ state->objp = CONSP; \
+ goto L_bcopy_yield; \
+ } \
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { \
+ int cost = (int) size; \
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ yield_count -= cost; \
+ } \
+ } \
+ ASSERT(size <= len); \
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); \
+ num_bits = 8*size+bitsize; \
+ copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); \
+ offset += bitsize; \
+ buf += size + (offset>7); \
+ LIST_TO_BITSTR_BUF_BCOPY_DBG; \
+ offset = offset & 7; \
+ } while(0)
+
+#ifdef DEBUG
+ ErlDrvSizeT len;
+#endif
+ Eterm obj;
+ char *buf;
+ Eterm *objp = NULL;
+ int offset;
+ int init_yield_count = 0, yield_count;
DECLARE_ESTACK(s);
- goto L_again;
-
- while (!ESTACK_ISEMPTY(s)) {
- obj = ESTACK_POP(s);
- L_again:
- if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- obj = CAR(objp);
- if (is_byte(obj)) {
- ASSERT(len > 0);
- if (offset == 0) {
- *buf++ = unsigned_val(obj);
- } else {
- *buf = (char)((unsigned_val(obj) >> offset) |
- ((*buf >> (8-offset)) << (8-offset)));
- buf++;
- *buf = (unsigned_val(obj) << (8-offset));
- }
+
+ obj = state->iolist.obj;
+ buf = state->buf;
+ offset = state->offset;
#ifdef DEBUG
- len--;
+ len = state->len;
#endif
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- ASSERT(size <= len);
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- num_bits = 8*size+bitsize;
- copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
- offset += bitsize;
- buf += size + (offset>7);
+
+ if (!yield_support) {
+ yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+ goto L_again;
+ }
+ else {
+
+ if (state->iolist.reds_left <= 0)
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED
+ * state->iolist.reds_left);
+ yield_count = init_yield_count;
+
+ if (!state->iolist.estack.start)
+ goto L_again;
+ else {
+ int chk_stack;
+ /* Restart; restore state... */
+ ESTACK_RESTORE(s, &state->iolist.estack);
+
+ if (!state->bcopy.bptr)
+ chk_stack = 0;
+ else {
+ chk_stack = 1;
+ if (list_to_bitstr_buf_bcopy(state, THE_NON_VALUE, &yield_count)) {
+ /* Yield again... */
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+ }
+ buf = state->buf;
+ offset = state->offset;
#ifdef DEBUG
- len -= size + (offset>7);
+ len = state->len;
#endif
- offset = offset & 7;
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else {
- ASSERT(is_nil(obj));
}
- obj = CDR(objp);
- if (is_list(obj)) {
- goto L_iter_list; /* on tail */
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- ASSERT(size <= len);
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- num_bits = 8*size+bitsize;
- copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
- offset += bitsize;
- buf += size+(offset>7);
+ objp = state->objp;
+ state->objp = NULL;
+
+ if (objp)
+ goto L_tail;
+ if (!chk_stack)
+ goto L_again;
+ /* check stack */
+ }
+ }
+
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
+ L_again:
+ if (is_list(obj)) {
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ ASSERT(len > 0);
+ if (offset == 0) {
+ *buf++ = unsigned_val(obj);
+ } else {
+ *buf = (char)((unsigned_val(obj) >> offset) |
+ ((*buf >> (8-offset)) << (8-offset)));
+ buf++;
+ *buf = (unsigned_val(obj) << (8-offset));
+ }
#ifdef DEBUG
- len -= size+(offset>7);
+ len--;
#endif
- offset = offset & 7;
- } else {
- ASSERT(is_nil(obj));
+ } else if (is_binary(obj)) {
+ LIST_TO_BITSTR_BUF_BCOPY(objp);
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else {
+ ASSERT(is_nil(obj));
+ }
+ break;
+ }
+
+ L_tail:
+
+ obj = CDR(objp);
+ if (is_list(obj)) {
+ continue; /* Tail loop */
+ } else if (is_binary(obj)) {
+ LIST_TO_BITSTR_BUF_BCOPY(NULL);
+ } else {
+ ASSERT(is_nil(obj));
+ }
+ break;
}
} else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- ASSERT(size <= len);
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- num_bits = 8*size+bitsize;
- copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
- offset += bitsize;
- buf += size + (offset>7);
-#ifdef DEBUG
- len -= size + (offset>7);
-#endif
- offset = offset & 7;
+ LIST_TO_BITSTR_BUF_BCOPY(NULL);
} else {
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
ASSERT(is_nil(obj));
}
}
DESTROY_ESTACK(s);
- return offset;
+
+ if (yield_support) {
+ int reds;
+ CLEAR_SAVED_ESTACK(&state->iolist.estack);
+ reds = ((init_yield_count - yield_count - 1)
+ / ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1;
+ BUMP_REDS(state->iolist.c_p, reds);
+ state->iolist.reds_left -= reds;
+ if (state->iolist.reds_left < 0)
+ state->iolist.reds_left = 0;
+ }
+ state->buf = buf;
+ state->offset = offset;
+ return 0;
+
+L_bcopy_yield:
+
+ state->buf = buf;
+ state->offset = offset;
+#ifdef DEBUG
+ state->len = len;
+#endif
+
+ if (list_to_bitstr_buf_bcopy(state, obj, &yield_count) == 0)
+ ERTS_INTERNAL_ERROR("Missing yield");
+
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+L_yield:
+
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ state->iolist.obj = obj;
+ state->buf = buf;
+ state->offset = offset;
+ ESTACK_SAVE(s, &state->iolist.estack);
+#ifdef DEBUG
+ state->len = len;
+#endif
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+
+#undef LIST_TO_BITSTR_BUF_BCOPY_DBG
+#undef LIST_TO_BITSTR_BUF_BCOPY
+
+}
+
+static ErlDrvSizeT
+list_to_bitstr_buf_yielding(ErtsIOList2BufState *state)
+{
+ return list_to_bitstr_buf(1, state);
+}
+
+static ErlDrvSizeT
+list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *state)
+{
+ return list_to_bitstr_buf(0, state);
}
static int
-bitstr_list_len(Eterm obj, Uint* num_bytes)
+list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp)
+{
+ int res;
+ char *buf = state->buf;
+ char *next_buf;
+ int offset = state->offset;
+ int next_offset;
+#ifdef DEBUG
+ ErlDrvSizeT len = state->len;
+ ErlDrvSizeT next_len;
+#endif
+ byte* bptr;
+ size_t size;
+ size_t max_size;
+ Uint bitoffs;
+ Uint num_bits;
+ Uint bitsize;
+ int yield_count = *yield_countp;
+
+ if (state->bcopy.bptr) {
+ bptr = state->bcopy.bptr;
+ size = state->bcopy.size;
+ bitoffs = state->bcopy.bitoffs;
+ bitsize = state->bcopy.bitsize;
+ state->bcopy.bptr = NULL;
+ }
+ else {
+
+ ASSERT(is_binary(obj));
+
+ size = binary_size(obj);
+
+ ASSERT(size <= len);
+
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
+ }
+
+ max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ if (yield_count > 0)
+ max_size *= (size_t) (yield_count+1);
+
+ if (size <= max_size) {
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {
+ int cost = (int) size;
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ yield_count -= cost;
+ }
+ next_offset = offset + bitsize;
+ next_buf = buf + size+(next_offset>7);
+#ifdef DEBUG
+ next_len = len - size+(next_offset>7);
+#endif
+ next_offset &= 7;
+ num_bits = 8*size+bitsize;
+ res = 0;
+ }
+ else {
+ ASSERT(0 < max_size && max_size < size);
+ yield_count = 0;
+ state->bcopy.bptr = bptr + max_size;
+ state->bcopy.bitoffs = bitoffs;
+ state->bcopy.bitsize = bitsize;
+ state->bcopy.size = size - max_size;
+ next_buf = buf + max_size;
+#ifdef DEBUG
+ next_len = len - max_size;
+#endif
+ next_offset = offset;
+ num_bits = 8*max_size;
+ size = max_size;
+ res = 1;
+ }
+
+ copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
+
+ state->offset = next_offset;
+ state->buf = next_buf;
+#ifdef DEBUG
+ state->len = next_len;
+#endif
+ *yield_countp = yield_count;
+
+ return res;
+}
+
+static int
+bitstr_list_len(ErtsIOListState *state)
{
Eterm* objp;
- Uint len = 0;
- Uint offs = 0;
+ Eterm obj;
+ Uint len, offs;
+ int res, init_yield_count, yield_count;
DECLARE_ESTACK(s);
+
+ if (state->reds_left <= 0)
+ return ERTS_IOLIST_YIELD;
+
+ len = (Uint) state->size;
+ offs = state->offs;
+ obj = state->obj;
+
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED;
+ init_yield_count *= state->reds_left;
+ yield_count = init_yield_count;
+ if (state->estack.start) {
+ /* Restart; restore estack... */
+ ESTACK_RESTORE(s, &state->estack);
+ }
+
goto L_again;
#define SAFE_ADD(Var, Val) \
@@ -748,46 +1431,55 @@ bitstr_list_len(Eterm obj, Uint* num_bytes)
obj = ESTACK_POP(s);
L_again:
if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- /* Head */
- obj = CAR(objp);
- if (is_byte(obj)) {
- len++;
- if (len == 0) {
- goto L_overflow_error;
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (--yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ /* Head */
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ len++;
+ if (len == 0) {
+ goto L_overflow_error;
+ }
+ } else if (is_binary(obj)) {
+ SAFE_ADD(len, binary_size(obj));
+ SAFE_ADD_BITSIZE(offs, obj);
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- } else if (is_binary(obj)) {
- SAFE_ADD(len, binary_size(obj));
- SAFE_ADD_BITSIZE(offs, obj);
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else if (is_not_nil(obj)) {
- goto L_type_error;
+ /* Tail */
+ obj = CDR(objp);
+ if (is_list(obj))
+ continue; /* Tail loop */
+ else if (is_binary(obj)) {
+ SAFE_ADD(len, binary_size(obj));
+ SAFE_ADD_BITSIZE(offs, obj);
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- /* Tail */
- obj = CDR(objp);
- if (is_list(obj))
- goto L_iter_list; /* on tail */
- else if (is_binary(obj)) {
+ } else {
+ if (--yield_count <= 0)
+ goto L_yield;
+ if (is_binary(obj)) {
SAFE_ADD(len, binary_size(obj));
SAFE_ADD_BITSIZE(offs, obj);
} else if (is_not_nil(obj)) {
goto L_type_error;
}
- } else if (is_binary(obj)) {
- SAFE_ADD(len, binary_size(obj));
- SAFE_ADD_BITSIZE(offs, obj);
- } else if (is_not_nil(obj)) {
- goto L_type_error;
}
}
#undef SAFE_ADD
#undef SAFE_ADD_BITSIZE
- DESTROY_ESTACK(s);
-
/*
* Make sure that the number of bits in the bitstring will fit
* in an Uint to ensure that the binary can be matched using
@@ -800,15 +1492,42 @@ bitstr_list_len(Eterm obj, Uint* num_bytes)
if (len << 3 < len) {
goto L_overflow_error;
}
- *num_bytes = len;
- return ERTS_IOLIST_OK;
+ state->size = len;
- L_type_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TYPE;
+ res = ERTS_IOLIST_OK;
+
+ L_return: {
+ int yc = init_yield_count - yield_count;
+ int reds;
+
+ DESTROY_ESTACK(s);
+ CLEAR_SAVED_ESTACK(&state->estack);
+
+ reds = (yc - 1)/ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED + 1;
+ BUMP_REDS(state->c_p, reds);
+ state->reds_left -= reds;
+ state->size = (ErlDrvSizeT) len;
+ state->have_size = 1;
+ return res;
+ }
L_overflow_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_OVERFLOW;
+ res = ERTS_IOLIST_OVERFLOW;
+ len = 0;
+ goto L_return;
+
+ L_type_error:
+ res = ERTS_IOLIST_TYPE;
+ len = 0;
+ goto L_return;
+
+ L_yield:
+ BUMP_ALL_REDS(state->c_p);
+ state->reds_left = 0;
+ state->size = len;
+ state->offs = offs;
+ state->obj = obj;
+ ESTACK_SAVE(s, &state->estack);
+ return ERTS_IOLIST_YIELD;
}
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index ff775691b3..7e0e825a0d 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -2294,18 +2294,11 @@ BIF_RETTYPE binary_bin_to_list_1(BIF_ALIST_1)
BIF_ERROR(BIF_P,BADARG);
}
-/*
- * Ok, erlang:list_to_binary does not interrupt, and we really don't want
- * an alternative implementation for the exact same thing, why we
- * have descided to use the old non-restarting implementation for now.
- * In reality, there are seldom many iterations involved in doing this, so the
- * problem of long-running bifs is not really that big in this case.
- * So, for now we use the old implementation also in the module binary.
- */
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_list_to_bin, 1)
BIF_RETTYPE binary_list_to_bin_1(BIF_ALIST_1)
{
- return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_binary_list_to_bin_1]);
}
typedef struct {
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 2adba9b240..4d5e55aaf5 100755..100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -2691,6 +2691,11 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("ets_limit",BIF_ARG_1)) {
BIF_RET(make_small(erts_db_get_max_tabs()));
}
+ else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) {
+ BIF_RET(erts_disable_tolerant_timeofday
+ ? am_disabled
+ : am_enabled);
+ }
BIF_ERROR(BIF_P, BADARG);
}
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 819b19e566..6c9f53ce87 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -166,7 +166,7 @@ Eterm erts_bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size,
* Common implementation for erlang:list_to_binary/1 and binary:list_to_bin/1
*/
-BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg);
+BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg, Export *bif);
BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple);
BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen);
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index a5d67571e2..8f246ffa07 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -259,10 +259,11 @@ static void schedule_free_dbtable(DbTable* tb)
/*
* NON-SMP case: Caller is *not* allowed to access the *tb
* structure after this function has returned!
- * SMP case: Caller is allowed to access the *tb structure
- * until the bif has returned (we typically
- * need to unlock the table lock after this
- * function has returned).
+ * SMP case: Caller is allowed to access the *common* part of the *tb
+ * structure until the bif has returned (we typically need to
+ * unlock the table lock after this function has returned).
+ * Caller is *not* allowed to access the specialized part
+ * (hash or tree) of *tb after this function has returned.
*/
ASSERT(erts_refc_read(&tb->common.ref, 0) == 0);
erts_schedule_thr_prgr_later_cleanup_op(free_dbtable,
@@ -3279,34 +3280,37 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
}
erts_smp_rwmtx_runlock(mmtl);
if (tb) {
- int reds;
- DbFixation** pp;
+ int reds = 0;
db_lock(tb, LCK_WRITE_REC);
- #ifdef ERTS_SMP
- erts_smp_mtx_lock(&tb->common.fixlock);
- #endif
- reds = 10;
-
- for (pp = &tb->common.fixations; *pp != NULL;
- pp = &(*pp)->next) {
- if ((*pp)->pid == pid) {
- DbFixation* fix = *pp;
- erts_aint_t diff = -((erts_aint_t) fix->counter);
- erts_refc_add(&tb->common.ref,diff,0);
- *pp = fix->next;
- erts_db_free(ERTS_ALC_T_DB_FIXATION,
- tb, fix, sizeof(DbFixation));
- ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
- break;
+ if (!(tb->common.status & DB_DELETE)) {
+ DbFixation** pp;
+
+ #ifdef ERTS_SMP
+ erts_smp_mtx_lock(&tb->common.fixlock);
+ #endif
+ reds = 10;
+
+ for (pp = &tb->common.fixations; *pp != NULL;
+ pp = &(*pp)->next) {
+ if ((*pp)->pid == pid) {
+ DbFixation* fix = *pp;
+ erts_aint_t diff = -((erts_aint_t) fix->counter);
+ erts_refc_add(&tb->common.ref,diff,0);
+ *pp = fix->next;
+ erts_db_free(ERTS_ALC_T_DB_FIXATION,
+ tb, fix, sizeof(DbFixation));
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
+ break;
+ }
+ }
+ #ifdef ERTS_SMP
+ erts_smp_mtx_unlock(&tb->common.fixlock);
+ #endif
+ if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) {
+ db_unfix_table_hash(&(tb->hash));
+ reds += 40;
}
- }
- #ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
- #endif
- if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) {
- db_unfix_table_hash(&(tb->hash));
- reds += 40;
}
db_unlock(tb, LCK_WRITE_REC);
BUMP_REDS(c_p, reds);
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 3ecb379326..5ced8c5ca0 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -198,7 +198,7 @@ typedef long long ErlDrvSInt64;
#error No 64-bit integer type
#endif
-#if defined(__WIN32__)
+#if defined(__WIN32__) || defined(_WIN32)
typedef ErlDrvUInt ErlDrvSizeT;
typedef ErlDrvSInt ErlDrvSSizeT;
#else
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index d54658f1ea..5e6d812242 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -324,7 +324,6 @@ erl_init(int ncpu,
BIN_VH_MIN_SIZE = erts_next_heap_size(BIN_VH_MIN_SIZE, 0);
erts_init_trace();
- erts_init_binary();
erts_init_bits();
erts_code_ix_init();
erts_init_fun_table();
@@ -337,6 +336,7 @@ erl_init(int ncpu,
erts_ddll_init();
init_emulator();
erts_ptab_init(); /* Must be after init_emulator() */
+ erts_init_binary(); /* Must be after init_emulator() */
erts_bp_init();
init_db(); /* Must be after init_emulator */
erts_bif_timer_init();
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 7e3a90779d..c13eb87012 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -270,9 +270,9 @@ union erts_lc_free_block_t_ {
static ethr_tsd_key locks_key;
-static erts_lc_locked_locks_t *erts_locked_locks;
+static erts_lc_locked_locks_t *erts_locked_locks = NULL;
-static erts_lc_free_block_t *free_blocks;
+static erts_lc_free_block_t *free_blocks = NULL;
#ifdef ERTS_LC_STATIC_ALLOC
#define ERTS_LC_FB_CHUNK_SIZE 10000
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index fdd2d0c0f6..5e740aacdd 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -58,6 +58,8 @@
* - maps:size/1
* - maps:without/2
*
+ * DEBUG: for sharing calculation
+ * - erts_internal:map_to_tuple_keys/1
*/
/* erlang:map_size/1
@@ -819,3 +821,17 @@ int erts_validate_and_sort_map(map_t* mp)
}
return 1;
}
+
+/*
+ * erts_internal:map_to_tuple_keys/1
+ *
+ * Used in erts_debug:size/1
+ */
+
+BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) {
+ if (is_map(BIF_ARG_1)) {
+ map_t *mp = (map_t*)map_val(BIF_ARG_1);
+ BIF_RET(mp->keys);
+ }
+ BIF_ERROR(BIF_P, BADARG);
+}
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 0eb8117980..59a677a12c 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -1032,7 +1032,6 @@ erts_send_message(Process* sender,
}
BM_SWAP_TIMER(send,system);
} else {
-#ifdef ERTS_SMP
ErlOffHeap *ohp;
Eterm *hp;
erts_aint32_t state;
@@ -1064,42 +1063,6 @@ erts_send_message(Process* sender,
#endif
);
BM_SWAP_TIMER(send,system);
-#else
- ErlMessage* mp = message_alloc();
- Eterm *hp;
- BM_SWAP_TIMER(send,size);
- msize = size_object(message);
- BM_SWAP_TIMER(size,send);
-
- if (receiver->stop - receiver->htop <= msize) {
- BM_SWAP_TIMER(send,system);
- erts_garbage_collect(receiver, msize, receiver->arg_reg, receiver->arity);
- BM_SWAP_TIMER(system,send);
- }
- hp = receiver->htop;
- receiver->htop = hp + msize;
- BM_SWAP_TIMER(send,copy);
- message = copy_struct(message, msize, &hp, &receiver->off_heap);
- BM_MESSAGE_COPIED(msize);
- BM_SWAP_TIMER(copy,send);
- DTRACE6(message_send, sender_name, receiver_name,
- (uint32_t)msize, tok_label, tok_lastcnt, tok_serial);
- ERL_MESSAGE_TERM(mp) = message;
- ERL_MESSAGE_TOKEN(mp) = NIL;
-#ifdef USE_VM_PROBES
- ERL_MESSAGE_DT_UTAG(mp) = NIL;
-#endif
- mp->next = NULL;
- mp->data.attached = NULL;
- LINK_MESSAGE(receiver, mp);
- res = receiver->msg.len;
- erts_proc_notify_new_message(receiver);
-
- if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) {
- trace_receive(receiver, message);
- }
- BM_SWAP_TIMER(send,system);
-#endif /* #ifndef ERTS_SMP */
}
return res;
}
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index b4b97d7df1..b73f9b7f92 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -2672,6 +2672,13 @@ aux_thread(void *unused)
ErtsThrPrgrCallbacks callbacks;
int thr_prgr_active = 1;
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ {
+ char buf[] = "aux_thread";
+ erts_lc_set_thread_name(buf);
+ }
+#endif
+
ssi->event = erts_tse_fetch();
callbacks.arg = (void *) ssi;
@@ -6144,7 +6151,7 @@ suspend_process(Process *c_p, Process *p)
if (c_p == p) {
state = erts_smp_atomic32_read_bor_relb(&p->state,
ERTS_PSFLG_SUSPENDED);
- ASSERT(state & ERTS_PSFLG_RUNNING);
+ ASSERT(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS));
suspended = (state & ERTS_PSFLG_SUSPENDED) ? -1: 1;
}
else {
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 3a968594f3..f8e1431a53 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -2126,6 +2126,8 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes)
mac = 1;
case ERL_FILENAME_UTF8:
size = strlen((char *) bytes);
+ if (size == 0)
+ return NIL;
if (erts_analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != ERTS_UTF8_OK) {
goto noconvert;
}
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 656de7c49a..8d240355b0 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -44,9 +44,6 @@
#include "erl_zlib.h"
#include "erl_map.h"
-#ifdef HIPE
-#include "hipe_mode_switch.h"
-#endif
#define in_area(ptr,start,nbytes) ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
#define MAX_STRING_LEN 0xffff
@@ -111,26 +108,17 @@ static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acm
static Export binary_to_term_trap_export;
static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1);
-static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b);
+static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
+ Export *bif, Eterm arg0, Eterm arg1);
void erts_init_external(void) {
-#if 1 /* In R16 */
erts_init_trap_export(&term_to_binary_trap_export,
- am_erlang, am_term_to_binary_trap, 1,
+ am_erts_internal, am_term_to_binary_trap, 1,
&term_to_binary_trap_1);
erts_init_trap_export(&binary_to_term_trap_export,
- am_erlang, am_binary_to_term_trap, 1,
+ am_erts_internal, am_binary_to_term_trap, 1,
&binary_to_term_trap_1);
-#else
- sys_memset((void *) &term_to_binary_trap_export, 0, sizeof(Export));
- term_to_binary_trap_export.address = &term_to_binary_trap_export.code[3];
- term_to_binary_trap_export.code[0] = am_erlang;
- term_to_binary_trap_export.code[1] = am_term_to_binary_trap;
- term_to_binary_trap_export.code[2] = 1;
- term_to_binary_trap_export.code[3] = (BeamInstr) em_apply_bif;
- term_to_binary_trap_export.code[4] = (BeamInstr) &term_to_binary_trap_1;
-#endif
return;
}
@@ -1069,6 +1057,8 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1)
}
}
+HIPE_WRAPPER_BIF_DISABLE_GC(term_to_binary, 1)
+
BIF_RETTYPE term_to_binary_1(BIF_ALIST_1)
{
Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL);
@@ -1081,6 +1071,8 @@ BIF_RETTYPE term_to_binary_1(BIF_ALIST_1)
}
}
+HIPE_WRAPPER_BIF_DISABLE_GC(term_to_binary, 2)
+
BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
{
Process* p = BIF_P;
@@ -1185,6 +1177,8 @@ typedef struct B2TContext_t {
Uint32 flags;
SWord reds;
Eterm trap_bin;
+ Export *bif;
+ Eterm arg[2];
enum B2TState state;
union {
B2TSizeContext sc;
@@ -1356,7 +1350,8 @@ static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1)
Binary *context_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val;
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor);
- return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin);
+ return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL,
+ THE_NON_VALUE, THE_NON_VALUE);
}
@@ -1391,8 +1386,10 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src)
return ctx;
}
-static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b)
+static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
+ Export *bif_init, Eterm arg0, Eterm arg1)
{
+ BIF_RETTYPE ret_val;
#ifdef EXTREME_B2T_TRAPPING
SWord initial_reds = 1 + b2t_rand() % 4;
#else
@@ -1409,6 +1406,9 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
ctx->state = B2TPrepare;
ctx->aligned_alloc = NULL;
ctx->flags = flags;
+ ctx->bif = bif_init;
+ ctx->arg[0] = arg0;
+ ctx->arg[1] = arg1;
IF_DEBUG(ctx->trap_bin = THE_NON_VALUE;)
} else {
is_first_call = 0;
@@ -1504,12 +1504,24 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
HRelease(p, ctx->u.dc.hp_end, ctx->u.dc.hp_start);
/*fall through*/
case B2TBadArg:
- b2t_destroy_context(ctx);
- if (!is_first_call) {
- erts_set_gc_state(p, 1);
- }
BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION);
- BIF_ERROR(p, BADARG & ~EXF_SAVETRACE);
+
+ ASSERT(ctx->bif == bif_export[BIF_binary_to_term_1]
+ || ctx->bif == bif_export[BIF_binary_to_term_2]);
+
+ if (is_first_call)
+ ERTS_BIF_PREP_ERROR(ret_val, p, BADARG);
+ else {
+ erts_set_gc_state(p, 1);
+ if (is_non_value(ctx->arg[1]))
+ ERTS_BIF_PREP_ERROR_TRAPPED1(ret_val, p, BADARG, ctx->bif,
+ ctx->arg[0]);
+ else
+ ERTS_BIF_PREP_ERROR_TRAPPED2(ret_val, p, BADARG, ctx->bif,
+ ctx->arg[0], ctx->arg[1]);
+ }
+ b2t_destroy_context(ctx);
+ return ret_val;
case B2TDone:
b2t_destroy_context(ctx);
@@ -1524,7 +1536,8 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
erts_set_gc_state(p, 1);
}
BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION);
- return ctx->u.dc.res;
+ ERTS_BIF_PREP_RET(ret_val, ctx->u.dc.res);
+ return ret_val;
default:
ASSERT(!"Unknown state in binary_to_term");
@@ -1541,15 +1554,24 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
erts_set_gc_state(p, 0);
}
BUMP_ALL_REDS(p);
- BIF_TRAP1(&binary_to_term_trap_export, p, ctx->trap_bin);
+
+ ERTS_BIF_PREP_TRAP1(ret_val, &binary_to_term_trap_export,
+ p, ctx->trap_bin);
+
+ return ret_val;
}
-BIF_RETTYPE erts_internal_binary_to_term_1(BIF_ALIST_1)
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 1)
+
+BIF_RETTYPE binary_to_term_1(BIF_ALIST_1)
{
- return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL);
+ return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_1],
+ BIF_ARG_1, THE_NON_VALUE);
}
-BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2)
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 2)
+
+BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
{
Eterm opts;
Eterm opt;
@@ -1570,7 +1592,8 @@ BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2)
if (is_not_nil(opts))
goto error;
- return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL);
+ return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_2],
+ BIF_ARG_1, BIF_ARG_2);
error:
BIF_ERROR(BIF_P, BADARG);
@@ -4440,66 +4463,3 @@ error:
#undef SKIP2
#undef CHKSIZE
}
-
-
-#ifdef HIPE
-BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1);
-BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2);
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1);
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2);
-
-/* Hipe wrappers used by native code for BIFs that disable GC while trapping.
- *
- * Problem:
- * When native code calls a BIF that traps, hipe_mode_switch will push a
- * "trap frame" on the Erlang stack in order to find its way back from beam_emu
- * back to native caller when finally done. If GC is disabled and stack/heap
- * is full there is no place to push the "trap frame".
- *
- * Solution:
- * We reserve space on stack for the "trap frame" here before the BIF is called.
- * If the BIF does not trap, the space is reclaimed here before returning.
- * If the BIF traps, hipe_push_beam_trap_frame() will detect that a "trap frame"
- * already is reserved and use it.
- */
-BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1);
- res = term_to_binary_1(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2);
- res = term_to_binary_2(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1);
- res = erts_internal_binary_to_term_1(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2);
- res = erts_internal_binary_to_term_2(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-#endif /*HIPE*/
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 8fcb95d0e2..891046a8b5 100755..100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -435,6 +435,8 @@ do {\
}\
} while(0)
+#define CLEAR_SAVED_ESTACK(estack) ((void) ((estack)->start = NULL))
+
/*
* Use on empty stack, only the allocator can be changed before this.
* The src stack is reset to NULL.
@@ -551,6 +553,8 @@ do {\
}\
} while(0)
+#define CLEAR_SAVED_WSTACK(wstack) ((void) ((wstack)->wstart = NULL))
+
/*
* Use on empty stack, only the allocator can be changed before this.
* The src stack is reset to NULL.
@@ -951,20 +955,67 @@ struct Sint_buf {
};
char* Sint_to_buf(Sint, struct Sint_buf*);
+#define ERTS_IOLIST_STATE_INITER(C_P, OBJ) \
+ {(C_P), 0, 0, (OBJ), {NULL, NULL, NULL, ERTS_ALC_T_INVALID}, 0, 0}
+
+#define ERTS_IOLIST_STATE_MOVE(TO, FROM) \
+ sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOListState))
+
+#define ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED 8
+
+typedef struct {
+ Process *c_p;
+ ErlDrvSizeT size;
+ Uint offs;
+ Eterm obj;
+ ErtsEStack estack;
+ int reds_left;
+ int have_size;
+} ErtsIOListState;
+
+#define ERTS_IOLIST2BUF_STATE_INITER(C_P, OBJ) \
+ {ERTS_IOLIST_STATE_INITER((C_P), (OBJ)), {NULL, 0, 0, 0}, NULL, 0, NULL, 0}
+
+#define ERTS_IOLIST2BUF_STATE_MOVE(TO, FROM) \
+ sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOList2BufState))
+
+#define ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT 32
+#define ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED 8
+#define ERTS_IOLIST_TO_BUF_BYTES_PER_RED \
+ (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED*ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT)
+
+typedef struct {
+ ErtsIOListState iolist;
+ struct {
+ byte *bptr;
+ size_t size;
+ Uint bitoffs;
+ Uint bitsize;
+ } bcopy;
+ char *buf;
+ ErlDrvSizeT len;
+ Eterm *objp;
+ int offset;
+} ErtsIOList2BufState;
+
#define ERTS_IOLIST_OK 0
#define ERTS_IOLIST_OVERFLOW 1
#define ERTS_IOLIST_TYPE 2
+#define ERTS_IOLIST_YIELD 3
Eterm buf_to_intlist(Eterm**, const char*, size_t, Eterm); /* most callers pass plain char*'s */
#define ERTS_IOLIST_TO_BUF_OVERFLOW (~((ErlDrvSizeT) 0))
#define ERTS_IOLIST_TO_BUF_TYPE_ERROR (~((ErlDrvSizeT) 1))
+#define ERTS_IOLIST_TO_BUF_YIELD (~((ErlDrvSizeT) 2))
#define ERTS_IOLIST_TO_BUF_FAILED(R) \
- (((R) & (~((ErlDrvSizeT) 1))) == (~((ErlDrvSizeT) 1)))
+ (((R) & (~((ErlDrvSizeT) 3))) == (~((ErlDrvSizeT) 3)))
#define ERTS_IOLIST_TO_BUF_SUCCEEDED(R) \
(!ERTS_IOLIST_TO_BUF_FAILED((R)))
ErlDrvSizeT erts_iolist_to_buf(Eterm, char*, ErlDrvSizeT);
+ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *);
+int erts_iolist_size_yielding(ErtsIOListState *state);
int erts_iolist_size(Eterm, ErlDrvSizeT *);
int is_string(Eterm);
void erl_at_exit(void (*) (void*), void*);
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 738f793020..72092ec7b0 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -3197,106 +3197,303 @@ buf_to_intlist(Eterm** hpp, const char *buf, size_t len, Eterm tail)
**
*/
-ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
+typedef enum {
+ ERTS_IL2B_BCOPY_OK,
+ ERTS_IL2B_BCOPY_YIELD,
+ ERTS_IL2B_BCOPY_OVERFLOW,
+ ERTS_IL2B_BCOPY_TYPE_ERROR
+} ErtsIL2BBCopyRes;
+
+static ErtsIL2BBCopyRes
+iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp);
+
+static ERTS_INLINE ErlDrvSizeT
+iolist_to_buf(const int yield_support,
+ ErtsIOList2BufState *state,
+ Eterm obj,
+ char* buf,
+ ErlDrvSizeT alloced_len)
{
- ErlDrvSizeT len = (ErlDrvSizeT) alloced_len;
- Eterm* objp;
+#undef IOLIST_TO_BUF_BCOPY
+#define IOLIST_TO_BUF_BCOPY(CONSP) \
+do { \
+ size_t size = binary_size(obj); \
+ if (size > 0) { \
+ Uint bitsize; \
+ byte* bptr; \
+ Uint bitoffs; \
+ Uint num_bits; \
+ if (yield_support) { \
+ size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ if (yield_count > 0) \
+ max_size *= yield_count+1; \
+ if (size > max_size) { \
+ state->objp = CONSP; \
+ goto L_bcopy_yield; \
+ } \
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { \
+ int cost = (int) size; \
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ yield_count -= cost; \
+ } \
+ } \
+ if (len < size) \
+ goto L_overflow; \
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); \
+ if (bitsize != 0) \
+ goto L_type_error; \
+ num_bits = 8*size; \
+ copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); \
+ buf += size; \
+ len -= size; \
+ } \
+} while (0)
+
+ ErlDrvSizeT res, len;
+ Eterm* objp = NULL;
+ int init_yield_count;
+ int yield_count;
DECLARE_ESTACK(s);
- goto L_again;
-
- while (!ESTACK_ISEMPTY(s)) {
- obj = ESTACK_POP(s);
- L_again:
- if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- obj = CAR(objp);
- if (is_byte(obj)) {
- if (len == 0) {
- goto L_overflow;
- }
- *buf++ = unsigned_val(obj);
- len--;
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- if (len < size) {
+
+ len = (ErlDrvSizeT) alloced_len;
+
+ if (!yield_support) {
+ yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+ goto L_again;
+ }
+ else {
+
+ if (state->iolist.reds_left <= 0)
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED
+ * state->iolist.reds_left);
+ yield_count = init_yield_count;
+
+ if (!state->iolist.estack.start)
+ goto L_again;
+ else {
+ int chk_stack;
+ /* Restart; restore state... */
+ ESTACK_RESTORE(s, &state->iolist.estack);
+
+ if (!state->bcopy.bptr)
+ chk_stack = 0;
+ else {
+ chk_stack = 1;
+ switch (iolist_to_buf_bcopy(state, THE_NON_VALUE, &yield_count)) {
+ case ERTS_IL2B_BCOPY_OK:
+ break;
+ case ERTS_IL2B_BCOPY_YIELD:
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+ case ERTS_IL2B_BCOPY_OVERFLOW:
goto L_overflow;
- }
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- if (bitsize != 0) {
+ case ERTS_IL2B_BCOPY_TYPE_ERROR:
goto L_type_error;
}
- num_bits = 8*size;
- copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
- buf += size;
- len -= size;
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else if (is_not_nil(obj)) {
- goto L_type_error;
}
- obj = CDR(objp);
- if (is_list(obj)) {
- goto L_iter_list; /* on tail */
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
- if (len < size) {
- goto L_overflow;
+ obj = state->iolist.obj;
+ buf = state->buf;
+ len = state->len;
+ objp = state->objp;
+ state->objp = NULL;
+ if (objp)
+ goto L_tail;
+ if (!chk_stack)
+ goto L_again;
+ /* check stack */
+ }
+ }
+
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
+ L_again:
+ if (is_list(obj)) {
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ if (len == 0) {
+ goto L_overflow;
+ }
+ *buf++ = unsigned_val(obj);
+ len--;
+ } else if (is_binary(obj)) {
+ IOLIST_TO_BUF_BCOPY(objp);
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- if (bitsize != 0) {
+
+ L_tail:
+
+ obj = CDR(objp);
+
+ if (is_list(obj)) {
+ continue; /* Tail loop */
+ } else if (is_binary(obj)) {
+ IOLIST_TO_BUF_BCOPY(NULL);
+ } else if (is_not_nil(obj)) {
goto L_type_error;
}
- num_bits = 8*size;
- copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
- buf += size;
- len -= size;
- } else if (is_not_nil(obj)) {
- goto L_type_error;
+ break;
}
} else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
- if (len < size) {
- goto L_overflow;
- }
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- if (bitsize != 0) {
- goto L_type_error;
- }
- num_bits = 8*size;
- copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
- buf += size;
- len -= size;
+ IOLIST_TO_BUF_BCOPY(NULL);
} else if (is_not_nil(obj)) {
goto L_type_error;
- }
+ } else if (yield_support && --yield_count <= 0)
+ goto L_yield;
}
+ res = len;
+
+ L_return:
+
DESTROY_ESTACK(s);
- return len;
+
+ if (yield_support) {
+ int reds;
+ CLEAR_SAVED_ESTACK(&state->iolist.estack);
+ reds = ((init_yield_count - yield_count - 1)
+ / ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1;
+ BUMP_REDS(state->iolist.c_p, reds);
+ state->iolist.reds_left -= reds;
+ if (state->iolist.reds_left < 0)
+ state->iolist.reds_left = 0;
+ }
+
+
+ return res;
L_type_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TO_BUF_TYPE_ERROR;
+ res = ERTS_IOLIST_TO_BUF_TYPE_ERROR;
+ goto L_return;
L_overflow:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TO_BUF_OVERFLOW;
+ res = ERTS_IOLIST_TO_BUF_OVERFLOW;
+ goto L_return;
+
+ L_bcopy_yield:
+
+ state->buf = buf;
+ state->len = len;
+
+ switch (iolist_to_buf_bcopy(state, obj, &yield_count)) {
+ case ERTS_IL2B_BCOPY_OK:
+ ERTS_INTERNAL_ERROR("Missing yield");
+ case ERTS_IL2B_BCOPY_YIELD:
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+ case ERTS_IL2B_BCOPY_OVERFLOW:
+ goto L_overflow;
+ case ERTS_IL2B_BCOPY_TYPE_ERROR:
+ goto L_type_error;
+ }
+
+ L_yield:
+
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ state->iolist.obj = obj;
+ state->buf = buf;
+ state->len = len;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+#undef IOLIST_TO_BUF_BCOPY
+}
+
+static ErtsIL2BBCopyRes
+iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp)
+{
+ ErtsIL2BBCopyRes res;
+ char *buf = state->buf;
+ ErlDrvSizeT len = state->len;
+ byte* bptr;
+ size_t size;
+ size_t max_size;
+ Uint bitoffs;
+ Uint num_bits;
+ int yield_count = *yield_countp;
+
+ if (state->bcopy.bptr) {
+ bptr = state->bcopy.bptr;
+ size = state->bcopy.size;
+ bitoffs = state->bcopy.bitoffs;
+ state->bcopy.bptr = NULL;
+ }
+ else {
+ Uint bitsize;
+
+ ASSERT(is_binary(obj));
+
+ size = binary_size(obj);
+ if (size <= 0)
+ return ERTS_IL2B_BCOPY_OK;
+
+ if (len < size)
+ return ERTS_IL2B_BCOPY_OVERFLOW;
+
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
+ if (bitsize != 0)
+ return ERTS_IL2B_BCOPY_TYPE_ERROR;
+ }
+
+ ASSERT(size > 0);
+ max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ if (yield_count > 0)
+ max_size *= (size_t) (yield_count+1);
+
+ if (size <= max_size) {
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {
+ int cost = (int) size;
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ yield_count -= cost;
+ }
+ res = ERTS_IL2B_BCOPY_OK;
+ }
+ else {
+ ASSERT(0 < max_size && max_size < size);
+ yield_count = 0;
+ state->bcopy.bptr = bptr + max_size;
+ state->bcopy.bitoffs = bitoffs;
+ state->bcopy.size = size - max_size;
+ size = max_size;
+ res = ERTS_IL2B_BCOPY_YIELD;
+ }
+
+ num_bits = 8*size;
+ copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
+ state->buf += size;
+ state->len -= size;
+ *yield_countp = yield_count;
+
+ return res;
+}
+
+ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *state)
+{
+ return iolist_to_buf(1, state, state->iolist.obj, state->buf, state->len);
+}
+
+ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
+{
+ return iolist_to_buf(0, NULL, obj, buf, alloced_len);
}
/*
@@ -3307,11 +3504,32 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
* Any input term error detected in erts_iolist_to_buf should also
* be detected in this function!
*/
-int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
+
+static ERTS_INLINE int
+iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSizeT* sizep)
{
+ int res, init_yield_count, yield_count;
Eterm* objp;
- Uint size = 0; /* Intentionally Uint due to halfword heap */
+ Uint size = (Uint) *sizep; /* Intentionally Uint due to halfword heap */
DECLARE_ESTACK(s);
+
+ if (!yield_support)
+ yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+ else {
+ if (state->reds_left <= 0)
+ return ERTS_IOLIST_YIELD;
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED;
+ init_yield_count *= state->reds_left;
+ yield_count = init_yield_count;
+ if (state->estack.start) {
+ /* Restart; restore state... */
+ ESTACK_RESTORE(s, &state->estack);
+ size = (Uint) state->size;
+ obj = state->obj;
+ }
+ }
+
goto L_again;
#define SAFE_ADD(Var, Val) \
@@ -3327,51 +3545,101 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
obj = ESTACK_POP(s);
L_again:
if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- /* Head */
- obj = CAR(objp);
- if (is_byte(obj)) {
- size++;
- if (size == 0) {
- goto L_overflow_error;
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ /* Head */
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ size++;
+ if (size == 0) {
+ goto L_overflow_error;
+ }
+ } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+ SAFE_ADD(size, binary_size(obj));
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
- SAFE_ADD(size, binary_size(obj));
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else if (is_not_nil(obj)) {
- goto L_type_error;
+ /* Tail */
+ obj = CDR(objp);
+ if (is_list(obj))
+ continue; /* Tail loop */
+ else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+ SAFE_ADD(size, binary_size(obj));
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- /* Tail */
- obj = CDR(objp);
- if (is_list(obj))
- goto L_iter_list; /* on tail */
- else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+ } else {
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */
SAFE_ADD(size, binary_size(obj));
} else if (is_not_nil(obj)) {
goto L_type_error;
}
- } else if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */
- SAFE_ADD(size, binary_size(obj));
- } else if (is_not_nil(obj)) {
- goto L_type_error;
}
}
#undef SAFE_ADD
- DESTROY_ESTACK(s);
*sizep = (ErlDrvSizeT) size;
- return ERTS_IOLIST_OK;
- L_overflow_error:
+ res = ERTS_IOLIST_OK;
+
+ L_return:
+
DESTROY_ESTACK(s);
- return ERTS_IOLIST_OVERFLOW;
+
+ if (yield_support) {
+ int yc, reds;
+ CLEAR_SAVED_ESTACK(&state->estack);
+ yc = init_yield_count - yield_count;
+ reds = ((yc - 1) / ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED) + 1;
+ BUMP_REDS(state->c_p, reds);
+ state->reds_left -= reds;
+ state->size = (ErlDrvSizeT) size;
+ state->have_size = 1;
+ }
+
+ return res;
+
+ L_overflow_error:
+ res = ERTS_IOLIST_OVERFLOW;
+ size = 0;
+ goto L_return;
L_type_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TYPE;
+ res = ERTS_IOLIST_TYPE;
+ size = 0;
+ goto L_return;
+
+ L_yield:
+ BUMP_ALL_REDS(state->c_p);
+ state->reds_left = 0;
+ state->size = size;
+ state->obj = obj;
+ ESTACK_SAVE(s, &state->estack);
+ return ERTS_IOLIST_YIELD;
+}
+
+int erts_iolist_size_yielding(ErtsIOListState *state)
+{
+ ErlDrvSizeT size = state->size;
+ return iolist_size(1, state, state->obj, &size);
+}
+
+int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
+{
+ *sizep = 0;
+ return iolist_size(0, NULL, obj, sizep);
}
/* return 0 if item is not a non-empty flat list of bytes */
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index 42f41c5f3d..878beb055b 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -360,7 +360,12 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
int fd;
int mode; /* Open mode. */
- if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) {
+ if (stat(name, &statbuf) < 0) {
+ /* statbuf is undefined: if the caller depends on it,
+ i.e. invoke_read_file(), fail the call immediately */
+ if (pSize && flags == EFILE_MODE_READ)
+ return check_error(-1, errInfo);
+ } else if (!ISREG(statbuf)) {
/*
* For UNIX only, here is some ugly code to allow
* /dev/null to be opened as a file.
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index 0997d81b2f..5f92b6bac4 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -268,9 +268,16 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc)
*/
define(CFUN,`ifelse($1,term_to_binary_1,hipe_wrapper_term_to_binary_1,
ifelse($1,term_to_binary_2,hipe_wrapper_term_to_binary_2,
-ifelse($1,erts_internal_binary_to_term_1,hipe_wrapper_erts_internal_binary_to_term_1,
-ifelse($1,erts_internal_binary_to_term_2,hipe_wrapper_erts_internal_binary_to_term_2,
-$1))))')
+ifelse($1,binary_to_term_1,hipe_wrapper_binary_to_term_1,
+ifelse($1,binary_to_term_2,hipe_wrapper_binary_to_term_2,
+ifelse($1,binary_to_list_1,hipe_wrapper_binary_to_list_1,
+ifelse($1,binary_to_list_3,hipe_wrapper_binary_to_list_3,
+ifelse($1,bitstring_to_list_1,hipe_wrapper_bitstring_to_list_1,
+ifelse($1,list_to_binary_1,hipe_wrapper_list_to_binary_1,
+ifelse($1,iolist_to_binary_1,hipe_wrapper_iolist_to_binary_1,
+ifelse($1,binary_list_to_bin_1,hipe_wrapper_binary_list_to_bin_1,
+ifelse($1,list_to_bitstring_1,hipe_wrapper_list_to_bitstring_1,
+$1)))))))))))')
define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))')
include(TARGET/`erl_bif_list.h')
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 0ded6b274e..0ded6b274e 100755..100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 7aba367e33..44e9e4f243 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -58,7 +58,8 @@
ordering/1,unaligned_order/1,gc_test/1,
bit_sized_binary_sizes/1,
otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1,
- otp_8180/1, trapping/1]).
+ otp_8180/1, trapping/1, large/1,
+ error_after_yield/1, cmp_old_impl/1]).
%% Internal exports.
-export([sleeper/0,trapping_loop/4]).
@@ -76,7 +77,8 @@ all() ->
bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
ordering, unaligned_order, gc_test,
bit_sized_binary_sizes, otp_6817, otp_8117, deep,
- obsolete_funs, robustness, otp_8180, trapping].
+ obsolete_funs, robustness, otp_8180, trapping, large,
+ error_after_yield, cmp_old_impl].
groups() ->
[].
@@ -1351,7 +1353,16 @@ trapping(Config) when is_list(Config)->
do_trapping(5, term_to_binary,
fun() -> [lists:duplicate(2000000,2000000)] end),
do_trapping(5, binary_to_term,
- fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end).
+ fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end),
+ do_trapping(5, binary_to_list,
+ fun() -> [list_to_binary(lists:duplicate(2000000,$x))] end),
+ do_trapping(5, list_to_binary,
+ fun() -> [lists:duplicate(2000000,$x)] end),
+ do_trapping(5, bitstring_to_list,
+ fun() -> [list_to_bitstring([lists:duplicate(2000000,$x),<<7:4>>])] end),
+ do_trapping(5, list_to_bitstring,
+ fun() -> [[lists:duplicate(2000000,$x),<<7:4>>]] end)
+ .
do_trapping(0, _, _) ->
ok;
@@ -1384,9 +1395,189 @@ trapping_loop2(Bif,Args,N) ->
apply(erlang,Bif,Args),
trapping_loop2(Bif, Args, N-1).
+large(Config) when is_list(Config) ->
+ List = lists:flatten(lists:map(fun (_) ->
+ [0,1,2,3,4,5,6,7,8]
+ end,
+ lists:seq(1, 131072))),
+ Bin = list_to_binary(List),
+ List = binary_to_list(Bin),
+ PartList = lists:reverse(tl(tl(lists:reverse(tl(tl(List)))))),
+ PartList = binary_to_list(Bin, 3, length(List)-2),
+ ListBS = List ++ [<<7:4>>],
+ ListBS = bitstring_to_list(list_to_bitstring(ListBS)),
+ BitStr1 = list_to_bitstring(lists:duplicate(1024*1024, [<<1,5:3>>])),
+ BitStr1 = list_to_bitstring(bitstring_to_list(BitStr1)),
+ BitStr2 = list_to_bitstring([lists:duplicate(512*1024, [<<1,5:3>>]),
+ Bin]),
+ BitStr2 = list_to_bitstring(bitstring_to_list(BitStr2)),
+ ok.
+
+error_after_yield(Config) when is_list(Config) ->
+ L2BTrap = {erts_internal, list_to_binary_continue, 1},
+ error_after_yield(badarg, erlang, list_to_binary, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap),
+ error_after_yield(badarg, erlang, iolist_to_binary, 1, fun () -> [[list2iolist(mk_list(1000000)), oops]] end, L2BTrap),
+ error_after_yield(badarg, erlang, list_to_bitstring, 1, fun () -> [[list2bitstrlist(mk_list(1000000)), oops]] end, L2BTrap),
+ error_after_yield(badarg, binary, list_to_bin, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap),
+
+ B2TTrap = {erts_internal, binary_to_term_trap, 1},
+
+ error_after_yield(badarg, erlang, binary_to_term, 1, fun () -> [error_after_yield_bad_ext_term()] end, B2TTrap),
+ error_after_yield(badarg, erlang, binary_to_term, 2, fun () -> [error_after_yield_bad_ext_term(), [safe]] end, B2TTrap),
+
+ case erlang:system_info(wordsize) of
+ 4 ->
+ SysLimitSz = 1 bsl 32,
+ error_after_yield(system_limit, erlang, list_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+ error_after_yield(system_limit, erlang, iolist_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+ error_after_yield(system_limit, erlang, list_to_bitstring, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+ error_after_yield(system_limit, binary, list_to_bin, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap);
+ 8 ->
+ % Takes waaaay to long time to test system_limit on 64-bit archs...
+ ok
+ end,
+ ok.
+
+error_after_yield(Type, M, F, AN, AFun, TrapFunc) ->
+ io:format("Testing ~p for ~p:~p/~p~n", [Type, M, F, AN]),
+ Tracer = self(),
+ {Pid, Mon} = spawn_monitor(fun () ->
+ A = AFun(),
+ try
+ erlang:yield(),
+ erlang:trace(self(),true,[running,{tracer,Tracer}]),
+ apply(M, F, A),
+ exit({unexpected_success, {M, F, A}})
+ catch
+ error:Type ->
+ erlang:trace(self(),false,[running,{tracer,Tracer}]),
+ %% We threw the exception from the native
+ %% function we trapped to, but we want
+ %% the BIF that originally was called
+ %% to appear in the stack trace.
+ [{M, F, A, _} | _] = erlang:get_stacktrace()
+ end
+ end),
+ receive
+ {'DOWN', Mon, process, Pid, Reason} ->
+ normal = Reason
+ end,
+ TD = erlang:trace_delivered(Pid),
+ receive
+ {trace_delivered, Pid, TD} ->
+ NoYields = error_after_yield_sched(Pid, TrapFunc, 0),
+ io:format("No of yields: ~p~n", [NoYields]),
+ true = NoYields > 2
+ end,
+ ok.
+
+error_after_yield_sched(P, TrapFunc, N) ->
+ receive
+ {trace, P, out, TrapFunc} ->
+ receive
+ {trace, P, in, TrapFunc} ->
+ error_after_yield_sched(P, TrapFunc, N+1)
+ after 0 ->
+ exit(trap_sched_mismatch)
+ end;
+ {trace, P, out, Func} ->
+ receive
+ {trace, P, in, Func} ->
+ error_after_yield_sched(P, TrapFunc, N)
+ after 0 ->
+ exit(other_sched_mismatch)
+ end
+ after 0 ->
+ N
+ end.
+
+error_after_yield_bad_ext_term() ->
+ TupleSz = 2000000,
+ <<131, % Version magic
+ AtomExt/binary>> = term_to_binary(an_atom_we_use_for_this),
+ BadAtomExt = [100, %% ATOM_EXT
+ 255, 255, % Invalid size of 65535 bytes
+ "oops"],
+
+ %% Produce a large tuple where the last element is invalid
+ list_to_binary([131, %% Version magic
+ 105, %% LARGE_TUPLE_EXT
+ <<TupleSz:32/big>>, %% Tuple size
+ lists:duplicate(TupleSz-1, AtomExt), %% Valid atoms
+ BadAtomExt]). %% Invalid atom at the end
+
+cmp_old_impl(Config) when is_list(Config) ->
+ %% Compare results from new yielding implementations with
+ %% old non yielding implementations
+ Cookie = atom_to_list(erlang:get_cookie()),
+ Rel = "r16b_latest",
+ case test_server:is_release_available(Rel) of
+ false ->
+ {skipped, "No "++Rel++" available"};
+ true ->
+ {ok, Node} = ?t:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel),
+ peer,
+ [{args, " -setcookie "++Cookie},
+ {erl, [{release, Rel}]}]),
+
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list_lb(10000000))]}),
+
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000000))]}),
+
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000000))]}),
+
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100000)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000000)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000000)))]}),
+
+ ?t:stop_node(Node),
+
+ ok
+ end.
%% Utilities.
+huge_iolist(Lim) ->
+ Sz = 1024,
+ huge_iolist(list_to_binary(mk_list(Sz)), Sz, Lim).
+
+huge_iolist(X, Sz, Lim) when Sz >= Lim ->
+ X;
+huge_iolist(X, Sz, Lim) ->
+ huge_iolist([X, X], Sz*2, Lim).
+
+cmp_node(Node, {M, F, A}) ->
+ Res = rpc:call(Node, M, F, A),
+ Res = apply(M, F, A),
+ ok.
+
make_sub_binary(Bin) when is_binary(Bin) ->
{_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3),
B;
@@ -1467,3 +1658,78 @@ get_reds() ->
erts_debug:set_internal_state(available_internal_state, true),
get_reds()
end.
+
+-define(LARGE_BIN, (512*1024+10)).
+-define(LARGE_BIN_LIM, (1024*1024)).
+
+mk_list(0, Acc) ->
+ Acc;
+mk_list(Sz, Acc) ->
+ mk_list(Sz-1, [$A+(Sz band 63) | Acc]).
+
+mk_list(Sz) when Sz >= ?LARGE_BIN_LIM ->
+ SzLeft = Sz - ?LARGE_BIN,
+ SzHd = SzLeft div 2,
+ SzTl = SzLeft - SzHd,
+ [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])];
+mk_list(Sz) ->
+ mk_list(Sz, []).
+
+mk_list_lb(Sz) when Sz >= ?LARGE_BIN_LIM ->
+ SzLeft = Sz - ?LARGE_BIN,
+ SzHd = SzLeft div 2,
+ SzTl = SzLeft - SzHd,
+ [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])];
+mk_list_lb(Sz) ->
+ mk_list(Sz, []).
+
+
+list2iolist(List) ->
+ list2iolist(List, []).
+
+list2iolist([], Acc) ->
+ Acc;
+list2iolist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256,
+ is_integer(X1), 0 =< X1, X1 < 256,
+ is_integer(X2), 0 =< X2, X2 < 256,
+ is_integer(X3), 0 =< X3, X3 < 256,
+ is_integer(X4), 0 =< X4, X4 < 256,
+ is_integer(X5), 0 =< X5, X5 < 256 ->
+ NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of
+ 0 ->
+ [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]];
+ 1 ->
+ [Acc, [], erlang:list_to_binary([X0, X1, X2, X3, X4, X5])];
+ 2 ->
+ [Acc, [[[[X0|erlang:list_to_binary([X1])],[X2|erlang:list_to_binary([X3])],[X4|erlang:list_to_binary([X5])]]]|<<"">>]];
+ 3 ->
+ [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])]
+ end,
+ list2iolist(Xs, NewAcc);
+list2iolist([X | Xs], Acc) ->
+ list2iolist(Xs, [Acc,X]).
+
+list2bitstrlist(List) ->
+ [list2bitstrlist(List, []), <<4:7>>].
+
+list2bitstrlist([], Acc) ->
+ Acc;
+list2bitstrlist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256,
+ is_integer(X1), 0 =< X1, X1 < 256,
+ is_integer(X2), 0 =< X2, X2 < 256,
+ is_integer(X3), 0 =< X3, X3 < 256,
+ is_integer(X4), 0 =< X4, X4 < 256,
+ is_integer(X5), 0 =< X5, X5 < 256 ->
+ NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of
+ 0 ->
+ [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]];
+ 1 ->
+ [Acc, [], <<X0:X1>>, <<X2:X3>>, <<X4:X5>>];
+ 2 ->
+ [Acc, [[[[X0|<<X1:X2>>],X3]],[X4|erlang:list_to_binary([X5])]|<<"">>]];
+ 3 ->
+ [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])]
+ end,
+ list2bitstrlist(Xs, NewAcc);
+list2bitstrlist([X | Xs], Acc) ->
+ list2bitstrlist(Xs, [Acc,X]).
diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
index 87778dd0c2..e5c904cfb9 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -67,6 +67,9 @@ test_size(Config) when is_list(Config) ->
2 = do_test_size({[]}),
3 = do_test_size({a,b}),
7 = do_test_size({a,[b,c]}),
+ 8 = do_test_size(#{b => 2,c => 3}),
+ 4 = do_test_size(#{}),
+ 32 = do_test_size(#{b => 2,c => 3,txt => "hello world"}),
%% Test internal consistency of sizes, but without testing
%% exact sizes.
@@ -97,6 +100,9 @@ test_size(Config) when is_list(Config) ->
do_test_size({SimplestFun,SimplestFun},
2*FunSz0+do_test_size({a,b}),
FunSz0+do_test_size({a,b})),
+
+ M = id(#{ "atom" => first, i => 0}),
+ do_test_size([M,M#{ "atom" := other },M#{i := 42}],54,32),
ok.
do_test_size(Term) ->
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index 8038888796..fdce157abc 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -1009,12 +1009,14 @@ loop_runner(Collector, Fun, Laps) ->
end,
loop_runner_cont(Collector, Fun, 0, Laps).
-loop_runner_cont(_Collector, _Fun, Laps, Laps) ->
+loop_runner_cont(Collector, _Fun, Laps, Laps) ->
receive
- {done, Collector} ->
- io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]),
- Collector ! {gone, self()}
- end;
+ {done, Collector} -> ok;
+ {abort, Collector} -> ok
+ end,
+ io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]),
+ Collector ! {gone, self()};
+
loop_runner_cont(Collector, Fun, N, Laps) ->
Fun(),
receive
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index ceb4afb5cf..f959714be7 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -155,6 +155,7 @@ misc_smoke_tests(Config) when is_list(Config) ->
?line true = is_binary(erlang:system_info(loaded)),
?line true = is_binary(erlang:system_info(dist)),
?line ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end,
+ true = lists:member(erlang:system_info(tolerant_timeofday), [enabled, disabled]),
?line ok.
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 2251575e5a..4d7598cf1f 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -181,6 +181,13 @@ send_trace(Config) when is_list(Config) ->
?line {trace, Sender, send, to_receiver, Receiver} = receive_first(),
?line receive_nothing(),
+ %% Check that a message sent to another registered process is traced.
+ register(?MODULE,Receiver),
+ Sender ! {send_please, ?MODULE, to_receiver},
+ {trace, Sender, send, to_receiver, ?MODULE} = receive_first(),
+ receive_nothing(),
+ unregister(?MODULE),
+
%% Check that a message sent to this process is traced.
?line Sender ! {send_please, self(), to_myself},
?line receive to_myself -> ok end,
@@ -188,6 +195,21 @@ send_trace(Config) when is_list(Config) ->
?line {trace, Sender, send, to_myself, Self} = receive_first(),
?line receive_nothing(),
+ %% Check that a message sent to dead process is traced.
+ {Pid,Ref} = spawn_monitor(fun() -> ok end),
+ receive {'DOWN',Ref,_,_,_} -> ok end,
+ Sender ! {send_please, Pid, to_dead},
+ {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first(),
+ receive_nothing(),
+
+ %% Check that a message sent to unknown registrated process is traced.
+ BadargSender = fun_spawn(fun sender/0),
+ 1 = erlang:trace(BadargSender, true, [send]),
+ unlink(BadargSender),
+ BadargSender ! {send_please, not_registered, to_unknown},
+ {trace, BadargSender, send, to_unknown, not_registered} = receive_first(),
+ receive_nothing(),
+
%% Another process should not be able to trace Sender.
?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end),
?line {'EXIT', Intruder, {badarg, _}} = receive_first(),
diff --git a/erts/emulator/utils/gen_git_version b/erts/emulator/utils/gen_git_version
index ef06a4b8e2..9faf015b62 100755
--- a/erts/emulator/utils/gen_git_version
+++ b/erts/emulator/utils/gen_git_version
@@ -5,9 +5,9 @@ OUTPUT_FILE=$1
if command -v git 2>&1 >/dev/null &&
test -d $ERL_TOP/.git -o -f $ERL_TOP/.git
then
- VSN=`git describe --match "OTP_R[0-9][0-9][A-B]*" HEAD`
+ VSN=`git describe --match "OTP-[0-9]*" HEAD`
case "$VSN" in
- OTP_R*-g*)
+ OTP-*-g*)
VSN=`echo $VSN | sed -e 's/.*-g\\(.*\\)/\\1/g'` ;;
*) VSN="na" ;;
esac
@@ -36,4 +36,4 @@ then
fi
exit 0
fi
-exit 1 \ No newline at end of file
+exit 1
diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in
index 8dc8dae5f6..0c7787a3b1 100644
--- a/erts/epmd/src/Makefile.in
+++ b/erts/epmd/src/Makefile.in
@@ -84,7 +84,7 @@ LD = @LD@
ifeq ($(findstring ose,$(TARGET)),ose)
LIBS = $(ERTS_INTERNAL_LIBS) @LIBS@
else
-LIBS = @LIBS@ $(ERTS_INTERNAL_LIBS)
+LIBS = @LIBS@ @SYSTEMD_DAEMON_LIBS@ $(ERTS_INTERNAL_LIBS)
endif
LDFLAGS = @LDFLAGS@
diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c
index 93982c2f60..48fd7a5f9c 100644
--- a/erts/epmd/src/epmd_srv.c
+++ b/erts/epmd/src/epmd_srv.c
@@ -213,7 +213,7 @@ void run(EpmdVars *g)
node_init(g);
g->conn = conn_init(g);
-#ifdef HAVE_SYSTEMD_SD_DAEMON_H
+#ifdef HAVE_SYSTEMD_DAEMON
if (g->is_systemd)
{
int n;
@@ -310,7 +310,7 @@ void run(EpmdVars *g)
SET_ADDR(iserv_addr[0],EPMD_ADDR_ANY,sport);
num_sockets = 1;
}
-#ifdef HAVE_SYSTEMD_SD_DAEMON_H
+#ifdef HAVE_SYSTEMD_DAEMON
}
#endif
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index 9e39764195..bf6eb00314 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2005-2012. All Rights Reserved.
+# Copyright Ericsson AB 2005-2014. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -54,13 +54,23 @@ document etp-help
% etp-mfa, etp-cp,
% etp-msgq, etpf-msgq,
% etp-stacktrace, etp-stackdump, etpf-stackdump, etp-dictdump
-% etp-offheapdump, etpf-offheapdump,
-% etp-print-procs, etp-search-heaps, etp-search-alloc,
+% etp-process-info, etp-process-memory-info
+% etp-port-info, etp-port-state, etp-port-sched-flags
+% etp-heapdump, etp-offheapdump, etpf-offheapdump,
+% etp-search-heaps, etp-search-alloc,
% etp-ets-tables, etp-ets-tabledump
%
% Complex commands that use the Erlang support module.
% etp-overlapped-heaps, etp-chart, etp-chart-start, etp-chart-end
-%
+%
+% System inspection
+% etp-system-info, etp-schedulers, etp-process, etp-ports, etp-lc-dump,
+% etp-migration-info, etp-processes-memory,
+% etp-compile-info, etp-config-h-info
+%
+% Platform specific (when gdb fails you)
+% etp-ppc-stacktrace
+%
% Erlang support module handling commands:
% etp-run
%
@@ -1055,7 +1065,9 @@ define etp-cp-1
set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2
end
if $etp_cp_p
- set $etp_cp_low = (Eterm**)($etp_cp_p->start + 8)
+ # 12 = MI_FUNCTIONS
+ set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12)
+ # 0 = MI_NUM_FUNCTIONS
set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0]
set $etp_cp_p = 0
while $etp_cp_low < $etp_cp_high
@@ -2830,6 +2842,152 @@ document etp-search-alloc
end
+define etp-alloc-stats
+ printf "\nIx Name Inst. Blocks Bytes Carriers Crr.bytes Util\n"
+ set $etp_tot_block_no = 0
+ set $etp_tot_block_sz = 0
+ set $etp_tot_crr_no = 0
+ set $etp_tot_crr_sz = 0
+ set $etp_ERTS_ALC_A_MIN = 1
+ set $etp_ERTS_ALC_A_MAX = (sizeof(erts_allctrs) / sizeof(*erts_allctrs)) - 1
+
+ set $etp_ix = $etp_ERTS_ALC_A_MIN
+ while $etp_ix <= $etp_ERTS_ALC_A_MAX
+ set $etp_allctr = 0
+ set $etp_alloc = erts_allctrs[$etp_ix].alloc
+ if $etp_alloc != erts_sys_alloc
+ if $etp_alloc == erts_alcu_alloc_thr_spec || \
+ $etp_alloc == erts_alcu_alloc_thr_pref
+ set $etp_instance = 0
+ set $etp_block_no = 0
+ set $etp_block_sz = 0
+ set $etp_crr_no = 0
+ set $etp_crr_sz = 0
+ set $etp_tspec = (ErtsAllocatorThrSpec_t *) erts_allctrs[$etp_ix].extra
+ if $etp_tspec->enabled
+ while $etp_instance < $etp_tspec->size
+ set $etp_allctr = $etp_tspec->allctr[$etp_instance]
+ set $etp_block_no = $etp_block_no + $etp_allctr->mbcs.blocks.curr.no \
+ + $etp_allctr->sbcs.blocks.curr.no
+ set $etp_block_sz = $etp_block_sz + $etp_allctr->mbcs.blocks.curr.size \
+ + $etp_allctr->sbcs.blocks.curr.size
+ set $etp_crr_no = $etp_crr_no + $etp_allctr->mbcs.curr.norm.mseg.no \
+ + $etp_allctr->sbcs.curr.norm.mseg.no \
+ + $etp_allctr->mbcs.curr.norm.sys_alloc.no \
+ + $etp_allctr->sbcs.curr.norm.sys_alloc.no
+ set $etp_crr_sz = $etp_crr_sz + $etp_allctr->mbcs.curr.norm.mseg.size \
+ + $etp_allctr->sbcs.curr.norm.mseg.size \
+ + $etp_allctr->mbcs.curr.norm.sys_alloc.size \
+ + $etp_allctr->sbcs.curr.norm.sys_alloc.size
+ set $etp_instance = $etp_instance + 1
+ end
+ else
+ printf "erts_allctr[%d]: Disabled (thread specific)\n", $etp_ix
+ end
+ else
+ if $etp_alloc == erts_alcu_alloc_ts || $etp_alloc == erts_alcu_alloc
+ set $etp_allctr = (Allctr_t*) erts_allctrs[$etp_ix].extra
+ set $etp_block_no = $etp_allctr->mbcs.blocks.curr.no \
+ + $etp_allctr->sbcs.blocks.curr.no
+ set $etp_block_sz = $etp_allctr->mbcs.blocks.curr.size \
+ + $etp_allctr->sbcs.blocks.curr.size
+ set $etp_crr_no = $etp_allctr->mbcs.curr.norm.mseg.no \
+ + $etp_allctr->sbcs.curr.norm.mseg.no \
+ + $etp_allctr->mbcs.curr.norm.sys_alloc.no \
+ + $etp_allctr->sbcs.curr.norm.sys_alloc.no
+ set $etp_crr_sz = $etp_allctr->mbcs.curr.norm.mseg.size \
+ + $etp_allctr->sbcs.curr.norm.mseg.size \
+ + $etp_allctr->mbcs.curr.norm.sys_alloc.size \
+ + $etp_allctr->sbcs.curr.norm.sys_alloc.size
+ set $etp_instance = 1
+ else
+ printf "erts_allctr[%d]: Unknown allocation function: ", $etp_ix
+ p $etp_alloc
+ end
+ end
+ end
+ if $etp_allctr != 0
+ printf "%2d %-8s%2d%12lu%13lu%12lu%13lu", $etp_ix, $etp_allctr->name_prefix, \
+ $etp_instance, \
+ $etp_block_no, $etp_block_sz, $etp_crr_no, $etp_crr_sz
+ if $etp_crr_sz != 0
+ printf "%5lu%%", ($etp_block_sz * 100) / $etp_crr_sz
+ end
+ printf "\n"
+ set $etp_tot_block_no = $etp_tot_block_no + $etp_block_no
+ set $etp_tot_block_sz = $etp_tot_block_sz + $etp_block_sz
+ set $etp_tot_crr_no = $etp_tot_crr_no + $etp_crr_no
+ set $etp_tot_crr_sz = $etp_tot_crr_sz + $etp_crr_sz
+ end
+ set $etp_ix = $etp_ix + 1
+ end
+ printf "\nTotal: %12lu%13lu%12lu%13lu", $etp_tot_block_no, $etp_tot_block_sz, \
+ $etp_tot_crr_no, $etp_tot_crr_sz
+ if $etp_tot_crr_sz != 0
+ printf "%5lu%%", ($etp_tot_block_sz * 100) / $etp_tot_crr_sz
+ end
+ printf "\n"
+end
+
+document etp-alloc-stats
+%---------------------------------------------------------------------------
+% etp-alloc-stats
+%
+% Combine and print allocator statistics
+%---------------------------------------------------------------------------
+end
+
+
+define etp-alloc-instances
+ set $etp_ERTS_ALC_A_MIN = 1
+ set $etp_ERTS_ALC_A_MAX = (sizeof(erts_allctrs) / sizeof(*erts_allctrs)) - 1
+
+ set $etp_ix = $arg0
+ if $etp_ix >= $etp_ERTS_ALC_A_MIN && $etp_ix <= $etp_ERTS_ALC_A_MAX
+ set $etp_allctr = 0
+ set $etp_alloc = erts_allctrs[$etp_ix].alloc
+ if $etp_alloc == erts_sys_alloc
+ printf "Allocator %d is sys_alloc\n", $etp_ix
+ else
+ if $etp_alloc == erts_alcu_alloc_thr_spec || \
+ $etp_alloc == erts_alcu_alloc_thr_pref
+ set $etp_instance = 0
+ set $etp_tspec = (ErtsAllocatorThrSpec_t *) erts_allctrs[$etp_ix].extra
+ if $etp_tspec->enabled
+ printf "All instances for allocator '%s'\n", $etp_tspec->allctr[0]->name_prefix
+ while $etp_instance < $etp_tspec->size
+ p $etp_tspec->allctr[$etp_instance]
+ set $etp_instance = $etp_instance + 1
+ end
+ else
+ printf "erts_allctr[%d]: Disabled (thread specific)\n", $etp_ix
+ end
+ else
+ if $etp_alloc == erts_alcu_alloc_ts || $etp_alloc == erts_alcu_alloc
+ set $etp_allctr = (Allctr_t*) erts_allctrs[$etp_ix].extra
+ printf "Single instances for allocator '%s'\n", $etp_allctr->name_prefix
+ p $etp_allctr
+ else
+ printf "erts_allctr[%d]: Unknown allocation function: ", $etp_ix
+ p $etp_alloc
+ end
+ end
+ end
+ else
+ printf "Allocator type not between %d and %d\n", $etp_ERTS_ALC_A_MIN, $etp_ERTS_ALC_A_MAX
+ end
+end
+
+document etp-alloc-instances
+%---------------------------------------------------------------------------
+% etp-alloc-instances
+%
+% Print pointers to all allocator instances for a specific type (Ix)
+%---------------------------------------------------------------------------
+end
+
+
+
define etp-overlapped-heaps
# Args:
@@ -3133,6 +3291,77 @@ document etp-ets-tabledump
%---------------------------------------------------------------------------
end
+define etp-lc-dump
+# Non-reentrant
+ set $etp_lc_dump_thread = erts_locked_locks
+ while $etp_lc_dump_thread
+ printf "Thread %s\n", $etp_lc_dump_thread->thread_name
+ set $etp_lc_dump_thread_locked = $etp_lc_dump_thread->locked.first
+ while $etp_lc_dump_thread_locked
+ if 0 <= $etp_lc_dump_thread_locked->id && $etp_lc_dump_thread_locked->id < sizeof(erts_lock_order)/sizeof(erts_lc_lock_order_t)
+ printf " %s:", erts_lock_order[$etp_lc_dump_thread_locked->id].name
+ else
+ printf " unkown:"
+ end
+ if ($etp_lc_dump_thread_locked->extra & 0x3) == 0x3
+ etp-1 $etp_lc_dump_thread_locked->extra
+ else
+ printf "%p", $etp_lc_dump_thread_locked->extra
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 0)
+ printf "[spinlock]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 1)
+ printf "[rw(spin)lock]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 2)
+ printf "[mutex]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 3)
+ printf "[rwmutex]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 4)
+ printf "[proclock]"
+ end
+ printf "(%s:%d)", $etp_lc_dump_thread_locked->file, $etp_lc_dump_thread_locked->line
+ if ($etp_lc_dump_thread_locked->flags & (0x60)) == (1 << 5)
+ printf "(r)"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x60)) == ((1 << 5) | (1 << 6))
+ printf "(rw)"
+ end
+ printf "\n"
+ set $etp_lc_dump_thread_locked = $etp_lc_dump_thread_locked->next
+ end
+ set $etp_lc_dump_thread = $etp_lc_dump_thread->next
+ end
+end
+
+document etp-lc-dump
+%---------------------------------------------------------------------------
+% etp-lc-dump
+%
+% Dump all info about locks in the lock checker
+%---------------------------------------------------------------------------
+end
+
+define etp-ppc-stacktrace
+# Args: R1
+# Non-reentrant
+ set $etp_ppc_st_fp = ($arg0)
+ while $etp_ppc_st_fp
+ info symbol ((void**)$etp_ppc_st_fp)[1]
+ set $etp_ppc_st_fp = ((void**)$etp_ppc_st_fp)[0]
+ end
+end
+
+document etp-ppc-stacktrace
+%---------------------------------------------------------------------------
+% etp-ppc-stacktrace R1
+%
+% Dump stacktrace from given $r1 frame pointer
+%---------------------------------------------------------------------------
+end
############################################################################
# OSE support
@@ -3177,6 +3406,154 @@ define etp-thr
end
############################################################################
+# erl_alloc_util (blocks and carriers)
+#
+
+define etp-block-size-1
+#
+# In: (Block_t*) in $arg0
+# Out: Byte size in $etp_blk_sz
+#
+ if ($arg0)->bhdr & 1
+ # Free block
+ set $etp_blk_sz = ($arg0)->bhdr & ~7
+ else
+ # Allocated block
+ if !$etp_MBC_ABLK_SZ_MASK
+ if etp_arch_bits == 64
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24)
+ else
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9)
+ end
+ set $etp_MBC_ABLK_SZ_MASK = ((UWord)1 << $etp_MBC_ABLK_OFFSET_SHIFT) - 1 - 7
+ end
+ set $etp_blk_sz = ($arg0)->bhdr & $etp_MBC_ABLK_SZ_MASK
+ end
+end
+
+define etp-block2mbc-1
+#
+# In: (Block_t*) in $arg0
+# Out: (Carrier_t*) in $etp-mbc
+#
+ if (($arg0)->bhdr) & 1
+ # Free block
+ set $etp_mbc = ($arg0)->u.carrier
+ else
+ # Allocated block
+ if !$etp_MBC_ABLK_OFFSET_SHIFT
+ if etp_arch_bits == 64
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24)
+ else
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9)
+ end
+ end
+ set $etp_mbc = (Carrier_t*) ((((UWord)($arg0) >> 18) - (($arg0)->bhdr >> $etp_MBC_ABLK_OFFSET_SHIFT)) << 18)
+ end
+end
+
+define etp-block2mbc
+ etp-block2mbc-1 ((Block_t*)$arg0)
+ print $etp_mbc
+end
+
+document etp-block2mbc
+%---------------------------------------------------------------------------
+% Print pointer to multiblock carrier containing the argument (Block_t*)
+%---------------------------------------------------------------------------
+end
+
+define etp-block
+ etp-block-size-1 ((Block_t*)$arg0)
+ if ((Block_t*)$arg0)->bhdr & 1
+ printf "%#lx: FREE sz=%#x\n", ($arg0), $etp_blk_sz
+ else
+ printf "%#lx: ALLOCATED sz=%#x\n", ($arg0), $etp_blk_sz
+ end
+end
+
+document etp-block
+%---------------------------------------------------------------------------
+% Print memory block (Block_t*)
+%---------------------------------------------------------------------------
+end
+
+define etp-carrier-blocks
+ set $etp_crr = (Carrier_t*) $arg0
+ set $etp_alc = (Allctr_t*)($etp_crr->allctr.counter & ~7)
+ set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size)
+ set $etp_prev_blk = 0
+ set $etp_error_cnt = 0
+ set $etp_ablk_cnt = 0
+ set $etp_fblk_cnt = 0
+
+ if $argc == 2
+ set $etp_be_silent = $arg1
+ else
+ set $etp_be_silent = 0
+ end
+
+ while 1
+ if !$etp_be_silent
+ etp-block $etp_blk
+ else
+ etp-block-size-1 $etp_blk
+ end
+ etp-block2mbc-1 $etp_blk
+ if $etp_mbc != $etp_crr
+ printf "ERROR: Invalid carrier pointer %#lx in block at %#lx\n", $etp_mbc, $etp_blk
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ if $etp_prev_blk
+ if ($etp_prev_blk->bhdr & 1)
+ # Prev is FREE
+ if ($etp_blk->bhdr & 1)
+ printf "ERROR: Adjacent FREE blocks at %#lx and %#lx\n", $etp_prev_blk, $etp_blk
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ if !($etp_blk->bhdr & 2)
+ printf "ERROR: Missing PREV_FREE_BLK_HDR_FLG (2) in block at %#lx\n", $etp_blk
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ end
+ end
+ if $etp_blk->bhdr & 1
+ set $etp_fblk_cnt = $etp_fblk_cnt + 1
+ else
+ set $etp_ablk_cnt = $etp_ablk_cnt + 1
+ end
+ if $etp_blk->bhdr & 4
+ # Last block
+ loop_break
+ end
+ # All free blocks except the last have a footer
+ if ($etp_blk->bhdr & 1) && ((UWord*)((char*)$etp_blk + $etp_blk_sz))[-1] != $etp_blk_sz
+ printf "ERROR: Invalid footer of free block at %#lx\n", $etp_blk
+ end
+ set $etp_prev_blk = $etp_blk
+ set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz)
+ end
+
+ if ((char*)$etp_blk + $etp_blk_sz) != ((char*)$etp_crr + ($etp_crr->chdr & ~7))
+ printf "ERROR: Last block not at end of carrier\n"
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ printf "Allocated blocks: %u\n", $etp_ablk_cnt
+ printf "Free blocks: %u\n", $etp_fblk_cnt
+ if $etp_error_cnt
+ printf "%u ERRORs reported above\n", $etp-error-cnt
+ end
+end
+
+document etp-carrier-blocks
+%---------------------------------------------------------------------------
+% Check and (maybe) print all memory blocks in carrier
+% Args: (Carrier_t*) [1=be_silent]
+%---------------------------------------------------------------------------
+end
+
+
+############################################################################
# Toolbox parameter handling
#
diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h
index 54acd1295a..70e9c937e9 100644
--- a/erts/include/internal/ethread.h
+++ b/erts/include/internal/ethread.h
@@ -51,16 +51,36 @@
# endif
#endif
+#if !defined(__GNUC__)
+# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
+#elif !defined(__GNUC_MINOR__)
+# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#elif !defined(__GNUC_PATCHLEVEL__)
+# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#else
+# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#endif
+
#undef ETHR_INLINE
#if defined(__GNUC__)
# define ETHR_INLINE __inline__
+# if ETHR_AT_LEAST_GCC_VSN__(3, 1, 1)
+# define ETHR_FORCE_INLINE __inline__ __attribute__((__always_inline__))
+# else
+# define ETHR_FORCE_INLINE __inline__
+# endif
#elif defined(__WIN32__)
# define ETHR_INLINE __forceinline
+# define ETHR_FORCE_INLINE __forceinline
#endif
#if defined(ETHR_DEBUG) || !defined(ETHR_INLINE) || ETHR_XCHK \
|| (defined(__GNUC__) && defined(ERTS_MIXED_CYGWIN_VC))
# undef ETHR_INLINE
# define ETHR_INLINE
+# define ETHR_FORCE_INLINE
# undef ETHR_TRY_INLINE_FUNCS
#endif
@@ -285,19 +305,6 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file,
const char *func,
int err);
-#if !defined(__GNUC__)
-# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
-#elif !defined(__GNUC_MINOR__)
-# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#elif !defined(__GNUC_PATCHLEVEL__)
-# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#else
-# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#endif
-
#if !ETHR_AT_LEAST_GCC_VSN__(2, 96, 0)
#define __builtin_expect(X, Y) (X)
#endif
diff --git a/erts/include/internal/win/ethr_membar.h b/erts/include/internal/win/ethr_membar.h
index 8237660b2c..a17f2459fc 100644
--- a/erts/include/internal/win/ethr_membar.h
+++ b/erts/include/internal/win/ethr_membar.h
@@ -63,13 +63,13 @@ do { \
#pragma intrinsic(_mm_sfence)
#pragma intrinsic(_mm_lfence)
-static __forceinline void
+static ETHR_FORCE_INLINE void
ethr_cfence__(void)
{
_ReadWriteBarrier();
}
-static __forceinline void
+static ETHR_FORCE_INLINE void
ethr_mfence__(void)
{
#if ETHR_SIZEOF_PTR == 4
@@ -80,7 +80,7 @@ ethr_mfence__(void)
_mm_mfence();
}
-static __forceinline void
+static ETHR_FORCE_INLINE void
ethr_sfence__(void)
{
#if ETHR_SIZEOF_PTR == 4
@@ -91,7 +91,7 @@ ethr_sfence__(void)
_mm_sfence();
}
-static __forceinline void
+static ETHR_FORCE_INLINE void
ethr_lfence__(void)
{
#if ETHR_SIZEOF_PTR == 4
diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c
index 5a271c5268..8bf7656bb0 100644
--- a/erts/lib_src/common/erl_misc_utils.c
+++ b/erts/lib_src/common/erl_misc_utils.c
@@ -25,6 +25,7 @@
# include <windows.h>
#endif
+#include "ethread.h"
#include "erl_misc_utils.h"
#if defined(__WIN32__)
@@ -191,7 +192,7 @@ struct erts_cpu_info_t_ {
#if defined(__WIN32__)
-static __forceinline int
+static ETHR_FORCE_INLINE int
get_proc_affinity(erts_cpu_info_t *cpuinfo, cpu_set_t *cpuset)
{
DWORD_PTR pamask;
@@ -206,7 +207,7 @@ get_proc_affinity(erts_cpu_info_t *cpuinfo, cpu_set_t *cpuset)
}
}
-static __forceinline int
+static ETHR_FORCE_INLINE int
set_thr_affinity(cpu_set_t *set)
{
if (*set == (cpu_set_t) 0)
@@ -1157,7 +1158,7 @@ read_topology(erts_cpu_info_t *cpuinfo)
#define ERTS_MU_RELATION_CACHE 2 /* RelationCache */
#define ERTS_MU_RELATION_PROCESSOR_PACKAGE 3 /* RelationProcessorPackage */
-static __forceinline int
+static ETHR_FORCE_INLINE int
rel_cmp_val(int r)
{
switch (r) {
diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c
index ceecdcef64..b77f2178f2 100644
--- a/erts/lib_src/common/ethr_aux.c
+++ b/erts/lib_src/common/ethr_aux.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2010-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2014. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -360,10 +360,10 @@ static ethr_ts_event *ts_event_pool(int size, ethr_ts_event **endpp)
int i;
ethr_aligned_ts_event *atsev;
atsev = ethr_mem__.std.alloc(sizeof(ethr_aligned_ts_event) * size
- + ETHR_CACHE_LINE_SIZE);
+ + ETHR_CACHE_LINE_SIZE - 1);
if (!atsev)
return NULL;
- if ((((ethr_uint_t) atsev) & ETHR_CACHE_LINE_MASK) == 0)
+ if ((((ethr_uint_t) atsev) & ETHR_CACHE_LINE_MASK) != 0)
atsev = ((ethr_aligned_ts_event *)
((((ethr_uint_t) atsev) & ~ETHR_CACHE_LINE_MASK)
+ ETHR_CACHE_LINE_SIZE));
diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c
index 72b44033ad..4e56efaf8b 100644
--- a/erts/lib_src/common/ethr_mutex.c
+++ b/erts/lib_src/common/ethr_mutex.c
@@ -1433,7 +1433,7 @@ void LeaveCriticalSection(CRITICAL_SECTION *cs)
#define ETHR_CND_WAIT__ ((ethr_sint32_t) 0x11dead11)
#define ETHR_CND_WAKEUP__ ((ethr_sint32_t) 0x11beef11)
-static __forceinline void
+static ETHR_FORCE_INLINE void
cond_wakeup(ethr_ts_event *tse)
{
ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs) == ETHR_CND_WAIT__);
@@ -1574,7 +1574,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx)
return 0;
}
-static __forceinline void
+static ETHR_FORCE_INLINE void
posix_compliant_mtx_enqueue(ethr_mutex *mtx,
ethr_ts_event *tse_start,
ethr_ts_event *tse_end)
@@ -1614,7 +1614,7 @@ posix_compliant_mtx_enqueue(ethr_mutex *mtx,
}
}
-static __forceinline void
+static ETHR_FORCE_INLINE void
enqueue_cond_wakeups(ethr_ts_event *queue, int posix_compliant)
{
if (queue) {
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index e19bb370bc..fdc7401475 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index d41c833e05..ba45e4e011 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index 7f2d2740e1..26f779500c 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 1508eed9ee..4ff0513321 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -79,7 +79,7 @@
-export([binary_to_integer/1,binary_to_integer/2]).
-export([binary_to_list/1]).
-export([binary_to_list/3, binary_to_term/1, binary_to_term/2]).
--export([bit_size/1, bitsize/1, bitstr_to_list/1, bitstring_to_list/1]).
+-export([bit_size/1, bitsize/1, bitstring_to_list/1]).
-export([bump_reductions/1, byte_size/1, call_on_load_function/1]).
-export([cancel_timer/1, check_old_code/1, check_process_code/2,
check_process_code/3, crc32/1]).
@@ -100,7 +100,7 @@
-export([integer_to_binary/1, integer_to_list/1]).
-export([iolist_size/1, iolist_to_binary/1]).
-export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]).
--export([list_to_atom/1, list_to_binary/1, list_to_bitstr/1]).
+-export([list_to_atom/1, list_to_binary/1]).
-export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]).
-export([list_to_integer/1, list_to_integer/2]).
-export([list_to_pid/1, list_to_tuple/1, loaded/0]).
@@ -361,25 +361,15 @@ binary_to_list(_Binary, _Start, _Stop) ->
%% binary_to_term/1
-spec binary_to_term(Binary) -> term() when
Binary :: ext_binary().
-binary_to_term(Binary) ->
- %% This BIF may throw badarg while trapping
- try
- erts_internal:binary_to_term(Binary)
- catch
- error:Reason -> erlang:error(Reason,[Binary])
- end.
+binary_to_term(_Binary) ->
+ erlang:nif_error(undefined).
%% binary_to_term/2
-spec binary_to_term(Binary, Opts) -> term() when
Binary :: ext_binary(),
Opts :: [safe].
-binary_to_term(Binary, Opts) ->
- %% This BIF may throw badarg while trapping
- try
- erts_internal:binary_to_term(Binary,Opts)
- catch
- error:Reason -> erlang:error(Reason,[Binary,Opts])
- end.
+binary_to_term(_Binary, _Opts) ->
+ erlang:nif_error(undefined).
%% bit_size/1
%% Shadowed by erl_bif_types: erlang:bit_size/1
@@ -394,12 +384,6 @@ bit_size(_Bitstring) ->
bitsize(_P1) ->
erlang:nif_error(undefined).
-%% bitstr_to_list/1
--spec erlang:bitstr_to_list(P1) -> [byte() | bitstring()] when
- P1 :: bitstring().
-bitstr_to_list(_P1) ->
- erlang:nif_error(undefined).
-
%% bitstring_to_list/1
-spec bitstring_to_list(Bitstring) -> [byte() | bitstring()] when
Bitstring :: bitstring().
@@ -1082,12 +1066,6 @@ list_to_atom(_String) ->
list_to_binary(_IoList) ->
erlang:nif_error(undefined).
-%% list_to_bitstr/1
--spec erlang:list_to_bitstr(P1) -> bitstring() when
- P1 :: bitstring_list().
-list_to_bitstr(_P1) ->
- erlang:nif_error(undefined).
-
%% list_to_bitstring/1
-spec list_to_bitstring(BitstringList) -> bitstring() when
BitstringList :: bitstring_list().
@@ -2286,6 +2264,7 @@ tuple_to_list(_Tuple) ->
(system_architecture) -> string();
(threads) -> boolean();
(thread_pool_size) -> non_neg_integer();
+ (tolerant_timeofday) -> enabled | disabled;
(trace_control_word) -> non_neg_integer();
(update_cpu_info) -> changed | unchanged;
(version) -> string();
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index edcd50c77e..2c5bd82cf0 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -29,8 +29,8 @@
-module(erts_internal).
-export([await_port_send_result/3]).
--export([binary_to_term/1, binary_to_term/2]).
-export([cmp_term/2]).
+-export([map_to_tuple_keys/1]).
-export([port_command/3, port_connect/2, port_close/1,
port_control/3, port_call/3, port_info/1, port_info/2]).
@@ -161,17 +161,6 @@ request_system_task(_Pid, _Prio, _Request) ->
check_process_code(_Module, _OptionList) ->
erlang:nif_error(undefined).
--spec binary_to_term(Binary) -> term() when
- Binary :: binary().
-binary_to_term(_Binary) ->
- erlang:nif_error(undefined).
-
--spec binary_to_term(Binary, Opts) -> term() when
- Binary :: binary(),
- Opts :: [safe].
-binary_to_term(_Binary, _Opts) ->
- erlang:nif_error(undefined).
-
%% term compare where integer() < float() = true
-spec cmp_term(A,B) -> Result when
@@ -181,3 +170,11 @@ binary_to_term(_Binary, _Opts) ->
cmp_term(_A,_B) ->
erlang:nif_error(undefined).
+
+%% return the internal key tuple for map keys
+-spec map_to_tuple_keys(M) -> Keys when
+ M :: map(),
+ Keys :: tuple().
+
+map_to_tuple_keys(_M) ->
+ erlang:nif_error(undefined).
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index ab8464956c..e95e11b3e6 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -1041,7 +1041,7 @@ start_em([]) -> ok.
start_it([]) ->
ok;
start_it({eval,Bin}) ->
- Str = binary_to_list(Bin),
+ Str = b2s(Bin),
{ok,Ts,_} = erl_scan:string(Str),
Ts1 = case reverse(Ts) of
[{dot,_}|_] -> Ts;
diff --git a/erts/vsn.mk b/erts/vsn.mk
index 2e773079f3..fff334c89f 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -17,7 +17,7 @@
# %CopyrightEnd%
#
-VSN = 6.1
+VSN = 6.0.2
# Port number 4365 in 4.2
# Port number 4366 in 4.3
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile
index 500f4a1358..6798da0072 100644
--- a/lib/asn1/src/Makefile
+++ b/lib/asn1/src/Makefile
@@ -52,6 +52,7 @@ CT_MODULES= \
asn1ct_pretty_format \
asn1ct_func \
asn1ct_gen \
+ asn1ct_gen_check \
asn1ct_gen_per \
asn1ct_name \
asn1ct_constructed_per \
diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
index a38da8bcc2..5fadd0495a 100644
--- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
@@ -962,8 +962,7 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
WhatKind = asn1ct_gen:type(InnerType),
emit(IndDeep),
emit(Assign),
- gen_optormand_case(OptOrMand,Erules,TopType,Cname,Type,InnerType,WhatKind,
- Element),
+ gen_optormand_case(OptOrMand, Erules, TopType, Cname, Type, Element),
case {Type,asn1ct_gen:get_constraint(Type#type.constraint,
componentrelation)} of
% #type{constraint=[{tableconstraint_info,RefedFieldName}],
@@ -1029,26 +1028,19 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
emit([nl,indent(7),"end"])
end.
-gen_optormand_case(mandatory,_Erules,_TopType,_Cname,_Type,_InnerType,_WhatKind,
- _Element) ->
+gen_optormand_case(mandatory, _Erules, _TopType, _Cname, _Type, _Element) ->
ok;
-gen_optormand_case('OPTIONAL',Erules,_TopType,_Cname,_Type,_InnerType,_WhatKind,
- Element) ->
+gen_optormand_case('OPTIONAL', Erules, _TopType, _Cname, _Type, Element) ->
emit([" case ",Element," of",nl]),
emit([indent(9),"asn1_NOVALUE -> {",
empty_lb(Erules),",0};",nl]),
emit([indent(9),"_ ->",nl,indent(12)]);
-gen_optormand_case({'DEFAULT',DefaultValue},Erules,TopType,Cname,Type,
- InnerType,WhatKind,Element) ->
+gen_optormand_case({'DEFAULT',DefaultValue}, Erules, _TopType,
+ _Cname, Type, Element) ->
CurrMod = get(currmod),
case catch lists:member(der,get(encoding_options)) of
true ->
- emit(" case catch "),
- asn1ct_gen:gen_check_call(TopType,Cname,Type,InnerType,
- WhatKind,{asis,DefaultValue},
- Element),
- emit([" of",nl]),
- emit([indent(12),"true -> {[],0};",nl]);
+ asn1ct_gen_check:emit(Type, DefaultValue, Element);
_ ->
emit([" case ",Element," of",nl]),
emit([indent(9),"asn1_DEFAULT -> {",
@@ -1063,10 +1055,9 @@ gen_optormand_case({'DEFAULT',DefaultValue},Erules,TopType,Cname,Type,
emit([indent(9),{asis,
DefaultValue}," -> {",
empty_lb(Erules),",0};",nl])
- end
- end,
- emit([indent(9),"_ ->",nl,indent(12)]).
-
+ end,
+ emit([indent(9),"_ ->",nl,indent(12)])
+ end.
gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) ->
@@ -1210,11 +1201,11 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC
(Type#type.def)#'ObjectClassFieldType'.fieldname,
[{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)),
asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}];
-gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand,
- OptOrMand,DecObjInf,_) ->
+gen_dec_call(InnerType, _Erules, TopType, Cname, Type, BytesVar,
+ Tag, _PrimOptOrMand, _OptOrMand, DecObjInf,_) ->
WhatKind = asn1ct_gen:type(InnerType),
- gen_dec_call1(WhatKind,InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,
- PrimOptOrMand,OptOrMand),
+ gen_dec_call1(WhatKind, InnerType, TopType, Cname,
+ Type, BytesVar, Tag),
case DecObjInf of
{Cname,{_,OSet,_UniqueFName,ValIndex}} ->
Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
@@ -1226,8 +1217,9 @@ gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand,
ok
end,
[].
-gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar,
- Tag,OptOrMand,_) ->
+
+gen_dec_call1({primitive,bif}, InnerType, TopType, Cname,
+ Type, BytesVar, Tag) ->
case {asn1ct:get_gen_state_field(namelist),InnerType} of
{[{Cname,undecoded}|Rest],_} ->
asn1ct:add_generated_refed_func({[Cname|TopType],undecoded,
@@ -1236,11 +1228,10 @@ gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar,
emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',",
BytesVar,"}"]);
_ ->
- ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[],
- ?PRIMITIVE,OptOrMand)
+ ?ASN1CT_GEN_BER:gen_dec_prim(Type, BytesVar, Tag)
end;
-gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,TopType,Cname,Type,BytesVar,
- Tag,OptOrMand,_) ->
+gen_dec_call1('ASN1_OPEN_TYPE', _InnerType, TopType, Cname,
+ Type, BytesVar, Tag) ->
case {asn1ct:get_gen_state_field(namelist),Type#type.def} of
{[{Cname,undecoded}|Rest],_} ->
asn1ct:add_generated_refed_func({[Cname|TopType],undecoded,
@@ -1249,15 +1240,12 @@ gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,TopType,Cname,Type,BytesVar,
emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',",
BytesVar,"}"]);
{_,#'ObjectClassFieldType'{type=OpenType}} ->
- ?ASN1CT_GEN_BER:gen_dec_prim(Erules,#type{def=OpenType},
- BytesVar,Tag,[],
- ?PRIMITIVE,OptOrMand);
+ ?ASN1CT_GEN_BER:gen_dec_prim(#type{def=OpenType},
+ BytesVar, Tag);
_ ->
- ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[],
- ?PRIMITIVE,OptOrMand)
+ ?ASN1CT_GEN_BER:gen_dec_prim(Type, BytesVar, Tag)
end;
-gen_dec_call1(WhatKind,_,_Erules,TopType,Cname,Type,BytesVar,
- Tag,_,_OptOrMand) ->
+gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) ->
case asn1ct:get_gen_state_field(namelist) of
[{Cname,undecoded}|Rest] ->
asn1ct:add_generated_refed_func({[Cname|TopType],undecoded,
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index ed3f6f886e..a91404ed54 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -426,8 +426,7 @@ gen_dec_open_type(Erule, Val, {Xmod,Xtype}, LeadingAttr,
emit([Term," = ",{asis,F},"(",TmpTerm,", ",Val,")"]).
dec_objset_optional(N, {'DEFAULT',Val}) ->
- dec_objset_optional_1(N, Val),
- dec_objset_optional_1(N, asn1_DEFAULT);
+ dec_objset_optional_1(N, Val);
dec_objset_optional(N, 'OPTIONAL') ->
dec_objset_optional_1(N, asn1_NOVALUE);
dec_objset_optional(_N, mandatory) -> ok.
diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl
index 33f998722a..fb94f65b32 100644
--- a/lib/asn1/src/asn1ct_func.erl
+++ b/lib/asn1/src/asn1ct_func.erl
@@ -19,7 +19,8 @@
%%
-module(asn1ct_func).
--export([start_link/0,need/1,call/3,call_gen/3,call_gen/4,generate/1]).
+-export([start_link/0,need/1,call/3,call_gen/3,call_gen/4,
+ generate/1,is_used/1]).
-export([init/1,handle_call/3,handle_cast/2,terminate/2]).
start_link() ->
@@ -63,6 +64,10 @@ generate(Fd) ->
Funcs = sofs:to_external(Funcs0),
ok = file:write(Fd, Funcs).
+is_used({_,_,_}=MFA) ->
+ req({is_used,MFA}).
+
+
req(Req) ->
gen_server:call(get(?MODULE), Req, infinity).
@@ -103,7 +108,10 @@ handle_call({gen_func,Prefix,Key,GenFun}, _From, #st{gen=G0,gc=Gc0}=St) ->
{reply,Name,St#st{gen=G,gc=Gc}};
{value,{Name,_}} ->
{reply,Name,St}
- end.
+ end;
+handle_call({is_used,MFA}, _From, #st{used=Used}=St) ->
+ {reply,gb_sets:is_member(MFA, Used),St}.
+
terminate(_, _) ->
ok.
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 44b050e59d..450d309688 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -29,7 +29,6 @@
list2rname/1,
constructed_suffix/2,
unify_if_string/1,
- gen_check_call/7,
get_constraint/2,
insert_once/2,
ct_gen_module/1,
@@ -43,6 +42,8 @@
-export([gen_encode_constructed/4,
gen_decode_constructed/4]).
+-define(SUPPRESSION_FUNC, 'dialyzer-suppressions').
+
%% pgen(Outfile, Erules, Module, TypeOrVal, Options)
%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
%% .hrl file is only generated if necessary
@@ -85,12 +86,18 @@ pgen_module(OutFile,Erules,Module,
"%%%",nl,
"%%% Run-time functions.",nl,
"%%%",nl]),
+ dialyzer_suppressions(Erules),
Fd = get(gen_file_out),
asn1ct_func:generate(Fd),
close_output_file(),
_ = erase(outfile),
asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options).
+dialyzer_suppressions(Erules) ->
+ emit([nl,
+ {asis,?SUPPRESSION_FUNC},"(Arg) ->",nl]),
+ Rtmod = ct_gen_module(Erules),
+ Rtmod:dialyzer_suppressions(Erules).
pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) ->
Rtmod = ct_gen_module(Erules),
@@ -98,11 +105,6 @@ pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects
pgen_values(Erules,Module,Values),
pgen_objects(Rtmod,Erules,Module,Objects),
pgen_objectsets(Rtmod,Erules,Module,ObjectSets),
- case catch lists:member(der,get(encoding_options)) of
- true ->
- pgen_check_defaultval(Erules,Module);
- _ -> ok
- end,
pgen_partial_decode(Rtmod,Erules,Module).
pgen_values(_,_,[]) ->
@@ -178,23 +180,6 @@ pgen_objectsets(Rtmod,Erules,Module,[H|T]) ->
Rtmod:gen_objectset_code(Erules,TypeDef),
pgen_objectsets(Rtmod,Erules,Module,T).
-pgen_check_defaultval(Erules,Module) ->
- CheckObjects = asn1ct_table:to_list(check_functions),
- case get(asndebug) of
- true ->
- FileName = lists:concat([Module,".table"]),
- {ok,IoDevice} = file:open(FileName,[write]),
- Fun =
- fun(X)->
- io:format(IoDevice,"~n~n************~n~n~p~n~n*****"
- "********~n~n",[X])
- end,
- lists:foreach(Fun,CheckObjects),
- ok = file:close(IoDevice);
- _ -> ok
- end,
- gen_check_defaultval(Erules,Module,CheckObjects).
-
pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber ->
pgen_partial_inc_dec(Rtmod,Erule,Module),
pgen_partial_dec(Rtmod,Erule,Module);
@@ -542,8 +527,7 @@ gen_part_decode_funcs({constructed,bif},TypeName,
emit([" 'dec_",TypeName,"'(Data,",{asis,Tag},")"]);
gen_part_decode_funcs({primitive,bif},_TypeName,
{_Name,undecoded,Tag,Type}) ->
- % Argument no 6 is 0, i.e. bit 6 for primitive encoding.
- asn1ct_gen_ber_bin_v2:gen_dec_prim(ber_bin_v2,Type,"Data",Tag,[],0,", mandatory, ");
+ asn1ct_gen_ber_bin_v2:gen_dec_prim(Type, "Data", Tag);
gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) ->
throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}).
@@ -576,131 +560,6 @@ gen_types(Erules,Tname,Type) when is_record(Type,type) ->
asn1ct_name:clear(),
Rtmod:gen_decode(Erules,Tname,Type).
-gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) ->
- gen_check_func(Name,Type),
- gen_check_defaultval(Erules,Module,Rest);
-gen_check_defaultval(_,_,[]) ->
- ok.
-
-gen_check_func(Name,FType = #type{def=Def}) ->
- EncName = ensure_atom(Name),
- emit({{asis,EncName},"(_V,asn1_DEFAULT) ->",nl," true;",nl}),
- emit({{asis,EncName},"(V,V) ->",nl," true;",nl}),
- emit({{asis,EncName},"(V,{_,V}) ->",nl," true;",nl}),
- case Def of
- {'SEQUENCE OF',Type} ->
- gen_check_sof(Name,'SEQOF',Type);
- {'SET OF',Type} ->
- gen_check_sof(Name,'SETOF',Type);
- #'SEQUENCE'{components=Components} ->
- gen_check_sequence(Name,Components);
- #'SET'{components=Components} ->
- gen_check_sequence(Name,Components);
- {'CHOICE',Components} ->
- gen_check_choice(Name,Components);
- #'Externaltypereference'{type=T} ->
- emit({{asis,EncName},"(DefaultValue,Value) ->",nl}),
- emit({" '",list2name([T,check]),"'(DefaultValue,Value).",nl});
- MaybePrim ->
- InnerType = get_inner(MaybePrim),
- case type(InnerType) of
- {primitive,bif} ->
- emit({{asis,EncName},"(DefaultValue,Value) ->",nl," "}),
- gen_prim_check_call(get_inner(InnerType),"DefaultValue","Value",
- FType),
- emit({".",nl,nl});
- _ ->
- throw({asn1_error,{unknown,type,MaybePrim}})
- end
- end.
-
-gen_check_sof(Name,SOF,Type) ->
- EncName = ensure_atom(Name),
- NewName = ensure_atom(list2name([sorted,Name])),
- emit({{asis,EncName},"(V1,V2) ->",nl}),
- emit({" ",{asis,NewName},"(lists:sort(V1),lists:sort(V2)).",nl,nl}),
- emit({{asis,NewName},"([],[]) ->",nl," true;",nl}),
- emit({{asis,NewName},"([DV|DVs],[V|Vs]) ->",nl," "}),
- InnerType = get_inner(Type#type.def),
- case type(InnerType) of
- {primitive,bif} ->
- gen_prim_check_call(get_inner(InnerType),"DV","V",Type),
- emit({",",nl});
- {constructed,bif} ->
- emit([{asis,ensure_atom(list2name([SOF,Name]))},"(DV, V),",nl]);
- #'Externaltypereference'{type=T} ->
- emit([{asis,ensure_atom(list2name([T,check]))},"(DV,V),",nl]);
- 'ASN1_OPEN_TYPE' ->
- emit(["DV = V,",nl]);
- _ ->
- emit(["DV = V,",nl])
- end,
- emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}).
-
-gen_check_sequence(Name, []) ->
- emit([{asis,ensure_atom(Name)},"(_,_) ->",nl,
- " throw(badval).",nl,nl]);
-gen_check_sequence(Name,Components) ->
- emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]),
- gen_check_sequence(Name,Components,1).
-
-gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) ->
- InnerType = get_inner(Type#type.def),
- NthDefV = ["element(",Num+1,",DefaultValue)"],
- NthV = ["element(",Num+1,",Value)"],
- gen_check_func_call(Name,Type,InnerType,NthDefV,NthV,N),
- case Cs of
- [] ->
- emit({".",nl,nl});
- _ ->
- emit({",",nl}),
- gen_check_sequence(Name,Cs,Num+1)
- end.
-
-gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) ->
- emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]),
- emit([" case Id of",nl]),
- gen_check_choice_components(Name,CList,1).
-
-gen_check_choice_components(_,[],_)->
- ok;
-gen_check_choice_components(Name,[#'ComponentType'{name=N,typespec=Type}|
- Cs],Num) ->
- Ind6 = " ",
- InnerType = get_inner(Type#type.def),
- emit({Ind6,"'",N,"' ->",nl,Ind6}),
- gen_check_func_call(Name,Type,InnerType,{var,"defaultValue"},
- {var,"value"},N),
- case Cs of
- [] ->
- emit({nl," end.",nl,nl});
- _ ->
- emit({";",nl}),
- gen_check_choice_components(Name,Cs,Num+1)
- end.
-
-gen_check_func_call(Name,Type,InnerType,DefVal,Val,N) ->
- case type(InnerType) of
- {primitive,bif} ->
- emit(" "),
- gen_prim_check_call(get_inner(InnerType),DefVal,Val,Type);
- #'Externaltypereference'{type=T} ->
- emit({" ",{asis,ensure_atom(list2name([T,check]))},"(",DefVal,",",Val,")"});
- 'ASN1_OPEN_TYPE' ->
- emit([" if",nl,
- " ",DefVal," == ",Val," -> true;",nl,
- " true -> throw({error,{asn1_open_type}})",nl,
- " end",nl]);
- {constructed,bif} ->
- emit([" ",{asis,ensure_atom(list2name([N,Name]))},"(",DefVal,",",Val,")"]);
- _ ->
- emit([" if",nl,
- " ",DefVal," == ",Val," -> true;",nl,
- " true -> throw({error,{asn1_open_type}})",nl,
- " end",nl])
- end.
-
-
%% VARIOUS GENERATOR STUFF
%% *************************************************
%%**************************************************
@@ -790,8 +649,9 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) ->
pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) ->
- emit(["-export([encoding_rule/0,bit_string_format/0,"
+ emit(["-export([encoding_rule/0,bit_string_format/0,",nl,
" legacy_erlang_types/0]).",nl]),
+ emit(["-export([",{asis,?SUPPRESSION_FUNC},"/1]).",nl]),
case Types of
[] -> ok;
_ ->
@@ -1077,9 +937,10 @@ gen_partial_inc_dispatcher() ->
ok;
{Data1,Data2} ->
% io:format("partial_incomplete_decode: ~p~ninc_type_pattern: ~p~n",[Data,Data2]),
- gen_partial_inc_dispatcher(Data1,Data2)
+ gen_partial_inc_dispatcher(Data1, Data2, "")
end.
-gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest],TypePattern) ->
+
+gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest], TypePattern, Sep) ->
TPattern =
case lists:keysearch(FuncName,1,TypePattern) of
{value,{_,TP}} -> TP;
@@ -1093,13 +954,13 @@ gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest],TypePattern) ->
_ ->
atom_to_list(TopType)
end,
- emit(["decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl,
+ emit([Sep,
+ "decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl,
" ",{asis,list_to_atom(lists:concat(["dec-inc-",FuncName2]))},
- "(Data);",nl]),
- gen_partial_inc_dispatcher(Rest,TypePattern);
-gen_partial_inc_dispatcher([],_) ->
- emit(["decode_partial_inc_disp(Type,_Data) ->",nl,
- " exit({error,{asn1,{undefined_type,Type}}}).",nl]).
+ "(Data)"]),
+ gen_partial_inc_dispatcher(Rest, TypePattern, ";\n");
+gen_partial_inc_dispatcher([], _, _) ->
+ emit([".",nl]).
gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) ->
emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]),
@@ -1465,171 +1326,6 @@ to_textual_order(Cs=[#'ComponentType'{textual_order=undefined}|_]) ->
to_textual_order(Cs) when is_list(Cs) ->
lists:keysort(#'ComponentType'.textual_order,Cs).
-
-gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) ->
- case WhatKind of
- {primitive,bif} ->
- gen_prim_check_call(InnerType,DefaultValue,Element,Type);
- #'Externaltypereference'{module=M,type=T} ->
- %% generate function call
- Name = list2name([T,check]),
- emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
- %% insert in ets table and do look ahead check
- Typedef = asn1_db:dbget(M,T),
- RefType = Typedef#typedef.typespec,
- InType = asn1ct_gen:get_inner(RefType#type.def),
- case insert_once(check_functions,{Name,RefType}) of
- true ->
- lookahead_innertype([T],InType,RefType);
- _ ->
- ok
- end;
- {constructed,bif} ->
- NameList = [Cname|TopType],
- Name = list2name(NameList ++ [check]),
- emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
- asn1ct_table:insert(check_functions, {Name, Type}),
- %% Must look for check functions in InnerType,
- %% that may be referenced or internal defined
- %% constructed types not used elsewhere.
- lookahead_innertype(NameList,InnerType,Type);
- _ ->
- %% Generate Dummy function call i.e. anything is accepted
- emit(["fun() -> true end ()"])
- end.
-
-gen_prim_check_call(PrimType, Default, Element, Type) ->
- case unify_if_string(PrimType) of
- 'BOOLEAN' ->
- check_call(check_bool, [Default,Element]);
- 'INTEGER' ->
- NNL = case Type#type.def of
- {_,NamedNumberList} -> NamedNumberList;
- _ -> []
- end,
- check_call(check_int, [Default,Element,{asis,NNL}]);
- 'BIT STRING' ->
- case Type#type.def of
- {_,[]} ->
- check_call(check_bitstring,
- [Default,Element]);
- {_,[_|_]=NBL} ->
- check_call(check_named_bitstring,
- [Default,Element,{asis,NBL}])
- end;
- 'OCTET STRING' ->
- check_call(check_octetstring, [Default,Element]);
- 'NULL' ->
- check_call(check_null, [Default,Element]);
- 'OBJECT IDENTIFIER' ->
- check_call(check_objectidentifier, [Default,Element]);
- 'RELATIVE-OID' ->
- check_call(check_objectidentifier, [Default,Element]);
- 'ObjectDescriptor' ->
- check_call(check_objectdescriptor, [Default,Element]);
- 'REAL' ->
- check_call(check_real, [Default,Element]);
- 'ENUMERATED' ->
- {_,Enumerations} = Type#type.def,
- check_call(check_enum, [Default,Element,{asis,Enumerations}]);
- restrictedstring ->
- check_call(check_restrictedstring, [Default,Element])
- end.
-
-check_call(F, Args) ->
- asn1ct_func:call(check, F, Args).
-
-%% lokahead_innertype/3 traverses Type and checks if check functions
-%% have to be generated, i.e. for all constructed or referenced types.
-lookahead_innertype(Name,'SEQUENCE',Type) ->
- Components = (Type#type.def)#'SEQUENCE'.components,
- lookahead_components(Name,Components);
-lookahead_innertype(Name,'SET',Type) ->
- Components = (Type#type.def)#'SET'.components,
- lookahead_components(Name,Components);
-lookahead_innertype(Name,'CHOICE',Type) ->
- {_,Components} = Type#type.def,
- lookahead_components(Name,Components);
-lookahead_innertype(Name,'SEQUENCE OF',SeqOf) ->
- lookahead_sof(Name,'SEQOF',SeqOf);
-lookahead_innertype(Name,'SET OF',SeqOf) ->
- lookahead_sof(Name,'SETOF',SeqOf);
-lookahead_innertype(_Name,#'Externaltypereference'{module=M,type=T},_) ->
- Typedef = asn1_db:dbget(M,T),
- RefType = Typedef#typedef.typespec,
- insert_once(check_functions,{list2name([T,check]),RefType}),
- InType = asn1ct_gen:get_inner(RefType#type.def),
- case type(InType) of
- {constructed,bif} ->
- lookahead_innertype([T],InType,RefType);
- Ref = #'Externaltypereference'{} ->
- lookahead_reference(Ref);
- _ ->
- ok
- end;
-lookahead_innertype(_,_,_) ->
- ok.
-
-lookahead_components(_,[]) -> ok;
-lookahead_components(Name,[C|Cs]) ->
- #'ComponentType'{name=Cname,typespec=Type} = C,
- InType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InType) of
- {constructed,bif} ->
- case insert_once(check_functions,
- {list2name([Cname|Name] ++ [check]),Type}) of
- true ->
- lookahead_innertype([Cname|Name],InType,Type);
- _ ->
- ok
- end;
- #'Externaltypereference'{module=RefMod,type=RefName} ->
- Typedef = asn1_db:dbget(RefMod,RefName),
- RefType = Typedef#typedef.typespec,
- case insert_once(check_functions,{list2name([RefName,check]),
- RefType}) of
- true ->
- lookahead_innertype([RefName],InType,RefType);
- _ ->
- ok
- end;
- _ ->
- ok
- end,
- lookahead_components(Name,Cs).
-
-lookahead_sof(Name,SOF,SOFType) ->
- Type = case SOFType#type.def of
- {_,_Type} -> _Type;
- _Type -> _Type
- end,
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- %% this is if a constructed type is defined in
- %% the SEQUENCE OF type
- NameList = [SOF|Name],
- insert_once(check_functions,
- {list2name(NameList ++ [check]),Type}),
- lookahead_innertype(NameList,InnerType,Type);
- Ref = #'Externaltypereference'{} ->
- lookahead_reference(Ref);
- _ ->
- ok
- end.
-
-lookahead_reference(#'Externaltypereference'{module=M,type=T}) ->
- Typedef = asn1_db:dbget(M,T),
- RefType = Typedef#typedef.typespec,
- InType = get_inner(RefType#type.def),
- case insert_once(check_functions,
- {list2name([T,check]),RefType}) of
- true ->
- lookahead_innertype([T],InType,RefType);
- _ ->
- ok
- end.
-
insert_once(Table,Object) ->
case asn1ct_table:lookup(Table, element(1, Object)) of
[] ->
@@ -1683,6 +1379,11 @@ conform_value(#type{def={'BIT STRING',[]}}, Bs) ->
bitstring when is_bitstring(Bs) ->
Bs
end;
+conform_value(#type{def='OCTET STRING'}, String) ->
+ case asn1ct:use_legacy_types() of
+ false -> String;
+ true -> binary_to_list(String)
+ end;
conform_value(_, Value) -> Value.
named_bitstring_value(List, Names) ->
@@ -1901,11 +1602,6 @@ get_constraint(C,Key) ->
{value,Cnstr} ->
Cnstr
end.
-
-ensure_atom(Atom) when is_atom(Atom) ->
- Atom;
-ensure_atom(List) when is_list(List) ->
- list_to_atom(List).
get_record_name_prefix() ->
case lists:keysearch(record_name_prefix,1,get(encoding_options)) of
diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
index bea0ec8968..e51b0898be 100644
--- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
@@ -27,11 +27,12 @@
-export([decode_class/1, decode_type/1]).
-export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]).
-export([gen_encode_prim/4]).
--export([gen_dec_prim/7]).
+-export([gen_dec_prim/3]).
-export([gen_objectset_code/2, gen_obj_code/3]).
-export([encode_tag_val/3]).
-export([gen_inc_decode/2,gen_decode_selected/3]).
-export([extaddgroup2sequence/1]).
+-export([dialyzer_suppressions/1]).
-import(asn1ct_gen, [emit/1,demit/1]).
@@ -65,6 +66,23 @@
%%===============================================================================
%%===============================================================================
+dialyzer_suppressions(_) ->
+ case asn1ct:use_legacy_types() of
+ false -> ok;
+ true -> suppress({ber,encode_bit_string,4})
+ end,
+ suppress({ber,decode_selective,2}),
+ emit([" ok.",nl]).
+
+suppress({M,F,A}=MFA) ->
+ case asn1ct_func:is_used(MFA) of
+ false ->
+ ok;
+ true ->
+ Args = [lists:concat(["element(",I,", Arg)"]) || I <- lists:seq(1, A)],
+ emit([" ",{call,M,F,Args},com,nl])
+ end.
+
%%===============================================================================
%% encode #{typedef, {pos, name, typespec}}
%%===============================================================================
@@ -163,6 +181,12 @@ gen_encode_user(Erules, #typedef{}=D, Wrapper) ->
gen_encode_prim(_Erules, #type{}=D, DoTag, Value) ->
BitStringConstraint = get_size_constraint(D#type.constraint),
+ MaxBitStrSize = case BitStringConstraint of
+ [] -> none;
+ {_,'MAX'} -> none;
+ {_,Max} -> Max;
+ Max when is_integer(Max) -> Max
+ end,
asn1ct_name:new(enumval),
Type = case D#type.def of
'OCTET STRING' -> restricted_string;
@@ -208,11 +232,11 @@ gen_encode_prim(_Erules, #type{}=D, DoTag, Value) ->
"end"]);
{'BIT STRING',[]} ->
case asn1ct:use_legacy_types() of
- false when BitStringConstraint =:= [] ->
+ false when MaxBitStrSize =:= none ->
call(encode_unnamed_bit_string, [Value,DoTag]);
false ->
call(encode_unnamed_bit_string,
- [{asis,BitStringConstraint},Value,DoTag]);
+ [{asis,MaxBitStrSize},Value,DoTag]);
true ->
call(encode_bit_string,
[{asis,BitStringConstraint},Value,
@@ -220,12 +244,12 @@ gen_encode_prim(_Erules, #type{}=D, DoTag, Value) ->
end;
{'BIT STRING',NamedNumberList} ->
case asn1ct:use_legacy_types() of
- false when BitStringConstraint =:= [] ->
+ false when MaxBitStrSize =:= none ->
call(encode_named_bit_string,
[Value,{asis,NamedNumberList},DoTag]);
false ->
call(encode_named_bit_string,
- [{asis,BitStringConstraint},Value,
+ [{asis,MaxBitStrSize},Value,
{asis,NamedNumberList},DoTag]);
true ->
call(encode_bit_string,
@@ -254,14 +278,20 @@ emit_enc_enumerated_cases(L, Tags) ->
emit_enc_enumerated_cases(L, Tags, noext).
emit_enc_enumerated_cases([{EnumName,EnumVal}|T], Tags, Ext) ->
+ Bytes = encode_pos_integer(EnumVal, []),
+ Len = length(Bytes),
emit([{asis,EnumName}," -> ",
- {call,ber,encode_enumerated,[EnumVal,Tags]},";",nl]),
+ {call,ber,encode_tags,[Tags,{asis,Bytes},Len]},";",nl]),
emit_enc_enumerated_cases(T, Tags, Ext);
emit_enc_enumerated_cases([], _Tags, _Ext) ->
%% FIXME: Should extension be handled?
emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]),
emit([nl,"end"]).
+encode_pos_integer(0, [B|_Acc] = L) when B < 128 ->
+ L;
+encode_pos_integer(N, Acc) ->
+ encode_pos_integer(N bsr 8, [N band 255|Acc]).
%%===============================================================================
%%===============================================================================
@@ -339,15 +369,11 @@ gen_decode_selected_type(_Erules,TypeDef) ->
case asn1ct_gen:type(InnerType) of
'ASN1_OPEN_TYPE' ->
asn1ct_name:new(len),
- gen_dec_prim(ber, Def#type{def='ASN1_OPEN_TYPE'},
- BytesVar,Tag, [] ,
- ?PRIMITIVE,"OptOrMand");
-% emit({";",nl});
+ gen_dec_prim(Def#type{def='ASN1_OPEN_TYPE'},
+ BytesVar, Tag);
{primitive,bif} ->
asn1ct_name:new(len),
- gen_dec_prim(ber, Def, BytesVar,Tag,[] ,
- ?PRIMITIVE,"OptOrMand");
-% emit([";",nl]);
+ gen_dec_prim(Def, BytesVar, Tag);
{constructed,bif} ->
TopType = case TypeDef#typedef.name of
A when is_atom(A) -> [A];
@@ -461,14 +487,12 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
case asn1ct_gen:type(InnerType) of
'ASN1_OPEN_TYPE' ->
asn1ct_name:new(len),
- gen_dec_prim(ber, Def#type{def='ASN1_OPEN_TYPE'},
- BytesVar,{string,"TagIn"}, [] ,
- ?PRIMITIVE,"OptOrMand"),
+ gen_dec_prim(Def#type{def='ASN1_OPEN_TYPE'},
+ BytesVar, {string,"TagIn"}),
emit({".",nl,nl});
{primitive,bif} ->
asn1ct_name:new(len),
- gen_dec_prim(ber, Def, BytesVar,{string,"TagIn"},[] ,
- ?PRIMITIVE,"OptOrMand"),
+ gen_dec_prim(Def, BytesVar, {string,"TagIn"}),
emit([".",nl,nl]);
{constructed,bif} ->
asn1ct:update_namelist(D#typedef.name),
@@ -481,17 +505,10 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
end.
-gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) ->
+gen_dec_prim(Att, BytesVar, DoTag) ->
Typename = Att#type.def,
-%% Currently not used for BER replaced with [] as place holder
-%% Constraint = Att#type.constraint,
-%% Constraint = [],
Constraint = get_size_constraint(Att#type.constraint),
IntConstr = int_constr(Att#type.constraint),
- AsBin = case get(binary_strings) of
- true -> "_as_bin";
- _ -> ""
- end,
NewTypeName = case Typename of
'NumericString' -> restricted_string;
'TeletexString' -> restricted_string;
@@ -505,107 +522,77 @@ gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) ->
'ObjectDescriptor'-> restricted_string;
'UTCTime' -> restricted_string;
'GeneralizedTime' -> restricted_string;
+ 'OCTET STRING' ->
+ case asn1ct:use_legacy_types() of
+ true -> restricted_string;
+ false -> Typename
+ end;
_ -> Typename
end,
+ TagStr = case DoTag of
+ {string,Tag1} -> Tag1;
+ _ when is_list(DoTag) -> {asis,DoTag}
+ end,
case NewTypeName of
'BOOLEAN'->
- emit(["decode_boolean(",BytesVar,","]),
- need(decode_boolean, 2);
+ call(decode_boolean, [BytesVar,TagStr]);
'INTEGER' ->
- case IntConstr of
- [] ->
- emit(["decode_integer(",BytesVar,","]),
- need(decode_integer, 2);
- {_,_} ->
- emit(["decode_integer(",BytesVar,",",
- {asis,IntConstr},","]),
- need(decode_integer, 3)
- end;
- {'INTEGER',NamedNumberList} ->
- case IntConstr of
- [] ->
- emit(["decode_named_integer(",BytesVar,",",
- {asis,NamedNumberList},","]),
- need(decode_named_integer, 3);
- {_,_} ->
- emit(["decode_named_integer(",BytesVar,",",
- {asis,IntConstr},",",
- {asis,NamedNumberList},","]),
- need(decode_named_integer, 4)
- end;
- {'ENUMERATED',NamedNumberList} ->
- emit(["decode_enumerated(",BytesVar,",",
- {asis,NamedNumberList},","]),
- need(decode_enumerated, 3);
+ check_constraint(decode_integer, [BytesVar,TagStr],
+ IntConstr,
+ identity,
+ identity);
+ {'INTEGER',NNL} ->
+ check_constraint(decode_integer,
+ [BytesVar,TagStr],
+ IntConstr,
+ identity,
+ fun(Val) ->
+ asn1ct_name:new(val),
+ emit([{curr,val}," = "]),
+ Val(),
+ emit([com,nl,
+ {call,ber,number2name,
+ [{curr,val},{asis,NNL}]}])
+ end);
+ {'ENUMERATED',NNL} ->
+ gen_dec_enumerated(BytesVar, NNL, TagStr);
'REAL' ->
- ok;
- {'BIT STRING',_NamedNumberList} ->
- ok;
+ asn1ct_name:new(tmpbuf),
+ emit(["begin",nl,
+ {curr,tmpbuf}," = ",
+ {call,ber,match_tags,[BytesVar,TagStr]},com,nl,
+ {call,real_common,decode_real,[{curr,tmpbuf}]},nl,
+ "end",nl]);
+ {'BIT STRING',NNL} ->
+ gen_dec_bit_string(BytesVar, Constraint, NNL, TagStr);
'NULL' ->
- emit(["decode_null(",BytesVar,","]),
- need(decode_null, 2);
+ call(decode_null, [BytesVar,TagStr]);
'OBJECT IDENTIFIER' ->
- emit(["decode_object_identifier(",BytesVar,","]),
- need(decode_object_identifier, 2);
+ call(decode_object_identifier, [BytesVar,TagStr]);
'RELATIVE-OID' ->
- emit(["decode_relative_oid(",BytesVar,","]),
- need(decode_relative_oid, 2);
+ call(decode_relative_oid, [BytesVar,TagStr]);
'OCTET STRING' ->
- F = case asn1ct:use_legacy_types() of
- false -> decode_octet_string;
- true -> decode_restricted_string
- end,
- emit([{asis,F},"(",BytesVar,","]),
- case Constraint of
- [] ->
- need(F, 2);
- _ ->
- emit([{asis,Constraint},","]),
- need(F, 3)
- end;
+ check_constraint(decode_octet_string, [BytesVar,TagStr],
+ Constraint, {erlang,byte_size}, identity);
restricted_string ->
- emit(["decode_restricted_string",AsBin,"(",BytesVar,","]),
- case Constraint of
- [] ->
- need(decode_restricted_string, 2);
- _ ->
- emit([{asis,Constraint},","]),
- need(decode_restricted_string, 3)
- end;
+ check_constraint(decode_restricted_string, [BytesVar,TagStr],
+ Constraint,
+ {erlang,byte_size},
+ fun(Val) ->
+ emit("binary_to_list("),
+ Val(),
+ emit(")")
+ end);
'UniversalString' ->
- emit(["decode_universal_string",AsBin,"(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_universal_string, 3);
+ check_constraint(decode_universal_string, [BytesVar,TagStr],
+ Constraint, {erlang,length}, identity);
'UTF8String' ->
- emit(["decode_UTF8_string",AsBin,"(",
- BytesVar,","]),
- need(decode_UTF8_string, 2);
+ call(decode_UTF8_string, [BytesVar,TagStr]);
'BMPString' ->
- emit(["decode_BMP_string",AsBin,"(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_BMP_string, 3);
+ check_constraint(decode_BMP_string, [BytesVar,TagStr],
+ Constraint, {erlang,length}, identity);
'ASN1_OPEN_TYPE' ->
- emit(["decode_open_type_as_binary(",
- BytesVar,","]),
- need(decode_open_type_as_binary, 2)
- end,
-
- TagStr = case DoTag of
- {string,Tag1} -> Tag1;
- _ when is_list(DoTag) -> {asis,DoTag}
- end,
- case NewTypeName of
- {'BIT STRING',NNL} ->
- gen_dec_bit_string(BytesVar, Constraint, NNL, TagStr);
- 'REAL' ->
- asn1ct_name:new(tmpbuf),
- emit(["begin",nl,
- {curr,tmpbuf}," = ",
- {call,ber,match_tags,[BytesVar,TagStr]},com,nl,
- {call,real_common,decode_real,[{curr,tmpbuf}]},nl,
- "end",nl]);
- _ ->
- emit([TagStr,")"])
+ call(decode_open_type_as_binary, [BytesVar,TagStr])
end.
%% Simplify an integer constraint so that we can efficiently test it.
@@ -621,7 +608,7 @@ int_constr(C) ->
[{'ValueRange',{_,_}=Range}] ->
Range;
[{'SingleValue',Sv}] ->
- {Sv,Sv};
+ Sv;
[] ->
[]
end.
@@ -632,16 +619,108 @@ gen_dec_bit_string(BytesVar, _Constraint, [_|_]=NNL, TagStr) ->
gen_dec_bit_string(BytesVar, Constraint, [], TagStr) ->
case asn1ct:get_bit_string_format() of
compact ->
- call(decode_compact_bit_string,
- [BytesVar,{asis,Constraint},TagStr]);
+ check_constraint(decode_compact_bit_string,
+ [BytesVar,TagStr],
+ Constraint,
+ {ber,compact_bit_string_size},
+ identity);
legacy ->
- call(decode_legacy_bit_string,
- [BytesVar,{asis,Constraint},TagStr]);
+ check_constraint(decode_native_bit_string,
+ [BytesVar,TagStr],
+ Constraint,
+ {erlang,bit_size},
+ fun(Val) ->
+ asn1ct_name:new(val),
+ emit([{curr,val}," = "]),
+ Val(),
+ emit([com,nl,
+ {call,ber,native_to_legacy_bit_string,
+ [{curr,val}]}])
+ end);
bitstring ->
- call(decode_native_bit_string,
- [BytesVar,{asis,Constraint},TagStr])
+ check_constraint(decode_native_bit_string,
+ [BytesVar,TagStr],
+ Constraint,
+ {erlang,bit_size},
+ identity)
+ end.
+
+check_constraint(F, Args, Constr, PreConstr0, ReturnVal0) ->
+ PreConstr = case PreConstr0 of
+ identity ->
+ fun(V) -> V end;
+ {Mod,Name} ->
+ fun(V) ->
+ asn1ct_name:new(c),
+ emit([{curr,c}," = ",
+ {call,Mod,Name,[V]},com,nl]),
+ {curr,c}
+ end
+ end,
+ ReturnVal = case ReturnVal0 of
+ identity -> fun(Val) -> Val() end;
+ _ -> ReturnVal0
+ end,
+ case Constr of
+ [] when ReturnVal0 =:= identity ->
+ %% No constraint, no complications.
+ call(F, Args);
+ [] ->
+ %% No constraint, but the return value could consist
+ %% of more than one statement.
+ emit(["begin",nl]),
+ ReturnVal(fun() -> call(F, Args) end),
+ emit([nl,
+ "end",nl]);
+ _ ->
+ %% There is a constraint.
+ asn1ct_name:new(val),
+ emit(["begin",nl,
+ {curr,val}," = ",{call,ber,F,Args},com,nl]),
+ PreVal0 = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
+ PreVal = PreConstr(PreVal0),
+ emit("if "),
+ case Constr of
+ {Min,Max} ->
+ emit([{asis,Min}," =< ",PreVal,", ",
+ PreVal," =< ",{asis,Max}]);
+ Sv when is_integer(Sv) ->
+ emit([PreVal," =:= ",{asis,Sv}])
+ end,
+ emit([" ->",nl]),
+ ReturnVal(fun() -> emit(PreVal0) end),
+ emit([";",nl,
+ "true ->",nl,
+ "exit({error,{asn1,bad_range}})",nl,
+ "end",nl,
+ "end"])
end.
+gen_dec_enumerated(BytesVar, NNL0, TagStr) ->
+ asn1ct_name:new(enum),
+ emit(["case ",
+ {call,ber,decode_integer,[BytesVar,TagStr]},
+ " of",nl]),
+ NNL = case NNL0 of
+ {L1,L2} ->
+ L1 ++ L2 ++ [accept];
+ [_|_] ->
+ NNL0 ++ [error]
+ end,
+ gen_dec_enumerated_1(NNL),
+ emit("end").
+
+gen_dec_enumerated_1([accept]) ->
+ asn1ct_name:new(default),
+ emit([{curr,default}," -> {asn1_enum,",{curr,default},"}",nl]);
+gen_dec_enumerated_1([error]) ->
+ asn1ct_name:new(default),
+ emit([{curr,default}," -> exit({error,{asn1,{illegal_enumerated,",
+ {curr,default},"}}})",nl]);
+gen_dec_enumerated_1([{V,K}|T]) ->
+ emit([{asis,K}," -> ",{asis,V},";",nl]),
+ gen_dec_enumerated_1(T).
+
%% Object code generating for encoding and decoding
%% ------------------------------------------------
@@ -986,9 +1065,8 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number ||
X <- OTag],
case Type#typedef.name of
- {primitive,bif} -> %%tag should be the primitive tag
- gen_dec_prim(ber,Def,Bytes,Tag,"TagIn",?PRIMITIVE,
- opt_or_default),
+ {primitive,bif} ->
+ gen_dec_prim(Def, Bytes, Tag),
[];
{constructed,bif} ->
emit({" 'dec_",ObjName,'_',FieldName,
@@ -1016,8 +1094,7 @@ gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
FieldName])),
typespec=Type}];
{primitive,bif} ->
- gen_dec_prim(ber,Type,Bytes,Tag,"TagIn",
- ?PRIMITIVE,opt_or_default),
+ gen_dec_prim(Type, Bytes, Tag),
[];
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
emit([" 'dec_",Etype,"'(",Bytes, " ,",{asis,Tag},")",nl]),
@@ -1386,7 +1463,7 @@ emit_dec_open_type(I) ->
end,
emit(S).
-emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop,
+emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, _Prop,
InternalDefFunName) ->
OTag = Type#type.tag,
%% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
@@ -1394,8 +1471,7 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop,
case {ExtName,Name} of
{primitive,bif} ->
emit(indent(12)),
- gen_dec_prim(ber,Type,"Bytes",Tag,"TagIn",
- ?PRIMITIVE,Prop),
+ gen_dec_prim(Type, "Bytes", Tag),
0;
{constructed,bif} ->
emit([indent(12),"'dec_",
@@ -1412,7 +1488,7 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop,
emit_inner_of_decfun(#typedef{name=Name},_Prop,_) ->
emit([indent(12),"'dec_",Name,"'(Bytes)"]),
0;
-emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) ->
+emit_inner_of_decfun(#type{}=Type, _Prop, _) ->
OTag = Type#type.tag,
%% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag],
@@ -1423,8 +1499,7 @@ emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) ->
case WhatKind of
{primitive,bif} ->
emit([indent(9),Def," ->",nl,indent(12)]),
- gen_dec_prim(ber,Type,"Bytes",Tag,"TagIn",
- ?PRIMITIVE,Prop);
+ gen_dec_prim(Type, "Bytes", Tag);
#'Externaltypereference'{module=CurrMod,type=T} ->
emit([indent(9),T," ->",nl,indent(12),"'dec_",T,
% "'(Bytes, ",Prop,")"]);
@@ -1561,6 +1636,3 @@ extaddgroup2sequence(ExtList) when is_list(ExtList) ->
call(F, Args) ->
asn1ct_func:call(ber, F, Args).
-
-need(F, Arity) ->
- asn1ct_func:need({ber,F,Arity}).
diff --git a/lib/asn1/src/asn1ct_gen_check.erl b/lib/asn1/src/asn1ct_gen_check.erl
new file mode 100644
index 0000000000..d80a02dfbf
--- /dev/null
+++ b/lib/asn1/src/asn1ct_gen_check.erl
@@ -0,0 +1,271 @@
+%% vim: tabstop=8:shiftwidth=4
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(asn1ct_gen_check).
+-export([emit/3]).
+
+-import(asn1ct_gen, [emit/1]).
+-include("asn1_records.hrl").
+
+emit(Type, Default, Value) ->
+ Key = {Type,Default},
+ Gen = fun(Fd, Name) ->
+ file:write(Fd, gen(Name, Type, Default))
+ end,
+ emit(" case "),
+ asn1ct_func:call_gen("is_default_", Key, Gen, [Value]),
+ emit([" of",nl,
+ "true -> {[],0};",nl,
+ "false ->",nl]).
+
+gen(Name, #type{def=T}, Default) ->
+ NameStr = atom_to_list(Name),
+ [NameStr,"(asn1_DEFAULT) ->\n",
+ "true;\n"|case do_gen(T, Default) of
+ {literal,Literal} ->
+ [NameStr,"(",term2str(Literal),") ->\n","true;\n",
+ NameStr,"(_) ->\n","false.\n\n"];
+ {exception,Func,Args} ->
+ [NameStr,"(Value) ->\n",
+ "try ",Func,"(Value",arg2str(Args),") of\n",
+ "_ -> true\n"
+ "catch throw:false -> false\n"
+ "end.\n\n"]
+ end].
+
+do_gen(_, asn1_NOVALUE) ->
+ {literal,asn1_NOVALUE};
+do_gen(#'Externaltypereference'{module=M,type=T}, Default) ->
+ #typedef{typespec=#type{def=Td}} = asn1_db:dbget(M, T),
+ do_gen(Td, Default);
+do_gen('BOOLEAN', Default) ->
+ {literal,Default};
+do_gen({'BIT STRING',[]}, Default) ->
+ true = is_bitstring(Default), %Assertion.
+ case asn1ct:use_legacy_types() of
+ false ->
+ {literal,Default};
+ true ->
+ {exception,need(check_legacy_bitstring, 2),[Default]}
+ end;
+do_gen({'BIT STRING',[_|_]=NBL}, Default) ->
+ do_named_bitstring(NBL, Default);
+do_gen({'ENUMERATED',_}, Default) ->
+ {literal,Default};
+do_gen('INTEGER', Default) ->
+ {literal,Default};
+do_gen({'INTEGER',NNL}, Default) ->
+ {exception,need(check_int, 3),[Default,NNL]};
+do_gen('NULL', Default) ->
+ {literal,Default};
+do_gen('OCTET STRING', Default) ->
+ true = is_binary(Default), %Assertion.
+ case asn1ct:use_legacy_types() of
+ false ->
+ {literal,Default};
+ true ->
+ {exception,need(check_octetstring, 2),[Default]}
+ end;
+do_gen('OBJECT IDENTIFIER', Default0) ->
+ Default = pre_process_oid(Default0),
+ {exception,need(check_objectidentifier, 2),[Default]};
+do_gen({'CHOICE',Cs}, Default) ->
+ {Tag,Value} = Default,
+ [Type] = [Type || #'ComponentType'{name=T,typespec=Type} <- Cs,
+ T =:= Tag],
+ case do_gen(Type#type.def, Value) of
+ {literal,Lit} ->
+ {literal,{Tag,Lit}};
+ {exception,Func0,Args} ->
+ Key = {Tag,Func0,Args},
+ Gen = fun(Fd, Name) ->
+ S = gen_choice(Name, Tag, Func0, Args),
+ ok = file:write(Fd, S)
+ end,
+ Func = asn1ct_func:call_gen("is_default_choice", Key, Gen),
+ {exception,atom_to_list(Func),[]}
+ end;
+do_gen(#'SEQUENCE'{components=Cs}, Default) ->
+ do_seq_set(Cs, Default);
+do_gen({'SEQUENCE OF',Type}, Default) ->
+ do_sof(Type, Default);
+do_gen(#'SET'{components=Cs}, Default) ->
+ do_seq_set(Cs, Default);
+do_gen({'SET OF',Type}, Default) ->
+ do_sof(Type, Default);
+do_gen(Type, Default) ->
+ case asn1ct_gen:unify_if_string(Type) of
+ restrictedstring ->
+ {exception,need(check_restrictedstring, 2),[Default]};
+ _ ->
+ %% Open type. Do our best.
+ {literal,Default}
+ end.
+
+do_named_bitstring(NBL, Default0) when is_list(Default0) ->
+ Default = lists:sort(Default0),
+ Bs = asn1ct_gen:named_bitstring_value(Default, NBL),
+ Func = case asn1ct:use_legacy_types() of
+ false -> check_named_bitstring;
+ true -> check_legacy_named_bitstring
+ end,
+ {exception,need(Func, 4),[Default,Bs,bit_size(Bs)]};
+do_named_bitstring(_, Default) when is_bitstring(Default) ->
+ Func = case asn1ct:use_legacy_types() of
+ false -> check_named_bitstring;
+ true -> check_legacy_named_bitstring
+ end,
+ {exception,need(Func, 3),[Default,bit_size(Default)]}.
+
+do_seq_set(Cs0, Default) ->
+ Tag = element(1, Default),
+ Cs1 = [T || #'ComponentType'{typespec=T} <- Cs0],
+ Cs = components(Cs1, tl(tuple_to_list(Default))),
+ case are_all_literals(Cs) of
+ true ->
+ Literal = list_to_tuple([Tag|[L || {literal,L} <- Cs]]),
+ {literal,Literal};
+ false ->
+ Key = {Cs,Default},
+ Gen = fun(Fd, Name) ->
+ S = gen_components(Name, Tag, Cs),
+ ok = file:write(Fd, S)
+ end,
+ Func = asn1ct_func:call_gen("is_default_cs_", Key, Gen),
+ {exception,atom_to_list(Func),[]}
+ end.
+
+do_sof(Type, Default0) ->
+ Default = lists:sort(Default0),
+ Cs0 = lists:duplicate(length(Default), Type),
+ Cs = components(Cs0, Default),
+ case are_all_literals(Cs) of
+ true ->
+ Literal = [Lit || {literal,Lit} <- Cs],
+ {exception,need(check_literal_sof, 2),[Literal]};
+ false ->
+ Key = Cs,
+ Gen = fun(Fd, Name) ->
+ S = gen_sof(Name, Cs),
+ ok = file:write(Fd, S)
+ end,
+ Func = asn1ct_func:call_gen("is_default_sof", Key, Gen),
+ {exception,atom_to_list(Func),[]}
+ end.
+
+are_all_literals([{literal,_}|T]) ->
+ are_all_literals(T);
+are_all_literals([_|_]) ->
+ false;
+are_all_literals([]) -> true.
+
+gen_components(Name, Tag, Cs) ->
+ [atom_to_list(Name),"(Value) ->\n",
+ "case Value of\n",
+ "{",term2str(Tag)|gen_cs_1(Cs, 1, [])].
+
+gen_cs_1([{literal,Lit}|T], I, Acc) ->
+ [",\n",term2str(Lit)|gen_cs_1(T, I, Acc)];
+gen_cs_1([H|T], I, Acc) ->
+ Var = "E"++integer_to_list(I),
+ [",\n",Var|gen_cs_1(T, I+1, [{Var,H}|Acc])];
+gen_cs_1([], _, Acc) ->
+ ["} ->\n"|gen_cs_2(Acc, "")].
+
+gen_cs_2([{Var,{exception,Func,Args}}|T], Sep) ->
+ [Sep,Func,"(",Var,arg2str(Args),")"|gen_cs_2(T, ",\n")];
+gen_cs_2([], _) ->
+ [";\n",
+ "_ ->\n"
+ "throw(false)\n"
+ "end.\n"].
+
+gen_sof(Name, Cs) ->
+ [atom_to_list(Name),"(Value) ->\n",
+ "case length(Value) of\n",
+ integer_to_list(length(Cs))," -> ok;\n"
+ "_ -> throw(false)\n"
+ "end,\n"
+ "T0 = lists:sort(Value)"|gen_sof_1(Cs, 1)].
+
+gen_sof_1([{exception,Func,Args}|Cs], I) ->
+ NumStr = integer_to_list(I),
+ H = "H" ++ NumStr,
+ T = "T" ++ NumStr,
+ Prev = "T" ++ integer_to_list(I-1),
+ [",\n",
+ "[",H,case Cs of
+ [] -> [];
+ [_|_] -> ["|",T]
+ end,"] = ",Prev,",\n",
+ Func,"(",H,arg2str(Args),")"|gen_sof_1(Cs, I+1)];
+gen_sof_1([], _) ->
+ ".\n".
+
+components([#type{def=Def}|Ts], [V|Vs]) ->
+ [do_gen(Def, V)|components(Ts, Vs)];
+components([], []) -> [].
+
+gen_choice(Name, Tag, Func, Args) ->
+ NameStr = atom_to_list(Name),
+ [NameStr,"({",term2str(Tag),",Value}) ->\n"
+ " ",Func,"(Value",arg2str(Args),");\n",
+ NameStr,"(_) ->\n"
+ " throw(false).\n"].
+
+pre_process_oid(Oid) ->
+ Reserved = reserved_oid(),
+ pre_process_oid(tuple_to_list(Oid), Reserved, []).
+
+pre_process_oid([H|T]=Tail, Res0, Acc) ->
+ case lists:keyfind(H, 2, Res0) of
+ false ->
+ {lists:reverse(Acc),Tail};
+ {Names0,H,Res} ->
+ Names = case is_list(Names0) of
+ false -> [Names0];
+ true -> Names0
+ end,
+ Keys = [H|Names],
+ pre_process_oid(T, Res, [Keys|Acc])
+ end.
+
+reserved_oid() ->
+ [{['itu-t',ccitt],0,
+ [{recommendation,0,[]},
+ {question,1,[]},
+ {administration,2,[]},
+ {'network-operator',3,[]},
+ {'identified-organization',4,[]}]},
+ {iso,1,[{standard,0,[]},
+ {'member-body',2,[]},
+ {'identified-organization',3,[]}]},
+ {['joint-iso-itu-t','joint-iso-ccitt'],2,[]}].
+
+arg2str(Args) ->
+ [", "++term2str(Arg) || Arg <- Args].
+
+term2str(T) ->
+ io_lib:format("~w", [T]).
+
+need(F, A) ->
+ asn1ct_func:need({check,F,A}),
+ atom_to_list(F).
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl
index 519ce9f054..39cc0536f8 100644
--- a/lib/asn1/src/asn1ct_gen_per.erl
+++ b/lib/asn1/src/asn1ct_gen_per.erl
@@ -32,6 +32,7 @@
-export([gen_encode/2, gen_encode/3]).
-export([gen_dec_external/2]).
-export([extaddgroup2sequence/1]).
+-export([dialyzer_suppressions/1]).
-import(asn1ct_gen, [emit/1,demit/1]).
-import(asn1ct_func, [call/3]).
@@ -40,6 +41,15 @@
%% Generate ENCODING ******************************
%%****************************************x
+dialyzer_suppressions(Erules) ->
+ case asn1ct_func:is_used({Erules,complete,1}) of
+ false ->
+ ok;
+ true ->
+ emit([" _ = complete(Arg),",nl])
+ end,
+ emit([" ok.",nl]).
+
gen_encode(Erules,Type) when is_record(Type,typedef) ->
gen_encode_user(Erules,Type).
diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl
index fde39c674e..bdd14871d1 100644
--- a/lib/asn1/src/asn1ct_imm.erl
+++ b/lib/asn1/src/asn1ct_imm.erl
@@ -82,15 +82,8 @@ per_dec_enumerated(NamedList0, Aligned) ->
Ub = length(NamedList0) - 1,
Constraint = [{'ValueRange',{0,Ub}}],
Int = per_dec_integer(Constraint, Aligned),
- EnumTail = case matched_range(Int) of
- {0,Ub} ->
- %% The error case can never happen.
- [];
- _ ->
- [enum_error]
- end,
- NamedList = per_dec_enumerated_fix_list(NamedList0, EnumTail, 0),
- {map,Int,NamedList}.
+ NamedList = per_dec_enumerated_fix_list(NamedList0, [enum_error], 0),
+ {map,Int,opt_map(NamedList, Int)}.
per_dec_enumerated(BaseNamedList, NamedListExt0, Aligned) ->
Base = per_dec_enumerated(BaseNamedList, Aligned),
@@ -124,7 +117,7 @@ per_dec_length(no, AllowZero, Aligned) ->
per_dec_named_integer(Constraint, NamedList0, Aligned) ->
Int = per_dec_integer(Constraint, Aligned),
NamedList = [{K,V} || {V,K} <- NamedList0] ++ [integer_default],
- {map,Int,NamedList}.
+ {map,Int,opt_map(NamedList, Int)}.
per_dec_k_m_string(StringType, Constraint, Aligned) ->
SzConstr = effective_constraint(bitstring, Constraint),
@@ -175,6 +168,8 @@ per_enc_bit_string(Val0, NNL0, Constraint0, Aligned) ->
ToBs = case ExtraArgs of
[] ->
{call,per_common,bs_drop_trailing_zeroes,[Val]};
+ [0] ->
+ {call,per_common,bs_drop_trailing_zeroes,[Val]};
[Lower] ->
{call,per_common,adjust_trailing_zeroes,[Val,Lower]}
end,
@@ -203,6 +198,7 @@ per_enc_legacy_bit_string(Val0, NNL0, Constraint0, Aligned) ->
Constraint = effective_constraint(bitstring, Constraint0),
ExtraArgs = case constr_min_size(Constraint) of
no -> [];
+ 0 -> [];
Lb -> [Lb]
end,
B ++ [{'try',
@@ -265,10 +261,6 @@ per_enc_k_m_string(Val0, StringType, Constraint, Aligned) ->
SzConstraint = effective_constraint(bitstring, Constraint),
Unit = string_num_bits(StringType, Constraint, Aligned),
Chars0 = char_tab(Constraint, StringType, Unit),
- Args = case enc_char_tab(Chars0) of
- notab -> [Val,Unit];
- Chars -> [Val,Unit,Chars]
- end,
Enc = case Unit of
16 ->
{call,per_common,encode_chars_16bit,[Val],Bin};
@@ -277,7 +269,15 @@ per_enc_k_m_string(Val0, StringType, Constraint, Aligned) ->
8 ->
{call,erlang,list_to_binary,[Val],Bin};
_ ->
- {call,per_common,encode_chars,Args,Bin}
+ case enc_char_tab(Chars0) of
+ notab ->
+ {call,per_common,encode_chars,[Val,Unit],Bin};
+ {tab,Tab} ->
+ {call,per_common,encode_chars,[Val,Unit,Tab],Bin};
+ {compact_map,Map} ->
+ {call,per_common,encode_chars_compact_map,
+ [Val,Unit,Map],Bin}
+ end
end,
case Unit of
8 ->
@@ -581,14 +581,42 @@ per_num_bits(N) when N =< 64 -> 6;
per_num_bits(N) when N =< 128 -> 7;
per_num_bits(N) when N =< 255 -> 8.
+opt_map(Map, Imm) ->
+ case matched_range(Imm) of
+ unknown -> Map;
+ {Lb,Ub} -> opt_map_1(Map, Lb, Ub)
+ end.
+
+opt_map_1([{I,_}=Pair|T], Lb, Ub) ->
+ if
+ I =:= Lb, I =< Ub ->
+ [Pair|opt_map_1(T, Lb+1, Ub)];
+ Lb < I, I =< Ub ->
+ [Pair|opt_map_1(T, Lb, Ub)];
+ true ->
+ opt_map_1(T, Lb, Ub)
+ end;
+opt_map_1(Map, Lb, Ub) ->
+ if
+ Lb =< Ub ->
+ Map;
+ true ->
+ []
+ end.
+
matched_range({get_bits,Bits0,[U|Flags]}) when is_integer(U) ->
- case lists:member(signed, Flags) of
- false ->
+ case not lists:member(signed, Flags) andalso is_integer(Bits0) of
+ true ->
Bits = U*Bits0,
{0,(1 bsl Bits) - 1};
- true ->
+ false ->
unknown
end;
+matched_range({add,Imm,Add}) ->
+ case matched_range(Imm) of
+ unknown -> unknown;
+ {Lb,Ub} -> {Lb+Add,Ub+Add}
+ end;
matched_range(_Op) -> unknown.
string_num_bits(StringType, Constraint, Aligned) ->
@@ -1289,6 +1317,8 @@ eval_cond_1({eq,[],[]}) ->
true;
eval_cond_1({eq,I,N}) when is_integer(I), is_integer(N) ->
I =:= N;
+eval_cond_1({ge,I,N}) when is_integer(I), is_integer(N) ->
+ I >= N;
eval_cond_1({lt,I,N}) when is_integer(I), is_integer(N) ->
I < N;
eval_cond_1(_) -> maybe.
@@ -1303,9 +1333,15 @@ prepend_to_cond_1([Check|T], Code) ->
enc_char_tab(notab) ->
notab;
enc_char_tab(Tab0) ->
- Tab = tuple_to_list(Tab0),
- First = hd(Tab),
- {First-1,list_to_tuple(enc_char_tab_1(Tab, First, 0))}.
+ Tab1 = tuple_to_list(Tab0),
+ First = hd(Tab1),
+ Tab = enc_char_tab_1(Tab1, First, 0),
+ case lists:member(ill, Tab) of
+ false ->
+ {compact_map,{First,tuple_size(Tab0)}};
+ true ->
+ {tab,{First-1,list_to_tuple(Tab)}}
+ end.
enc_char_tab_1([H|T], H, I) ->
[I|enc_char_tab_1(T, H+1, I+1)];
diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl
index 4bd814769f..c4cd872368 100644
--- a/lib/asn1/src/asn1rtt_ber.erl
+++ b/lib/asn1/src/asn1rtt_ber.erl
@@ -26,25 +26,24 @@
skip_ExtensionAdditions/2]).
-export([encode_boolean/2,decode_boolean/2,
encode_integer/2,encode_integer/3,
- decode_integer/2,decode_integer/3,
- decode_named_integer/3,decode_named_integer/4,
- encode_enumerated/2,decode_enumerated/3,
+ decode_integer/2,
+ number2name/2,
encode_unnamed_bit_string/2,encode_unnamed_bit_string/3,
encode_named_bit_string/3,encode_named_bit_string/4,
encode_bit_string/4,
decode_named_bit_string/3,
- decode_compact_bit_string/3,
- decode_legacy_bit_string/3,
- decode_native_bit_string/3,
+ decode_compact_bit_string/2,compact_bit_string_size/1,
+ decode_native_bit_string/2,
+ native_to_legacy_bit_string/1,
encode_null/2,decode_null/2,
encode_relative_oid/2,decode_relative_oid/2,
encode_object_identifier/2,decode_object_identifier/2,
encode_restricted_string/2,
- decode_octet_string/2,decode_octet_string/3,
- decode_restricted_string/2,decode_restricted_string/3,
- encode_universal_string/2,decode_universal_string/3,
+ decode_octet_string/2,
+ decode_restricted_string/2,
+ encode_universal_string/2,decode_universal_string/2,
encode_UTF8_string/2,decode_UTF8_string/2,
- encode_BMP_string/2,decode_BMP_string/3]).
+ encode_BMP_string/2,decode_BMP_string/2]).
-export([encode_open_type/2,decode_open_type/2,
decode_open_type_as_binary/2]).
@@ -591,8 +590,6 @@ encode_tags(TagIn, {BytesSoFar,LenSoFar}) ->
encode_open_type(Val, T) when is_list(Val) ->
encode_open_type(list_to_binary(Val), T);
-encode_open_type(Val, []) ->
- {Val,byte_size(Val)};
encode_open_type(Val, Tag) ->
encode_tags(Tag, Val, byte_size(Val)).
@@ -697,41 +694,14 @@ encode_integer_neg(N, Acc) ->
%%===============================================================================
%% decode integer
-%% (Buffer, Range, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes}
-%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes}
%%===============================================================================
-decode_named_integer(Tlv, NamedNumberList, TagIn) ->
- V = match_tags(Tlv, TagIn),
- Int = decode_integer(V),
- number2name(Int, NamedNumberList).
-
-decode_named_integer(Tlv, Range, NamedNumberList, TagIn) ->
- V = match_tags(Tlv, TagIn),
- Int = range_check_integer(decode_integer(V), Range),
- number2name(Int, NamedNumberList).
-
decode_integer(Tlv, TagIn) ->
- V = match_tags(Tlv, TagIn),
- decode_integer(V).
-
-decode_integer(Tlv, Range, TagIn) ->
- V = match_tags(Tlv, TagIn),
- Int = decode_integer(V),
- range_check_integer(Int, Range).
-
-decode_integer(Bin) ->
+ Bin = match_tags(Tlv, TagIn),
Len = byte_size(Bin),
<<Int:Len/signed-unit:8>> = Bin,
Int.
-range_check_integer(Int, {Lb,Ub}) when Lb =< Int, Int =< Ub ->
- Int;
-range_check_integer(Int, Range) ->
- exit({error,{asn1,{integer_range,Range,Int}}}).
-
-number2name(Int, []) ->
- Int;
number2name(Int, NamedNumberList) ->
case lists:keyfind(Int, 2, NamedNumberList) of
{NamedVal,_} ->
@@ -740,49 +710,6 @@ number2name(Int, NamedNumberList) ->
Int
end.
-
-%%============================================================================
-%% Enumerated value, ITU_T X.690 Chapter 8.4
-
-%% encode enumerated value
-%%============================================================================
-encode_enumerated(Val, TagIn) when is_integer(Val) ->
- encode_tags(TagIn, encode_integer(Val)).
-
-%%============================================================================
-%% decode enumerated value
-%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> Value
-%%===========================================================================
-decode_enumerated(Tlv, NamedNumberList, Tags) ->
- Buffer = match_tags(Tlv, Tags),
- decode_enumerated_notag(Buffer, NamedNumberList, Tags).
-
-decode_enumerated_notag(Buffer, {NamedNumberList,ExtList}, _Tags) ->
- IVal = decode_integer(Buffer),
- case decode_enumerated1(IVal, NamedNumberList) of
- {asn1_enum,IVal} ->
- decode_enumerated1(IVal,ExtList);
- EVal ->
- EVal
- end;
-decode_enumerated_notag(Buffer, NNList, _Tags) ->
- IVal = decode_integer(Buffer),
- case decode_enumerated1(IVal, NNList) of
- {asn1_enum,_} ->
- exit({error,{asn1, {illegal_enumerated, IVal}}});
- EVal ->
- EVal
- end.
-
-decode_enumerated1(Val, NamedNumberList) ->
- %% it must be a named integer
- case lists:keyfind(Val, 2, NamedNumberList) of
- {NamedVal, _} ->
- NamedVal;
- _ ->
- {asn1_enum,Val}
- end.
-
%%============================================================================
%% Bitstring value, ITU_T X.690 Chapter 8.6
%%
@@ -794,45 +721,46 @@ encode_unnamed_bit_string(Bits, TagIn) ->
Bin = <<Unused,Bits/bitstring,0:Unused>>,
encode_tags(TagIn, Bin, byte_size(Bin)).
-encode_unnamed_bit_string(C, Bits, TagIn) ->
+encode_unnamed_bit_string(MaxBits, Bits, TagIn) ->
NumBits = bit_size(Bits),
Unused = (8 - (NumBits band 7)) band 7,
Bin = <<Unused,Bits/bitstring,0:Unused>>,
- case C of
- {_Min,Max} ->
- if
- NumBits > Max ->
- exit({error,{asn1,
- {bitstring_length,
- {{was,NumBits},{maximum,Max}}}}});
- true ->
- ok
- end;
- Size ->
- if NumBits =< Size ->
- ok;
- true ->
- exit({error,{asn1,
- {bitstring_length,
- {{was,NumBits},{should_be,Size}}}}})
- end
- end,
- encode_tags(TagIn, Bin, byte_size(Bin)).
+ if
+ NumBits > MaxBits ->
+ exit({error,{asn1,
+ {bitstring_length,
+ {{was,NumBits},{maximum,MaxBits}}}}});
+ true ->
+ encode_tags(TagIn, Bin, byte_size(Bin))
+ end.
encode_named_bit_string([H|_]=Bits, NamedBitList, TagIn) when is_atom(H) ->
- encode_bit_string_named([], Bits, NamedBitList, TagIn);
+ do_encode_named_bit_string(Bits, NamedBitList, TagIn);
encode_named_bit_string([{bit,_}|_]=Bits, NamedBitList, TagIn) ->
- encode_bit_string_named([], Bits, NamedBitList, TagIn);
+ do_encode_named_bit_string(Bits, NamedBitList, TagIn);
encode_named_bit_string(Bits, _NamedBitList, TagIn) when is_bitstring(Bits) ->
encode_unnamed_bit_string(Bits, TagIn).
encode_named_bit_string(C, [H|_]=Bits, NamedBitList, TagIn) when is_atom(H) ->
- encode_bit_string_named(C, Bits, NamedBitList, TagIn);
+ do_encode_named_bit_string(C, Bits, NamedBitList, TagIn);
encode_named_bit_string(C, [{bit,_}|_]=Bits, NamedBitList, TagIn) ->
- encode_bit_string_named(C, Bits, NamedBitList, TagIn);
+ do_encode_named_bit_string(C, Bits, NamedBitList, TagIn);
encode_named_bit_string(C, Bits, _NamedBitList, TagIn) when is_bitstring(Bits) ->
encode_unnamed_bit_string(C, Bits, TagIn).
+do_encode_named_bit_string([FirstVal | RestVal], NamedBitList, TagIn) ->
+ ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []),
+ Size = lists:max(ToSetPos) + 1,
+ BitList = make_and_set_list(Size, ToSetPos, 0),
+ {Len,Unused,OctetList} = encode_bitstring(BitList),
+ encode_tags(TagIn, [Unused|OctetList],Len+1).
+
+do_encode_named_bit_string(Size, [FirstVal | RestVal], NamedBitList, TagIn) ->
+ ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []),
+ BitList = make_and_set_list(Size, ToSetPos, 0),
+ {Len, Unused, OctetList} = encode_bitstring(BitList),
+ encode_tags(TagIn, [Unused|OctetList], Len+1).
+
%%============================================================================
%% Bitstring value, ITU_T X.690 Chapter 8.6
%%
@@ -932,15 +860,14 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) ->
encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) ->
ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []),
- Size =
- case C of
- [] ->
- lists:max(ToSetPos)+1;
- {_Min,Max} ->
- Max;
- TSize ->
- TSize
- end,
+ Size = case C of
+ [] ->
+ lists:max(ToSetPos) + 1;
+ {_Min,Max} ->
+ Max;
+ TSize ->
+ TSize
+ end,
BitList = make_and_set_list(Size, ToSetPos, 0),
{Len, Unused, OctetList} = encode_bitstring(BitList),
encode_tags(TagIn, [Unused|OctetList],Len+1).
@@ -1098,33 +1025,23 @@ unused_bitlist([Bit | Rest], Trail, Ack) ->
%% decode bitstring value
%%============================================================================
-decode_compact_bit_string(Buffer, Range, Tags) ->
+decode_compact_bit_string(Buffer, Tags) ->
case match_and_collect(Buffer, Tags) of
- <<0>> ->
- check_restricted_string({0,<<>>}, 0, Range);
- <<Unused,Bits/binary>> ->
- Val = {Unused,Bits},
- Len = bit_size(Bits) - Unused,
- check_restricted_string(Val, Len, Range)
+ <<0>> -> {0,<<>>};
+ <<Unused,Bits/binary>> -> {Unused,Bits}
end.
-decode_legacy_bit_string(Buffer, Range, Tags) ->
- Val = case match_and_collect(Buffer, Tags) of
- <<0>> ->
- [];
- <<Unused,Bits/binary>> ->
- decode_bitstring2(byte_size(Bits), Unused, Bits)
- end,
- check_restricted_string(Val, length(Val), Range).
+compact_bit_string_size({Unused,Bits}) ->
+ bit_size(Bits) - Unused.
-decode_native_bit_string(Buffer, Range, Tags) ->
+decode_native_bit_string(Buffer, Tags) ->
case match_and_collect(Buffer, Tags) of
<<0>> ->
- check_restricted_string(<<>>, 0, Range);
+ <<>>;
<<Unused,Bits/binary>> ->
Size = bit_size(Bits) - Unused,
<<Val:Size/bitstring,_:Unused/bitstring>> = Bits,
- check_restricted_string(Val, Size, Range)
+ Val
end.
decode_named_bit_string(Buffer, NamedNumberList, Tags) ->
@@ -1147,6 +1064,9 @@ decode_bitstring2(Len, Unused,
[B7,B6,B5,B4,B3,B2,B1,B0|
decode_bitstring2(Len - 1, Unused, Buffer)].
+native_to_legacy_bit_string(Bits) ->
+ [B || <<B:1>> <= Bits].
+
%%----------------------------------------
%% Decode the bitlist to names
%%----------------------------------------
@@ -1310,31 +1230,12 @@ decode_octet_string(Tlv, TagsIn) ->
Bin = match_and_collect(Tlv, TagsIn),
binary:copy(Bin).
-decode_octet_string(Tlv, Range, TagsIn) ->
- Bin0 = match_and_collect(Tlv, TagsIn),
- Bin = binary:copy(Bin0),
- check_restricted_string(Bin, byte_size(Bin), Range).
-
%%============================================================================
%% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings
%%============================================================================
decode_restricted_string(Tlv, TagsIn) ->
- Bin = match_and_collect(Tlv, TagsIn),
- binary_to_list(Bin).
-
-decode_restricted_string(Tlv, Range, TagsIn) ->
- Bin = match_and_collect(Tlv, TagsIn),
- check_restricted_string(binary_to_list(Bin), byte_size(Bin), Range).
-
-check_restricted_string(Val, _Len, []) ->
- Val;
-check_restricted_string(Val, Len, {Lb,Ub}) when Lb =< Len, Len =< Ub ->
- Val;
-check_restricted_string(Val, Len, Len) ->
- Val;
-check_restricted_string(Val, _Len, Range) ->
- exit({error,{asn1,{length,Range,Val}}}).
+ match_and_collect(Tlv, TagsIn).
%%============================================================================
%% encode Universal string
@@ -1360,10 +1261,9 @@ mk_uni_list([H|T],List) ->
%% {String, Remain, RemovedBytes}
%%===========================================================================
-decode_universal_string(Buffer, Range, Tags) ->
+decode_universal_string(Buffer, Tags) ->
Bin = match_and_collect(Buffer, Tags),
- Val = mk_universal_string(binary_to_list(Bin)),
- check_restricted_string(Val, length(Val), Range).
+ mk_universal_string(binary_to_list(Bin)).
mk_universal_string(In) ->
mk_universal_string(In, []).
@@ -1423,10 +1323,9 @@ mk_BMP_list([H|T], List) ->
%% (Buffer, Range, StringType, HasTag, TotalLen) ->
%% {String, Remain, RemovedBytes}
%%============================================================================
-decode_BMP_string(Buffer, Range, Tags) ->
+decode_BMP_string(Buffer, Tags) ->
Bin = match_and_collect(Buffer, Tags),
- Val = mk_BMP_string(binary_to_list(Bin)),
- check_restricted_string(Val, length(Val), Range).
+ mk_BMP_string(binary_to_list(Bin)).
mk_BMP_string(In) ->
mk_BMP_string(In,[]).
diff --git a/lib/asn1/src/asn1rtt_check.erl b/lib/asn1/src/asn1rtt_check.erl
index be4f9c8bff..0083867a10 100644
--- a/lib/asn1/src/asn1rtt_check.erl
+++ b/lib/asn1/src/asn1rtt_check.erl
@@ -18,43 +18,41 @@
%%
-module(asn1rtt_check).
--export([check_bool/2,
+-export([check_fail/1,
check_int/3,
- check_bitstring/2,check_named_bitstring/3,
+ check_legacy_bitstring/2,
+ check_legacy_named_bitstring/3,
+ check_legacy_named_bitstring/4,
+ check_named_bitstring/3,
+ check_named_bitstring/4,
+ check_literal_sof/2,
check_octetstring/2,
- check_null/2,
check_objectidentifier/2,
check_objectdescriptor/2,
check_real/2,
- check_enum/3,
check_restrictedstring/2]).
-check_bool(_Bool, asn1_DEFAULT) ->
- true;
-check_bool(Bool, Bool) when is_boolean(Bool) ->
- true;
-check_bool(_Bool1, Bool2) ->
- throw({error,Bool2}).
+check_fail(_) ->
+ throw(false).
-check_int(_, asn1_DEFAULT, _) ->
- true;
check_int(Value, Value, _) when is_integer(Value) ->
true;
-check_int(DefValue, Value, NNL) when is_atom(Value) ->
+check_int(Value, DefValue, NNL) when is_atom(Value) ->
case lists:keyfind(Value, 1, NNL) of
{_,DefValue} ->
true;
_ ->
- throw({error,DefValue})
+ throw(false)
end;
-check_int(DefaultValue, _Value, _) ->
- throw({error,DefaultValue}).
+check_int(_, _, _) ->
+ throw(false).
+
+check_legacy_bitstring(Value, Default) ->
+ check_bitstring(Default, Value).
%% check_bitstring(Default, UserBitstring) -> true|false
%% Default = bitstring()
%% UserBitstring = integeger() | list(0|1) | {Unused,binary()} | bitstring()
-check_bitstring(_, asn1_DEFAULT) ->
- true;
check_bitstring(DefVal, {Unused,Binary}) ->
%% User value in compact format.
Sz = bit_size(Binary) - Unused,
@@ -62,7 +60,7 @@ check_bitstring(DefVal, {Unused,Binary}) ->
check_bitstring(DefVal, Val);
check_bitstring(DefVal, Val) when is_bitstring(Val) ->
case Val =:= DefVal of
- false -> throw(error);
+ false -> throw(false);
true -> true
end;
check_bitstring(Def, Val) when is_list(Val) ->
@@ -75,178 +73,95 @@ check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) ->
check_bitstring_list(<<>>, []) ->
true;
check_bitstring_list(_, _) ->
- throw(error).
+ throw(false).
check_bitstring_integer(<<H:1,T1/bitstring>>, Int) when H =:= Int band 1 ->
check_bitstring_integer(T1, Int bsr 1);
check_bitstring_integer(<<>>, 0) ->
true;
check_bitstring_integer(_, _) ->
- throw(error).
-
-check_named_bitstring(_, asn1_DEFAULT, _) ->
- true;
-check_named_bitstring(V, V, _) ->
- true;
-%% Default value and user value as lists of ones and zeros
-check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) ->
- L2new = remove_trailing_zeros(L2),
- check_named_bitstring(L1, L2new, NBL);
-%% Default value as a list of 1 and 0 and user value as a list of atoms
-check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) ->
- L3 = bit_list_to_nbl(L1, NBL, 0, []),
- check_named_bitstring(L3, L2, NBL);
-%% Both default value and user value as a list of atoms
-check_named_bitstring(L1=[H1|T1], L2=[H2|_T2], _)
- when is_atom(H1), is_atom(H2), length(L1) =:= length(L2) ->
- case lists:member(H1, L2) of
- true ->
- check_bitstring1(T1, L2);
- false -> throw({error,L2})
- end;
-%% Default value as a list of atoms and user value as a list of 1 and 0
-check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) ->
- L3 = bit_list_to_nbl(L2, NBL, 0, []),
- check_named_bitstring(L1, L3, NBL);
-%% User value in compact format
-check_named_bitstring(DefVal,CBS={_,_}, NBL) ->
- NewVal = cbs_to_bit_list(CBS),
- check_named_bitstring(DefVal, NewVal, NBL);
-%% User value as a binary
-check_named_bitstring(DefVal, CBS, NBL) when is_binary(CBS) ->
- NewVal = cbs_to_bit_list({0,CBS}),
- check_named_bitstring(DefVal, NewVal, NBL);
-%% User value as a bitstring
-check_named_bitstring(DefVal, CBS, NBL) when is_bitstring(CBS) ->
- BitSize = bit_size(CBS),
- Unused = 8 - (BitSize band 7),
- NewVal = cbs_to_bit_list({Unused,<<CBS:BitSize/bits,0:Unused>>}),
- check_named_bitstring(DefVal, NewVal, NBL);
-check_named_bitstring(DV, V, _) ->
- throw({error,DV,V}).
-
-int_to_bit_list(0, Acc, 0) ->
- Acc;
-int_to_bit_list(Int, Acc, Len) when Len > 0 ->
- int_to_bit_list(Int bsr 1, [Int band 1|Acc], Len - 1).
-
-bit_list_to_nbl([0|T], NBL, Pos, Acc) ->
- bit_list_to_nbl(T, NBL, Pos+1, Acc);
-bit_list_to_nbl([1|T], NBL, Pos, Acc) ->
- case lists:keyfind(Pos, 2, NBL) of
- {N,_} ->
- bit_list_to_nbl(T, NBL, Pos+1, [N|Acc]);
+ throw(false).
+
+check_legacy_named_bitstring([Int|_]=Val, Bs, BsSize) when is_integer(Int) ->
+ check_named_bitstring(<< <<B:1>> || B <- Val >>, Bs, BsSize);
+check_legacy_named_bitstring({Unused,Val0}, Bs, BsSize) ->
+ Sz = bit_size(Val0) - Unused,
+ <<Val:Sz/bits,_/bits>> = Val0,
+ check_named_bitstring(Val, Bs, BsSize);
+check_legacy_named_bitstring(Val, Bs, BsSize) when is_integer(Val) ->
+ L = legacy_int_to_bitlist(Val),
+ check_named_bitstring(<< <<B:1>> || B <- L >>, Bs, BsSize);
+check_legacy_named_bitstring(Val, Bs, BsSize) ->
+ check_named_bitstring(Val, Bs, BsSize).
+
+check_legacy_named_bitstring([Int|_]=Val, Names, Bs, BsSize) when is_integer(Int) ->
+ check_named_bitstring(<< <<B:1>> || B <- Val >>, Names, Bs, BsSize);
+check_legacy_named_bitstring({Unused,Val0}, Names, Bs, BsSize) ->
+ Sz = bit_size(Val0) - Unused,
+ <<Val:Sz/bits,_/bits>> = Val0,
+ check_named_bitstring(Val, Names, Bs, BsSize);
+check_legacy_named_bitstring(Val, Names, Bs, BsSize) when is_integer(Val) ->
+ L = legacy_int_to_bitlist(Val),
+ check_named_bitstring(<< <<B:1>> || B <- L >>, Names, Bs, BsSize);
+check_legacy_named_bitstring(Val, Names, Bs, BsSize) ->
+ check_named_bitstring(Val, Names, Bs, BsSize).
+
+legacy_int_to_bitlist(0) ->
+ [];
+legacy_int_to_bitlist(Int) ->
+ [Int band 1|legacy_int_to_bitlist(Int bsr 1)].
+
+check_named_bitstring(Bs, Bs, _) ->
+ true;
+check_named_bitstring(Val, Bs, BsSize) ->
+ Rest = bit_size(Val) - BsSize,
+ case Val of
+ <<Bs:BsSize/bits,0:Rest>> ->
+ true;
_ ->
- throw({error,{no,named,element,at,pos,Pos}})
- end;
-bit_list_to_nbl([], _, _, Acc) ->
- Acc.
-
-remove_trailing_zeros(L2) ->
- remove_trailing_zeros1(lists:reverse(L2)).
-remove_trailing_zeros1(L) ->
- lists:reverse(lists:dropwhile(fun(0)->true;
- (_) ->false
- end,
- L)).
-
-check_bitstring1([H|T], NBL) ->
- case lists:member(H, NBL) of
- true -> check_bitstring1(T, NBL);
- V -> throw({error,V})
- end;
-check_bitstring1([], _) ->
- true.
-
-cbs_to_bit_list({Unused, <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Rest/binary>>}) when byte_size(Rest) >= 1 ->
- [B7,B6,B5,B4,B3,B2,B1,B0|cbs_to_bit_list({Unused,Rest})];
-cbs_to_bit_list({0,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1>>}) ->
- [B7,B6,B5,B4,B3,B2,B1,B0];
-cbs_to_bit_list({Unused,Bin}) when byte_size(Bin) =:= 1 ->
- Used = 8-Unused,
- <<Int:Used,_:Unused>> = Bin,
- int_to_bit_list(Int, [], Used).
-
+ throw(false)
+ end.
-check_octetstring(_, asn1_DEFAULT) ->
- true;
-check_octetstring(L, L) ->
- true;
-check_octetstring(L, Int) when is_list(L), is_integer(Int) ->
- case integer_to_octetlist(Int) of
- L -> true;
- V -> throw({error,V})
+check_named_bitstring([_|_]=Val, Names, _, _) ->
+ case lists:sort(Val) of
+ Names -> true;
+ _ -> throw(false)
end;
-check_octetstring(_, V) ->
- throw({error,V}).
-
-integer_to_octetlist(Int) ->
- integer_to_octetlist(Int, []).
-integer_to_octetlist(0, Acc) ->
- Acc;
-integer_to_octetlist(Int, Acc) ->
- integer_to_octetlist(Int bsr 8, [(Int band 255)|Acc]).
-
-check_null(_, asn1_DEFAULT) ->
+check_named_bitstring(Bs, _, Bs, _) ->
true;
-check_null('NULL', 'NULL') ->
- true;
-check_null(_, V) ->
- throw({error,V}).
+check_named_bitstring(Val, _, Bs, BsSize) ->
+ Rest = bit_size(Val) - BsSize,
+ case Val of
+ <<Bs:BsSize/bits,0:Rest>> ->
+ true;
+ _ ->
+ throw(false)
+ end.
-check_objectidentifier(_, asn1_DEFAULT) ->
- true;
-check_objectidentifier(OI, OI) ->
+check_octetstring(V, V) ->
true;
-check_objectidentifier(DOI, OI) when is_tuple(DOI), is_tuple(OI) ->
- check_objectidentifier1(tuple_to_list(DOI), tuple_to_list(OI));
-check_objectidentifier(_, OI) ->
- throw({error,OI}).
-
-check_objectidentifier1([V|Rest1], [V|Rest2]) ->
- check_objectidentifier1(Rest1, Rest2, V);
-check_objectidentifier1([V1|Rest1], [V2|Rest2]) ->
- case reserved_objectid(V2, []) of
- V1 ->
- check_objectidentifier1(Rest1, Rest2, [V1]);
- V ->
- throw({error,V})
- end.
-check_objectidentifier1([V|Rest1], [V|Rest2], Above) ->
- check_objectidentifier1(Rest1, Rest2, [V|Above]);
-check_objectidentifier1([V1|Rest1], [V2|Rest2], Above) ->
- case reserved_objectid(V2, Above) of
- V1 ->
- check_objectidentifier1(Rest1, Rest2, [V1|Above]);
- V ->
- throw({error,V})
+check_octetstring(V, Def) when is_list(V) ->
+ case list_to_binary(V) of
+ Def -> true;
+ _ -> throw(false)
+ end;
+check_octetstring(_, _) ->
+ throw(false).
+
+check_objectidentifier(Value, {Prefix,Tail}) when is_tuple(Value) ->
+ check_oid(tuple_to_list(Value), Prefix, Tail);
+check_objectidentifier(_, _) ->
+ throw(false).
+
+check_oid([H|T], [K|Ks], Tail) ->
+ case lists:member(H, K) of
+ false -> throw(false);
+ true -> check_oid(T, Ks, Tail)
end;
-check_objectidentifier1([], [], _) ->
+check_oid(Tail, [], Tail) ->
true;
-check_objectidentifier1(_, V, _) ->
- throw({error,object,identifier,V}).
-
-%% ITU-T Rec. X.680 Annex B - D
-reserved_objectid('itu-t', []) -> 0;
-reserved_objectid('ccitt', []) -> 0;
-%% arcs below "itu-t"
-reserved_objectid('recommendation', [0]) -> 0;
-reserved_objectid('question', [0]) -> 1;
-reserved_objectid('administration', [0]) -> 2;
-reserved_objectid('network-operator', [0]) -> 3;
-reserved_objectid('identified-organization', [0]) -> 4;
-
-reserved_objectid(iso, []) -> 1;
-%% arcs below "iso", note that number 1 is not used
-reserved_objectid('standard', [1]) -> 0;
-reserved_objectid('member-body', [1]) -> 2;
-reserved_objectid('identified-organization', [1]) -> 3;
-
-reserved_objectid('joint-iso-itu-t', []) -> 2;
-reserved_objectid('joint-iso-ccitt', []) -> 2;
-
-reserved_objectid(_, _) -> false.
-
+check_oid(_, _, _) ->
+ throw(false).
check_objectdescriptor(_, asn1_DEFAULT) ->
true;
@@ -262,21 +177,6 @@ check_real(R, R) ->
check_real(_, _) ->
throw({error,{not_implemented_yet,check_real}}).
-check_enum(_, asn1_DEFAULT, _) ->
- true;
-check_enum(Val, Val, _) ->
- true;
-check_enum(Int, Atom, Enumerations) when is_integer(Int), is_atom(Atom) ->
- case lists:keyfind(Atom, 1, Enumerations) of
- {_,Int} -> true;
- _ -> throw({error,{enumerated,Int,Atom}})
- end;
-check_enum(DefVal, Val, _) ->
- throw({error,{enumerated,DefVal,Val}}).
-
-
-check_restrictedstring(_, asn1_DEFAULT) ->
- true;
check_restrictedstring(Val, Val) ->
true;
check_restrictedstring([V|Rest1], [V|Rest2]) ->
@@ -295,7 +195,15 @@ check_restrictedstring({V1,V2,V3,V4}, [V1,V2,V3,V4]) ->
check_restrictedstring([V1,V2,V3,V4], {V1,V2,V3,V4}) ->
true;
%% character string list
-check_restrictedstring(V1, V2) when is_list(V1), is_tuple(V2) ->
- check_restrictedstring(V1, tuple_to_list(V2));
-check_restrictedstring(V1, V2) ->
- throw({error,{restricted,string,V1,V2}}).
+check_restrictedstring(V1, V2) when is_tuple(V1) ->
+ check_restrictedstring(tuple_to_list(V1), V2);
+check_restrictedstring(_, _) ->
+ throw(false).
+
+check_literal_sof(Value, Default) ->
+ case lists:sort(Value) of
+ Default ->
+ true;
+ _ ->
+ throw(false)
+ end.
diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl
index 71fec411a0..0290c75a28 100644
--- a/lib/asn1/src/asn1rtt_per_common.erl
+++ b/lib/asn1/src/asn1rtt_per_common.erl
@@ -30,6 +30,7 @@
decode_big_chars/2,
decode_oid/1,decode_relative_oid/1,
encode_chars/2,encode_chars/3,
+ encode_chars_compact_map/3,
encode_chars_16bit/1,encode_big_chars/1,
encode_fragmented/2,
encode_oid/1,encode_relative_oid/1,
@@ -108,6 +109,9 @@ encode_chars(Val, NumBits) ->
encode_chars(Val, NumBits, {Lb,Tab}) ->
<< <<(enc_char(C, Lb, Tab)):NumBits>> || C <- Val >>.
+encode_chars_compact_map(Val, NumBits, {Lb,Limit}) ->
+ << <<(enc_char_cm(C, Lb, Limit)):NumBits>> || C <- Val >>.
+
encode_chars_16bit(Val) ->
L = [case C of
{0,0,A,B} -> [A,B];
@@ -383,6 +387,15 @@ enc_char(C0, Lb, Tab) ->
illegal_char_error()
end.
+enc_char_cm(C0, Lb, Limit) ->
+ C = C0 - Lb,
+ if
+ 0 =< C, C < Limit ->
+ C;
+ true ->
+ illegal_char_error()
+ end.
+
illegal_char_error() ->
error({error,{asn1,"value forbidden by FROM constraint"}}).
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index 782217ed2d..11d1b82fb4 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -50,13 +50,14 @@ all() ->
{group, performance}].
groups() ->
- [{compile, parallel([]),
+ Parallel = asn1_test_lib:parallel(),
+ [{compile, Parallel,
[c_syntax,
c_string,
c_implicit_before_choice,
constraint_equivalence]},
- {ber, parallel([]),
+ {ber, Parallel,
[ber_choiceinseq,
% Uses 'SOpttest'
ber_optional]},
@@ -65,7 +66,7 @@ groups() ->
{appup_test, [], [{asn1_appup_test, all}]},
- {parallel, parallel([]),
+ {parallel, Parallel,
[cover,
xref,
{group, ber},
@@ -173,13 +174,6 @@ groups() ->
testTimer_per,
testTimer_uper]}].
-parallel(Options) ->
- case erlang:system_info(smp_support) andalso
- erlang:system_info(schedulers) > 1 of
- true -> [parallel|Options];
- false -> Options
- end.
-
%%------------------------------------------------------------------------------
%% Init/end
%%------------------------------------------------------------------------------
@@ -428,14 +422,12 @@ testMultipleLevels(Config, Rule, Opts) ->
asn1_test_lib:compile("MultipleLevels", Config, [Rule|Opts]),
testMultipleLevels:main(Rule).
-testDef(Config) -> test(Config, fun testDef/3).
-testDef(Config, Rule, Opts) ->
- asn1_test_lib:compile("Def", Config, [Rule|Opts]),
- testDef:main(Rule).
-
testDEFAULT(Config) ->
test(Config, fun testDEFAULT/3, [ber,{ber,[der]},per,uper]).
testDEFAULT(Config, Rule, Opts) ->
+ asn1_test_lib:compile_all(["Def","Default"], Config, [Rule|Opts]),
+ testDef:main(Rule),
+ testSeqSetDefaultVal:main(Rule, Opts),
asn1_test_lib:compile_all(["Def","Default"], Config,
[legacy_erlang_types,Rule|Opts]),
testDef:main(Rule),
diff --git a/lib/asn1/test/asn1_SUITE_data/Constraints.py b/lib/asn1/test/asn1_SUITE_data/Constraints.py
index c3b3aebd6d..3495cd841b 100644
--- a/lib/asn1/test/asn1_SUITE_data/Constraints.py
+++ b/lib/asn1/test/asn1_SUITE_data/Constraints.py
@@ -16,6 +16,7 @@ SemiConstrained ::= INTEGER (100..MAX)
NegSemiConstrained ::= INTEGER (-128..MAX)
SemiConstrainedExt ::= INTEGER (42..MAX, ...)
NegSemiConstrainedExt ::= INTEGER (-128..MAX, ...)
+SemiNamed ::= INTEGER {a(100), b(200)} (100..MAX)
-- Extensions --
LongLongExt ::= INTEGER (0..18446744073709551615, ..., -5000..-1)
Range256to65536Ext ::= INTEGER (256..65536, ..., 1000000..9000000)
@@ -65,10 +66,12 @@ Wednesday ::= Day(wednesday)
Thing ::= INTEGER {fred (0),fred2 (1),fred3 (2)}
-
-
AnotherThing ::= Thing (fred | fred2)
+OneMoreThing ::= INTEGER {wilma(0), fred(1), betty(3), barney(2)}
+OneMoreThing-1 ::= OneMoreThing (wilma | fred)
+OneMoreThing-2 ::= OneMoreThing (fred | barney)
+
I ::= INTEGER (0|15..269) -- OTP-5457
X1 ::= INTEGER (1..4 | 8 | 10 | 20) -- OTP-9946
diff --git a/lib/asn1/test/asn1_SUITE_data/Default.asn b/lib/asn1/test/asn1_SUITE_data/Default.asn
index 168ce50bb2..b91660381a 100644
--- a/lib/asn1/test/asn1_SUITE_data/Default.asn
+++ b/lib/asn1/test/asn1_SUITE_data/Default.asn
@@ -25,6 +25,10 @@ SeqBS ::= SEQUENCE {
e BIT STRING DEFAULT '01011010'B
}
+SeqBS2 ::= SEQUENCE {
+ bs BIT STRING {a(0), z(25)} DEFAULT '101'B
+}
+
SetBS ::= SET {
a BIT STRING DEFAULT '1010110'B,
b BIT STRING DEFAULT 'A8A'H,
@@ -156,4 +160,23 @@ four INTEGER ::= 4
cr IA5String ::= {0,13}
+SeqNamedInts ::= SEQUENCE {
+ i1 INTEGER {first(0), last(31)} DEFAULT 15,
+ i2 INTEGER {first(0), last(31)} DEFAULT 31
+}
+
+S5 ::= SEQUENCE {
+ s3 S3 DEFAULT {},
+ so SEQUENCE OF OBJECT IDENTIFIER DEFAULT {
+ {itu-t question 999},
+ {itu-t question 555}
+ },
+ soe SEQUENCE OF OBJECT IDENTIFIER DEFAULT { }
+}
+
+SOI ::= SEQUENCE {
+ soi SEQUENCE OF OBJECT IDENTIFIER
+ DEFAULT { {iso member-body f(250) 9 55}, {iso member-body f(250) 3 4} }
+}
+
END
diff --git a/lib/asn1/test/asn1_SUITE_data/Set.py b/lib/asn1/test/asn1_SUITE_data/Set.py
index 4062f6b804..3928004e6b 100644
--- a/lib/asn1/test/asn1_SUITE_data/Set.py
+++ b/lib/asn1/test/asn1_SUITE_data/Set.py
@@ -80,8 +80,8 @@ SetOpt3 ::= SET
SetIn ::= SET
{
- boolIn BOOLEAN,
- intIn INTEGER
+ boolIn BOOLEAN OPTIONAL,
+ intIn INTEGER OPTIONAL
}
diff --git a/lib/asn1/test/asn1_app_test.erl b/lib/asn1/test/asn1_app_test.erl
index 1225e36778..d800846b3f 100644
--- a/lib/asn1/test/asn1_app_test.erl
+++ b/lib/asn1/test/asn1_app_test.erl
@@ -134,13 +134,13 @@ get_ebin_mods(App) ->
check_asn1ct_modules(Extra) ->
ASN1CTMods = [asn1ct,asn1ct_check,asn1_db,asn1ct_pretty_format,
- asn1ct_gen,asn1ct_gen_per,asn1ct_gen_per_rt2ct,
+ asn1ct_gen,asn1ct_gen_check,asn1ct_gen_per,
asn1ct_name,asn1ct_constructed_per,asn1ct_constructed_ber,
asn1ct_gen_ber,asn1ct_constructed_ber_bin_v2,
asn1ct_gen_ber_bin_v2,asn1ct_value,
asn1ct_tok,asn1ct_parser2,asn1ct_table,
asn1ct_imm,asn1ct_func,asn1ct_rtt,
- asn1ct_eval_ext,asn1ct_eval_per,asn1ct_eval_uper],
+ asn1ct_eval_ext],
case Extra -- ASN1CTMods of
[] ->
ok;
diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl
index 417380159e..06e9b2c093 100644
--- a/lib/asn1/test/asn1_test_lib.erl
+++ b/lib/asn1/test/asn1_test_lib.erl
@@ -21,19 +21,72 @@
-export([compile/3,compile_all/3,compile_erlang/3,
hex_to_bin/1,
+ parallel/0,
roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4]).
-include_lib("test_server/include/test_server.hrl").
+run_dialyzer() ->
+ false.
+
compile(File, Config, Options) -> compile_all([File], Config, Options).
compile_all(Files, Config, Options) ->
DataDir = ?config(data_dir, Config),
CaseDir = ?config(case_dir, Config),
- [compile_file(filename:join(DataDir, F), [{outdir, CaseDir}|Options])
+ [compile_file(filename:join(DataDir, F), [{outdir, CaseDir},
+ debug_info|Options])
|| F <- Files],
+ dialyze(Files, Options),
ok.
+parallel() ->
+ case erlang:system_info(schedulers) > 1 andalso not run_dialyzer() of
+ true -> [parallel];
+ false -> []
+ end.
+
+dialyze(Files, Options) ->
+ case not run_dialyzer() orelse lists:member(abs, Options) of
+ true -> ok;
+ false -> dialyze(Files)
+ end.
+
+dialyze(Files) ->
+ Beams0 = [code:which(module(F)) || F <- Files],
+ Beams = [code:which(asn1rt_nif)|Beams0],
+ case dialyzer:run([{files,Beams},
+ {warnings,[no_improper_lists]},
+ {get_warnings,true}]) of
+ [] ->
+ ok;
+ [_|_]=Ws ->
+ io:put_chars([[B,$\n] || B <- Beams]),
+ io:put_chars([dialyzer:format_warning(W) || W <- Ws]),
+ error(dialyzer_warnings)
+ end.
+
+module(F0) ->
+ F1 = filename:basename(F0),
+ F2 = case filename:extension(F1) of
+ ".asn" ->
+ filename:rootname(F1);
+ ".asn1" ->
+ filename:rootname(F1);
+ ".py" ->
+ filename:rootname(F1);
+ "" ->
+ F1
+ end,
+ F = case filename:extension(F2) of
+ ".set" ->
+ filename:rootname(F2);
+ "" ->
+ F2
+ end,
+ list_to_atom(F).
+%% filename:join(CaseDir, F ++ ".beam").
+
compile_file(File, Options) ->
try
ok = asn1ct:compile(File, [warnings_as_errors|Options])
diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl
index 57cb483374..e37e22163a 100644
--- a/lib/asn1/test/testNBAPsystem.erl
+++ b/lib/asn1/test/testNBAPsystem.erl
@@ -79,13 +79,14 @@ powerRaiseLimit, dLPowerAveragingWindowSize, 'iE-Extensions' = asn1_NOVALUE}).
compile(Config, Options) ->
- [asn1_test_lib:compile(filename:join([nbapsystem, M]), Config, Options)
- || M <- ["NBAP-CommonDataTypes.asn",
- "NBAP-IEs.asn",
- "NBAP-PDU-Contents.asn",
- "NBAP-PDU-Discriptions.asn",
- "NBAP-Constants.asn",
- "NBAP-Containers.asn"]],
+ Fs = [filename:join("nbapsystem", M) ||
+ M <- ["NBAP-CommonDataTypes.asn",
+ "NBAP-IEs.asn",
+ "NBAP-PDU-Contents.asn",
+ "NBAP-PDU-Discriptions.asn",
+ "NBAP-Constants.asn",
+ "NBAP-Containers.asn"]],
+ asn1_test_lib:compile_all(Fs, Config, Options),
ok.
diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl
index 79992a0a94..c3d9ce33b7 100644
--- a/lib/asn1/test/testSeqSetDefaultVal.erl
+++ b/lib/asn1/test/testSeqSetDefaultVal.erl
@@ -36,6 +36,7 @@
c = asn1_DEFAULT,
d = asn1_DEFAULT,
e = asn1_DEFAULT}).
+-record('SeqBS2',{bs = asn1_DEFAULT}).
-record('SetBS',{a = asn1_DEFAULT,
b = asn1_DEFAULT,
c = asn1_DEFAULT,
@@ -93,6 +94,13 @@
b = asn1_DEFAULT}).
-record('S4_b',{ba = asn1_DEFAULT,
bb = asn1_DEFAULT}).
+-record('SeqNamedInts',
+ {i1 = asn1_DEFAULT,
+ i2 = asn1_DEFAULT}).
+-record('S5',{s3 = asn1_DEFAULT,
+ so = asn1_DEFAULT,
+ soe = asn1_DEFAULT}).
+-record('SOI', {soi = asn1_DEFAULT}).
main(ber, []) ->
%% Nothing to test because plain BER will only use
@@ -105,7 +113,11 @@ main(Rule, Opts) ->
case {Rule,Opts} of
{ber,[der]} ->
- der();
+ der(),
+ case 'Default':legacy_erlang_types() of
+ false -> der_new_types();
+ true -> der_legacy()
+ end;
{_,_} ->
ok
end,
@@ -118,45 +130,45 @@ main(Rule, Opts) ->
{#'SeqBS'{},
[{#'SeqBS'.a,
- [asn1_DEFAULT,
- 2#0110101,
+ [asn1_DEFAULT, %Always.
+ <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>],
+ [2#0110101, %Legacy only.
[1,0,1,0,1,1,0],
- {1,<<16#AC>>},
- <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>]},
+ {1,<<16#AC>>}]},
{#'SeqBS'.b,
[asn1_DEFAULT,
- 2#10100010101,
+ <<16#A8:8,16#A:4>>],
+ [2#10100010101,
[1,0,1,0,1,0,0,0,1,0,1,0],
- {4,<<16#A8,16#A0>>},
- <<16#A8:8,16#A:4>>]},
+ {4,<<16#A8,16#A0>>}]},
{#'SeqBS'.c,
[asn1_DEFAULT,
[second],
- [0,1],
- {6,<<0:1,1:1,0:6>>},
- <<1:2>>]},
+ <<1:2>>],
+ [[0,1],
+ {6,<<0:1,1:1,0:6>>}]},
{#'SeqBS'.c, %Zeroes on the right
[asn1_DEFAULT,
[second],
- [0,1,0,0,0],
- {4,<<0:1,1:1,0:6>>},
- <<1:2,0:17>>]},
+ <<1:2,0:17>>],
+ [[0,1,0,0,0],
+ {4,<<0:1,1:1,0:6>>}]},
{#'SeqBS'.d,
[asn1_DEFAULT,
- 2#1001,
+ <<2#1001:4>>],
+ [2#1001,
[1,0,0,1],
- {4,<<2#1001:4,0:4>>},
- <<2#1001:4>>]},
+ {4,<<2#1001:4,0:4>>}]},
{#'SeqBS'.e,
[asn1_DEFAULT,
- [0,1,0,1,1,0,1,0],
- {0,<<2#01011010:8>>},
- <<2#01011010:8>>]},
+ <<2#01011010:8>>],
+ [[0,1,0,1,1,0,1,0],
+ {0,<<2#01011010:8>>}]},
%% Not EQUAL to DEFAULT.
{#'SeqBS'.b,
+ [<<6:3>>],
[[1,1,0], %Not equal to DEFAULT
- {5,<<6:3,0:5>>},
- <<6:3>>]}
+ {5,<<6:3,0:5>>}]}
]},
{#'SeqOS'{},
@@ -170,15 +182,14 @@ main(Rule, Opts) ->
{1,2,14,15}]},
{#'SeqOI'.b,
[asn1_DEFAULT,
-%% {iso,'member-body',250,3,4},
+ %% {iso,'member-body',250,3,4},
{1,2,250,3,4}]},
{#'SeqOI'.c,
[asn1_DEFAULT,
-%% {iso,standard,8571,2,250,4},
+ %% {iso,standard,8571,2,250,4},
{1,0,8571,2,250,4}]}]}
],
- io:format("~p\n", [Ts]),
- R0 = [[consistency(Rec, Pos, Vs) || {Pos,Vs} <- Fs] || {Rec,Fs} <- Ts],
+ R0 = [[consistency(Rec, PosVs) || PosVs <- Fs] || {Rec,Fs} <- Ts],
case lists:flatten(R0) of
[] ->
ok;
@@ -187,8 +198,20 @@ main(Rule, Opts) ->
?t:fail()
end.
-consistency(Rec0, Pos, [V|Vs]) ->
+legacy_filter({_,_}=Keep) ->
+ Keep;
+legacy_filter({Rec,Standard,Legacy}) ->
+ case 'Default':legacy_erlang_types() of
+ false ->
+ {Rec,Standard};
+ true ->
+ {Rec,Standard++Legacy}
+ end.
+
+consistency(Rec0, PosVs) ->
+ {Pos,[V|Vs]=AllVs} = legacy_filter(PosVs),
T = element(1, Rec0),
+ io:format("~p: ~p\n", [T,AllVs]),
Rec = setelement(Pos, Rec0, V),
{ok,Enc} = 'Default':encode(T, Rec),
{ok,_SmokeTest} = 'Default':decode(T, Enc),
@@ -206,7 +229,7 @@ consistency_1([V|Vs], Rec0, Pos, Enc) ->
consistency_1([], _, _, _) -> [].
der() ->
- io:put_chars("Peforming DER-specific tests..."),
+ io:put_chars("Performing DER-specific tests..."),
roundtrip(<<48,0>>,
'SeqInts',
#'SeqInts'{a=asn1_DEFAULT,b=asn1_DEFAULT,
@@ -227,98 +250,6 @@ der() ->
#'SetInts'{a=1,b=-1,c=three,d=1},
#'SetInts'{a=1,b=-1,c=3,d=1}),
-
- roundtrip(<<48,0>>,
- 'SeqBS',
- #'SeqBS'{a=2#0110101,
- b=2#010100010101,
- c=[second],
- d=[1,0,0,1]},
- #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<2#1001:4>>,
- e = <<2#01011010:8>>}),
- roundtrip(<<48,0>>,
- 'SeqBS',
- #'SeqBS'{a=[1,0,1,0,1,1,0],
- b=[1,0,1,0,1,0,0,0,1,0,1,0],
- c={5,<<64>>},
- d=2#1001},
- #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<2#1001:4>>,
- e = <<2#01011010:8>>}),
- roundtrip(<<48,3,131,1,0>>,
- 'SeqBS',
- #'SeqBS'{a=[1,0,1,0,1,1,0],
- b=[1,0,1,0,1,0,0,0,1,0,1,0],
- c={5,<<64>>},
- d=0},
- #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<>>,
- e = <<2#01011010:8>>}),
- roundtrip(<<48,3,131,1,0>>,
- 'SeqBS',
- #'SeqBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>,
- b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>,
- c = <<2:3>>,
- d=0,
- e = <<16#5A:8>>},
- #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<>>,
- e = <<2#01011010:8>>}),
-
- %% None of the default values are used.
- roundtrip(<<48,19,128,2,7,128,129,2,5,64,130,2,5,32,131,1,0,132,2,5,224>>,
- 'SeqBS',
- #'SeqBS'{a = <<1:1>>,
- b = {5,<<64>>},
- c = [third],
- d = 0,
- e = <<7:3>>},
- #'SeqBS'{a = <<1:1>>,
- b = <<2:3>>,
- c = [third],
- d = <<>>,
- e = <<7:3>>}),
-
- roundtrip(<<49,0>>,
- 'SetBS',
- #'SetBS'{a=2#0110101,
- b=2#010100010101,
- c=[second],
- d=[1,0,0,1]},
- #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<2#1001:4>>}),
- roundtrip(<<49,0>>,
- 'SetBS',
- #'SetBS'{a=[1,0,1,0,1,1,0],
- b=[1,0,1,0,1,0,0,0,1,0,1,0],
- c={5,<<64>>},
- d=9},
- #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<2#1001:4>>}),
- roundtrip(<<49,3,131,1,0>>,
- 'SetBS',
- #'SetBS'{a=[1,0,1,0,1,1,0],
- b=[1,0,1,0,1,0,0,0,1,0,1,0],
- c={5,<<64>>},
- d=0},
- #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<>>}),
- roundtrip(<<49,3,131,1,0>>,
- 'SetBS',
- #'SetBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>,
- b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>,
- c = <<2:3>>,
- d=0},
- #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
- c=[second], d = <<>>}),
-
- roundtrip(<<48,0>>, 'SeqOS',
- #'SeqOS'{a = <<172>>,b = <<16#A8,16#A0>>,c='NULL'}),
-
- roundtrip(<<49,0>>, 'SetOS',
- #'SetOS'{a = <<172>>,b = <<16#A8,16#A0>>,c='NULL'}),
-
roundtrip(<<48,0>>,
'SeqOI',
#'SeqOI'{a={1,2,14,15},
@@ -443,6 +374,184 @@ der() ->
#'S4'{a=#'S2'{a=1,b=asn1_NOVALUE},b=#'S4_b'{ba=true,bb=0}},
#'S4'{a=#'S2'{a=1,b=asn1_NOVALUE},b=#'S4_b'{ba=true,bb=0}}),
+ roundtrip(<<48,0>>,
+ 'SeqBS',
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>,
+ e = <<2#01011010:8>>}),
+ roundtrip(<<49,0>>,
+ 'SetBS',
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>}),
+
+ %% None of the default values are used.
+ roundtrip(<<48,19,128,2,7,128,129,2,5,64,130,2,5,32,131,1,0,132,2,5,224>>,
+ 'SeqBS',
+ #'SeqBS'{a = <<1:1>>,
+ b = <<2:3>>,
+ c = [third],
+ d = <<>>,
+ e = <<7:3>>}),
+ roundtrip(<<49,3,131,1,0>>,
+ 'SetBS',
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>}),
+
+ %% SeqNamedInts
+ roundtrip(<<48,0>>,
+ 'SeqNamedInts',
+ #'SeqNamedInts'{i1=15,i2=31}),
+ roundtrip(<<48,0>>,
+ 'SeqNamedInts',
+ #'SeqNamedInts'{},
+ #'SeqNamedInts'{i1=15,i2=31}),
+ roundtrip(<<48,0>>,
+ 'SeqNamedInts',
+ #'SeqNamedInts'{i2=last},
+ #'SeqNamedInts'{i1=15,i2=31}),
+ roundtrip(<<48,3,128,1,0>>,
+ 'SeqNamedInts',
+ #'SeqNamedInts'{i1=first,i2=31},
+ #'SeqNamedInts'{i1=first,i2=31}),
+
+ %% S5
+ roundtrip(<<48,0>>,
+ 'S5',
+ #'S5'{s3=#'S3'{a=[11,12,13],
+ b=[{a,11},{b,true},{c,13}],
+ c=[1,2,3,4],
+ d=[#'S2'{a=20,b=true},#'S2'{a=30,b=false}]},
+ so=[{0,1,999},{0,1,555}],
+ soe=[]}),
+ roundtrip(<<48,0>>,
+ 'S5',
+ #'S5'{},
+ #'S5'{s3=#'S3'{a=[11,12,13],
+ b=[{a,11},{b,true},{c,13}],
+ c=[1,2,3,4],
+ d=[#'S2'{a=20,b=true},#'S2'{a=30,b=false}]},
+ so=[{0,1,999},{0,1,555}],
+ soe=[]}),
+
+ %% SOI
+ roundtrip(<<48,0>>,
+ 'SOI',
+ #'SOI'{},
+ #'SOI'{soi=[{1,2,250,9,55},{1,2,250,3,4}]}),
+
+ %% SeqBS2
+ roundtrip(<<48,0>>,
+ 'SeqBS2',
+ #'SeqBS2'{bs= <<16#5:3>>}),
+ roundtrip(<<48,0>>,
+ 'SeqBS2',
+ #'SeqBS2'{bs= <<16#5:3,0:4>>},
+ #'SeqBS2'{bs= <<16#5:3>>}),
+
+ ok.
+
+der_new_types() ->
+ io:put_chars("Performing DER-specific tests with new types..."),
+
+ roundtrip(<<48,0>>, 'SeqOS',
+ #'SeqOS'{a = <<172>>,b = <<16#A8,16#A0>>,c='NULL'}),
+
+ roundtrip(<<49,0>>, 'SetOS',
+ #'SetOS'{a = <<172>>,b = <<16#A8,16#A0>>,c='NULL'}),
+ ok.
+
+der_legacy() ->
+ io:put_chars("Performing DER-specific tests with legacy types..."),
+
+ roundtrip(<<48,0>>, 'SeqOS',
+ #'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}),
+ roundtrip(<<49,0>>, 'SetOS',
+ #'SetOS'{a=[172],b=[16#A8,16#A0],c='NULL'}),
+
+ roundtrip(<<48,0>>,
+ 'SeqBS',
+ #'SeqBS'{a=2#0110101,
+ b=2#010100010101,
+ c=[second],
+ d=[1,0,0,1]},
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>,
+ e = <<2#01011010:8>>}),
+ roundtrip(<<48,0>>,
+ 'SeqBS',
+ #'SeqBS'{a=[1,0,1,0,1,1,0],
+ b=[1,0,1,0,1,0,0,0,1,0,1,0],
+ c={5,<<64>>},
+ d=2#1001},
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>,
+ e = <<2#01011010:8>>}),
+ roundtrip(<<48,3,131,1,0>>,
+ 'SeqBS',
+ #'SeqBS'{a=[1,0,1,0,1,1,0],
+ b=[1,0,1,0,1,0,0,0,1,0,1,0],
+ c={5,<<64>>},
+ d=0},
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>,
+ e = <<2#01011010:8>>}),
+ roundtrip(<<48,3,131,1,0>>,
+ 'SeqBS',
+ #'SeqBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>,
+ b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>,
+ c = <<2:3>>,
+ d=0,
+ e = <<16#5A:8>>},
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>,
+ e = <<2#01011010:8>>}),
+
+ %% None of the default values are used.
+ roundtrip(<<48,19,128,2,7,128,129,2,5,64,130,2,5,32,131,1,0,132,2,5,224>>,
+ 'SeqBS',
+ #'SeqBS'{a = <<1:1>>,
+ b = {5,<<64>>},
+ c = [third],
+ d = 0,
+ e = <<7:3>>},
+ #'SeqBS'{a = <<1:1>>,
+ b = <<2:3>>,
+ c = [third],
+ d = <<>>,
+ e = <<7:3>>}),
+ roundtrip(<<49,0>>,
+ 'SetBS',
+ #'SetBS'{a=2#0110101,
+ b=2#010100010101,
+ c=[second],
+ d=[1,0,0,1]},
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>}),
+ roundtrip(<<49,0>>,
+ 'SetBS',
+ #'SetBS'{a=[1,0,1,0,1,1,0],
+ b=[1,0,1,0,1,0,0,0,1,0,1,0],
+ c={5,<<64>>},
+ d=9},
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>}),
+ roundtrip(<<49,3,131,1,0>>,
+ 'SetBS',
+ #'SetBS'{a=[1,0,1,0,1,1,0],
+ b=[1,0,1,0,1,0,0,0,1,0,1,0],
+ c={5,<<64>>},
+ d=0},
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>}),
+ roundtrip(<<49,3,131,1,0>>,
+ 'SetBS',
+ #'SetBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>,
+ b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>,
+ c = <<2:3>>,
+ d=0},
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>}),
+
ok.
roundtrip(Encoded, Type, Value) ->
diff --git a/lib/asn1/test/testTcapsystem.erl b/lib/asn1/test/testTcapsystem.erl
index 4979a385b2..fcc9e084e0 100644
--- a/lib/asn1/test/testTcapsystem.erl
+++ b/lib/asn1/test/testTcapsystem.erl
@@ -21,44 +21,42 @@
-export([compile/2]).
--include_lib("test_server/include/test_server.hrl").
-
compile(Config, Options) ->
- [asn1_test_lib:compile(filename:join([tcapsystem, M]), Config, Options)
- || M <- ["DialoguePDUs.asn",
- "MAP-ApplicationContexts.asn",
- "MAP-BS-Code.asn",
- "MAP-CallHandlingOperations.asn",
- "MAP-CH-DataTypes.asn",
- "MAP-CommonDataTypes.asn",
- "MAP-DialogueInformation.asn",
- "MAP-ER-DataTypes.asn",
- "MAP-Errors.asn",
- "MAP-ExtensionDataTypes.asn",
- "MAP-GR-DataTypes.asn",
- "MAP-Group-Call-Operations.asn",
- "MAP-LCS-DataTypes.asn",
- "MAP-LocationServiceOperations.asn",
- "MAP-MobileServiceOperations.asn",
- "MAP-MS-DataTypes.asn",
- "MAP-OM-DataTypes.asn",
- "MAP-OperationAndMaintenanceOperations.asn",
- "MAP-Protocol.asn",
- "MAP-SecureTransportOperations.asn",
- "MAP-ShortMessageServiceOperations.asn",
- "MAP-SM-DataTypes.asn",
- "MAP-SS-Code.asn",
- "MAP-SS-DataTypes.asn",
- "MAP-ST-DataTypes.asn",
- "MAP-SupplementaryServiceOperations.asn",
- "MAP-TS-Code.asn",
- "MobileDomainDefinitions.asn",
- "Remote-Operations-Generic-ROS-PDUs.asn",
- "Remote-Operations-Information-Objects.asn",
- "Remote-Operations-Useful-Definitions.asn",
- "TCAP-Examples.asn",
- "TCAPMessages.asn",
- "TCAP-Tools.asn",
- "TC-Notation-Extensions.asn",
- "UnidialoguePDUs.asn"]],
- ok.
+ Fs = [filename:join("tcapsystem", M) ||
+ M <- ["DialoguePDUs.asn",
+ "MAP-ApplicationContexts.asn",
+ "MAP-BS-Code.asn",
+ "MAP-CallHandlingOperations.asn",
+ "MAP-CH-DataTypes.asn",
+ "MAP-CommonDataTypes.asn",
+ "MAP-DialogueInformation.asn",
+ "MAP-ER-DataTypes.asn",
+ "MAP-Errors.asn",
+ "MAP-ExtensionDataTypes.asn",
+ "MAP-GR-DataTypes.asn",
+ "MAP-Group-Call-Operations.asn",
+ "MAP-LCS-DataTypes.asn",
+ "MAP-LocationServiceOperations.asn",
+ "MAP-MobileServiceOperations.asn",
+ "MAP-MS-DataTypes.asn",
+ "MAP-OM-DataTypes.asn",
+ "MAP-OperationAndMaintenanceOperations.asn",
+ "MAP-Protocol.asn",
+ "MAP-SecureTransportOperations.asn",
+ "MAP-ShortMessageServiceOperations.asn",
+ "MAP-SM-DataTypes.asn",
+ "MAP-SS-Code.asn",
+ "MAP-SS-DataTypes.asn",
+ "MAP-ST-DataTypes.asn",
+ "MAP-SupplementaryServiceOperations.asn",
+ "MAP-TS-Code.asn",
+ "MobileDomainDefinitions.asn",
+ "Remote-Operations-Generic-ROS-PDUs.asn",
+ "Remote-Operations-Information-Objects.asn",
+ "Remote-Operations-Useful-Definitions.asn",
+ "TCAP-Examples.asn",
+ "TCAPMessages.asn",
+ "TCAP-Tools.asn",
+ "TC-Notation-Extensions.asn",
+ "UnidialoguePDUs.asn"]],
+ asn1_test_lib:compile_all(Fs, Config, Options).
diff --git a/lib/common_test/configure.in b/lib/common_test/configure.in
index b2e6ad997a..b2e6ad997a 100755..100644
--- a/lib/common_test/configure.in
+++ b/lib/common_test/configure.in
diff --git a/lib/common_test/doc/src/cover_chapter.xml b/lib/common_test/doc/src/cover_chapter.xml
index a215c8c2f3..accb94e1a9 100644
--- a/lib/common_test/doc/src/cover_chapter.xml
+++ b/lib/common_test/doc/src/cover_chapter.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2006</year><year>2013</year>
+ <year>2006</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -81,10 +81,7 @@
specify that previously exported data should be imported and
included in the analysis for a test (you can specify multiple
import files). This way it is possible to analyse total code coverage
- without necessarily running all tests at once. Note that even if
- you run separate tests in one test run, code coverage data will
- not be passed on from one test to another unless you specify an
- export file for Common Test to use for this purpose.</p>
+ without necessarily running all tests at once.</p>
<p>To activate the code coverage support, you simply specify the
name of the cover specification file as you start Common Test.
@@ -266,10 +263,20 @@ ct_cover:cross_cover_analyse(Level, [{s1,S1LogDir},{s2,S2LogDir}]).</code>
<section>
<title>Logging</title>
- <p>To view the result of a code coverage test, follow the
- "Coverage log" link on the test suite results page. This
- takes you to the code coverage overview page. If you have
- successfully performed a detailed coverage analysis, you
+ <p>To view the result of a code coverage test, click the button
+ labled "COVER LOG" in the top level index page for the test run.</p>
+
+ <p>Prior to Erlang/OTP 17.1, if your test run consisted of
+ multiple tests, cover would be started and stopped for each test
+ within the test run. Separate logs would be available via the
+ "Coverage log" link on the test suite result pages. These links
+ are still available, but now they all point to the same page as
+ the button on the top level index page. The log contains the
+ accumulated results for the complete test run. See the release
+ notes for more information about this change.</p>
+
+ <p>The buttonc takes you to the code coverage overview page. If you
+ have successfully performed a detailed coverage analysis, you
find links to each individual module coverage page here.</p>
<p>If cross cover analysis has been performed, and there are
diff --git a/lib/common_test/priv/run_test.in b/lib/common_test/priv/run_test.in
index 1508751e4f..1508751e4f 100755..100644
--- a/lib/common_test/priv/run_test.in
+++ b/lib/common_test/priv/run_test.in
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 241cd928b7..85afdc7834 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -773,7 +773,7 @@ comment(Format, Args) when is_list(Format), is_list(Args) ->
send_html_comment(Comment) ->
Html = "<font color=\"green\">" ++ Comment ++ "</font>",
- ct_util:set_testdata({comment,Html}),
+ ct_util:set_testdata({{comment,group_leader()},Html}),
test_server:comment(Html).
%%%-----------------------------------------------------------------
diff --git a/lib/common_test/src/ct_cover.erl b/lib/common_test/src/ct_cover.erl
index ae671c750a..cf2860ae25 100644
--- a/lib/common_test/src/ct_cover.erl
+++ b/lib/common_test/src/ct_cover.erl
@@ -47,18 +47,21 @@ add_nodes(Nodes) ->
undefined ->
{error,cover_not_running};
_ ->
- {File,Nodes0,Import,Export,AppInfo} = ct_util:get_testdata(cover),
+ Nodes0 = cover:which_nodes(),
Nodes1 = [Node || Node <- Nodes,
lists:member(Node,Nodes0) == false],
ct_logs:log("COVER INFO",
"Adding nodes to cover test: ~w", [Nodes1]),
case cover:start(Nodes1) of
- Result = {ok,_} ->
- ct_util:set_testdata({cover,{File,Nodes1++Nodes0,
- Import,Export,AppInfo}}),
-
+ Result = {ok,StartedNodes} ->
+ ct_logs:log("COVER INFO",
+ "Successfully added nodes to cover test: ~w",
+ [StartedNodes]),
Result;
Error ->
+ ct_logs:log("COVER INFO",
+ "Failed to add nodes to cover test: ~tp",
+ [Error]),
Error
end
end.
@@ -81,19 +84,20 @@ remove_nodes(Nodes) ->
undefined ->
{error,cover_not_running};
_ ->
- {File,Nodes0,Import,Export,AppInfo} = ct_util:get_testdata(cover),
+ Nodes0 = cover:which_nodes(),
ToRemove = [Node || Node <- Nodes, lists:member(Node,Nodes0)],
ct_logs:log("COVER INFO",
- "Removing nodes from cover test: ~w", [ToRemove]),
+ "Removing nodes from cover test: ~w", [ToRemove]),
case cover:stop(ToRemove) of
ok ->
- Nodes1 = lists:foldl(fun(N,Deleted) ->
- lists:delete(N,Deleted)
- end, Nodes0, ToRemove),
- ct_util:set_testdata({cover,{File,Nodes1,
- Import,Export,AppInfo}}),
+ ct_logs:log("COVER INFO",
+ "Successfully removed nodes from cover test.",
+ []),
ok;
Error ->
+ ct_logs:log("COVER INFO",
+ "Failed to remove nodes from cover test: ~tp",
+ [Error]),
Error
end
end.
@@ -149,7 +153,7 @@ get_spec_test(File) ->
{value,{_,[Exp]}} ->
filename:absname(Exp);
_ ->
- []
+ undefined
end,
Nodes =
case lists:keysearch(nodes, 1, Terms) of
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 9ef917a507..e8ea7992b4 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -657,7 +657,18 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) ->
_ ->
ok
end,
- ct_util:delete_testdata(comment),
+ if Func == end_per_group; Func == end_per_suite ->
+ %% clean up any saved comments
+ ct_util:match_delete_testdata({comment,'_'});
+ true ->
+ %% attemp to delete any saved comment for this TC
+ case process_info(TCPid, group_leader) of
+ {group_leader,TCGL} ->
+ ct_util:delete_testdata({comment,TCGL});
+ _ ->
+ ok
+ end
+ end,
ct_util:delete_suite_data(last_saved_config),
FuncSpec = group_or_func(Func,Args),
@@ -850,7 +861,7 @@ error_notification(Mod,Func,_Args,{Error,Loc}) ->
_ ->
%% this notification comes from the test case process, so
%% we can add error info to comment with test_server:comment/1
- case ct_util:get_testdata(comment) of
+ case ct_util:get_testdata({comment,group_leader()}) of
undefined ->
test_server:comment(ErrorHtml);
Comment ->
@@ -1233,38 +1244,7 @@ report(What,Data) ->
ct_logs:make_all_suites_index({TestName,RunDir}),
ok;
tests_start ->
- case ct_util:get_testdata(cover) of
- undefined ->
- ok;
- {_CovFile,_CovNodes,CovImport,CovExport,_CovAppData} ->
- %% Always import cover data from files specified by CovImport
- %% if no CovExport defined. If CovExport is defined, only
- %% import from CovImport files initially, then use CovExport
- %% to pass coverdata between proceeding tests (in the same run).
- Imps =
- case CovExport of
- [] -> % don't export data between tests
- CovImport;
- _ ->
- case filelib:is_file(CovExport) of
- true ->
- [CovExport];
- false ->
- CovImport
- end
- end,
- lists:foreach(
- fun(Imp) ->
- case cover:import(Imp) of
- ok ->
- ok;
- {error,Reason} ->
- ct_logs:log("COVER INFO",
- "Importing cover data from: ~ts fails! "
- "Reason: ~p", [Imp,Reason])
- end
- end, Imps)
- end;
+ ok;
tests_done ->
ok;
severe_error ->
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index a4ad65c0a4..32c8773ca5 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -62,6 +62,7 @@
-define(totals_name, "totals.info").
-define(log_cache_name, "ct_log_cache").
-define(misc_io_log, "misc_io.log.html").
+-define(coverlog_name, "cover.html"). % must be same as in test_server_ctrl
-define(table_color1,"#ADD8E6").
-define(table_color2,"#E4F0FE").
@@ -1368,6 +1369,19 @@ index_header(Label, StartTime) ->
format_time(StartTime),
{[],[1],[2,3,4,5]})
end,
+ Cover =
+ case filelib:is_regular(?abs(?coverlog_name)) of
+ true ->
+ xhtml(["<p><a href=\"",?coverlog_name,
+ "\">Cover Log</a></p><br>\n"],
+ ["<br />"
+ "<div id=\"button_holder\" class=\"btn\">\n"
+ "<a href=\"",?coverlog_name,
+ "\">COVER LOG</a>\n</div><br /><br />"]);
+ false ->
+ xhtml("<br>\n", "<br /><br /><br />\n")
+ end,
+
[Head |
["<center>\n",
xhtml(["<p><a href=\"",?ct_log_name,
@@ -1375,8 +1389,8 @@ index_header(Label, StartTime) ->
["<br />"
"<div id=\"button_holder\" class=\"btn\">\n"
"<a href=\"",?ct_log_name,
- "\">COMMON TEST FRAMEWORK LOG</a>\n</div>"]),
- xhtml("<br>\n", "<br /><br /><br />\n"),
+ "\">COMMON TEST FRAMEWORK LOG</a>\n</div><br>\n"]),
+ Cover,
xhtml(["<table border=\"3\" cellpadding=\"5\" "
"bgcolor=\"",?table_color3,"\">\n"],
["<table id=\"",?sortable_table_name,"\">\n",
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index 03cf06abed..00d0aab507 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -1646,7 +1646,7 @@ do_run(Tests, Misc, LogDir, LogOpts) when is_list(Misc),
do_run(Tests, [], Opts#opts{logdir = LogDir}, []);
do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) ->
- #opts{label = Label, profile = Profile, cover = Cover,
+ #opts{label = Label, profile = Profile,
verbosity = VLvls} = Opts,
%% label - used by ct_logs
TestLabel =
@@ -1670,22 +1670,6 @@ do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) ->
non_existing ->
{error,no_path_to_test_server};
_ ->
- Opts1 = if Cover == undefined ->
- Opts;
- true ->
- case ct_cover:get_spec(Cover) of
- {error,Reason} ->
- exit({error,Reason});
- CoverSpec ->
- CoverStop =
- case Opts#opts.cover_stop of
- undefined -> true;
- Stop -> Stop
- end,
- Opts#opts{coverspec = CoverSpec,
- cover_stop = CoverStop}
- end
- end,
%% This env variable is used by test_server to determine
%% which framework it runs under.
case os:getenv("TEST_SERVER_FRAMEWORK") of
@@ -1711,7 +1695,7 @@ do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) ->
_Pid ->
ct_util:set_testdata({starter,Opts#opts.starter}),
compile_and_run(Tests, Skip,
- Opts1#opts{verbosity=Verbosity}, Args)
+ Opts#opts{verbosity=Verbosity}, Args)
end
end.
@@ -2146,67 +2130,11 @@ check_and_add([{TestDir0,M,_} | Tests], Added, PA) ->
check_and_add([], _, PA) ->
{ok,PA}.
-do_run_test(Tests, Skip, Opts) ->
+do_run_test(Tests, Skip, Opts0) ->
case check_and_add(Tests, [], []) of
{ok,AddedToPath} ->
ct_util:set_testdata({stats,{0,0,{0,0}}}),
- ct_util:set_testdata({cover,undefined}),
test_server_ctrl:start_link(local),
- case Opts#opts.coverspec of
- CovData={CovFile,
- CovNodes,
- _CovImport,
- CovExport,
- #cover{app = CovApp,
- level = CovLevel,
- excl_mods = CovExcl,
- incl_mods = CovIncl,
- cross = CovCross,
- src = _CovSrc}} ->
- ct_logs:log("COVER INFO",
- "Using cover specification file: ~ts~n"
- "App: ~w~n"
- "Cross cover: ~w~n"
- "Including ~w modules~n"
- "Excluding ~w modules",
- [CovFile,CovApp,CovCross,
- length(CovIncl),length(CovExcl)]),
-
- %% cover export file will be used for export and import
- %% between tests so make sure it doesn't exist initially
- case filelib:is_file(CovExport) of
- true ->
- DelResult = file:delete(CovExport),
- ct_logs:log("COVER INFO",
- "Warning! "
- "Export file ~ts already exists. "
- "Deleting with result: ~p",
- [CovExport,DelResult]);
- false ->
- ok
- end,
-
- %% tell test_server which modules should be cover compiled
- %% note that actual compilation is done when tests start
- test_server_ctrl:cover(CovApp, CovFile, CovExcl, CovIncl,
- CovCross, CovExport, CovLevel,
- Opts#opts.cover_stop),
- %% save cover data (used e.g. to add nodes dynamically)
- ct_util:set_testdata({cover,CovData}),
- %% start cover on specified nodes
- if (CovNodes /= []) and (CovNodes /= undefined) ->
- ct_logs:log("COVER INFO",
- "Nodes included in cover "
- "session: ~w",
- [CovNodes]),
- cover:start(CovNodes);
- true ->
- ok
- end,
- true;
- _ ->
- false
- end,
%% let test_server expand the test tuples and count no of cases
{Suites,NoOfCases} = count_test_cases(Tests, Skip),
@@ -2231,24 +2159,31 @@ do_run_test(Tests, Skip, Opts) ->
end,
%% if the verbosity level is set lower than ?STD_IMPORTANCE, tell
%% test_server to ignore stdout printouts to the test case log file
- case proplists:get_value(default, Opts#opts.verbosity) of
+ case proplists:get_value(default, Opts0#opts.verbosity) of
VLvl when is_integer(VLvl), (?STD_IMPORTANCE < (100-VLvl)) ->
test_server_ctrl:reject_io_reqs(true);
_Lower ->
ok
end,
- test_server_ctrl:multiply_timetraps(Opts#opts.multiply_timetraps),
- test_server_ctrl:scale_timetraps(Opts#opts.scale_timetraps),
+ test_server_ctrl:multiply_timetraps(Opts0#opts.multiply_timetraps),
+ test_server_ctrl:scale_timetraps(Opts0#opts.scale_timetraps),
test_server_ctrl:create_priv_dir(choose_val(
- Opts#opts.create_priv_dir,
+ Opts0#opts.create_priv_dir,
auto_per_run)),
+
+ {ok,LogDir} = ct_logs:get_log_dir(true),
+ {TsCoverInfo,Opts} = maybe_start_cover(Opts0, LogDir),
+
ct_event:notify(#event{name=start_info,
node=node(),
data={NoOfTests,NoOfSuites,NoOfCases}}),
CleanUp = add_jobs(Tests, Skip, Opts, []),
unlink(whereis(test_server_ctrl)),
catch test_server_ctrl:wait_finish(),
+
+ maybe_stop_cover(Opts, TsCoverInfo, LogDir),
+
%% check if last testcase has left a "dead" trace window
%% behind, and if so, kill it
case ct_util:get_testdata(interpret) of
@@ -2281,6 +2216,102 @@ do_run_test(Tests, Skip, Opts) ->
exit(Error)
end.
+maybe_start_cover(Opts=#opts{cover=Cover,cover_stop=CoverStop0},LogDir) ->
+ if Cover == undefined ->
+ {undefined,Opts};
+ true ->
+ case ct_cover:get_spec(Cover) of
+ {error,Reason} ->
+ exit({error,Reason});
+ CoverSpec ->
+ CoverStop =
+ case CoverStop0 of
+ undefined -> true;
+ Stop -> Stop
+ end,
+ start_cover(Opts#opts{coverspec=CoverSpec,
+ cover_stop=CoverStop},
+ LogDir)
+ end
+ end.
+
+start_cover(Opts=#opts{coverspec=CovData,cover_stop=CovStop},LogDir) ->
+ {CovFile,
+ CovNodes,
+ CovImport,
+ _CovExport,
+ #cover{app = CovApp,
+ level = CovLevel,
+ excl_mods = CovExcl,
+ incl_mods = CovIncl,
+ cross = CovCross,
+ src = _CovSrc}} = CovData,
+ ct_logs:log("COVER INFO",
+ "Using cover specification file: ~ts~n"
+ "App: ~w~n"
+ "Cross cover: ~w~n"
+ "Including ~w modules~n"
+ "Excluding ~w modules",
+ [CovFile,CovApp,CovCross,
+ length(CovIncl),length(CovExcl)]),
+
+ %% Tell test_server to print a link in its coverlog
+ %% pointing to the real coverlog which will be written in
+ %% maybe_stop_cover/2
+ test_server_ctrl:cover({log,LogDir}),
+
+ %% Cover compile all modules
+ {ok,TsCoverInfo} = test_server_ctrl:cover_compile(CovApp,CovFile,
+ CovExcl,CovIncl,
+ CovCross,CovLevel,
+ CovStop),
+ ct_logs:log("COVER INFO",
+ "Compilation completed - test_server cover info: ~tp",
+ [TsCoverInfo]),
+
+ %% start cover on specified nodes
+ if (CovNodes /= []) and (CovNodes /= undefined) ->
+ ct_logs:log("COVER INFO",
+ "Nodes included in cover "
+ "session: ~w",
+ [CovNodes]),
+ cover:start(CovNodes);
+ true ->
+ ok
+ end,
+ lists:foreach(
+ fun(Imp) ->
+ case cover:import(Imp) of
+ ok ->
+ ok;
+ {error,Reason} ->
+ ct_logs:log("COVER INFO",
+ "Importing cover data from: ~ts fails! "
+ "Reason: ~p", [Imp,Reason])
+ end
+ end, CovImport),
+ {TsCoverInfo,Opts}.
+
+maybe_stop_cover(_,undefined,_) ->
+ ok;
+maybe_stop_cover(#opts{coverspec=CovData},TsCoverInfo,LogDir) ->
+ {_CovFile,
+ _CovNodes,
+ _CovImport,
+ CovExport,
+ _AppData} = CovData,
+ case CovExport of
+ undefined -> ok;
+ _ ->
+ ct_logs:log("COVER INFO","Exporting cover data to ~tp",[CovExport]),
+ cover:export(CovExport)
+ end,
+ ct_logs:log("COVER INFO","Analysing cover data to ~tp",[LogDir]),
+ test_server_ctrl:cover_analyse(TsCoverInfo,LogDir),
+ ct_logs:log("COVER INFO","Analysis completed.",[]),
+ ok.
+
+
delete_dups([S | Suites]) ->
Suites1 = lists:delete(S, Suites),
[S | delete_dups(Suites1)];
diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl
index c9dc2338cd..3b2652d06c 100644
--- a/lib/common_test/src/ct_telnet.erl
+++ b/lib/common_test/src/ct_telnet.erl
@@ -604,9 +604,12 @@ handle_msg({cmd,Cmd,Timeout},State) ->
end_gen_log(),
{Return,State#state{buffer=NewBuffer,prompt=Prompt}};
handle_msg({send,Cmd},State) ->
+ start_gen_log(heading(send,State#state.name)),
log(State,send,"Sending: ~p",[Cmd]),
+
debug_cont_gen_log("Throwing Buffer:",[]),
debug_log_lines(State#state.buffer),
+
case {State#state.type,State#state.prompt} of
{ts,_} ->
silent_teln_expect(State#state.name,
@@ -626,6 +629,7 @@ handle_msg({send,Cmd},State) ->
ok
end,
ct_telnet_client:send_data(State#state.teln_pid,Cmd),
+ end_gen_log(),
{ok,State#state{buffer=[],prompt=false}};
handle_msg(get_data,State) ->
start_gen_log(heading(get_data,State#state.name)),
@@ -869,14 +873,13 @@ teln_cmd(Pid,Cmd,Prx,Timeout) ->
teln_receive_until_prompt(Pid,Prx,Timeout).
teln_get_all_data(Pid,Prx,Data,Acc,LastLine) ->
- case check_for_prompt(Prx,lists:reverse(LastLine) ++ Data) of
+ case check_for_prompt(Prx,LastLine++Data) of
{prompt,Lines,_PromptType,Rest} ->
teln_get_all_data(Pid,Prx,Rest,[Lines|Acc],[]);
{noprompt,Lines,LastLine1} ->
case ct_telnet_client:get_data(Pid) of
{ok,[]} ->
- {ok,lists:reverse(lists:append([Lines|Acc])),
- lists:reverse(LastLine1)};
+ {ok,lists:reverse(lists:append([Lines|Acc])),LastLine1};
{ok,Data1} ->
teln_get_all_data(Pid,Prx,Data1,[Lines|Acc],LastLine1)
end
@@ -1334,7 +1337,7 @@ teln_receive_until_prompt(Pid,Prx,Timeout) ->
teln_receive_until_prompt(Pid,Prx,Acc,LastLine) ->
{ok,Data} = ct_telnet_client:get_data(Pid),
- case check_for_prompt(Prx,LastLine ++ Data) of
+ case check_for_prompt(Prx,LastLine++Data) of
{prompt,Lines,PromptType,Rest} ->
Return = lists:reverse(lists:append([Lines|Acc])),
{ok,Return,PromptType,Rest};
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index f5eb3a72f0..56027586d1 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.erl
@@ -37,7 +37,7 @@
save_suite_data_async/3, save_suite_data_async/2,
read_suite_data/1,
delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1,
- delete_testdata/0, delete_testdata/1,
+ delete_testdata/0, delete_testdata/1, match_delete_testdata/1,
set_testdata/1, get_testdata/1, get_testdata/2,
set_testdata_async/1, update_testdata/2, update_testdata/3,
set_verbosity/1, get_verbosity/1]).
@@ -270,6 +270,9 @@ delete_testdata() ->
delete_testdata(Key) ->
call({delete_testdata, Key}).
+match_delete_testdata(KeyPat) ->
+ call({match_delete_testdata, KeyPat}).
+
update_testdata(Key, Fun) ->
update_testdata(Key, Fun, []).
@@ -361,7 +364,25 @@ loop(Mode,TestData,StartDir) ->
{{delete_testdata,Key},From} ->
TestData1 = lists:keydelete(Key,1,TestData),
return(From,ok),
- loop(From,TestData1,StartDir);
+ loop(From,TestData1,StartDir);
+ {{match_delete_testdata,{Key1,Key2}},From} ->
+ %% handles keys with 2 elements
+ TestData1 =
+ lists:filter(fun({Key,_}) when not is_tuple(Key) ->
+ true;
+ ({Key,_}) when tuple_size(Key) =/= 2 ->
+ true;
+ ({{_,KeyB},_}) when Key1 == '_' ->
+ KeyB =/= Key2;
+ ({{KeyA,_},_}) when Key2 == '_' ->
+ KeyA =/= Key1;
+ (_) when Key1 == '_' ; Key2 == '_' ->
+ false;
+ (_) ->
+ true
+ end, TestData),
+ return(From,ok),
+ loop(From,TestData1,StartDir);
{{set_testdata,New = {Key,_Val}},From} ->
TestData1 = lists:keydelete(Key,1,TestData),
return(From,ok),
diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index 085f19d023..a0ac47f12a 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2008-2013. All Rights Reserved.
+# Copyright Ericsson AB 2008-2014. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -61,6 +61,7 @@ MODULES= \
ct_snmp_SUITE \
ct_group_leader_SUITE \
ct_cover_SUITE \
+ ct_cover_nomerge_SUITE \
ct_groups_search_SUITE \
ct_surefire_SUITE \
ct_telnet_SUITE
diff --git a/lib/common_test/test/ct_cover_SUITE.erl b/lib/common_test/test/ct_cover_SUITE.erl
index ec2680f664..47080b5577 100644
--- a/lib/common_test/test/ct_cover_SUITE.erl
+++ b/lib/common_test/test/ct_cover_SUITE.erl
@@ -172,8 +172,8 @@ cross(Config) ->
check_calls(Events2,1),
%% Get the log dirs for each test and run cross cover analyse
- [D11,D12] = lists:sort(get_run_dirs(Events1)),
- [D21,D22] = lists:sort(get_run_dirs(Events2)),
+ [D11,D12] = lists:sort(get_log_dirs(Events1)),
+ [D21,D22] = lists:sort(get_log_dirs(Events2)),
ct_cover:cross_cover_analyse(details,[{cross1,D11},{cross2,D21}]),
ct_cover:cross_cover_analyse(details,[{cross1,D12},{cross2,D22}]),
@@ -267,18 +267,17 @@ check_cover(Node) when is_atom(Node) ->
false
end.
-%% Get the log dir "run.<timestamp>" for all (both!) tests
-get_run_dirs(Events) ->
- [filename:dirname(TCLog) ||
+%% Get the log dir "ct_run.<timestamp>" for all (both!) tests
+get_log_dirs(Events) ->
+ [LogDir ||
{ct_test_support_eh,
- {event,tc_logfile,_Node,
- {{?suite,init_per_suite},TCLog}}} <- Events].
+ {event,start_logging,_Node,LogDir}} <- Events].
%% Check that each coverlog includes N calls to ?mod:foo/0
check_calls(Events,N) ->
check_calls(Events,{?mod,foo,0},N).
check_calls(Events,MFA,N) ->
- CoverLogs = [filename:join(D,"all.coverdata") || D <- get_run_dirs(Events)],
+ CoverLogs = [filename:join(D,"all.coverdata") || D <- get_log_dirs(Events)],
do_check_logs(CoverLogs,MFA,N).
do_check_logs([CoverLog|CoverLogs],{Mod,_,_} = MFA,N) ->
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE.erl b/lib/common_test/test/ct_cover_nomerge_SUITE.erl
new file mode 100644
index 0000000000..8e2ee1b500
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE.erl
@@ -0,0 +1,221 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File: ct_cover_nomerge_SUITE
+%%%
+%%% Description:
+%%% Test code cover analysis support when merge_tests=false
+%%%
+%%%-------------------------------------------------------------------
+-module(ct_cover_nomerge_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+-define(eh, ct_test_support_eh).
+-define(mod, cover_test_mod).
+
+%%--------------------------------------------------------------------
+%% TEST SERVER CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
+
+%%--------------------------------------------------------------------
+%% Description: Since Common Test starts another Test Server
+%% instance, the tests need to be performed on a separate node (or
+%% there will be clashes with logging processes etc).
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ case test_server:is_cover() of
+ true ->
+ {skip,"Test server is running cover already - skipping"};
+ false ->
+ ct_test_support:init_per_suite(Config)
+ end.
+
+end_per_suite(Config) ->
+ ct_test_support:end_per_suite(Config).
+
+init_per_testcase(TestCase, Config) ->
+ ct_test_support:init_per_testcase(TestCase, Config).
+
+end_per_testcase(TestCase, Config) ->
+ try apply(?MODULE,TestCase,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ct_test_support:end_per_testcase(TestCase, Config).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [
+ local,
+ remote,
+ remote_nostop
+ ].
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+
+local(Config) ->
+ DataDir = ?config(data_dir, Config),
+ Spec = filename:join(DataDir, "local.spec"),
+ CoverSpec = [{incl_mods,[?mod]}],
+ CoverFile = create_cover_file(local,CoverSpec,Config),
+ {Opts,ERPid} = setup([{spec,Spec},{label,local},{cover,CoverFile}], Config),
+ {ok,Events} = execute(local, local, Opts, ERPid, Config),
+ false = check_cover(Config),
+ check_calls(Events,2),
+ ok.
+
+remote(Config) ->
+ DataDir = ?config(data_dir, Config),
+ Spec = filename:join(DataDir, "remote.spec"),
+ %% extending some timers for slow test hosts
+ {ok,Node} = ct_slave:start(ct_nomerge,[{boot_timeout,15},
+ {init_timeout,15},
+ {startup_timeout,15}]),
+
+ CoverSpec = [{nodes,[Node]},
+ {incl_mods,[?mod]}],
+ CoverFile = create_cover_file(remote,CoverSpec,Config),
+ {Opts,ERPid} = setup([{spec,Spec},{label,remote},{cover,CoverFile}], Config),
+ {ok,Events} = execute(remote, remote, Opts, ERPid, Config),
+ false = check_cover(Config),
+ check_calls(Events,2),
+ ok.
+remote(cleanup,_Config) ->
+ {ok,_} = ct_slave:stop(ct_nomerge),
+ ok.
+
+remote_nostop(Config) ->
+ DataDir = ?config(data_dir, Config),
+ Spec = filename:join(DataDir, "remote_nostop.spec"),
+ %% extending some timers for slow test hosts
+ {ok,Node} = ct_slave:start(ct_nomerge,[{boot_timeout,15},
+ {init_timeout,15},
+ {startup_timeout,15}]),
+
+ CoverSpec = [{nodes,[Node]},
+ {incl_mods,[?mod]}],
+ CoverFile = create_cover_file(remote_nostop,CoverSpec,Config),
+ {Opts,ERPid} = setup([{spec,Spec},{label,remote_nostop},
+ {cover,CoverFile},{cover_stop,false}],
+ Config),
+ {ok,Events} = execute(remote_nostop, remote_nostop, Opts, ERPid, Config),
+ {true,[Node],[cover_test_mod]} = check_cover(Config),
+ check_calls(Events,2),
+ ok.
+remote_nostop(cleanup,Config) ->
+ CtNode = ?config(ct_node,Config),
+ ok = rpc:call(CtNode,cover,stop,[]),
+ {ok,_} = ct_slave:stop(ct_nomerge),
+ ok.
+
+
+%%%-----------------------------------------------------------------
+%%% HELP FUNCTIONS
+%%%-----------------------------------------------------------------
+setup(Test, Config) ->
+ Opts0 = ct_test_support:get_opts(Config),
+ Level = ?config(trace_level, Config),
+ EvHArgs = [{cbm,ct_test_support},{trace_level,Level}],
+ Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test],
+ ERPid = ct_test_support:start_event_receiver(Config),
+ {Opts,ERPid}.
+
+execute(Name, Testcase, Opts, ERPid, Config) ->
+ ok = ct_test_support:run(Opts, Config),
+ Events = ct_test_support:get_events(ERPid, Config),
+
+ ct_test_support:log_events(Name,
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
+ TestEvents = events_to_check(Testcase),
+ R = ct_test_support:verify_events(TestEvents, Events, Config),
+ {R,Events}.
+
+reformat(Events, EH) ->
+ ct_test_support:reformat(Events, EH).
+
+events_to_check(local) ->
+ events_to_check1(cover_nomerge_local_SUITE);
+events_to_check(remote) ->
+ events_to_check1(cover_nomerge_remote_SUITE);
+events_to_check(remote_nostop) ->
+ events_to_check1(cover_nomerge_remote_nostop_SUITE).
+events_to_check1(Suite) ->
+ OneTest =
+ [{?eh,start_logging,{'DEF','RUNDIR'}}] ++
+ [{?eh,tc_done,{Suite,t1,ok}}] ++
+ [{?eh,tc_done,{Suite,t2,ok}}] ++
+ [{?eh,stop_logging,[]}],
+
+ %% 2 tests (ct:run_test + script_start) is default
+ OneTest ++ OneTest.
+
+check_cover(Config) when is_list(Config) ->
+ CTNode = proplists:get_value(ct_node, Config),
+ check_cover(CTNode);
+check_cover(Node) when is_atom(Node) ->
+ case rpc:call(Node,test_server,is_cover,[]) of
+ true ->
+ {true,
+ rpc:call(Node,cover,which_nodes,[]),
+ rpc:call(Node,cover,modules,[])};
+ false ->
+ false
+ end.
+
+%% Get the log dir "ct_run.<timestamp>" for all (both!) tests
+get_log_dirs(Events) ->
+ [LogDir ||
+ {ct_test_support_eh,
+ {event,start_logging,_Node,LogDir}} <- Events].
+
+%% Check that each coverlog includes N calls to ?mod:foo/0
+check_calls(Events,N) ->
+ check_calls(Events,{?mod,foo,0},N).
+check_calls(Events,MFA,N) ->
+ CoverLogs = [filename:join(D,"all.coverdata") || D <- get_log_dirs(Events)],
+ do_check_logs(CoverLogs,MFA,N).
+
+do_check_logs([CoverLog|CoverLogs],{Mod,_,_} = MFA,N) ->
+ {ok,_} = cover:start(),
+ ok = cover:import(CoverLog),
+ {ok,Calls} = cover:analyse(Mod,calls,function),
+ ok = cover:stop(),
+ {MFA,N} = lists:keyfind(MFA,1,Calls),
+ do_check_logs(CoverLogs,MFA,N);
+do_check_logs([],_,_) ->
+ ok.
+
+create_cover_file(Filename,Terms,Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ File = filename:join(PrivDir,Filename) ++ ".cover",
+ {ok,Fd} = file:open(File,[write]),
+ lists:foreach(fun(Term) ->
+ file:write(Fd,io_lib:format("~p.~n",[Term]))
+ end,Terms),
+ ok = file:close(Fd),
+ File.
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_local_SUITE.erl b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_local_SUITE.erl
new file mode 100644
index 0000000000..e1fe3b5fc9
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_local_SUITE.erl
@@ -0,0 +1,63 @@
+%%--------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+-module(cover_nomerge_local_SUITE).
+-include_lib("common_test/include/ct.hrl").
+
+-compile(export_all).
+
+%% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+suite() ->
+ [].
+
+all() ->
+ [t1,t2].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ Config.
+
+init_per_testcase(_Case, Config) ->
+ Dog = test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+end_per_testcase(Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Test cases
+break(_Config) ->
+ test_server:break(""),
+ ok.
+
+t1(_Config) ->
+ cover_compiled = code:which(cover_test_mod),
+ ok = cover_test_mod:foo(),
+ ok.
+
+t2(_Config) ->
+ cover_compiled = code:which(cover_test_mod),
+ ok = cover_test_mod:foo(),
+ ok.
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_SUITE.erl b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_SUITE.erl
new file mode 100644
index 0000000000..a77ae0c2db
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_SUITE.erl
@@ -0,0 +1,75 @@
+%%--------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+-module(cover_nomerge_remote_SUITE).
+-include_lib("common_test/include/ct.hrl").
+
+-compile(export_all).
+
+%% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+suite() ->
+ [].
+
+all() ->
+ [t1,t2].
+
+init_per_suite(Config) ->
+ {ok,Host} = inet:gethostname(),
+ Node = list_to_atom("ct_nomerge@"++Host),
+ pong = net_adm:ping(Node),
+
+%% Include this row, and exclude the equivalent row in end_per_suite =>
+%% fails every now and then with missing data. Why?
+%% ct_cover:remove_nodes([Node]),
+ ct_cover:add_nodes([Node]),
+ [{node,Node}|Config].
+
+end_per_suite(Config) ->
+ Node = ?config(node,Config),
+ ct_cover:remove_nodes([Node]),
+ Config.
+
+init_per_testcase(_Case, Config) ->
+ Dog = test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+end_per_testcase(Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Test cases
+break(_Config) ->
+ test_server:break(""),
+ ok.
+
+t1(Config) ->
+ Node = ?config(node,Config),
+ cover_compiled = rpc:call(Node, code, which, [cover_test_mod]),
+ ok = rpc:call(Node, cover_test_mod, foo, []),
+ ok.
+
+t2(Config) ->
+ Node = ?config(node,Config),
+ cover_compiled = rpc:call(Node, code, which, [cover_test_mod]),
+ ok = rpc:call(Node, cover_test_mod, foo, []),
+ ok.
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_nostop_SUITE.erl b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_nostop_SUITE.erl
new file mode 100644
index 0000000000..0b3159f2c3
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_nomerge_remote_nostop_SUITE.erl
@@ -0,0 +1,68 @@
+%%--------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+-module(cover_nomerge_remote_nostop_SUITE).
+-include_lib("common_test/include/ct.hrl").
+
+-compile(export_all).
+
+%% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+suite() ->
+ [].
+
+all() ->
+ [t1,t2].
+
+init_per_suite(Config) ->
+ {ok,Host} = inet:gethostname(),
+ Node = list_to_atom("ct_nomerge@"++Host),
+ pong = net_adm:ping(Node),
+ [{node,Node}|Config].
+
+end_per_suite(Config) ->
+ Config.
+
+init_per_testcase(_Case, Config) ->
+ Dog = test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+end_per_testcase(Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Test cases
+break(_Config) ->
+ test_server:break(""),
+ ok.
+
+t1(Config) ->
+ Node = ?config(node,Config),
+ cover_compiled = rpc:call(Node, code, which, [cover_test_mod]),
+ ok = rpc:call(Node, cover_test_mod, foo, []),
+ ok.
+
+t2(Config) ->
+ Node = ?config(node,Config),
+ cover_compiled = rpc:call(Node, code, which, [cover_test_mod]),
+ ok = rpc:call(Node, cover_test_mod, foo, []),
+ ok.
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_test_mod.erl b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_test_mod.erl
new file mode 100644
index 0000000000..d4f69452c3
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE_data/cover_test_mod.erl
@@ -0,0 +1,4 @@
+-module(cover_test_mod).
+-compile(export_all).
+foo() ->
+ ok.
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE_data/local.spec b/lib/common_test/test/ct_cover_nomerge_SUITE_data/local.spec
new file mode 100644
index 0000000000..893c48b010
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE_data/local.spec
@@ -0,0 +1,6 @@
+{merge_tests,false}.
+
+{alias,dir,"."}.
+
+{cases, dir, cover_nomerge_local_SUITE, [t1]}.
+{cases, dir, cover_nomerge_local_SUITE, [t2]}.
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE_data/remote.spec b/lib/common_test/test/ct_cover_nomerge_SUITE_data/remote.spec
new file mode 100644
index 0000000000..78c4332270
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE_data/remote.spec
@@ -0,0 +1,6 @@
+{merge_tests,false}.
+
+{alias,dir,"."}.
+
+{cases, dir, cover_nomerge_remote_SUITE, [t1]}.
+{cases, dir, cover_nomerge_remote_SUITE, [t2]}.
diff --git a/lib/common_test/test/ct_cover_nomerge_SUITE_data/remote_nostop.spec b/lib/common_test/test/ct_cover_nomerge_SUITE_data/remote_nostop.spec
new file mode 100644
index 0000000000..049f586c72
--- /dev/null
+++ b/lib/common_test/test/ct_cover_nomerge_SUITE_data/remote_nostop.spec
@@ -0,0 +1,6 @@
+{merge_tests,false}.
+
+{alias,dir,"."}.
+
+{cases, dir, cover_nomerge_remote_nostop_SUITE, [t1]}.
+{cases, dir, cover_nomerge_remote_nostop_SUITE, [t2]}.
diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
index 0ee0525216..c0f79d0f10 100644
--- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
+++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
@@ -16,7 +16,8 @@ suite() ->
].
all() ->
- [expect,
+ [
+ expect,
expect_repeat,
expect_sequence,
expect_error_prompt,
@@ -31,8 +32,10 @@ all() ->
ignore_prompt_repeat,
ignore_prompt_sequence,
ignore_prompt_timeout,
+ large_string,
server_speaks,
- server_disconnects].
+ server_disconnects
+ ].
groups() ->
[].
@@ -214,6 +217,41 @@ no_prompt_check_timeout(_) ->
ok = ct_telnet:close(Handle),
ok.
+%% Check that it's possible to receive multiple chunks of data sent from
+%% the server with one get_data call
+large_string(_) ->
+ {ok, Handle} = ct_telnet:open(telnet_server_conn1),
+ String = "abcd efgh ijkl mnop qrst uvwx yz ",
+ BigString = lists:flatmap(fun(S) -> S end,
+ [String || _ <- lists:seq(1,10)]),
+ VerifyStr = [C || C <- BigString, C/=$ ],
+
+ {ok,Data} = ct_telnet:cmd(Handle, "echo_sep "++BigString),
+ ct:log("[CMD] Received ~w chars: ~s", [length(lists:flatten(Data)),Data]),
+ VerifyStr = [C || C <- lists:flatten(Data), C/=$ , C/=$\r, C/=$\n, C/=$>],
+
+ %% Test #1: With a long sleep value, all data gets gets buffered and
+ %% ct_telnet can receive it with one single request to ct_telnet_client.
+ %% Test #2: With a short sleep value, ct_telnet needs multiple calls to
+ %% ct_telnet_client to collect the data. This iterative operation should
+ %% yield the same result as the single request case.
+
+ ok = ct_telnet:send(Handle, "echo_sep "++BigString),
+ timer:sleep(1000),
+ {ok,Data1} = ct_telnet:get_data(Handle),
+ ct:log("[GET DATA #1] Received ~w chars: ~s",
+ [length(lists:flatten(Data1)),Data1]),
+ VerifyStr = [C || C <- lists:flatten(Data1), C/=$ , C/=$\r, C/=$\n, C/=$>],
+
+ ok = ct_telnet:send(Handle, "echo_sep "++BigString),
+ timer:sleep(50),
+ {ok,Data2} = ct_telnet:get_data(Handle),
+ ct:log("[GET DATA #2] Received ~w chars: ~s", [length(lists:flatten(Data2)),Data2]),
+ VerifyStr = [C || C <- lists:flatten(Data2), C/=$ , C/=$\r, C/=$\n, C/=$>],
+
+ ok = ct_telnet:close(Handle),
+ ok.
+
%% The server says things. Manually check that it gets printed correctly
%% in the general IO log.
server_speaks(_) ->
diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl
index ae56787819..1d341d6106 100644
--- a/lib/common_test/test/telnet_server.erl
+++ b/lib/common_test/test/telnet_server.erl
@@ -198,6 +198,14 @@ do_handle_data(Data,#state{authorized={user,_}}=State) ->
do_handle_data("echo " ++ Data,State) ->
send(Data++"\r\n> ",State),
{ok,State};
+do_handle_data("echo_sep " ++ Data,State) ->
+ Msgs = string:tokens(Data," "),
+ lists:foreach(fun(Msg) ->
+ send(Msg,State),
+ timer:sleep(10)
+ end, Msgs),
+ send("\r\n> ",State),
+ {ok,State};
do_handle_data("echo_no_prompt " ++ Data,State) ->
send(Data,State),
{ok,State};
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 54eac20ac4..9d6768b157 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -126,9 +126,11 @@
map_es/1,
map_arg/1,
update_c_map/3,
+ c_map/1, is_c_map_empty/1,
ann_c_map/2, ann_c_map/3,
map_pair_op/1,map_pair_key/1,map_pair_val/1,
update_c_map_pair/4,
+ c_map_pair/2,
ann_c_map_pair/4
]).
@@ -1582,9 +1584,20 @@ map_es(#c_map{es = Es}) ->
-spec map_arg(c_map()) -> c_map() | c_literal().
-map_arg(#c_map{arg = M}) ->
+map_arg(#c_map{arg=M}) ->
M.
+-spec c_map([c_map_pair()]) -> c_map().
+
+c_map(Pairs) ->
+ #c_map{es=Pairs}.
+
+-spec is_c_map_empty(c_map() | c_literal()) -> boolean().
+
+is_c_map_empty(#c_map{ es=[] }) -> true;
+is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true;
+is_c_map_empty(_) -> false.
+
-spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal().
ann_c_map(As,Es) ->
@@ -1644,6 +1657,11 @@ map_pair_key(#c_map_pair{key=K}) -> K.
map_pair_val(#c_map_pair{val=V}) -> V.
map_pair_op(#c_map_pair{op=Op}) -> Op.
+-spec c_map_pair(cerl(), cerl()) -> c_map_pair().
+
+c_map_pair(Key,Val) ->
+ #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}.
+
-spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) ->
c_map_pair().
@@ -4245,6 +4263,9 @@ ann_make_tree(As, bitstr, [[V],[S],[U],[T],[Fs]]) ->
ann_c_bitstr(As, V, S, U, T, Fs);
ann_make_tree(As, cons, [[H], [T]]) -> ann_c_cons(As, H, T);
ann_make_tree(As, tuple, [Es]) -> ann_c_tuple(As, Es);
+ann_make_tree(As, map, [Es]) -> ann_c_map(As, Es);
+ann_make_tree(As, map, [[A], Es]) -> ann_c_map(As, A, Es);
+ann_make_tree(As, map_pair, [[Op], [K], [V]]) -> ann_c_map_pair(As, Op, K, V);
ann_make_tree(As, 'let', [Vs, [A], [B]]) -> ann_c_let(As, Vs, A, B);
ann_make_tree(As, seq, [[A], [B]]) -> ann_c_seq(As, A, B);
ann_make_tree(As, apply, [[Op], Es]) -> ann_c_apply(As, Op, Es);
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index fca08c4eed..6642183cb8 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -215,6 +215,7 @@ static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -344,6 +345,7 @@ static ErlNifFunc nif_funcs[] = {
{"des_ecb_crypt", 3, des_ecb_crypt},
{"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt},
{"des_ede3_cfb_crypt_nif", 6, des_ede3_cfb_crypt_nif},
+ {"aes_cfb_8_crypt", 4, aes_cfb_8_crypt},
{"aes_cfb_128_crypt", 4, aes_cfb_128_crypt},
{"aes_ctr_encrypt", 3, aes_ctr_encrypt},
{"aes_ctr_decrypt", 3, aes_ctr_encrypt},
@@ -1382,6 +1384,7 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
ErlNifBinary key;
struct hmac_context* obj;
const EVP_MD *md;
+ ERL_NIF_TERM ret;
CHECK_OSE_CRYPTO();
@@ -1413,7 +1416,9 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
HMAC_CTX_init(&obj->ctx);
HMAC_Init(&obj->ctx, key.data, key.size, md);
- return enif_make_resource(env, obj);
+ ret = enif_make_resource(env, obj);
+ enif_release_resource(obj);
+ return ret;
}
static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -1600,6 +1605,30 @@ static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_N
#endif
}
+static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key, IVec, Data, IsEncrypt) */
+ ErlNifBinary key, ivec, text;
+ AES_KEY aes_key;
+ unsigned char ivec_clone[16]; /* writable copy */
+ int new_ivlen = 0;
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 16
+ || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
+ || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
+ return enif_make_badarg(env);
+ }
+
+ memcpy(ivec_clone, ivec.data, 16);
+ AES_set_encrypt_key(key.data, 128, &aes_key);
+ AES_cfb8_encrypt((unsigned char *) text.data,
+ enif_make_new_binary(env, text.size, &ret),
+ text.size, &aes_key, ivec_clone, &new_ivlen,
+ (argv[3] == atom_true));
+ CONSUME_REDS(env,text);
+ return ret;
+}
+
static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, IVec, Data, IsEncrypt) */
ErlNifBinary key, ivec, text;
@@ -2480,6 +2509,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
return enif_make_binary(env, &ret_bin);
}
else {
+ enif_release_binary(&ret_bin);
return atom_error;
}
}
@@ -2742,6 +2772,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T
ret = enif_make_binary(env, &ret_bin);
}
else {
+ enif_release_binary(&ret_bin);
ret = atom_error;
}
}
@@ -2866,8 +2897,8 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_
/* a + (u * x) */
bn_exp2 = BN_new();
- BN_mod_mul(bn_result, bn_u, bn_exponent, bn_prime, bn_ctx);
- BN_mod_add(bn_exp2, bn_a, bn_result, bn_prime, bn_ctx);
+ BN_mul(bn_result, bn_u, bn_exponent, bn_ctx);
+ BN_add(bn_exp2, bn_a, bn_result);
/* (B - (k * g^x)) ^ (a + (u * x)) % N */
BN_mod_exp(bn_result, bn_base, bn_exp2, bn_prime, bn_ctx);
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index e88bf01491..7712173ed8 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -128,7 +128,7 @@
<p><code>stream_cipher() = rc4 | aes_ctr </code></p>
- <p><code>block_cipher() = aes_cbc128 | aes_cfb128 | aes_ige256 | blowfish_cbc |
+ <p><code>block_cipher() = aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc |
blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf
| des_ede3 | rc2_cbc </code></p>
@@ -152,7 +152,7 @@
Note that both md4 and md5 are recommended only for compatibility with existing applications.
</p>
<p><code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 |
- blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p>
+ blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p>
<p><code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported
with ecdsa and ecdh.
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 5bf52fc8a4..e1fbbf9ab8 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -210,7 +210,7 @@ supports()->
[{hashs, Hashs},
{ciphers, [des_cbc, des_cfb, des3_cbc, des_ede3, blowfish_cbc,
- blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb128,
+ blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb8, aes_cfb128,
aes_cbc256, rc2_cbc, aes_ctr, rc4] ++ Ciphers},
{public_keys, [rsa, dss, dh, srp] ++ PubKeys}
].
@@ -281,7 +281,7 @@ hmac_final_n(_Context, _HashLen) -> ? nif_stub.
%% Ecrypt/decrypt %%%
-spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
- blowfish_cfb64 | aes_cbc128 | aes_cfb128 | aes_cbc256 | rc2_cbc,
+ blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc,
Key::iodata(), Ivec::binary(), Data::iodata()) -> binary().
block_encrypt(des_cbc, Key, Ivec, Data) ->
@@ -306,6 +306,8 @@ block_encrypt(aes_cbc256, Key, Ivec, Data) ->
aes_cbc_256_encrypt(Key, Ivec, Data);
block_encrypt(aes_ige256, Key, Ivec, Data) ->
aes_ige_256_encrypt(Key, Ivec, Data);
+block_encrypt(aes_cfb8, Key, Ivec, Data) ->
+ aes_cfb_8_encrypt(Key, Ivec, Data);
block_encrypt(aes_cfb128, Key, Ivec, Data) ->
aes_cfb_128_encrypt(Key, Ivec, Data);
block_encrypt(rc2_cbc, Key, Ivec, Data) ->
@@ -313,7 +315,7 @@ block_encrypt(rc2_cbc, Key, Ivec, Data) ->
-spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 |
- aes_cfb128 | rc2_cbc,
+ aes_cfb8 | aes_cfb128 | rc2_cbc,
Key::iodata(), Ivec::binary(), Data::iodata()) -> binary().
block_decrypt(des_cbc, Key, Ivec, Data) ->
@@ -338,6 +340,8 @@ block_decrypt(aes_cbc256, Key, Ivec, Data) ->
aes_cbc_256_decrypt(Key, Ivec, Data);
block_decrypt(aes_ige256, Key, Ivec, Data) ->
aes_ige_256_decrypt(Key, Ivec, Data);
+block_decrypt(aes_cfb8, Key, Ivec, Data) ->
+ aes_cfb_8_decrypt(Key, Ivec, Data);
block_decrypt(aes_cfb128, Key, Ivec, Data) ->
aes_cfb_128_decrypt(Key, Ivec, Data);
block_decrypt(rc2_cbc, Key, Ivec, Data) ->
@@ -1159,7 +1163,21 @@ blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub.
%%
-%% AES in cipher feedback mode (CFB)
+%% AES in cipher feedback mode (CFB) - 8 bit shift
+%%
+-spec aes_cfb_8_encrypt(iodata(), binary(), iodata()) -> binary().
+-spec aes_cfb_8_decrypt(iodata(), binary(), iodata()) -> binary().
+
+aes_cfb_8_encrypt(Key, IVec, Data) ->
+ aes_cfb_8_crypt(Key, IVec, Data, true).
+
+aes_cfb_8_decrypt(Key, IVec, Data) ->
+ aes_cfb_8_crypt(Key, IVec, Data, false).
+
+aes_cfb_8_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+
+%%
+%% AES in cipher feedback mode (CFB) - 128 bit shift
%%
-spec aes_cfb_128_encrypt(iodata(), binary(), iodata()) -> binary().
-spec aes_cfb_128_decrypt(iodata(), binary(), iodata()) -> binary().
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 63552d2e70..03aa3964a5 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -55,6 +55,7 @@ all() ->
{group, blowfish_cfb64},
{group, blowfish_ofb64},
{group, aes_cbc128},
+ {group, aes_cfb8},
{group, aes_cfb128},
{group, aes_cbc256},
{group, aes_ige256},
@@ -90,6 +91,7 @@ groups() ->
{des3_cbf,[], [block]},
{rc2_cbc,[], [block]},
{aes_cbc128,[], [block]},
+ {aes_cfb8,[], [block]},
{aes_cfb128,[], [block]},
{aes_cbc256,[], [block]},
{aes_ige256,[], [block]},
@@ -688,7 +690,7 @@ group_config(ecdsa = Type, Config) ->
SignVerify = [{Type, sha, Public, Private, Msg}],
[{sign_verify, SignVerify} | Config];
group_config(srp, Config) ->
- GenerateCompute = [srp3(), srp6(), srp6a()],
+ GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()],
[{generate_compute, GenerateCompute} | Config];
group_config(ecdh, Config) ->
Compute = ecdh(),
@@ -723,6 +725,9 @@ group_config(aes_cbc256, Config) ->
group_config(aes_ige256, Config) ->
Block = aes_ige256(),
[{block, Block} | Config];
+group_config(aes_cfb8, Config) ->
+ Block = aes_cfb8(),
+ [{block, Block} | Config];
group_config(aes_cfb128, Config) ->
Block = aes_cfb128(),
[{block, Block} | Config];
@@ -1164,6 +1169,25 @@ aes_ige256() ->
hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}
].
+aes_cfb8() ->
+ [{aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("000102030405060708090a0b0c0d0e0f"),
+ hexstr2bin("6bc1bee22e409f96e93d7e117393172a")},
+ {aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("3B3FD92EB72DAD20333449F8E83CFB4A"),
+ hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")},
+ {aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("C8A64537A0B3A93FCDE3CDAD9F1CE58B"),
+ hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")},
+ {aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("26751F67A3CBB140B1808CF187A4F4DF"),
+ hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}
+ ].
+
aes_cfb128() ->
[{aes_cfb128,
hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
@@ -1472,6 +1496,32 @@ srp6() ->
ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime),
srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPrivate, UserPassHash, Scrambler, SessionKey).
+
+srp6a_smaller_prime() ->
+ Username = <<"alice">>,
+ Password = <<"password123">>,
+ Salt = <<"mystrongsalt">>,
+ Prime = hexstr2bin("894B645E89E1535BBDAD5B8B290650530801B18EBFBF5E8FAB3C82872A3E9BB7"),
+ Generator = <<7>>,
+ Version = '6a',
+ Scrambler = hexstr2bin("18DE4A002AD05EF464B19AE2B6929F9B1319C7AA"),
+ Verifier = hexstr2bin("867401D5DE10964768184EAF246B322760C847604075FA66A4423907"
+ "8428BCA5"),
+ ClientPrivate = hexstr2bin("C49F832EE8D67ECF9E7F2785EB0622D8B3FE2344C00F96E1AEF4103C"
+ "A44D51F9"),
+ ServerPrivate = hexstr2bin("6C78CCEAAEC15E69068A87795B2A20ED7B45CFC5A254EBE2F17F144A"
+ "4D99DB18"),
+ ClientPublic = hexstr2bin("2452A57166BBBF690DB77539BAF9C57CD1ED99D5AA15ED925AD9B5C3"
+ "64BBEDFF"),
+ ServerPublic = hexstr2bin("2C0464DE84B91E4963A3546CAC0EFE55F31F49208C3F0AD7EE55F444"
+ "8F38BA7F"),
+
+ SessionKey = hexstr2bin("65581B2302580BD26F522A5A421CF969B9CCBCE4051196B034A2A9D22065D848"),
+ UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]),
+ Verifier = crypto:mod_pow(Generator, UserPassHash, Prime),
+ ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime),
+ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPrivate, UserPassHash, Scrambler, SessionKey).
+
srp6a() ->
Username = <<"alice">>,
Password = <<"password123">>,
diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl
index 0653ce4c00..77297de0f3 100644
--- a/lib/debugger/src/dbg_ieval.erl
+++ b/lib/debugger/src/dbg_ieval.erl
@@ -665,11 +665,11 @@ expr({map,Line,E0,Fs0}, Bs0, Ieval0) ->
{value,E,Bs1} = expr(E0, Bs0, Ieval),
case E of
#{} ->
- {Fs,Bs2} = eval_map_fields(Fs0, Bs1, Ieval),
+ {Fs,Bs2} = eval_map_fields(Fs0, Bs0, Ieval),
Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi);
({map_exact,K,V}, Mi) -> maps:update(K,V,Mi)
end, E, Fs),
- {value,Value,Bs2};
+ {value,Value,merge_bindings(Bs2, Bs1, Ieval)};
_ ->
exception(error, {badarg,E}, Bs1, Ieval)
end;
diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl
index ecbd68ab40..9d7ef238e3 100644
--- a/lib/debugger/test/int_eval_SUITE.erl
+++ b/lib/debugger/test/int_eval_SUITE.erl
@@ -294,6 +294,7 @@ stacktrace(Config) when is_list(Config) ->
maps(Config) when is_list(Config) ->
Fun = fun () -> ?IM:empty_map_update([camembert]) end,
{'EXIT',{{badarg,[camembert]},_}} = spawn_eval(Fun),
+ [#{hello := 0, price := 0}] = spawn_eval(fun () -> ?IM:update_in_fun() end),
ok.
diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
index e047a33d8c..7f55360f48 100644
--- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
+++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
@@ -29,7 +29,7 @@
-export([more_catch/1,more_nocatch/1,exit_me/0]).
-export([f/1, f_try/1, f_catch/1]).
-export([otp_5837/1, otp_8310/0]).
--export([empty_map_update/1]).
+-export([empty_map_update/1, update_in_fun/0]).
%% Internal exports.
-export([echo/2,my_subtract/2,catch_a_ball/0,throw_a_ball/0]).
@@ -244,3 +244,6 @@ otp_8310() ->
ok.
empty_map_update(Map) -> Map#{}.
+
+update_in_fun() ->
+ lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]).
diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml
index a92b890a80..3de60b2f7a 100644
--- a/lib/dialyzer/doc/src/dialyzer.xml
+++ b/lib/dialyzer/doc/src/dialyzer.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2006</year><year>2013</year>
+ <year>2006</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -50,33 +50,31 @@
<p>Dialyzer also has a command line version for automated use. Below is a
brief description of the list of its options. The same information can
be obtained by writing</p>
- <code type="none"><![CDATA[
- dialyzer --help
- ]]></code>
+ <code type="none">
+ dialyzer --help</code>
<p>in a shell. Please refer to the GUI description for more details on
the operation of Dialyzer.</p>
<p>The exit status of the command line version is:</p>
- <code type="none"><![CDATA[
+ <code type="none">
0 - No problems were encountered during the analysis and no
warnings were emitted.
1 - Problems were encountered during the analysis.
- 2 - No problems were encountered, but warnings were emitted.
- ]]></code>
+ 2 - No problems were encountered, but warnings were emitted.</code>
<p>Usage:</p>
- <code type="none"><![CDATA[
+ <code type="none">
dialyzer [--help] [--version] [--shell] [--quiet] [--verbose]
[-pa dir]* [--plt plt] [--plts plt*] [-Ddefine]*
- [-I include_dir]* [--output_plt file] [-Wwarn]*
+ [-I include_dir]* [--output_plt file] [-Wwarn]* [--raw]
[--src] [--gui] [files_or_dirs] [-r dirs]
[--apps applications] [-o outfile]
[--build_plt] [--add_to_plt] [--remove_from_plt]
[--check_plt] [--no_check_plt] [--plt_info] [--get_warnings]
- [--no_native] [--fullpath]
- ]]></code>
+ [--dump_callgraph file] [--no_native] [--fullpath]
+ [--statistics]</code>
<p>Options:</p>
<taglist>
<tag><c><![CDATA[files_or_dirs]]></c> (for backwards compatibility also
- as: <c><![CDATA[-c files_or_dirs]]></c></tag>
+ as: <c><![CDATA[-c files_or_dirs]]></c>)</tag>
<item>Use Dialyzer from the command line to detect defects in the
specified files or directories containing <c><![CDATA[.erl]]></c> or
<c><![CDATA[.beam]]></c> files, depending on the type of the
@@ -88,16 +86,14 @@
analysis.</item>
<tag><c><![CDATA[--apps applications]]></c></tag>
<item>Option typically used when building or modifying a plt as in:
- <code type="none"><![CDATA[
- dialyzer --build_plt --apps erts kernel stdlib mnesia ...
- ]]></code>
+ <code type="none">
+ dialyzer --build_plt --apps erts kernel stdlib mnesia ...</code>
to conveniently refer to library applications corresponding to the
Erlang/OTP installation. However, the option is general and can also
be used during analysis in order to refer to Erlang/OTP applications.
In addition, file or directory names can also be included, as in:
- <code type="none"><![CDATA[
- dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam
- ]]></code></item>
+ <code type="none">
+ dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam</code></item>
<tag><c><![CDATA[-o outfile]]></c> (or
<c><![CDATA[--output outfile]]></c>)</tag>
<item>When using Dialyzer from the command line, send the analysis
@@ -129,24 +125,26 @@
that the plts are disjoint (i.e., do not have any module
appearing in more than one plt).
The plts are created in the usual way:
- <code type="none"><![CDATA[
+ <code type="none">
dialyzer --build_plt --output_plt plt_1 files_to_include
...
- dialyzer --build_plt --output_plt plt_n files_to_include
- ]]></code>
+ dialyzer --build_plt --output_plt plt_n files_to_include</code>
and then can be used in either of the following ways:
- <code type="none"><![CDATA[
- dialyzer files_to_analyze --plts plt_1 ... plt_n
- ]]></code>
+ <code type="none">
+ dialyzer files_to_analyze --plts plt_1 ... plt_n</code>
or:
- <code type="none"><![CDATA[
- dialyzer --plts plt_1 ... plt_n -- files_to_analyze
- ]]></code>
+ <code type="none">
+ dialyzer --plts plt_1 ... plt_n -- files_to_analyze</code>
(Note the -- delimiter in the second case)</item>
<tag><c><![CDATA[-Wwarn]]></c></tag>
<item>A family of options which selectively turn on/off warnings
(for help on the names of warnings use
- <c><![CDATA[dialyzer -Whelp]]></c>).</item>
+ <c><![CDATA[dialyzer -Whelp]]></c>).
+ Note that the options can also be given in the file with a
+ <c>-dialyzer({nowarn_tag, WarningTags})</c> attribute.
+ See <seealso
+ marker="doc/reference_manual:typespec#suppression">Erlang Reference
+ Manual</seealso> for details.</item>
<tag><c><![CDATA[--shell]]></c></tag>
<item>Do not disable the Erlang shell while running the GUI.</item>
<tag><c><![CDATA[--version]]></c> (or <c><![CDATA[-v]]></c>)</tag>
@@ -220,8 +218,6 @@
<item>Suppress warnings for unused functions.</item>
<tag><c><![CDATA[-Wno_improper_lists]]></c></tag>
<item>Suppress warnings for construction of improper lists.</item>
- <tag><c><![CDATA[-Wno_tuple_as_fun]]></c></tag>
- <item>Suppress warnings for using tuples instead of funs.</item>
<tag><c><![CDATA[-Wno_fun_app]]></c></tag>
<item>Suppress warnings for fun applications that will fail.</item>
<tag><c><![CDATA[-Wno_match]]></c></tag>
@@ -229,9 +225,16 @@
match.</item>
<tag><c><![CDATA[-Wno_opaque]]></c></tag>
<item>Suppress warnings for violations of opaqueness of data types.</item>
+ <tag><c><![CDATA[-Wno_fail_call]]></c></tag>
+ <item>Suppress warnings for failing calls.</item>
+ <tag><c><![CDATA[-Wno_contracts]]></c></tag>
+ <item>Suppress warnings about invalid contracts.</item>
<tag><c><![CDATA[-Wno_behaviours]]></c></tag>
<item>Suppress warnings about behaviour callbacks which drift from the
published recommended interfaces.</item>
+ <tag><c><![CDATA[-Wno_undefined_callbacks]]></c></tag>
+ <item>Suppress warnings about behaviours that have no
+ <c>-callback</c> attributes for their callbacks.</item>
<tag><c><![CDATA[-Wunmatched_returns]]></c>***</tag>
<item>Include warnings for function calls which ignore a structured return
value or do not match against one of many possible return
@@ -278,13 +281,13 @@
</type>
<desc>
<p>Dialyzer GUI version.</p>
- <code type="none"><![CDATA[
+ <code type="none">
OptList :: [Option]
Option :: {files, [Filename :: string()]}
| {files_rec, [DirName :: string()]}
| {defines, [{Macro: atom(), Value : term()}]}
- | {from, src_code | byte_code} %% Defaults to byte_code
- | {init_plt, FileName :: string()} %% If changed from default
+ | {from, src_code | byte_code} %% Defaults to byte_code
+ | {init_plt, FileName :: string()} %% If changed from default
| {plts, [FileName :: string()]} %% If changed from default
| {include_dirs, [DirName :: string()]}
| {output_file, FileName :: string()}
@@ -304,14 +307,15 @@ WarnOpts :: no_return
| no_match
| no_opaque
| no_fail_call
+ | no_contracts
+ | no_behaviours
+ | no_undefined_callbacks
+ | unmatched_returns
| error_handling
| race_conditions
- | behaviours
- | unmatched_returns
| overspecs
| underspecs
- | specdiffs
- ]]></code>
+ | specdiffs</code>
</desc>
</func>
<func>
@@ -323,17 +327,30 @@ WarnOpts :: no_return
</type>
<desc>
<p>Dialyzer command line version.</p>
- <code type="none"><![CDATA[
+ <code type="none">
Warnings :: [{Tag, Id, Msg}]
-Tag :: 'warn_return_no_exit' | 'warn_return_only_exit'
- | 'warn_not_called' | 'warn_non_proper_list'
- | 'warn_fun_app' | 'warn_matching'
- | 'warn_failing_call' | 'warn_contract_types'
- | 'warn_contract_syntax' | 'warn_contract_not_equal'
- | 'warn_contract_subtype' | 'warn_contract_supertype'
+Tag :: 'warn_behaviour'
+ | 'warn_bin_construction'
+ | 'warn_callgraph'
+ | 'warn_contract_not_equal'
+ | 'warn_contract_range'
+ | 'warn_contract_subtype'
+ | 'warn_contract_supertype'
+ | 'warn_contract_syntax'
+ | 'warn_contract_types'
+ | 'warn_failing_call'
+ | 'warn_fun_app'
+ | 'warn_matching'
+ | 'warn_non_proper_list'
+ | 'warn_not_called'
+ | 'warn_opaque'
+ | 'warn_race_condition'
+ | 'warn_return_no_exit'
+ | 'warn_return_only_exit'
+ | 'warn_umatched_return'
+ | 'warn_undefined_callbacks'
Id = {File :: string(), Line :: integer()}
-Msg = msg() -- Undefined
-]]></code>
+Msg = msg() -- Undefined</code>
</desc>
</func>
<func>
diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl
index db27b2037d..04ce0e8bc3 100644
--- a/lib/dialyzer/src/dialyzer_cl_parse.erl
+++ b/lib/dialyzer/src/dialyzer_cl_parse.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -357,12 +357,13 @@ help_warnings() ->
help_message() ->
S = "Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose]
[-pa dir]* [--plt plt] [--plts plt*] [-Ddefine]*
- [-I include_dir]* [--output_plt file] [-Wwarn]*
+ [-I include_dir]* [--output_plt file] [-Wwarn]* [--raw]
[--src] [--gui] [files_or_dirs] [-r dirs]
[--apps applications] [-o outfile]
[--build_plt] [--add_to_plt] [--remove_from_plt]
[--check_plt] [--no_check_plt] [--plt_info] [--get_warnings]
- [--no_native] [--fullpath] [--statistics]
+ [--dump_callgraph file] [--no_native] [--fullpath]
+ [--statistics]
Options:
files_or_dirs (for backwards compatibility also as: -c files_or_dirs)
Use Dialyzer from the command line to detect defects in the
@@ -495,14 +496,16 @@ warning_options_msg() ->
Suppress warnings for unused functions.
-Wno_improper_lists
Suppress warnings for construction of improper lists.
- -Wno_tuple_as_fun
- Suppress warnings for using tuples instead of funs.
-Wno_fun_app
Suppress warnings for fun applications that will fail.
-Wno_match
Suppress warnings for patterns that are unused or cannot match.
-Wno_opaque
Suppress warnings for violations of opaqueness of data types.
+ -Wno_fail_call
+ Suppress warnings for failing calls.
+ -Wno_contracts
+ Suppress warnings about invalid contracts.
-Wno_behaviours
Suppress warnings about behaviour callbacks which drift from the published
recommended interfaces.
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 283031eb9a..1d2dfc7b2d 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -752,14 +752,7 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) ->
t_from_forms_without_remote([{FType, []}], RecDict) ->
Type0 = erl_types:t_from_form(FType, RecDict),
- Map =
- fun(Type) ->
- case erl_types:t_is_remote(Type) of
- true -> erl_types:t_none();
- false -> Type
- end
- end,
- {ok, erl_types:t_map(Map, Type0)};
+ {ok, erl_types:subst_all_remote(Type0, erl_types:t_none())};
t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) ->
%% 'When' constraints
unsupported;
diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_difftype b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype
new file mode 100644
index 0000000000..8980321135
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype
@@ -0,0 +1,3 @@
+
+maps_difftype.erl:10: Function empty_mismatch/1 has no local return
+maps_difftype.erl:11: The pattern ~{}~ can never match the type tuple()
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl
new file mode 100644
index 0000000000..f362a06bca
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl
@@ -0,0 +1,6 @@
+-type host() :: nonempty_string().
+-type path() :: nonempty_string().
+-type url() :: binary().
+
+% The host portion of a url, if available.
+-type url_host() :: host() | none.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl
new file mode 100644
index 0000000000..8cab65fc9c
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl
@@ -0,0 +1,148 @@
+
+-define(SECOND, 1000).
+-define(MINUTE, (60 * ?SECOND)).
+-define(HOUR, (60 * ?MINUTE)).
+-define(DAY, (24 * ?HOUR)).
+-define(MB, (1024 * 1024)).
+
+% Maximum length of tag/blob prefix
+-define(NAME_MAX, 511).
+
+% How long ddfs node startup can take. The most time-consuming part
+% is the scanning of the tag objects in the node's DDFS volumes.
+-define(NODE_STARTUP, (1 * ?MINUTE)).
+
+% How long to wait on the master for replies from nodes.
+-define(NODE_TIMEOUT, (10 * ?SECOND)).
+
+% How long to wait for a reply from an operation coordinated by the
+% master that accesses nodes. This value should be larger than
+% NODE_TIMEOUT.
+-define(NODEOP_TIMEOUT, (1 * ?MINUTE)).
+
+% The minimum amount of free space a node must have, to be considered
+% a primary candidate host for a new blob.
+-define(MIN_FREE_SPACE, (1024 * ?MB)).
+
+% The maximum number of active HTTP connections on a system (this
+% applies separately for GET and PUT operations).
+-define(HTTP_MAX_ACTIVE, 3).
+
+% The maximum number of waiting HTTP connections to queue up on a busy system.
+-define(HTTP_QUEUE_LENGTH, 100).
+
+% The maximum number of simultaneous HTTP connections. Note that
+% HTTP_MAX_CONNS * 2 * 2 + 32 < Maximum number of file descriptors, where
+% 2 = Get and put, 2 = two FDs required for each connection (connection
+% itself + a file it accesses), 32 = a guess how many extra fds is needed.
+-define(HTTP_MAX_CONNS, 128).
+
+% How long to keep a PUT request in queue if the system is busy.
+-define(PUT_WAIT_TIMEOUT, (1 * ?MINUTE)).
+
+% How long to keep a GET request in queue if the system is busy.
+-define(GET_WAIT_TIMEOUT, (1 * ?MINUTE)).
+
+% An unused loaded tag expires in TAG_EXPIRES milliseconds. Note that
+% if TAG_EXPIRES is not smaller than GC_INTERVAL, tags will never
+% expire from the memory cache and will always take up memory.
+-define(TAG_EXPIRES, (10 * ?HOUR)).
+
+% How often the master's cache of all known tag names is refreshed.
+% This refresh is only needed to purge deleted tags eventually from
+% the tag cache. It doesn't harm to have a long interval.
+-define(TAG_CACHE_INTERVAL, (10 * ?MINUTE)).
+
+% How soon a tag object initialized in memory expires if it's content
+% cannot be fetched from the cluster.
+-define(TAG_EXPIRES_ONERROR, (1 * ?SECOND)).
+
+% How often a DDFS node should refresh its tag cache from disk.
+-define(FIND_TAGS_INTERVAL, ?DAY).
+
+% How often buffered (delayed) updates to a tag need to be
+% flushed. Tradeoff: The longer the interval, the more updates are
+% bundled in a single commit. On the other hand, in the worst case
+% the requester has to wait for the full interval before getting a
+% reply. A long interval also increases the likelihood that the server
+% crashes before the commit has finished successfully, making requests
+% more unreliable.
+-define(DELAYED_FLUSH_INTERVAL, (1 * ?SECOND)).
+
+% How long to wait between garbage collection runs.
+-define(GC_INTERVAL, ?DAY).
+
+% Max duration for a GC run. This should be smaller than
+% min(ORPHANED_{BLOB,TAG}_EXPIRES).
+-define(GC_MAX_DURATION, (3 * ?DAY)).
+
+% How long to wait after startup for cluster to stabilize before
+% starting the first GC run.
+-define(GC_DEFAULT_INITIAL_WAIT, (5 * ?MINUTE)).
+
+% The longest potential interval between messages in the GC protocol;
+% used to ensure GC makes forward progress. This can be set to the
+% estimated time to traverse all the volumes on a DDFS node.
+-define(GC_PROGRESS_INTERVAL, (30 * ?MINUTE)).
+
+% Number of extra replicas (i.e. lost replicas recovered during GC) to
+% allow before deleting extra replicas.
+-define(NUM_EXTRA_REPLICAS, 1).
+
+% Permissions for files backing blobs and tags.
+-define(FILE_MODE, 8#00400).
+
+% How often to check available disk space in ddfs_node.
+-define(DISKSPACE_INTERVAL, (10 * ?SECOND)).
+
+% The maximum size of payloads of HTTP requests to the /ddfs/tag/
+% prefix.
+-define(MAX_TAG_BODY_SIZE, (512 * ?MB)).
+
+% Tag attribute names and values have a limited size, and there
+% can be only a limited number of them.
+-define(MAX_TAG_ATTRIB_NAME_SIZE, 1024).
+-define(MAX_TAG_ATTRIB_VALUE_SIZE, 1024).
+-define(MAX_NUM_TAG_ATTRIBS, 1000).
+
+% How long HTTP requests that perform tag updates should wait to
+% finish (a long time).
+-define(TAG_UPDATE_TIMEOUT, ?DAY).
+
+% Timeout for re-replicating a single blob over HTTP PUT. This
+% depends on the largest blobs hosted by DDFS, and the speed of the
+% cluster network.
+-define(GC_PUT_TIMEOUT, (180 * ?MINUTE)).
+
+% Delete !partial files after this many milliseconds.
+-define(PARTIAL_EXPIRES, ?DAY).
+
+% When orphaned blob can be deleted. This should be large enough that
+% you can upload all the new blobs of a tag and perform the tag update
+% within this time.
+-define(ORPHANED_BLOB_EXPIRES, (5 * ?DAY)).
+
+% When orphaned tag can be deleted.
+-define(ORPHANED_TAG_EXPIRES, (5 * ?DAY)).
+
+% How long a tag has to stay on the deleted list before
+% we can permanently forget it, after all known instances
+% of the tag object have been removed. This quarantine period
+% ensures that a node that was temporarily unavailable
+% and reactivates can't resurrect deleted tags. You
+% must ensure that all temporarily inactive nodes
+% are reactivated (or cleaned) within the ?DELETED_TAG_EXPIRES
+% time frame.
+%
+% This value _must_ be larger than the other time-related DDFS
+% parameters listed in this file. In particular, it must be larger
+% than ORPHANED_TAG_EXPIRES.
+-define(DELETED_TAG_EXPIRES, (30 * ?DAY)).
+
+% How many times a tag operation should be retried before aborting.
+-define(MAX_TAG_OP_RETRIES, 3).
+
+% How long to wait before timing out a tag retrieval. This should be
+% large enough to read a large tag object off the disk and send it
+% over the network.
+-define(GET_TAG_TIMEOUT, (5 * ?MINUTE)).
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl
new file mode 100644
index 0000000000..e43ec23fe1
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl
@@ -0,0 +1,9 @@
+-type volume_name() :: nonempty_string().
+
+% Diskinfo is {FreeSpace, UsedSpace}.
+-type diskinfo() :: {non_neg_integer(), non_neg_integer()}.
+-type volume() :: {diskinfo(), volume_name()}.
+
+-type object_type() :: 'blob' | 'tag'.
+-type object_name() :: binary().
+-type taginfo() :: {erlang:timestamp(), volume_name()}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl
new file mode 100644
index 0000000000..dc43f7586b
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl
@@ -0,0 +1,17 @@
+-type local_object() :: {object_name(), node()}.
+-type phase() :: 'start' | 'build_map' | 'map_wait' | 'gc'
+ | 'rr_blobs' | 'rr_blobs_wait' | 'rr_tags'.
+-type protocol_msg() :: {'check_blob', object_name()} | 'start_gc' | 'end_rr'.
+
+-type blob_update() :: {object_name(), 'filter' | [url()]}.
+
+-type check_blob_result() :: 'false' | {'true', volume_name()}.
+
+% GC statistics
+
+% {Files, Bytes}
+-type gc_stat() :: {non_neg_integer(), non_neg_integer()}.
+% {Kept, Deleted}
+-type obj_stats() :: {gc_stat(), gc_stat()}.
+% {Tags, Blobs}.
+-type gc_run_stats() :: {obj_stats(), obj_stats()}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl
new file mode 100644
index 0000000000..2be2773dc5
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl
@@ -0,0 +1,531 @@
+-module(ddfs_master).
+-behaviour(gen_server).
+
+-export([start_link/0]).
+-export([get_tags/1, get_tags/3,
+ get_nodeinfo/1,
+ get_read_nodes/0,
+ get_hosted_tags/1,
+ gc_blacklist/0, gc_blacklist/1,
+ gc_stats/0,
+ choose_write_nodes/3,
+ new_blob/4, new_blob/5,
+ safe_gc_blacklist/0, safe_gc_blacklist/1,
+ refresh_tag_cache/0,
+ tag_notify/2,
+ tag_operation/2, tag_operation/3,
+ update_gc_stats/1,
+ update_nodes/1
+ ]).
+-export([init/1,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ terminate/2,
+ code_change/3]).
+
+-define(WEB_PORT, 8011).
+
+-compile(nowarn_deprecated_type).
+
+-include("common_types.hrl").
+-include("gs_util.hrl").
+-include("config.hrl").
+-include("ddfs.hrl").
+-include("ddfs_tag.hrl").
+-include("ddfs_gc.hrl").
+
+-type node_info() :: {node(), {non_neg_integer(), non_neg_integer()}}.
+-type gc_stats() :: none | gc_run_stats().
+
+-record(state, {tags = gb_trees:empty() :: gb_trees:tree(),
+ tag_cache = false :: false | gb_sets:set(),
+ cache_refresher :: pid(),
+
+ nodes = [] :: [node_info()],
+ write_blacklist = [] :: [node()],
+ read_blacklist = [] :: [node()],
+ gc_blacklist = [] :: [node()],
+ safe_gc_blacklist = gb_sets:empty() :: gb_sets:set(),
+ gc_stats = none :: none | {gc_stats(), erlang:timestamp()}}).
+-type state() :: #state{}.
+-type replyto() :: {pid(), reference()}.
+
+-export_type([gc_stats/0, node_info/0]).
+
+%% ===================================================================
+%% API functions
+
+-spec start_link() -> {ok, pid()}.
+start_link() ->
+ lager:info("DDFS master starts"),
+ case gen_server:start_link({local, ?MODULE}, ?MODULE, [], []) of
+ {ok, Server} -> {ok, Server};
+ {error, {already_started, Server}} -> {ok, Server}
+ end.
+
+-spec tag_operation(term(), tagname()) -> term().
+tag_operation(Op, Tag) ->
+ gen_server:call(?MODULE, {tag, Op, Tag}).
+-spec tag_operation(term(), tagname(), non_neg_integer() | infinity) ->
+ term().
+tag_operation(Op, Tag, Timeout) ->
+ gen_server:call(?MODULE, {tag, Op, Tag}, Timeout).
+
+-spec tag_notify(term(), tagname()) -> ok.
+tag_notify(Op, Tag) ->
+ gen_server:cast(?MODULE, {tag_notify, Op, Tag}).
+
+-spec get_nodeinfo(all) -> {ok, [node_info()]}.
+get_nodeinfo(all) ->
+ gen_server:call(?MODULE, {get_nodeinfo, all}).
+
+-spec get_read_nodes() -> {ok, [node()], non_neg_integer()} | {error, term()}.
+get_read_nodes() ->
+ gen_server:call(?MODULE, get_read_nodes, infinity).
+
+-spec gc_blacklist() -> {ok, [node()]}.
+gc_blacklist() ->
+ gen_server:call(?MODULE, gc_blacklist).
+
+-spec gc_blacklist([node()]) -> ok.
+gc_blacklist(Nodes) ->
+ gen_server:cast(?MODULE, {gc_blacklist, Nodes}).
+
+-spec gc_stats() -> {ok, none | {gc_stats(), erlang:timestamp()}} | {error, term()}.
+gc_stats() ->
+ gen_server:call(?MODULE, gc_stats).
+
+-spec get_hosted_tags(host()) -> {ok, [tagname()]} | {error, term()}.
+get_hosted_tags(Host) ->
+ gen_server:call(?MODULE, {get_hosted_tags, Host}).
+
+-spec choose_write_nodes(non_neg_integer(), [node()], [node()]) -> {ok, [node()]}.
+choose_write_nodes(K, Include, Exclude) ->
+ gen_server:call(?MODULE, {choose_write_nodes, K, Include, Exclude}).
+
+-spec get_tags(gc) -> {ok, [tagname()], [node()]} | too_many_failed_nodes;
+ (safe) -> {ok, [binary()]} | too_many_failed_nodes.
+get_tags(Mode) ->
+ get_tags(?MODULE, Mode, ?GET_TAG_TIMEOUT).
+
+-spec get_tags(server(), gc, non_neg_integer()) ->
+ {ok, [tagname()], [node()]} | too_many_failed_nodes;
+ (server(), safe, non_neg_integer()) ->
+ {ok, [binary()]} | too_many_failed_nodes.
+get_tags(Server, Mode, Timeout) ->
+ disco_profile:timed_run(
+ fun() -> gen_server:call(Server, {get_tags, Mode}, Timeout) end,
+ get_tags).
+
+-spec new_blob(string()|object_name(), non_neg_integer(), [node()], [node()]) ->
+ too_many_replicas | {ok, [nonempty_string()]}.
+new_blob(Obj, K, Include, Exclude) ->
+ gen_server:call(?MODULE, {new_blob, Obj, K, Include, Exclude}, infinity).
+
+-spec new_blob(server(), string()|object_name(), non_neg_integer(), [node()], [node()]) ->
+ too_many_replicas | {ok, [nonempty_string()]}.
+new_blob(Master, Obj, K, Include, Exclude) ->
+ gen_server:call(Master, {new_blob, Obj, K, Include, Exclude}, infinity).
+
+-spec safe_gc_blacklist() -> {ok, [node()]} | {error, term()}.
+safe_gc_blacklist() ->
+ gen_server:call(?MODULE, safe_gc_blacklist).
+
+-spec safe_gc_blacklist(gb_sets:set()) -> ok.
+safe_gc_blacklist(SafeGCBlacklist) ->
+ gen_server:cast(?MODULE, {safe_gc_blacklist, SafeGCBlacklist}).
+
+-spec update_gc_stats(gc_run_stats()) -> ok.
+update_gc_stats(Stats) ->
+ gen_server:cast(?MODULE, {update_gc_stats, Stats}).
+
+-type nodes_update() :: [{node(), boolean(), boolean()}].
+-spec update_nodes(nodes_update()) -> ok.
+update_nodes(DDFSNodes) ->
+ gen_server:cast(?MODULE, {update_nodes, DDFSNodes}).
+
+-spec update_nodestats(gb_trees:tree()) -> ok.
+update_nodestats(NewNodes) ->
+ gen_server:cast(?MODULE, {update_nodestats, NewNodes}).
+
+-spec update_tag_cache(gb_sets:set()) -> ok.
+update_tag_cache(TagCache) ->
+ gen_server:cast(?MODULE, {update_tag_cache, TagCache}).
+
+-spec refresh_tag_cache() -> ok.
+refresh_tag_cache() ->
+ gen_server:cast(?MODULE, refresh_tag_cache).
+
+%% ===================================================================
+%% gen_server callbacks
+
+-spec init(_) -> gs_init().
+init(_Args) ->
+ _ = [disco_profile:new_histogram(Name)
+ || Name <- [get_tags, do_get_tags_all, do_get_tags_filter,
+ do_get_tags_safe, do_get_tags_gc]],
+ spawn_link(fun() -> monitor_diskspace() end),
+ spawn_link(fun() -> ddfs_gc:start_gc(disco:get_setting("DDFS_DATA")) end),
+ Refresher = spawn_link(fun() -> refresh_tag_cache_proc() end),
+ put(put_port, disco:get_setting("DDFS_PUT_PORT")),
+ {ok, #state{cache_refresher = Refresher}}.
+
+-type choose_write_nodes_msg() :: {choose_write_nodes, non_neg_integer(), [node()], [node()]}.
+-type new_blob_msg() :: {new_blob, string() | object_name(), non_neg_integer(), [node()]}.
+-type tag_msg() :: {tag, ddfs_tag:call_msg(), tagname()}.
+-spec handle_call(dbg_state_msg(), from(), state()) ->
+ gs_reply(state());
+ ({get_nodeinfo, all}, from(), state()) ->
+ gs_reply({ok, [node_info()]});
+ (get_read_nodes, from(), state()) ->
+ gs_reply({ok, [node()], non_neg_integer});
+ (gc_blacklist, from(), state()) ->
+ gs_reply({ok, [node()]});
+ (gc_stats, from(), state()) ->
+ gs_reply({ok, gc_stats(), erlang:timestamp()});
+ (choose_write_nodes_msg(), from(), state()) ->
+ gs_reply({ok, [node()]});
+ (new_blob_msg(), from(), state()) ->
+ gs_reply(new_blob_result());
+ (tag_msg(), from(), state()) ->
+ gs_reply({error, nonodes}) | gs_noreply();
+ ({get_tags, gc | safe}, from(), state()) ->
+ gs_noreply();
+ ({get_hosted_tags, host()}, from(), state()) ->
+ gs_noreply();
+ (safe_gc_blacklist, from(), state()) ->
+ gs_reply({ok, [node()]}).
+handle_call(dbg_get_state, _, S) ->
+ {reply, S, S};
+
+handle_call({get_nodeinfo, all}, _From, #state{nodes = Nodes} = S) ->
+ {reply, {ok, Nodes}, S};
+
+handle_call(get_read_nodes, _F, #state{nodes = Nodes, read_blacklist = RB} = S) ->
+ {reply, do_get_readable_nodes(Nodes, RB), S};
+
+handle_call(gc_blacklist, _F, #state{gc_blacklist = Nodes} = S) ->
+ {reply, {ok, Nodes}, S};
+
+handle_call(gc_stats, _F, #state{gc_stats = Stats} = S) ->
+ {reply, {ok, Stats}, S};
+
+handle_call({choose_write_nodes, K, Include, Exclude}, _,
+ #state{nodes = N, write_blacklist = WBL, gc_blacklist = GBL} = S) ->
+ BL = lists:umerge(WBL, GBL),
+ {reply, do_choose_write_nodes(N, K, Include, Exclude, BL), S};
+
+handle_call({new_blob, Obj, K, Include, Exclude}, _,
+ #state{nodes = N, gc_blacklist = GBL, write_blacklist = WBL} = S) ->
+ BL = lists:umerge(WBL, GBL),
+ {reply, do_new_blob(Obj, K, Include, Exclude, BL, N), S};
+
+handle_call({tag, _M, _Tag}, _From, #state{nodes = []} = S) ->
+ {reply, {error, no_nodes}, S};
+
+handle_call({tag, M, Tag}, From, S) ->
+ {noreply, do_tag_request(M, Tag, From, S)};
+
+handle_call({get_tags, Mode}, From, #state{nodes = Nodes} = S) ->
+ spawn(fun() ->
+ gen_server:reply(From, do_get_tags(Mode, [N || {N, _} <- Nodes]))
+ end),
+ {noreply, S};
+
+handle_call({get_hosted_tags, Host}, From, S) ->
+ spawn(fun() -> gen_server:reply(From, ddfs_gc:hosted_tags(Host)) end),
+ {noreply, S};
+
+handle_call(safe_gc_blacklist, _From, #state{safe_gc_blacklist = SBL} = S) ->
+ {reply, {ok, gb_sets:to_list(SBL)}, S}.
+
+-spec handle_cast({tag_notify, ddfs_tag:cast_msg(), tagname()}
+ | {gc_blacklist, [node()]}
+ | {safe_gc_blacklist, gb_sets:set()}
+ | {update_gc_stats, gc_stats()}
+ | {update_tag_cache, gb_sets:set()}
+ | refresh_tag_cache
+ | {update_nodes, nodes_update()}
+ | {update_nodestats, gb_trees:tree()},
+ state()) -> gs_noreply().
+handle_cast({tag_notify, M, Tag}, S) ->
+ {noreply, do_tag_notify(M, Tag, S)};
+
+handle_cast({gc_blacklist, Nodes}, #state{safe_gc_blacklist = SBL} = S) ->
+ BLSet = gb_sets:from_list(Nodes),
+ NewSBL = gb_sets:intersection(BLSet, SBL),
+ {noreply, S#state{gc_blacklist = gb_sets:to_list(BLSet),
+ safe_gc_blacklist = NewSBL}};
+
+handle_cast({safe_gc_blacklist, SafeBlacklist}, #state{gc_blacklist = BL} = S) ->
+ SBL = gb_sets:intersection(SafeBlacklist, gb_sets:from_list(BL)),
+ {noreply, S#state{safe_gc_blacklist = SBL}};
+
+handle_cast({update_gc_stats, Stats}, S) ->
+ {noreply, S#state{gc_stats = {Stats, now()}}};
+
+handle_cast({update_tag_cache, TagCache}, S) ->
+ {noreply, S#state{tag_cache = TagCache}};
+
+handle_cast(refresh_tag_cache, #state{cache_refresher = Refresher} = S) ->
+ Refresher ! refresh,
+ {noreply, S};
+
+handle_cast({update_nodes, NewNodes}, S) ->
+ {noreply, do_update_nodes(NewNodes, S)};
+
+handle_cast({update_nodestats, NewNodes}, S) ->
+ {noreply, do_update_nodestats(NewNodes, S)}.
+
+-spec handle_info({'DOWN', _, _, pid(), _}, state()) -> gs_noreply().
+handle_info({'DOWN', _, _, Pid, _}, S) ->
+ {noreply, do_tag_exit(Pid, S)}.
+
+%% ===================================================================
+%% gen_server callback stubs
+
+-spec terminate(term(), state()) -> ok.
+terminate(Reason, _State) ->
+ lager:warning("DDFS master died: ~p", [Reason]).
+
+-spec code_change(term(), state(), term()) -> {ok, state()}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
+
+%% ===================================================================
+%% internal functions
+
+-spec do_get_readable_nodes([node_info()], [node()]) ->
+ {ok, [node()], non_neg_integer()}.
+do_get_readable_nodes(Nodes, ReadBlacklist) ->
+ NodeSet = gb_sets:from_ordset(lists:sort([Node || {Node, _} <- Nodes])),
+ BlackSet = gb_sets:from_ordset(ReadBlacklist),
+ ReadableNodeSet = gb_sets:subtract(NodeSet, BlackSet),
+ {ok, gb_sets:to_list(ReadableNodeSet), gb_sets:size(BlackSet)}.
+
+-spec do_choose_write_nodes([node_info()], non_neg_integer(), [node()], [node()], [node()]) ->
+ {ok, [node()]}.
+do_choose_write_nodes(Nodes, K, Include, Exclude, BlackList) ->
+ % Include is the list of nodes that must be included
+ %
+ % Node selection algorithm:
+ % 1. try to choose K nodes randomly from all the nodes which have
+ % more than ?MIN_FREE_SPACE bytes free space available and which
+ % are not excluded or blacklisted.
+ % 2. if K nodes cannot be found this way, choose the K emptiest
+ % nodes which are not excluded or blacklisted.
+ Primary = ([N || {N, {Free, _Total}} <- Nodes, Free > ?MIN_FREE_SPACE / 1024]
+ -- (Exclude ++ BlackList)),
+ if length(Primary) >= K ->
+ {ok, Include ++ disco_util:choose_random(Primary -- Include , K - length(Include))};
+ true ->
+ Preferred = [N || {N, _} <- lists:reverse(lists:keysort(2, Nodes))],
+ Secondary = Include ++ lists:sublist(Preferred -- (Include ++ Exclude ++ BlackList),
+ K - length(Include)),
+ {ok, Secondary}
+ end.
+
+-type new_blob_result() :: too_many_replicas | {ok, [nonempty_string()]}.
+-spec do_new_blob(string()|object_name(), non_neg_integer(), [node()], [node()], [node()], [node_info()]) ->
+ new_blob_result().
+do_new_blob(_Obj, K, _Include, _Exclude, _BlackList, Nodes) when K > length(Nodes) ->
+ too_many_replicas;
+do_new_blob(Obj, K, Include, Exclude, BlackList, Nodes) ->
+ {ok, WriteNodes} = do_choose_write_nodes(Nodes, K, Include, Exclude, BlackList),
+ Urls = [["http://", disco:host(N), ":", get(put_port), "/ddfs/", Obj]
+ || N <- WriteNodes],
+ {ok, Urls}.
+
+% Tag request: Start a new tag server if one doesn't exist already. Forward
+% the request to the tag server.
+
+-spec get_tag_pid(tagname(), gb_trees:tree(), false | gb_sets:set()) ->
+ {pid(), gb_trees:tree()}.
+get_tag_pid(Tag, Tags, Cache) ->
+ case gb_trees:lookup(Tag, Tags) of
+ none ->
+ NotFound = (Cache =/= false
+ andalso not gb_sets:is_element(Tag, Cache)),
+ {ok, Server} = ddfs_tag:start(Tag, NotFound),
+ erlang:monitor(process, Server),
+ {Server, gb_trees:insert(Tag, Server, Tags)};
+ {value, P} ->
+ {P, Tags}
+ end.
+
+-spec do_tag_request(term(), tagname(), replyto(), state()) ->
+ state().
+do_tag_request(M, Tag, From, #state{tags = Tags, tag_cache = Cache} = S) ->
+ {Pid, TagsN} = get_tag_pid(Tag, Tags, Cache),
+ gen_server:cast(Pid, {M, From}),
+ S#state{tags = TagsN,
+ tag_cache = Cache =/= false andalso gb_sets:add(Tag, Cache)}.
+
+-spec do_tag_notify(term(), tagname(), state()) -> state().
+do_tag_notify(M, Tag, #state{tags = Tags, tag_cache = Cache} = S) ->
+ {Pid, TagsN} = get_tag_pid(Tag, Tags, Cache),
+ gen_server:cast(Pid, {notify, M}),
+ S#state{tags = TagsN,
+ tag_cache = Cache =/= false andalso gb_sets:add(Tag, Cache)}.
+
+-spec do_update_nodes(nodes_update(), state()) -> state().
+do_update_nodes(NewNodes, #state{nodes = Nodes, tags = Tags} = S) ->
+ WriteBlacklist = lists:sort([Node || {Node, false, _} <- NewNodes]),
+ ReadBlacklist = lists:sort([Node || {Node, _, false} <- NewNodes]),
+ OldNodes = gb_trees:from_orddict(Nodes),
+ UpdatedNodes = lists:keysort(1, [case gb_trees:lookup(Node, OldNodes) of
+ none ->
+ {Node, {0, 0}};
+ {value, OldStats} ->
+ {Node, OldStats}
+ end || {Node, _WB, _RB} <- NewNodes]),
+ if
+ UpdatedNodes =/= Nodes ->
+ _ = [gen_server:cast(Pid, {die, none}) || Pid <- gb_trees:values(Tags)],
+ spawn(fun() ->
+ {ok, ReadableNodes, RBSize} =
+ do_get_readable_nodes(UpdatedNodes, ReadBlacklist),
+ refresh_tag_cache(ReadableNodes, RBSize)
+ end),
+ S#state{nodes = UpdatedNodes,
+ write_blacklist = WriteBlacklist,
+ read_blacklist = ReadBlacklist,
+ tag_cache = false,
+ tags = gb_trees:empty()};
+ true ->
+ S#state{write_blacklist = WriteBlacklist,
+ read_blacklist = ReadBlacklist}
+ end.
+
+-spec do_update_nodestats(gb_trees:tree(), state()) -> state().
+do_update_nodestats(NewNodes, #state{nodes = Nodes} = S) ->
+ UpdatedNodes = [case gb_trees:lookup(Node, NewNodes) of
+ none ->
+ {Node, Stats};
+ {value, NewStats} ->
+ {Node, NewStats}
+ end || {Node, Stats} <- Nodes],
+ S#state{nodes = UpdatedNodes}.
+
+-spec do_tag_exit(pid(), state()) -> state().
+do_tag_exit(Pid, S) ->
+ NewTags = [X || {_, V} = X <- gb_trees:to_list(S#state.tags), V =/= Pid],
+ S#state{tags = gb_trees:from_orddict(NewTags)}.
+
+-spec do_get_tags(all | filter, [node()]) -> {[node()], [node()], [binary()]};
+ (safe, [node()]) -> {ok, [binary()]} | too_many_failed_nodes;
+ (gc, [node()]) -> {ok, [binary()], [node()]} | too_many_failed_nodes.
+do_get_tags(all, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ {Replies, Failed} =
+ gen_server:multi_call(Nodes, ddfs_node, get_tags, ?NODE_TIMEOUT),
+ {OkNodes, Tags} = lists:unzip(Replies),
+ {OkNodes, Failed, lists:usort(lists:flatten(Tags))}
+ end, do_get_tags_all);
+
+do_get_tags(filter, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ {OkNodes, Failed, Tags} = do_get_tags(all, Nodes),
+ case tag_operation(get_tagnames, <<"+deleted">>, ?NODEOP_TIMEOUT) of
+ {ok, Deleted} ->
+ TagSet = gb_sets:from_ordset(Tags),
+ DelSet = gb_sets:insert(<<"+deleted">>, Deleted),
+ NotDeleted = gb_sets:to_list(gb_sets:subtract(TagSet, DelSet)),
+ {OkNodes, Failed, NotDeleted};
+ E ->
+ E
+ end
+ end, do_get_tags_filter);
+
+do_get_tags(safe, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")),
+ case do_get_tags(filter, Nodes) of
+ {_OkNodes, Failed, Tags} when length(Failed) < TagMinK ->
+ {ok, Tags};
+ _ ->
+ too_many_failed_nodes
+ end
+ end, do_get_tags_safe);
+
+% The returned tag list may include +deleted.
+do_get_tags(gc, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ {OkNodes, Failed, Tags} = do_get_tags(all, Nodes),
+ TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")),
+ case length(Failed) < TagMinK of
+ false ->
+ too_many_failed_nodes;
+ true ->
+ case tag_operation(get_tagnames, <<"+deleted">>, ?NODEOP_TIMEOUT) of
+ {ok, Deleted} ->
+ TagSet = gb_sets:from_ordset(Tags),
+ NotDeleted = gb_sets:subtract(TagSet, Deleted),
+ {ok, gb_sets:to_list(NotDeleted), OkNodes};
+ E ->
+ E
+ end
+ end
+ end, do_get_tags_gc).
+
+% Timeouts in this call by the below processes can cause ddfs_master
+% itself to crash, since the processes are linked to it.
+-spec safe_get_read_nodes() -> {ok, [node()], non_neg_integer()} | error.
+safe_get_read_nodes() ->
+ try get_read_nodes() of
+ {ok, _ReadableNodes, _RBSize} = RN ->
+ RN;
+ E ->
+ lager:error("unexpected response retrieving readable nodes: ~p", [E]),
+ error
+ catch
+ K:E ->
+ lager:error("error retrieving readable nodes: ~p:~p", [K, E]),
+ error
+ end.
+
+-spec monitor_diskspace() -> no_return().
+monitor_diskspace() ->
+ case safe_get_read_nodes() of
+ {ok, ReadableNodes, _RBSize} ->
+ {Space, _F} = gen_server:multi_call(ReadableNodes,
+ ddfs_node,
+ get_diskspace,
+ ?NODE_TIMEOUT),
+ update_nodestats(gb_trees:from_orddict(lists:keysort(1, Space)));
+ error ->
+ ok
+ end,
+ timer:sleep(?DISKSPACE_INTERVAL),
+ monitor_diskspace().
+
+-spec refresh_tag_cache_proc() -> no_return().
+refresh_tag_cache_proc() ->
+ case safe_get_read_nodes() of
+ {ok, ReadableNodes, RBSize} ->
+ refresh_tag_cache(ReadableNodes, RBSize);
+ error ->
+ ok
+ end,
+ receive
+ refresh ->
+ ok
+ after ?TAG_CACHE_INTERVAL ->
+ ok
+ end,
+ refresh_tag_cache_proc().
+
+-spec refresh_tag_cache([node()], non_neg_integer()) -> ok.
+refresh_tag_cache(Nodes, BLSize) ->
+ TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")),
+ {Replies, Failed} =
+ gen_server:multi_call(Nodes, ddfs_node, get_tags, ?NODE_TIMEOUT),
+ if Nodes =/= [], length(Failed) + BLSize < TagMinK ->
+ {_OkNodes, Tags} = lists:unzip(Replies),
+ update_tag_cache(gb_sets:from_list(lists:flatten(Tags)));
+ true -> ok
+ end.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl
new file mode 100644
index 0000000000..2920b67fc5
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl
@@ -0,0 +1,19 @@
+
+-type tokentype() :: 'read' | 'write'.
+-type user_attr() :: [{binary(), binary()}].
+% An 'internal' token is also used by internal consumers, but never stored.
+-type token() :: 'null' | binary().
+
+-type tagname() :: binary().
+-type tagid() :: binary().
+
+-type attrib() :: 'urls' | 'read_token' | 'write_token' | {'user', binary()}.
+
+-record(tagcontent, {id :: tagid(),
+ last_modified :: binary(),
+ read_token = null :: token(),
+ write_token = null :: token(),
+ urls = [] :: [[binary()]],
+ user = [] :: user_attr()}).
+
+-type tagcontent() :: #tagcontent{}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl
new file mode 100644
index 0000000000..d579e9a7d7
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl
@@ -0,0 +1,16 @@
+% This is a set of type utilities to be used when spec-cing the
+% callbacks of a gen_server implementation. It should be included in
+% the impl module, which needs to define the state() type.
+
+-type gs_init() :: {ok, state()}.
+-type gs_reply(T) :: {reply, (T), state()}.
+-type gs_noreply() :: {noreply, state()}.
+-type gs_noreply_t() :: {noreply, state(), non_neg_integer()}.
+-type gs_stop(T) :: {stop, (T), state()}.
+
+% Generic utilities.
+
+-type server() :: pid() | atom() | {atom(), node()}.
+-type from() :: {pid(), term()}.
+
+-type dbg_state_msg() :: dbg_get_state.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl
new file mode 100644
index 0000000000..19e61a7944
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl
@@ -0,0 +1,11 @@
+%%
+%% File: maps_difftype.erl
+%% Author: Björn-Egil Dahlberg
+%% Created: 2014-04-29
+%%
+-module(maps_difftype).
+
+-export([empty_mismatch/1]).
+
+empty_mismatch(Tuple) when is_tuple(Tuple) ->
+ case Tuple of #{} -> ok end.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl
new file mode 100644
index 0000000000..c34fa1b9dd
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl
@@ -0,0 +1,11 @@
+-module(remote_field).
+
+-type f(T) :: {ssl:sslsocket(), T}.
+
+-record(r1, { f1 :: f(_) }).
+-type r1(T) :: #r1{ f1 :: fun((ssl:sslsocket(), T) -> any()) }.
+
+-record(state, {
+ r :: r1(T),
+ arg :: T
+ }).
diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl
new file mode 100644
index 0000000000..35687e22ec
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl
@@ -0,0 +1,17 @@
+-module(remote_field2).
+
+-export([handle_cast/2]).
+
+-record(state, {tcp_socket :: inet:socket()}).
+
+-spec handle_cast(_,_) ->
+ {noreply,_} |
+ {stop,{shutdown,connection_closed},
+ #state{tcp_socket :: port()}}.
+handle_cast({send, Message}, #state{tcp_socket = TCPSocket} = State) ->
+ case gen_tcp:send(TCPSocket, Message) of
+ ok ->
+ {noreply, State};
+ {error, closed} ->
+ {stop, {shutdown, connection_closed}, State}
+ end.
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 7d6a28e51c..ab9ad25a3a 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -227,7 +227,7 @@ question is as if a callback had taken place and returned
<c>{error, failure}</c>.</p>
<p>
-Defaults to <c>report</c> if unspecified.</p>
+Defaults to <c>discard</c> if unspecified.</p>
</item>
<tag><c>{request_errors, answer_3xxx|answer|callback}</c></tag>
diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml
index 675ffcfd18..68e69dbfeb 100644
--- a/lib/diameter/doc/src/notes.xml
+++ b/lib/diameter/doc/src/notes.xml
@@ -238,7 +238,7 @@ first.</p>
<section><title>diameter 1.4.4</title>
- <section><title>Known Bugs and Problems</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
<list>
<item>
<p>
diff --git a/lib/diameter/examples/code/client.erl b/lib/diameter/examples/code/client.erl
index bfe71b0e56..46eb4a55db 100644
--- a/lib/diameter/examples/code/client.erl
+++ b/lib/diameter/examples/code/client.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/diameter/examples/code/client_cb.erl b/lib/diameter/examples/code/client_cb.erl
index ee3dcb2fec..843cdd9262 100644
--- a/lib/diameter/examples/code/client_cb.erl
+++ b/lib/diameter/examples/code/client_cb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -77,23 +77,11 @@ prepare_retransmit(Packet, SvcName, Peer) ->
%% handle_answer/4
-%% Since client.erl has detached the call when using the list
-%% encoding and not otherwise, output to the terminal in the
-%% the former case, return in the latter.
-
-handle_answer(#diameter_packet{msg = Msg}, Request, _SvcName, _Peer)
- when is_list(Request) ->
- io:format("answer: ~p~n", [Msg]);
-
handle_answer(#diameter_packet{msg = Msg}, _Request, _SvcName, _Peer) ->
{ok, Msg}.
%% handle_error/4
-handle_error(Reason, Request, _SvcName, _Peer)
- when is_list(Request) ->
- io:format("error: ~p~n", [Reason]);
-
handle_error(Reason, _Request, _SvcName, _Peer) ->
{error, Reason}.
diff --git a/lib/diameter/examples/code/redirect_cb.erl b/lib/diameter/examples/code/redirect_cb.erl
index 69836774a1..8d98b0d2df 100644
--- a/lib/diameter/examples/code/redirect_cb.erl
+++ b/lib/diameter/examples/code/redirect_cb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -34,12 +34,10 @@
-define(UNEXPECTED, erlang:error({unexpected, ?MODULE, ?LINE})).
-peer_up(_SvcName, {PeerRef, _}, State) ->
- io:format("up: ~p~n", [PeerRef]),
+peer_up(_SvcName, _Peer, State) ->
State.
-peer_down(_SvcName, {PeerRef, _}, State) ->
- io:format("down: ~p~n", [PeerRef]),
+peer_down(_SvcName, _Peer, State) ->
State.
pick_peer(_, _, _SvcName, _State) ->
diff --git a/lib/diameter/examples/code/relay_cb.erl b/lib/diameter/examples/code/relay_cb.erl
index 9f9cd8d5ae..68798014e6 100644
--- a/lib/diameter/examples/code/relay_cb.erl
+++ b/lib/diameter/examples/code/relay_cb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -32,12 +32,10 @@
handle_error/5,
handle_request/3]).
-peer_up(_SvcName, {PeerRef, _}, State) ->
- io:format("up: ~p~n", [PeerRef]),
+peer_up(_SvcName, _Peer, State) ->
State.
-peer_down(_SvcName, {PeerRef, _}, State) ->
- io:format("down: ~p~n", [PeerRef]),
+peer_down(_SvcName, _Peer, State) ->
State.
%% Returning 'relay' from handle_request causes diameter to resend the
diff --git a/lib/diameter/examples/code/server_cb.erl b/lib/diameter/examples/code/server_cb.erl
index 0f6eb32ed6..9d8d395d06 100644
--- a/lib/diameter/examples/code/server_cb.erl
+++ b/lib/diameter/examples/code/server_cb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -38,12 +38,10 @@
-define(UNEXPECTED, erlang:error({unexpected, ?MODULE, ?LINE})).
-peer_up(_SvcName, {PeerRef, _}, State) ->
- io:format("up: ~p~n", [PeerRef]),
+peer_up(_SvcName, _Peer, State) ->
State.
-peer_down(_SvcName, {PeerRef, _}, State) ->
- io:format("down: ~p~n", [PeerRef]),
+peer_down(_SvcName, _Peer, State) ->
State.
pick_peer(_, _, _SvcName, _State) ->
@@ -68,10 +66,13 @@ handle_request(#diameter_packet{msg = Req, errors = []}, _SvcName, {_, Caps})
origin_realm = {OR,_}}
= Caps,
#diameter_base_RAR{'Session-Id' = Id,
- 'Re-Auth-Request-Type' = RT}
+ 'Re-Auth-Request-Type' = Type}
= Req,
- {reply, answer(RT, Id, OH, OR)};
+ {reply, #diameter_base_RAA{'Result-Code' = rc(Type),
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR,
+ 'Session-Id' = Id}};
%% ... or one that wasn't. 3xxx errors are answered by diameter itself
%% but these are 5xxx errors for which we must contruct a reply.
@@ -84,32 +85,18 @@ handle_request(#diameter_packet{msg = Req}, _SvcName, {_, Caps})
#diameter_base_RAR{'Session-Id' = Id}
= Req,
- Ans = #diameter_base_RAA{'Origin-Host' = OH,
- 'Origin-Realm' = OR,
- 'Session-Id' = Id},
+ {reply, #diameter_base_RAA{'Origin-Host' = OH,
+ 'Origin-Realm' = OR,
+ 'Session-Id' = Id}};
- {reply, Ans};
+%% Answer that any other message is unsupported.
+handle_request(#diameter_packet{}, _SvcName, _) ->
+ {answer_message, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED
-%% Should really reply to other base messages that we don't support
-%% but simply discard them instead.
-handle_request(#diameter_packet{}, _SvcName, {_,_}) ->
- discard.
+%% Map Re-Auth-Request-Type to Result-Code just for the purpose of
+%% generating different answers.
-%% ---------------------------------------------------------------------------
-
-%% Answer using the record or list encoding depending on
-%% Re-Auth-Request-Type. This is just as an example. You would
-%% typically just choose one, and this has nothing to do with the how
-%% client.erl sends.
-
-answer(0, Id, OH, OR) ->
- #diameter_base_RAA{'Result-Code' = 2001, %% DIAMETER_SUCCESS
- 'Origin-Host' = OH,
- 'Origin-Realm' = OR,
- 'Session-Id' = Id};
-
-answer(_, Id, OH, OR) ->
- ['RAA', {'Result-Code', 5012}, %% DIAMETER_UNABLE_TO_COMPLY
- {'Origin-Host', OH},
- {'Origin-Realm', OR},
- {'Session-Id', Id}].
+rc(0) ->
+ 2001; %% DIAMETER_SUCCESS
+rc(_) ->
+ 5012. %% DIAMETER_UNABLE_TO_COMPLY
diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl
index 5a40e42300..c2c271a9a3 100644
--- a/lib/diameter/include/diameter.hrl
+++ b/lib/diameter/include/diameter.hrl
@@ -126,7 +126,7 @@
default,
extra = []}).
-%% The diameter service and diameter_apps records are only passed
+%% The diameter service and diameter_app records are only passed
%% through the transport interface when starting a transport process,
%% although typically a transport implementation will (and probably
%% should) only be interested host_ip_address.
@@ -143,6 +143,7 @@
init_state, %% option 'state', initial callback state
id, %% 32-bit unsigned application identifier = Dict:id()
mutable = false, %% boolean(), do traffic callbacks modify state?
- options = [{answer_errors, report}, %% | callback | discard
+ options = [{answer_errors, discard}, %% | callback | report
{request_errors, answer_3xxx}]}). %% | callback | answer
+
-endif. %% -ifdef(diameter_hrl).
diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl
index c8f706dc3e..7e91ce375f 100644
--- a/lib/diameter/include/diameter_gen.hrl
+++ b/lib/diameter/include/diameter_gen.hrl
@@ -30,6 +30,10 @@
%% error or not. See is_strict/0.
-define(STRICT_KEY, strict).
+%% Key that says whether or not we should do a best-effort decode
+%% within Failed-AVP.
+-define(FAILED_KEY, failed).
+
-type parent_name() :: atom(). %% parent = Message or AVP
-type parent_record() :: tuple(). %%
-type avp_name() :: atom().
@@ -286,15 +290,7 @@ decode(Name, 'AVP', Avp, Acc) ->
%% d/3
-%% Don't try to decode the value of a Failed-AVP component since it
-%% probably won't. Note that matching on 'Failed-AVP' assumes that
-%% this is the RFC AVP, with code 279. Strictly, this doesn't need to
-%% be the case, so we're assuming no one defines another Failed-AVP.
-d('Failed-AVP' = Name, Avp, Acc) ->
- decode_AVP(Name, Avp, Acc);
-
-%% Or try to decode.
-d(Name, Avp, {Avps, Acc}) ->
+d(Name, Avp, Acc) ->
#diameter_avp{name = AvpName,
data = Data,
type = Type,
@@ -307,51 +303,81 @@ d(Name, Avp, {Avps, Acc}) ->
%% value around through the entire decode. The solution here is
%% simple in comparison, both to implement and to understand.
- Reset = relax(Type, M),
+ Strict = relax(Type, M),
+ %% Use the process dictionary again to keep track of whether we're
+ %% decoding within Failed-AVP and should ignore decode errors
+ %% altogether.
+
+ Failed = relax(Name), %% Not AvpName or else a failed Failed-AVP
+ %% decode is packed into 'AVP'.
try avp(decode, Data, AvpName) of
V ->
+ {Avps, T} = Acc,
{H, A} = ungroup(V, Avp),
- {[H | Avps], pack_avp(Name, A, Acc)}
+ {[H | Avps], pack_avp(Name, A, T)}
catch
error: Reason ->
- %% Failures here won't be visible since they're a "normal"
- %% occurrence if the peer sends a faulty AVP that we need to
- %% respond sensibly to. Log the occurence for traceability,
- %% but the peer will also receive info in the resulting
- %% answer-message.
- diameter_lib:log({decode, failure},
- ?MODULE,
- ?LINE,
- {Reason, Avp, erlang:get_stacktrace()}),
- {Rec, Failed} = Acc,
- {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}
+ d(undefined == Failed orelse is_failed(), Reason, Name, Avp, Acc)
after
- relax(Reset)
+ reset(?STRICT_KEY, Strict),
+ reset(?FAILED_KEY, Failed)
end.
+%% Ignore a decode error within Failed-AVP ...
+d(true, _, Name, Avp, Acc) ->
+ decode_AVP(Name, Avp, Acc);
+
+%% ... or not. Failures here won't be visible since they're a "normal"
+%% occurrence if the peer sends a faulty AVP that we need to respond
+%% sensibly to. Log the occurence for traceability, but the peer will
+%% also receive info in the resulting answer message.
+d(false, Reason, Name, Avp, {Avps, Acc}) ->
+ Stack = diameter_lib:get_stacktrace(),
+ diameter_lib:log(decode_error,
+ ?MODULE,
+ ?LINE,
+ {Reason, Name, Avp#diameter_avp.name, Stack}),
+ {Rec, Failed} = Acc,
+ {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}.
+
%% Set false in the process dictionary as soon as we see a Grouped AVP
%% that doesn't set the M-bit, so that is_strict() can say whether or
%% not to ignore the M-bit on an encapsulated AVP.
relax('Grouped', M) ->
- V = getr(?STRICT_KEY),
- if V == undefined andalso not M ->
+ case getr(?STRICT_KEY) of
+ undefined when not M ->
putr(?STRICT_KEY, M);
- true ->
+ _ ->
false
end;
relax(_, _) ->
false.
-%% Reset strictness.
-relax(undefined) ->
- eraser(?STRICT_KEY);
-relax(false) ->
- ok.
-
is_strict() ->
false /= getr(?STRICT_KEY).
+%% Set true in the process dictionary as soon as we see Failed-AVP.
+%% Matching on 'Failed-AVP' assumes that this is the RFC AVP.
+%% Strictly, this doesn't need to be the case.
+relax('Failed-AVP') ->
+ case getr(?FAILED_KEY) of
+ undefined ->
+ putr(?FAILED_KEY, true);
+ true = Yes ->
+ Yes
+ end;
+relax(_) ->
+ is_failed().
+
+is_failed() ->
+ true == getr(?FAILED_KEY).
+
+reset(Key, undefined) ->
+ eraser(Key);
+reset(_, _) ->
+ ok.
+
%% decode_AVP/3
%%
%% Don't know this AVP: see if it can be packed in an 'AVP' field
@@ -410,6 +436,23 @@ pack_avp(_, Arity, Avp, Acc) ->
%% pack_AVP/3
+%% 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.
+
+pack_AVP(_, #diameter_avp{data = <<0:1, Data/binary>>} = Avp, Acc) ->
+ {Rec, Failed} = Acc,
+ {Rec, [{5014, Avp#diameter_avp{data = Data}} | Failed]};
+
pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) ->
case pack_arity(Name, M) of
0 ->
@@ -422,7 +465,15 @@ pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) ->
%% Give Failed-AVP special treatment since it'll contain any
%% unrecognized mandatory AVP's.
pack_arity(Name, M) ->
- case Name /= 'Failed-AVP' andalso M andalso is_strict() of
+ NF = Name /= 'Failed-AVP' andalso not is_failed(),
+ %% 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. Note that we
+ %% can't just test not is_failed() since this will be 'true' when
+ %% packing an unknown AVP directly within Failed-AVP.
+ case NF andalso M andalso is_strict() of
true ->
0;
false ->
diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl
index 0de4d53973..06a4f5de64 100644
--- a/lib/diameter/src/base/diameter_codec.erl
+++ b/lib/diameter/src/base/diameter_codec.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -70,12 +70,15 @@ encode(Mod, #diameter_packet{} = Pkt) ->
try
e(Mod, Pkt)
catch
+ exit: {Reason, Stack, #diameter_header{} = H} = T ->
+ %% Exit with a header in the reason to let the caller
+ %% count encode errors.
+ ?LOG(encode_error, {Reason, Stack, H}),
+ exit({?MODULE, encode, T});
error: Reason ->
- %% Be verbose since a crash report may be truncated and
- %% encode errors are self-inflicted.
- X = {?MODULE, encode, {Reason, ?STACK}},
- diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}),
- exit(X)
+ T = {Reason, diameter_lib:get_stacktrace()},
+ ?LOG(encode_error, T),
+ exit({?MODULE, encode, T})
end;
encode(Mod, Msg) ->
@@ -87,53 +90,62 @@ encode(Mod, Msg) ->
msg = Msg}).
e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) ->
- Avps = encode_avps(As),
- Length = size(Avps) + 20,
-
- #diameter_header{version = Vsn,
- cmd_code = Code,
- application_id = Aid,
- hop_by_hop_id = Hid,
- end_to_end_id = Eid}
- = Hdr,
-
- Flags = make_flags(0, Hdr),
-
- Pkt#diameter_packet{header = Hdr,
- bin = <<Vsn:8, Length:24,
- Flags:8, Code:24,
- Aid:32,
- Hid:32,
- Eid:32,
- Avps/binary>>};
+ try encode_avps(As) of
+ Avps ->
+ Length = size(Avps) + 20,
+
+ #diameter_header{version = Vsn,
+ cmd_code = Code,
+ application_id = Aid,
+ hop_by_hop_id = Hid,
+ end_to_end_id = Eid}
+ = Hdr,
+
+ Flags = make_flags(0, Hdr),
+
+ Pkt#diameter_packet{header = Hdr,
+ bin = <<Vsn:8, Length:24,
+ Flags:8, Code:24,
+ Aid:32,
+ Hid:32,
+ Eid:32,
+ Avps/binary>>}
+ catch
+ error: Reason ->
+ exit({Reason, diameter_lib:get_stacktrace(), Hdr})
+ end;
-e(Mod, #diameter_packet{header = Hdr, msg = Msg} = Pkt) ->
+e(Mod, #diameter_packet{header = Hdr0, msg = Msg} = Pkt) ->
#diameter_header{version = Vsn,
hop_by_hop_id = Hid,
end_to_end_id = Eid}
- = Hdr,
+ = Hdr0,
MsgName = rec2msg(Mod, Msg),
- {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr),
- Flags = make_flags(Flags0, Hdr),
-
- Avps = encode_avps(Mod, MsgName, values(Msg)),
- Length = size(Avps) + 20,
-
- Pkt#diameter_packet{header = Hdr#diameter_header
- {length = Length,
- cmd_code = Code,
- application_id = Aid,
- is_request = 0 /= ?MASK(7, Flags),
- is_proxiable = 0 /= ?MASK(6, Flags),
- is_error = 0 /= ?MASK(5, Flags),
- is_retransmitted = 0 /= ?MASK(4, Flags)},
- bin = <<Vsn:8, Length:24,
- Flags:8, Code:24,
- Aid:32,
- Hid:32,
- Eid:32,
- Avps/binary>>}.
+ {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr0),
+ Flags = make_flags(Flags0, Hdr0),
+ Hdr = Hdr0#diameter_header{cmd_code = Code,
+ application_id = Aid,
+ is_request = 0 /= ?MASK(7, Flags),
+ is_proxiable = 0 /= ?MASK(6, Flags),
+ is_error = 0 /= ?MASK(5, Flags),
+ is_retransmitted = 0 /= ?MASK(4, Flags)},
+ Values = values(Msg),
+
+ try encode_avps(Mod, MsgName, Values) of
+ Avps ->
+ Length = size(Avps) + 20,
+ Pkt#diameter_packet{header = Hdr#diameter_header{length = Length},
+ bin = <<Vsn:8, Length:24,
+ Flags:8, Code:24,
+ Aid:32,
+ Hid:32,
+ Eid:32,
+ Avps/binary>>}
+ catch
+ error: Reason ->
+ exit({Reason, diameter_lib:get_stacktrace(), Hdr})
+ end.
%% make_flags/2
@@ -225,7 +237,7 @@ rec2msg(Mod, Rec) ->
%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors.
--spec decode(module(), #diameter_packet{} | bitstring())
+-spec decode(module(), #diameter_packet{} | binary())
-> #diameter_packet{}.
decode(Mod, Pkt) ->
@@ -259,34 +271,34 @@ decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) ->
decode_avps(MsgName, Mod, Pkt, collect_avps(Pkt));
decode(Id, Mod, Bin)
- when is_bitstring(Bin) ->
+ when is_binary(Bin) ->
decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}).
decode_avps(MsgName, Mod, Pkt, {E, Avps}) ->
- ?LOG(invalid, Pkt#diameter_packet.bin),
+ ?LOG(invalid_avp_length, Pkt#diameter_packet.header),
#diameter_packet{errors = Failed}
= P
= decode_avps(MsgName, Mod, Pkt, Avps),
P#diameter_packet{errors = [E | Failed]};
-decode_avps('', Mod, Pkt, Avps) -> %% unknown message ...
- ?LOG(unknown, {Mod, Pkt#diameter_packet.header}),
+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
%% msg = undefined identifies this case.
decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not
- {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps),
- ?LOGC([] /= Failed, failed, {Mod, Failed}),
+ {Rec, As, Errors} = Mod:decode_avps(MsgName, Avps),
+ ?LOGC([] /= Errors, decode_errors, Pkt#diameter_packet.header),
Pkt#diameter_packet{msg = Rec,
- errors = Failed,
+ errors = Errors,
avps = As}.
%%% ---------------------------------------------------------------------------
%%% # decode_header/1
%%% ---------------------------------------------------------------------------
--spec decode_header(bitstring())
+-spec decode_header(binary())
-> #diameter_header{}
| false.
@@ -297,7 +309,7 @@ decode_header(<<Version:8,
ApplicationId:32,
HopByHopId:32,
EndToEndId:32,
- _/bitstring>>) ->
+ _/binary>>) ->
<<R:1, P:1, E:1, T:1, _:4>>
= CmdFlags,
%% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored
@@ -410,7 +422,7 @@ msg_id(#diameter_header{application_id = A,
is_request = R}) ->
{A, C, if R -> 1; true -> 0 end};
-msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) ->
+msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/binary>>) ->
{ApplId, CmdCode, Rbit}.
%%% ---------------------------------------------------------------------------
@@ -421,17 +433,18 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) ->
%% order in the binary. Note also that grouped avp's aren't unraveled,
%% only those at the top level.
--spec collect_avps(#diameter_packet{} | bitstring())
+-spec collect_avps(#diameter_packet{} | binary())
-> [Avp]
| {Error, [Avp]}
when Avp :: #diameter_avp{},
Error :: {5014, #diameter_avp{}}.
collect_avps(#diameter_packet{bin = Bin}) ->
- <<_:20/binary, Avps/bitstring>> = Bin,
+ <<_:20/binary, Avps/binary>> = Bin,
collect_avps(Avps);
-collect_avps(Bin) ->
+collect_avps(Bin)
+ when is_binary(Bin) ->
collect_avps(Bin, 0, []).
collect_avps(<<>>, _, Acc) ->
@@ -461,7 +474,9 @@ collect_avps(Bin, N, Acc) ->
split_avp(Bin) ->
{Code, V, M, P, Len, HdrLen} = split_head(Bin),
- {Data, B} = split_data(Bin, HdrLen, Len - HdrLen),
+
+ <<_:HdrLen/binary, Rest/binary>> = Bin,
+ {Data, B} = split_data(Rest, Len - HdrLen),
{B, #diameter_avp{code = Code,
vendor_id = V,
@@ -471,17 +486,15 @@ split_avp(Bin) ->
%% split_head/1
-split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/bitstring>>) ->
+split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/binary>>) ->
{Code, V, M, P, Len, 12};
-split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/bitstring>>) ->
+split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/binary>>) ->
{Code, undefined, M, P, Len, 8};
-%% Header is truncated: pack_avp/1 will pad to the minimum header
-%% length.
-split_head(B)
- when is_bitstring(B) ->
- ?THROW({5014, #diameter_avp{data = B}}).
+%% Header is truncated.
+split_head(Bin) ->
+ ?THROW({5014, #diameter_avp{data = Bin}}).
%% 3588:
%%
@@ -516,34 +529,27 @@ split_head(B)
%% split_data/3
-split_data(Bin, HdrLen, Len)
- when 0 =< Len ->
- split_data(Bin, HdrLen, Len, (4 - (Len rem 4)) rem 4);
+split_data(Bin, Len) ->
+ Pad = (4 - (Len rem 4)) rem 4,
-split_data(_, _, _) ->
- invalid_avp_length().
+ %% Len might be negative here, but that ensures the failure of the
+ %% binary match.
-%% split_data/4
-
-split_data(Bin, HdrLen, Len, Pad) ->
case Bin of
- <<_:HdrLen/binary, Data:Len/binary, _:Pad/binary, Rest/bitstring>> ->
+ <<Data:Len/binary, _:Pad/binary, Rest/binary>> ->
{Data, Rest};
_ ->
- invalid_avp_length()
+ %% Header length points past the end of the message. 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. Here we don't
+ %% know type. If the type isn't known, then the decode
+ %% just strips the extra bit.
+ {<<0:1, Bin/binary>>, <<>>}
end.
-%% invalid_avp_length/0
-%%
-%% AVP Length doesn't mesh with payload. Induce a decode error by
-%% returning a payload that no valid Diameter type can have. This is
-%% so that a known AVP will result in 5014 error with a zero'd
-%% payload. Here we simply don't know how to construct this payload.
-%% (Yes, this solution is an afterthought.)
-
-invalid_avp_length() ->
- {<<0:1>>, <<>>}.
-
%%% ---------------------------------------------------------------------------
%%% # pack_avp/1
%%% ---------------------------------------------------------------------------
@@ -575,17 +581,23 @@ pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) ->
{Name, Type} = Dict:avp_name(Code, Vid),
pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}});
+%% ... with a truncated header ...
pack_avp(#diameter_avp{code = undefined, data = B})
- when is_bitstring(B) ->
+ when is_binary(B) ->
%% Reset the AVP Length of an AVP Header resulting from a 5014
%% error. The RFC doesn't explicitly say to do this but the
%% receiver can't correctly extract this and following AVP's
%% without a correct length. On the downside, the header doesn't
%% reveal if the received header has been padded.
Pad = 8*header_length(B) - bit_size(B),
- Len = size(<<H:5/binary, _:24, T/binary>> = <<B/bitstring, 0:Pad>>),
+ Len = size(<<H:5/binary, _:24, T/binary>> = <<B/binary, 0:Pad>>),
<<H/binary, Len:24, T/binary>>;
+%% ... from a dictionary compiled against old code in diameter_gen ...
+%% ... when ignoring errors in Failed-AVP ...
+pack_avp(#diameter_avp{data = <<0:1, B/binary>>} = A) ->
+ pack_avp(A#diameter_avp{data = B});
+
%% ... or as an iolist.
pack_avp(#diameter_avp{code = Code,
vendor_id = V,
diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl
index f5ea459fd0..dd1c9b73bb 100644
--- a/lib/diameter/src/base/diameter_config.erl
+++ b/lib/diameter/src/base/diameter_config.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -753,7 +753,7 @@ app_acc({application, Opts} = T, Acc) ->
Alias = get_opt(alias, Opts, Dict),
ModS = get_opt(state, Opts, Alias),
M = get_opt(call_mutates_state, Opts, false, [true]),
- A = get_opt(answer_errors, Opts, report, [callback, discard]),
+ A = get_opt(answer_errors, Opts, discard, [callback, report]),
P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]),
[#diameter_app{alias = Alias,
dictionary = Dict,
diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl
index 44d81e2778..5b3a2063f8 100644
--- a/lib/diameter/src/base/diameter_lib.erl
+++ b/lib/diameter/src/base/diameter_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -25,6 +25,8 @@
now_diff/1,
time/1,
eval/1,
+ eval_name/1,
+ get_stacktrace/0,
ipaddr/1,
spawn_opts/2,
wait/1,
@@ -32,6 +34,22 @@
log/4]).
%% ---------------------------------------------------------------------------
+%% # get_stacktrace/0
+%% ---------------------------------------------------------------------------
+
+%% Return a stacktrace with a leading, potentially large, argument
+%% list replaced by an arity. Trace on stacktrace/0 to see the
+%% original.
+
+get_stacktrace() ->
+ stacktrace(erlang:get_stacktrace()).
+
+stacktrace([{M,F,A,L} | T]) when is_list(A) ->
+ [{M, F, length(A), L} | T];
+stacktrace(L) ->
+ L.
+
+%% ---------------------------------------------------------------------------
%% # info_report/2
%% ---------------------------------------------------------------------------
@@ -60,9 +78,17 @@ warning_report(Reason, T) ->
report(fun error_logger:warning_report/1, Reason, T).
report(Fun, Reason, T) ->
- Fun([{why, Reason}, {who, self()}, {what, T}]),
+ Fun(io_lib:format("diameter: ~" ++ fmt(Reason) ++ "~n ~p~n",
+ [Reason, T])),
false.
+fmt(T) ->
+ if is_list(T) ->
+ "s";
+ true ->
+ "p"
+ end.
+
%% ---------------------------------------------------------------------------
%% # now_diff/1
%% ---------------------------------------------------------------------------
@@ -129,8 +155,8 @@ eval({M,F,A}) ->
eval([{M,F,A} | X]) ->
apply(M, F, X ++ A);
-eval([[F|A] | X]) ->
- eval([F | X ++ A]);
+eval([[F|X] | A]) ->
+ eval([F | A ++ X]);
eval([F|A]) ->
apply(F,A);
@@ -142,6 +168,28 @@ eval(F) ->
F().
%% ---------------------------------------------------------------------------
+%% eval_name/1
+%% ---------------------------------------------------------------------------
+
+eval_name({M,F,A}) ->
+ {M, F, length(A)};
+
+eval_name([{M,F,A} | X]) ->
+ {M, F, length(A) + length(X)};
+
+eval_name([[F|A] | X]) ->
+ eval_name([F | X ++ A]);
+
+eval_name([F|_]) ->
+ F;
+
+eval_name({F}) ->
+ eval_name(F);
+
+eval_name(F) ->
+ F.
+
+%% ---------------------------------------------------------------------------
%% # ipaddr/1
%%
%% Parse an IP address.
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index f76bd96c3c..31e570ae20 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -283,7 +283,7 @@ handle_info(T, #state{} = State) ->
ok ->
{noreply, State};
#state{state = X} = S ->
- ?LOGC(X =/= State#state.state, transition, X),
+ ?LOGC(X /= State#state.state, transition, X),
{noreply, S};
{stop, Reason} ->
?LOG(stop, Reason),
@@ -292,15 +292,12 @@ handle_info(T, #state{} = State) ->
?LOG(stop, T),
{stop, {shutdown, T}, State}
catch
- exit: {diameter_codec, encode, _} = Reason ->
+ exit: {diameter_codec, encode, T} = Reason ->
+ incr_error(send, T, State#state.dictionary),
?LOG(stop, Reason),
- %% diameter_codec:encode/2 emits an error report. Only
- %% indicate the probable reason here.
- diameter_lib:info_report(probable_configuration_error,
- insufficient_capabilities),
{stop, {shutdown, Reason}, State};
{?MODULE, Tag, Reason} ->
- ?LOG(Tag, {Reason, T}),
+ ?LOG(stop, Tag),
{stop, {shutdown, Reason}, State}
end.
%% The form of the throw caught here is historical. It's
@@ -476,12 +473,12 @@ send_CER(#state{state = {'Wait-Conn-Ack', Tmo},
orelse
close({already_connected, Remote, LCaps}),
CER = build_CER(S),
- ?LOG(send, 'CER'),
#diameter_packet{header = #diameter_header{end_to_end_id = Eid,
hop_by_hop_id = Hid}}
= Pkt
= encode(CER, Dict),
send(TPid, Pkt),
+ ?LOG(send, 'CER'),
start_timer(Tmo, S#state{state = {'Wait-CEA', Hid, Eid}}).
%% Register ourselves as connecting to the remote endpoint in
@@ -526,7 +523,6 @@ recv(#diameter_packet{header = #diameter_header{} = Hdr}
= S) ->
Name = diameter_codec:msg_name(Dict0, Hdr),
Pid ! {recv, self(), Name, Pkt},
- diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received
rcv(Name, Pkt, S);
recv(#diameter_packet{header = undefined,
@@ -553,42 +549,30 @@ recv(#diameter_header{length = Len}
recv(#diameter_header{}
= H,
#diameter_packet{bin = Bin},
- #state{length_errors = E}
- = S) ->
- invalid(E,
- invalid_message_length,
- recv,
- [size(Bin), bit_size(Bin) rem 8, H, S]);
+ #state{length_errors = E}) ->
+ T = {size(Bin), bit_size(Bin) rem 8, H},
+ invalid(E, message_length_mismatch, T);
-recv(false, Pkt, #state{length_errors = E} = S) ->
- invalid(E, truncated_header, recv, [Pkt, S]).
+recv(false, #diameter_packet{bin = Bin}, #state{length_errors = E}) ->
+ invalid(E, truncated_header, Bin).
%% Note that counters here only count discarded messages.
-invalid(E, Reason, F, A) ->
+invalid(E, Reason, T) ->
diameter_stats:incr(Reason),
- abort(E, Reason, F, A).
-
-abort(exit, Reason, F, A) ->
- diameter_lib:warning_report(Reason, {?MODULE, F, A}),
- throw({?MODULE, abort, Reason});
-
-abort(_, _, _, _) ->
+ E == exit andalso close({Reason, T}),
+ ?LOG(Reason, T),
ok.
-msg_id({_,_,_} = T, _) ->
- T;
-msg_id(_, Hdr) ->
- {_,_,_} = diameter_codec:msg_id(Hdr).
-
%% rcv/3
%% Incoming CEA.
-rcv('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) ->
+ ?LOG(recv, N),
handle_CEA(Pkt, S);
%% Incoming CER
@@ -609,34 +593,71 @@ rcv('DPR' = N, Pkt, S) ->
%% DPA in response to DPR and with the expected identifiers.
rcv('DPA' = N,
#diameter_packet{header = #diameter_header{end_to_end_id = Eid,
- hop_by_hop_id = Hid}},
- #state{transport = TPid,
+ hop_by_hop_id = Hid}
+ = H}
+ = Pkt,
+ #state{dictionary = Dict0,
+ transport = TPid,
dpr = {Hid, Eid}}) ->
+ ?LOG(recv, N),
+ incr(recv, H, Dict0),
+ incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0),
diameter_peer:close(TPid),
{stop, N};
%% Ignore anything else, an unsolicited DPA in particular.
+rcv(N, #diameter_packet{header = H}, _)
+ when N == 'CER';
+ N == 'CEA';
+ N == 'DPR';
+ N == 'DPA' ->
+ ?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(_, _, _) ->
ok.
+%% incr/3
+
+incr(Dir, Hdr, Dict0) ->
+ diameter_traffic:incr(Dir, Hdr, self(), Dict0).
+
+%% incr_rc/3
+
+incr_rc(Dir, Pkt, Dict0) ->
+ diameter_traffic:incr_rc(Dir, Pkt, self(), Dict0).
+
+%% incr_error/3
+
+incr_error(Dir, Pkt, Dict0) ->
+ diameter_traffic:incr_error(Dir, Pkt, self(), Dict0).
+
%% send/2
%% Msg here could be a #diameter_packet or a binary depending on who's
%% sending. In particular, the watchdog will send DWR as a binary
%% while messages coming from clients will be in a #diameter_packet.
send(Pid, Msg) ->
- diameter_stats:incr({diameter_codec:msg_id(Msg), send}),
diameter_peer:send(Pid, Msg).
%% handle_request/3
+%%
+%% Incoming CER or DPR.
-handle_request(Type, #diameter_packet{} = Pkt, #state{dictionary = D} = S) ->
- ?LOG(recv, Type),
- send_answer(Type, diameter_codec:decode(D, Pkt), S).
+handle_request(Name,
+ #diameter_packet{header = H} = Pkt,
+ #state{dictionary = Dict0} = S) ->
+ ?LOG(recv, Name),
+ incr(recv, H, Dict0),
+ send_answer(Name, diameter_codec:decode(Dict0, Pkt), S).
%% send_answer/3
send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) ->
+ incr_error(recv, ReqPkt, Dict),
+
#diameter_packet{header = H,
transport_data = TD}
= ReqPkt,
@@ -653,13 +674,19 @@ send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) ->
msg = Msg,
transport_data = TD},
- send(TPid, diameter_codec:encode(Dict, Pkt)),
+ AnsPkt = diameter_codec:encode(Dict, Pkt),
+
+ incr(send, AnsPkt, Dict),
+ incr_rc(send, AnsPkt, Dict),
+ send(TPid, AnsPkt),
+ ?LOG(send, ans(Type)),
eval(PostF, S).
+ans('CER') -> 'CEA';
+ans('DPR') -> 'DPA'.
+
eval([F|A], S) ->
apply(F, A ++ [S]);
-eval(ok, S) ->
- S;
eval(T, _) ->
close(T).
@@ -723,8 +750,8 @@ cea(CEA, RC, Dict0) ->
post('CER' = T, RC, Pkt, S) ->
{T, caps(S), {RC, Pkt}};
-post('DPR', _, _, _) ->
- ok.
+post('DPR' = T, _, _, #state{parent = Pid}) ->
+ [fun(S) -> Pid ! {T, self()}, S end].
rejected({capabilities_cb, _F, Reason}, T, S) ->
rejected(Reason, T, S);
@@ -734,7 +761,7 @@ rejected(discard, T, _) ->
rejected({N, Es}, T, S) ->
{answer('CER', N, failed_avp(N, Es), S), T};
rejected(N, T, S) ->
- rejected({N, []}, T, S).
+ {answer('CER', N, [], S), T}.
failed_avp(RC, [{RC, Avp} | _]) ->
[{'Failed-AVP', [[{'AVP', [Avp]}]]}];
@@ -848,28 +875,27 @@ recv_CER(CER, #state{service = Svc, dictionary = Dict}) ->
close({'CER', CER, Svc, Dict, Reason})
end.
-%% handle_CEA/1
+%% handle_CEA/2
-handle_CEA(#diameter_packet{bin = Bin}
+handle_CEA(#diameter_packet{header = H}
= Pkt,
#state{dictionary = Dict0,
service = #diameter_service{capabilities = LCaps}}
- = S)
- when is_binary(Bin) ->
- ?LOG(recv, 'CEA'),
+ = S) ->
+ incr(recv, H, Dict0),
- #diameter_packet{msg = CEA}
+ #diameter_packet{}
= DPkt
= diameter_codec:decode(Dict0, Pkt),
+ RC = result_code(incr_rc(recv, DPkt, Dict0)),
+
{SApps, IS, RCaps} = recv_CEA(DPkt, S),
#diameter_caps{origin_host = {OH, DH}}
= Caps
= capz(LCaps, RCaps),
- RC = Dict0:'#get-'('Result-Code', CEA),
-
%% Ensure that we don't already have a connection to the peer in
%% question. This isn't the peer election of 3588 except in the
%% sense that, since we don't know who we're talking to until we
@@ -877,7 +903,7 @@ handle_CEA(#diameter_packet{bin = Bin}
%% connection with the peer.
try
- ?IS_SUCCESS(RC)
+ is_integer(RC) andalso ?IS_SUCCESS(RC)
orelse ?THROW(RC),
[] == SApps
andalso ?THROW(no_common_application),
@@ -897,6 +923,11 @@ handle_CEA(#diameter_packet{bin = Bin}
%% capabilities exchange could send DIAMETER_LIMITED_SUCCESS = 2002,
%% even if this isn't required by RFC 3588.
+result_code({'Result-Code', N}) ->
+ N;
+result_code(_) ->
+ undefined.
+
%% recv_CEA/2
recv_CEA(#diameter_packet{header = #diameter_header{version
@@ -988,19 +1019,13 @@ capz(#diameter_caps{} = L, #diameter_caps{} = R) ->
tl(tuple_to_list(R)))]).
%% close/1
+%%
+%% A good function to trace on in case of problems with capabilities
+%% exchange.
close(Reason) ->
- report(Reason),
throw({?MODULE, close, Reason}).
-%% Could possibly log more here.
-report({M, _, _, _, _} = T)
- when M == 'CER';
- M == 'CEA' ->
- diameter_lib:error_report(failure, T);
-report(_) ->
- ok.
-
%% dpr/2
%%
%% The RFC isn't clear on whether DPR should be send in a non-Open
@@ -1034,7 +1059,7 @@ dpr(_Reason, _S) ->
%% process and contact it. (eg. diameter:service_info/2)
dpr([CB|Rest], [Reason | _] = Args, S) ->
- try diameter_lib:eval([CB | Args]) of
+ case diameter_lib:eval([CB | Args]) of
{dpr, Opts} when is_list(Opts) ->
send_dpr(Reason, Opts, S);
dpr ->
@@ -1044,14 +1069,7 @@ dpr([CB|Rest], [Reason | _] = Args, S) ->
ignore ->
dpr(Rest, Args, S);
T ->
- No = {disconnect_cb, T},
- diameter_lib:error_report(invalid, No),
- {stop, No}
- catch
- E:R ->
- No = {disconnect_cb, E, R, ?STACK},
- diameter_lib:error_report(failure, No),
- {stop, No}
+ ?ERROR({disconnect_cb, CB, Args, T})
end;
dpr([], [Reason | _], S) ->
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index 8914992f17..b7cd311e02 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -499,9 +499,21 @@ transition(Req, S) ->
%% # terminate/2
%% ---------------------------------------------------------------------------
-terminate(Reason, #state{service_name = Name} = S) ->
+terminate(Reason, #state{service_name = Name, peerT = PeerT} = S) ->
send_event(Name, stop),
ets:delete(?STATE_TABLE, Name),
+
+ %% Communicate pending loss of any peers that connection_down/3
+ %% won't. This is needed when stopping a service since we don't
+ %% wait for watchdog state changes to take care of if. That this
+ %% takes place after deleting the state entry ensures that the
+ %% resulting failover by request processes accomplishes nothing.
+ ets:foldl(fun(#peer{pid = TPid}, _) ->
+ diameter_traffic:peer_down(TPid)
+ end,
+ ok,
+ PeerT),
+
shutdown == Reason %% application shutdown
andalso shutdown(application, S).
@@ -719,14 +731,27 @@ remotes(F) ->
L when is_list(L) ->
L;
T ->
- diameter_lib:error_report({invalid_return, T}, F),
+ ?LOG(invalid_return, {F,T}),
+ error_report(invalid_return, share_peers, F),
[]
catch
E:R ->
- diameter_lib:error_report({failure, {E, R, ?STACK}}, F),
+ ?LOG(failure, {E, R, F, diameter_lib:get_stacktrace()}),
+ error_report(failure, share_peers, F),
[]
end.
+%% error_report/3
+
+error_report(T, What, F) ->
+ Reason = io_lib:format("~s from ~p callback", [reason(T), What]),
+ diameter_lib:error_report(Reason, diameter_lib:eval_name(F)).
+
+reason(invalid_return) ->
+ "invalid return";
+reason(failure) ->
+ "failure".
+
%% ---------------------------------------------------------------------------
%% # start/3
%% ---------------------------------------------------------------------------
@@ -869,7 +894,7 @@ watchdog(TPid, [], ?WD_OKAY, ?WD_SUSPECT = To, Wd, State) ->
%% Watchdog has lost its connection.
watchdog(TPid, [], _, ?WD_DOWN = To, Wd, #state{peerT = PeerT} = S) ->
- close(Wd, S),
+ close(Wd),
watchdog_down(Wd, To, S),
ets:delete(PeerT, TPid);
@@ -1026,8 +1051,11 @@ peer_cb(App, F, A) ->
true
catch
E:R ->
- diameter_lib:error_report({failure, {E, R, ?STACK}},
- {App, F, A}),
+ %% Don't include arguments since a #diameter_caps{} strings
+ %% from the peer, which could be anything (especially, large).
+ [Mod|X] = App#diameter_app.module,
+ ?LOG(failure, {E, R, Mod, F, diameter_lib:get_stacktrace()}),
+ error_report(failure, F, {Mod, F, A ++ X}),
false
end.
@@ -1187,26 +1215,16 @@ tc(false = No, _, _) -> %% removed
%% another watchdog to be able to detect that it should transition
%% from initial into reopen rather than okay. That someone is either
%% the accepting watchdog upon reception of a CER from the previously
-%% connected peer, or us after connect_timer timeout.
+%% connected peer, or us after connect_timer timeout or immediately.
-close(#watchdog{type = connect}, _) ->
+close(#watchdog{type = connect}) ->
ok;
+
close(#watchdog{type = accept,
pid = Pid,
- ref = Ref,
- options = Opts},
- #state{service_name = SvcName}) ->
- c(Pid, diameter_config:have_transport(SvcName, Ref), Opts).
-
-%% Tell watchdog to (maybe) die later ...
-c(Pid, true, Opts) ->
+ options = Opts}) ->
Tc = connect_timer(Opts, 2*?DEFAULT_TC),
- erlang:send_after(Tc, Pid, close);
-
-%% ... or now.
-c(Pid, false, _Opts) ->
- Pid ! close.
-
+ erlang:send_after(Tc, Pid, close).
%% The RFC's only document the behaviour of Tc, our connect_timer,
%% for the establishment of connections but we also give
%% connect_timer semantics for a listener, being the time within
@@ -1260,13 +1278,14 @@ cm([#diameter_app{alias = Alias} = App], Req, From, Svc) ->
mod_state(Alias, ModS),
{T, RC};
T ->
- diameter_lib:error_report({invalid, T},
- {App, handle_call, Args}),
+ ModX = App#diameter_app.module,
+ ?LOG(invalid_return, {ModX, handle_call, Args, T}),
invalid
catch
E: Reason ->
- diameter_lib:error_report({failure, {E, Reason, ?STACK}},
- {App, handle_call, Args}),
+ ModX = App#diameter_app.module,
+ Stack = diameter_lib:get_stacktrace(),
+ ?LOG(failure, {E, Reason, ModX, handle_call, Stack}),
failure
end;
@@ -1424,13 +1443,16 @@ pick_peer(Local,
T; %% Accept returned state in the immutable
{false = No, S} -> %% case as long it isn't changed.
No;
- T ->
- diameter_lib:error_report({invalid, T, App},
- {App, pick_peer, Args})
+ T when M ->
+ ModX = App#diameter_app.module,
+ ?LOG(invalid_return, {ModX, pick_peer, T}),
+ false
catch
- E: Reason ->
- diameter_lib:error_report({failure, {E, Reason, ?STACK}},
- {App, pick_peer, Args})
+ E: Reason when M ->
+ ModX = App#diameter_app.module,
+ Stack = diameter_lib:get_stacktrace(),
+ ?LOG(failure, {E, Reason, ModX, pick_peer, Stack}),
+ false
end.
%% peers/4
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index 7fbb306b02..5fac61f416 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -31,6 +31,11 @@
%% towards diameter_watchdog
-export([receive_message/4]).
+%% towards diameter_peer_fsm and diameter_watchdog
+-export([incr/4,
+ incr_error/4,
+ incr_rc/4]).
+
%% towards diameter_service
-export([make_recvdata/1,
peer_up/1,
@@ -44,6 +49,8 @@
-include_lib("diameter/include/diameter.hrl").
-include("diameter_internal.hrl").
+-define(LOGX(Reason, T), begin ?LOG(Reason, T), x({Reason, T}) end).
+
-define(RELAY, ?DIAMETER_DICT_RELAY).
-define(BASE, ?DIAMETER_DICT_COMMON). %% Note: the RFC 3588 dictionary
@@ -109,6 +116,67 @@ peer_down(TPid) ->
failover(TPid).
%% ---------------------------------------------------------------------------
+%% incr/4
+%% ---------------------------------------------------------------------------
+
+incr(Dir, #diameter_packet{header = H}, TPid, Dict) ->
+ incr(Dir, H, TPid, Dict);
+
+incr(Dir, #diameter_header{} = H, TPid, Dict) ->
+ incr(TPid, {msg_id(H, Dict), Dir}).
+
+%% ---------------------------------------------------------------------------
+%% incr_error/4
+%% ---------------------------------------------------------------------------
+
+%% Decoded message without errors.
+incr_error(recv, #diameter_packet{errors = []}, _, _) ->
+ ok;
+
+incr_error(recv = D, #diameter_packet{header = H}, TPid, Dict) ->
+ incr_error(D, H, TPid, Dict);
+
+%% Encoded message with errors and an identifiable header ...
+incr_error(send = D, {_, _, #diameter_header{} = H}, TPid, Dict) ->
+ incr_error(D, H, TPid, Dict);
+
+%% ... or not.
+incr_error(send = D, {_,_}, TPid, _) ->
+ incr_error(D, unknown, TPid);
+
+incr_error(Dir, #diameter_header{} = H, TPid, Dict) ->
+ incr_error(Dir, msg_id(H, Dict), TPid);
+
+incr_error(Dir, Id, TPid, _) ->
+ incr_error(Dir, Id, TPid).
+
+incr_error(Dir, Id, TPid) ->
+ incr(TPid, {Id, Dir, error}).
+
+%% ---------------------------------------------------------------------------
+%% incr_rc/4
+%% ---------------------------------------------------------------------------
+
+-spec incr_rc(send|recv, Pkt, TPid, Dict0)
+ -> {Counter, non_neg_integer()}
+ | Reason
+ when Pkt :: #diameter_packet{},
+ TPid :: pid(),
+ Dict0 :: module(),
+ Counter :: {'Result-Code', integer()}
+ | {'Experimental-Result', integer(), integer()},
+ Reason :: atom().
+
+incr_rc(Dir, Pkt, TPid, Dict0) ->
+ try
+ incr_rc(Dir, Pkt, Dict0, TPid, Dict0)
+ catch
+ exit: {E,_} when E == no_result_code;
+ E == invalid_error_bit ->
+ E
+ end.
+
+%% ---------------------------------------------------------------------------
%% pending/1
%% ---------------------------------------------------------------------------
@@ -182,7 +250,7 @@ spawn_request(TPid, Pkt, Dict0, Opts, RecvData) ->
spawn_opt(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end, Opts)
catch
error: system_limit = E -> %% discard
- ?LOG({error, E}, now())
+ ?LOG(error, E)
end.
%% ---------------------------------------------------------------------------
@@ -211,7 +279,9 @@ recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps},
Pkt0,
Dict0,
RecvData) ->
+ incr(recv, Pkt0, TPid, Dict),
Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)),
+ incr_error(recv, Pkt, TPid, Dict),
{Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)};
%% Note that the decode is different depending on whether or not Id is
%% ?APP_ID_RELAY.
@@ -283,23 +353,25 @@ rc(N) ->
%% This error is returned when a request is received with an invalid
%% message length.
-errors(_, #diameter_packet{header = #diameter_header{length = Len},
+errors(_, #diameter_packet{header = #diameter_header{length = Len} = H,
bin = Bin,
errors = Es}
= Pkt)
when Len < 20;
0 /= Len rem 4;
8*Len /= bit_size(Bin) ->
+ ?LOG(invalid_message_length, {H, bit_size(Bin)}),
Pkt#diameter_packet{errors = [5015 | Es]};
%% DIAMETER_UNSUPPORTED_VERSION 5011
%% This error is returned when a request was received, whose version
%% number is unsupported.
-errors(_, #diameter_packet{header = #diameter_header{version = V},
+errors(_, #diameter_packet{header = #diameter_header{version = V} = H,
errors = Es}
= Pkt)
when V /= ?DIAMETER_VERSION ->
+ ?LOG(unsupported_version, H),
Pkt#diameter_packet{errors = [5011 | Es]};
%% DIAMETER_COMMAND_UNSUPPORTED 3001
@@ -307,12 +379,13 @@ errors(_, #diameter_packet{header = #diameter_header{version = V},
%% recognize or support. This MUST be used when a Diameter node
%% receives an experimental command that it does not understand.
-errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P},
+errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P} = H,
msg = M,
errors = Es}
= Pkt)
when ?APP_ID_RELAY /= Id, undefined == M; %% don't know the command
?APP_ID_RELAY == Id, not P -> %% command isn't proxiable
+ ?LOG(command_unsupported, H),
Pkt#diameter_packet{errors = [3001 | Es]};
%% DIAMETER_INVALID_HDR_BITS 3008
@@ -321,9 +394,11 @@ errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P},
%% inconsistent with the command code's definition.
errors(_, #diameter_packet{header = #diameter_header{is_request = true,
- is_error = true},
+ is_error = true}
+ = H,
errors = Es}
= Pkt) ->
+ ?LOG(invalid_hdr_bits, H),
Pkt#diameter_packet{errors = [3008 | Es]};
%% Green.
@@ -479,7 +554,6 @@ answer_message(RC,
origin_realm = {OR,_}},
Dict0,
Pkt) ->
- ?LOG({error, RC}, Pkt),
{Dict0, answer_message(OH, OR, RC, Dict0, Pkt)}.
%% resend/7
@@ -595,9 +669,11 @@ reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt)
reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) ->
Pkt = encode(Dict,
+ TPid,
reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0),
Fs),
- incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes
+ incr(send, Pkt, TPid, Dict),
+ incr_rc(send, Pkt, Dict, TPid, Dict0), %% count outgoing
send(TPid, Pkt).
%% reset/3
@@ -962,35 +1038,48 @@ find(Pred, [H|T]) ->
%% code, the missing vendor id, and a zero filled payload of the minimum
%% required length for the omitted AVP will be added.
-%% incr/4
+%% incr_rc/5
%%
%% Increment a stats counter for result codes in incoming and outgoing
%% answers.
%% Outgoing message as binary: don't count. (Sending binaries is only
%% partially supported.)
-incr(_, #diameter_packet{msg = undefined}, _, _, _) ->
- ok;
-
-%% Incoming with decode errors.
-incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) ->
- incr(TPid, {diameter_codec:msg_id(H), D, error});
+incr_rc(_, #diameter_packet{msg = undefined = No}, _, _, _) ->
+ No;
-%% Incoming without errors or outgoing. Outgoing with encode errors
-%% never gets here since encode fails.
-incr(Dir, Pkt, Dict, TPid, Dict0) ->
+%% Incoming or outgoing. Outgoing with encode errors never gets here
+%% since encode fails.
+incr_rc(Dir, Pkt, Dict, TPid, Dict0) ->
#diameter_packet{header = #diameter_header{is_error = E}
= Hdr,
- msg = Rec}
+ msg = Msg,
+ errors = Es}
= Pkt,
- RC = int(get_avp_value(Dict, 'Result-Code', Rec)),
+ Id = msg_id(Hdr, Dict),
+
+ %% Count incoming decode errors.
+ recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, Dict),
- %% Exit on an improper Result-Code.
+ %% Exit on a missing result code.
+ T = rc_counter(Dict, Msg),
+ T == false andalso ?LOGX(no_result_code, {Dict, Dir, Hdr}),
+ {Ctr, RC} = T,
+
+ %% Or on an inappropriate value.
is_result(RC, E, Dict0)
- orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]),
+ orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, RC}),
+
+ incr(TPid, {Id, Dir, Ctr}),
+ Ctr.
- irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)).
+%% Only count on known keeps so as not to be vulnerable to attack:
+%% there are 2^32 (application ids) * 2^24 (command codes) * 2 (R-bits)
+%% = 2^57 Ids for an attacker to choose from.
+msg_id(Hdr, Dict) ->
+ {_ApplId, Code, R} = Id = diameter_codec:msg_id(Hdr),
+ choose('' == Dict:msg_name(Code, 0 == R), unknown, Id).
%% No E-bit: can't be 3xxx.
is_result(RC, false, _Dict0) ->
@@ -1006,12 +1095,6 @@ is_result(RC, true, _) ->
orelse
5000 =< RC andalso RC < 6000.
-irc(_, _, _, undefined) ->
- false;
-
-irc(TPid, Hdr, Dir, Ctr) ->
- incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}).
-
%% incr/2
incr(TPid, Counter) ->
@@ -1024,14 +1107,16 @@ incr(TPid, Counter) ->
%% All Diameter answer messages defined in vendor-specific
%% applications MUST include either one Result-Code AVP or one
%% Experimental-Result AVP.
-%%
-%% Maintain statistics assuming one or the other, not both, which is
-%% surely the intent of the RFC.
-rc_counter(Dict, Rec, undefined) ->
- rcc(get_avp_value(Dict, 'Experimental-Result', Rec));
-rc_counter(_, _, RC) ->
- {'Result-Code', RC}.
+rc_counter(Dict, Msg) ->
+ rcc(Dict, Msg, int(get_avp_value(Dict, 'Result-Code', Msg))).
+
+rcc(Dict, Msg, undefined) ->
+ rcc(get_avp_value(Dict, 'Experimental-Result', Msg));
+
+rcc(_, _, N)
+ when is_integer(N) ->
+ {{'Result-Code', N}, N}.
%% Outgoing answers may be in any of the forms messages can be sent
%% in. Incoming messages will be records. We're assuming here that the
@@ -1039,12 +1124,12 @@ rc_counter(_, _, RC) ->
rcc([{_,_,N} = T | _])
when is_integer(N) ->
- T;
+ {T,N};
rcc({_,_,N} = T)
when is_integer(N) ->
- T;
+ {T,N};
rcc(_) ->
- undefined.
+ false.
%% Extract the first good looking integer. There's no guarantee
%% that what we're looking for has arity 1.
@@ -1057,13 +1142,6 @@ int(N)
int(_) ->
undefined.
--spec x(any(), atom(), list()) -> no_return().
-
-%% Warn and exit request process on errors in an incoming answer.
-x(Reason, F, A) ->
- diameter_lib:warning_report(Reason, {?MODULE, F, A}),
- x(Reason).
-
x(T) ->
exit(T).
@@ -1305,7 +1383,7 @@ send_R(Pkt0,
{Pid, Ref},
SvcName,
Fs) ->
- Pkt = encode(Dict, Pkt0, Fs),
+ Pkt = encode(Dict, TPid, Pkt0, Fs),
#options{timeout = Timeout}
= Opts,
@@ -1370,11 +1448,19 @@ handle_answer(SvcName,
%% want to examine the answer?
handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) ->
+ incr(recv, Pkt, TPid, Dict),
+
try
- incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes
+ incr_rc(recv, Pkt, Dict, TPid, Dict0) %% count incoming
of
_ -> answer(Pkt, SvcName, App, Req)
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.
+ answer(Pkt, SvcName, App, Req);
exit: {invalid_error_bit, RC} ->
#diameter_packet{errors = Es}
= Pkt,
@@ -1401,11 +1487,16 @@ a(#diameter_packet{errors = Es}
callback == AE ->
cb(ModX, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]);
-a(Pkt, SvcName, _, report, Req) ->
- x(errors, handle_answer, [SvcName, Req, Pkt]);
+a(Pkt, SvcName, _, AE, _) ->
+ a(Pkt#diameter_packet.header, SvcName, AE).
+
+a(Hdr, SvcName, report) ->
+ MFA = {?MODULE, handle_answer, [SvcName, Hdr]},
+ diameter_lib:warning_report(errors, MFA),
+ a(Hdr, SvcName, discard);
-a(Pkt, SvcName, _, discard, Req) ->
- x({errors, handle_answer, [SvcName, Req, Pkt]}).
+a(Hdr, SvcName, discard) ->
+ x({answer_errors, {SvcName, Hdr}}).
%% Note that we don't check that the application id in the answer's
%% header is what we expect. (TODO: Does the rfc says anything about
@@ -1463,10 +1554,10 @@ msg(#diameter_packet{msg = undefined, bin = Bin}) ->
msg(#diameter_packet{msg = Msg}) ->
Msg.
-%% encode/3
+%% encode/4
-encode(Dict, Pkt, Fs) ->
- P = encode(Dict, Pkt),
+encode(Dict, TPid, Pkt, Fs) ->
+ P = encode(Dict, TPid, Pkt),
eval_packet(P, Fs),
P.
@@ -1478,11 +1569,17 @@ encode(Dict, Pkt, Fs) ->
%% support retransmission but is useful for test.
%% A message to be encoded.
-encode(Dict, #diameter_packet{bin = undefined} = Pkt) ->
- diameter_codec:encode(Dict, Pkt);
+encode(Dict, TPid, #diameter_packet{bin = undefined} = Pkt) ->
+ try
+ diameter_codec:encode(Dict, Pkt)
+ catch
+ exit: {diameter_codec, encode, T} = Reason ->
+ incr_error(send, T, TPid, Dict),
+ exit(Reason)
+ end;
%% An encoded binary: just send.
-encode(_, #diameter_packet{} = Pkt) ->
+encode(_, _, #diameter_packet{} = Pkt) ->
Pkt.
%% send_request/5
@@ -1579,13 +1676,13 @@ resend_request(Pkt0,
SvcName,
Tmo,
Fs) ->
- Pkt = encode(Dict, Pkt0, Fs),
+ Pkt = encode(Dict, TPid, Pkt0, Fs),
Req = Req0#request{transport = TPid,
packet = Pkt0,
caps = Caps},
- ?LOG(retransmission, Req),
+ ?LOG(retransmission, Pkt#diameter_packet.header),
TRef = send_request(TPid, Pkt, Req, SvcName, Tmo),
{TRef, Req}.
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index 53e659e3f6..eff5096745 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -49,8 +49,6 @@
-define(IS_NATURAL(N), (is_integer(N) andalso 0 =< N)).
--define(CHOOSE(B,T,F), if (B) -> T; true -> F end).
-
-record(config,
{suspect = 1 :: non_neg_integer(), %% OKAY -> SUSPECT
okay = 3 :: non_neg_integer()}). %% REOPEN -> OKAY
@@ -221,7 +219,6 @@ dict0(_, _, Acc) ->
Acc.
config_error(T) ->
- diameter_lib:error_report(configuration_error, T),
exit({shutdown, {configuration_error, T}}).
%% handle_call/3
@@ -270,7 +267,7 @@ event(Msg,
TPid = tpid(F,T),
E = {[TPid | data(Msg, TPid, From, To)], From, To},
send(Pid, {watchdog, self(), E}),
- ?LOG(transition, {self(), E}).
+ ?LOG(transition, {From, To}).
data(Msg, TPid, reopen, okay) ->
{recv, TPid, 'DWA', _Pkt} = Msg, %% assert
@@ -313,14 +310,13 @@ code_change(_, State, _) ->
%% The state transitions documented here are extracted from RFC 3539,
%% the commentary is ours.
-%% Service or watchdog is telling the watchdog of an accepting
-%% transport to die after connect_timer expiry or reestablished
-%% connection (in another transport process) respectively.
-transition(close, #watchdog{status = down}) ->
+%% Service is telling the watchdog of an accepting transport to die
+%% following transport death in state INITIAL, or after connect_timer
+%% expiry; or another watchdog is saying the same after reestablishing
+%% a connection previously had by this one.
+transition(close, #watchdog{}) ->
{{accept, _}, _, _} = getr(restart), %% assert
stop;
-transition(close, #watchdog{}) ->
- ok;
%% Service is asking for the peer to be taken down gracefully.
transition({shutdown, Pid, _}, #watchdog{parent = Pid,
@@ -332,6 +328,11 @@ transition({shutdown = T, Pid, Reason}, #watchdog{parent = Pid,
send(TPid, {T, self(), Reason}),
S#watchdog{shutdown = true};
+%% Transport is telling us that DPA has been sent in response to DPR:
+%% its death should lead to ours.
+transition({'DPR', TPid}, #watchdog{transport = TPid} = S) ->
+ S#watchdog{shutdown = true};
+
%% Parent process has died,
transition({'DOWN', _, process, Pid, _Reason},
#watchdog{parent = Pid}) ->
@@ -403,18 +404,39 @@ transition({open = Key, TPid, _Hosts, T},
%% REOPEN Connection down CloseConnection()
%% SetWatchdog() DOWN
+%% Transport has died after DPA or service requested termination ...
transition({'DOWN', _, process, TPid, _Reason},
#watchdog{transport = TPid,
shutdown = true}) ->
stop;
+%% ... or not.
transition({'DOWN', _, process, TPid, _Reason},
#watchdog{transport = TPid,
- status = T}
- = S) ->
- set_watchdog(S#watchdog{status = ?CHOOSE(initial == T, T, down),
- pending = false,
- transport = undefined});
+ status = T,
+ restrict = {_,R}}
+ = S0) ->
+ S = S0#watchdog{pending = false,
+ transport = undefined},
+ {{M,_}, _, _} = getr(restart),
+
+ %% Close an accepting watchdog immediately if there's no
+ %% restriction on the number of connections to the same peer: the
+ %% state machine never enters state REOPEN in this case. The
+ %% 'close' message (instead of stop) is so as not to bypass the
+ %% sending of messages to the service process in handle_info/2.
+
+ if T /= initial, M == accept, not R ->
+ send(self(), close),
+ S#watchdog{status = down};
+ T /= initial ->
+ set_watchdog(S#watchdog{status = down});
+ M == connect ->
+ set_watchdog(S);
+ M == accept ->
+ send(self(), close),
+ S
+ end;
%% Incoming message.
transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) ->
@@ -454,9 +476,7 @@ encode(dwr = M, Dict0, Mask) ->
hop_by_hop_id = Seq},
Pkt = #diameter_packet{header = Hdr,
msg = Msg},
- #diameter_packet{bin = Bin} = diameter_codec:encode(Dict0, Pkt),
- Bin;
-
+ diameter_codec:encode(Dict0, Pkt);
encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD}
= ReqPkt) ->
@@ -525,10 +545,14 @@ send_watchdog(#watchdog{pending = false,
dictionary = Dict0,
sequence = Mask}
= S) ->
- send(TPid, {send, encode(dwr, Dict0, Mask)}),
+ #diameter_packet{bin = Bin} = EPkt = encode(dwr, Dict0, Mask),
+ diameter_traffic:incr(send, EPkt, TPid, Dict0),
+ send(TPid, {send, Bin}),
?LOG(send, 'DWR'),
S#watchdog{pending = true}.
+%% Dont' count encode errors since we don't expect any on DWR/DWA.
+
%% recv/3
recv(Name, Pkt, S) ->
@@ -545,13 +569,29 @@ recv(Name, Pkt, S) ->
rcv('DWR', Pkt, #watchdog{transport = TPid,
dictionary = Dict0}) ->
- send(TPid, {send, encode(dwa, Dict0, Pkt)}),
+ ?LOG(recv, 'DWR'),
+ DPkt = diameter_codec:decode(Dict0, Pkt),
+ diameter_traffic:incr(recv, DPkt, TPid, Dict0),
+ diameter_traffic:incr_error(recv, DPkt, TPid, Dict0),
+ EPkt = encode(dwa, Dict0, Pkt),
+ diameter_traffic:incr(send, EPkt, TPid, Dict0),
+ diameter_traffic:incr_rc(send, EPkt, TPid, Dict0),
+
+ send(TPid, {send, EPkt}),
?LOG(send, 'DWA');
+rcv('DWA', Pkt, #watchdog{transport = TPid,
+ dictionary = Dict0}) ->
+ ?LOG(recv, 'DWA'),
+ diameter_traffic:incr(recv, Pkt, TPid, Dict0),
+ diameter_traffic:incr_rc(recv,
+ diameter_codec:decode(Dict0, Pkt),
+ TPid,
+ Dict0);
+
rcv(N, _, _)
when N == 'CER';
N == 'CEA';
- N == 'DWA';
N == 'DPR';
N == 'DPA' ->
false;
@@ -740,7 +780,7 @@ timeout(#watchdog{status = T} = S)
restart(#watchdog{transport = undefined} = S) ->
restart(getr(restart), S);
-restart(S) ->
+restart(S) -> %% reconnect has won race with timeout
S.
%% restart/2
@@ -770,9 +810,10 @@ restart({{connect, _} = T, Opts, Svc},
%% die. Note that a state machine never enters state REOPEN in this
%% case.
restart({{accept, _}, _, _}, #watchdog{restrict = {_, false}}) ->
- stop;
+ stop; %% 'DOWN' was in old code: 'close' was not sent
-%% Otherwise hang around until told to die.
+%% Otherwise hang around until told to die, either by the service or
+%% by another watchdog.
restart({{accept, _}, _, _}, S) ->
S.
diff --git a/lib/diameter/src/compiler/diameter_dict_util.erl b/lib/diameter/src/compiler/diameter_dict_util.erl
index 136bba16cb..cf4741e563 100644
--- a/lib/diameter/src/compiler/diameter_dict_util.erl
+++ b/lib/diameter/src/compiler/diameter_dict_util.erl
@@ -731,8 +731,8 @@ no_messages_without_id(Dict) ->
%% explode/4
%%
-%% {avp_vendor_id, AvpName} -> [Lineno, Id::integer()]
-%% {custom_types|codecs|inherits, AvpName} -> [Lineno, Mod::string()]
+%% {avp_vendor_id, AvpName} -> [Lineno, Id::integer()]
+%% {custom|inherits, AvpName} -> [Lineno, Mod::string()]
explode({_, Line, AvpName}, Dict, {_, _, X} = T, K) ->
true = K /= avp_vendor_id orelse is_uint32(T, [K]),
@@ -1094,7 +1094,7 @@ explode_avps([{_, Line, Name} | Toks], Dict) ->
Vid = avp_vendor_id(Flags, Name, Line, Dict),
%% An AVP is uniquely defined by its AVP code and vendor id (if any).
- %% Ensure there are no duplicate.
+ %% Ensure there are no duplicates.
store_new({avp_types, {Code, Vid}},
[Line, Name],
Dict,
@@ -1302,8 +1302,7 @@ x({K, {Name, AvpName}}, [Line | _], Dict)
%% Ditto.
x({K, AvpName}, [Line | _], Dict)
when K == avp_vendor_id;
- K == custom_types;
- K == codecs ->
+ K == custom ->
true = avp_is_defined(AvpName, Dict, Line);
%% Ensure that all local AVP's of type Grouped are also present in @grouped.
diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src
index 0d421c229e..3b6e259f5a 100644
--- a/lib/diameter/src/diameter.appup.src
+++ b/lib/diameter/src/diameter.appup.src
@@ -34,7 +34,19 @@
{"1.4.2", [{restart_application, diameter}]}, %% R16B01
{"1.4.3", [{restart_application, diameter}]}, %% R16B02
{"1.4.4", [{restart_application, diameter}]},
- {"1.5", [{restart_application, diameter}]} %% R16B03
+ {"1.5", [{restart_application, diameter}]}, %% R16B03
+ {"1.6", [{load_module, diameter_lib}, %% 17.0
+ {load_module, diameter_traffic},
+ {load_module, diameter_watchdog},
+ {load_module, diameter_peer_fsm},
+ {load_module, diameter_service},
+ {load_module, diameter_gen_base_rfc6733},
+ {load_module, diameter_gen_acct_rfc6733},
+ {load_module, diameter_gen_base_rfc3588},
+ {load_module, diameter_gen_base_accounting},
+ {load_module, diameter_gen_relay},
+ {load_module, diameter_codec},
+ {load_module, diameter_sctp}]}
],
[
{"0.9", [{restart_application, diameter}]},
@@ -51,6 +63,18 @@
{"1.4.2", [{restart_application, diameter}]},
{"1.4.3", [{restart_application, diameter}]},
{"1.4.4", [{restart_application, diameter}]},
- {"1.5", [{restart_application, diameter}]}
+ {"1.5", [{restart_application, diameter}]},
+ {"1.6", [{load_module, diameter_sctp},
+ {load_module, diameter_codec},
+ {load_module, diameter_gen_relay},
+ {load_module, diameter_gen_base_accounting},
+ {load_module, diameter_gen_base_rfc3588},
+ {load_module, diameter_gen_acct_rfc6733},
+ {load_module, diameter_gen_base_rfc6733},
+ {load_module, diameter_service},
+ {load_module, diameter_peer_fsm},
+ {load_module, diameter_watchdog},
+ {load_module, diameter_traffic},
+ {load_module, diameter_lib}]}
]
}.
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index d0a01351f3..32e7aaca39 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -616,6 +616,8 @@ send(#diameter_packet{bin = Bin, transport_data = {outstream, SId}},
S;
%% ... or not: rotate through all streams.
+send(#diameter_packet{bin = Bin}, S) ->
+ send(Bin, S);
send(Bin, #transport{streams = {_, OS},
os = N}
= S)
diff --git a/lib/diameter/test/diameter_compiler_SUITE.erl b/lib/diameter/test/diameter_compiler_SUITE.erl
index 08ffe5981d..20c9275808 100644
--- a/lib/diameter/test/diameter_compiler_SUITE.erl
+++ b/lib/diameter/test/diameter_compiler_SUITE.erl
@@ -317,6 +317,21 @@
{avp_not_defined,
"CEA ::=",
"<XXX> &"},
+ {ok,
+ "@avp_types",
+ "@codecs tmod Session-Id &"},
+ {ok,
+ "@avp_types",
+ "@custom_types tmod Session-Id &"},
+ {avp_not_defined,
+ "@avp_types",
+ "@codecs tmod OctetString &"},
+ {avp_not_defined,
+ "@avp_types",
+ "@custom_types tmod OctetString &"},
+ {avp_already_defined,
+ "@avp_types",
+ "@codecs tmod Session-Id @custom_types tmod Session-Id &"},
{not_loaded,
[{"@avp_types", "@inherits nomod XXX &"},
{"CEA ::=", "<XXX> &"}]},
diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl
index 9252650bf7..f3f16b06e0 100644
--- a/lib/diameter/test/diameter_dpr_SUITE.erl
+++ b/lib/diameter/test/diameter_dpr_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -73,7 +73,7 @@
%% Valid values for Disconnect-Cause.
-define(CAUSES, [0, rebooting, 1, busy, 2, goaway]).
-%% Establish one client connection for element of this list,
+%% Establish one client connection for each element of this list,
%% configured with disconnect/5 as disconnect_cb and returning the
%% specified value.
-define(RETURNS,
@@ -129,8 +129,8 @@ stop_service(Config) ->
service == group(Config)
andalso (ok = diameter:stop_service(?CLIENT)).
-%% Check for callbacks and stop the service. (Not the other way around
-%% for the timing reason explained below.)
+%% Check for callbacks before diameter:stop/0, not the other way around
+%% for the timing reason explained below.
check(Config) ->
Grp = group(Config),
[Pid | Refs] = ?util:read_priv(Config, config),
diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl
index 02c8d34361..aef4bc35ef 100644
--- a/lib/diameter/test/diameter_examples_SUITE.erl
+++ b/lib/diameter/test/diameter_examples_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -24,7 +24,10 @@
-module(diameter_examples_SUITE).
-export([suite/0,
- all/0]).
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2]).
%% testcases
-export([dict/1, dict/0,
@@ -46,7 +49,7 @@
%% The order here is significant and causes the server to listen
%% before the clients connect.
--define(NODES, [compile, server, client]).
+-define(NODES, [server, client]).
%% Options to ct_slave:start/2.
-define(TIMEOUTS, [{T, 15000} || T <- [boot_timeout,
@@ -63,6 +66,9 @@
%% Common dictionaries to inherit from examples.
-define(DICT0, [rfc3588_base, rfc6733_base]).
+%% Transport protocols over which the example Diameter nodes are run.
+-define(PROTS, [tcp, sctp]).
+
%% ===========================================================================
suite() ->
@@ -71,7 +77,34 @@ suite() ->
all() ->
[dict,
code,
- slave,
+ {group, all}].
+
+groups() ->
+ Tc = tc(),
+ [{all, [parallel], [{group, P} || P <- ?PROTS]}
+ | [{P, [], Tc} || P <- ?PROTS]].
+
+init_per_group(all, Config) ->
+ Config;
+
+init_per_group(tcp = N, Config) ->
+ [{group, N} | Config];
+
+init_per_group(sctp = N, Config) ->
+ case gen_sctp:open() of
+ {ok, Sock} ->
+ gen_sctp:close(Sock),
+ [{group, N} | Config];
+ {error, E} when E == eprotonosupport;
+ E == esocktnosupport -> %% fail on any other reason
+ {skip, no_sctp}
+ end.
+
+end_per_group(_, _) ->
+ ok.
+
+tc() ->
+ [slave,
enslave,
start,
traffic,
@@ -88,7 +121,7 @@ dict() ->
dict(_Config) ->
Dirs = [filename:join(H ++ ["examples", "dict"])
|| H <- [[code:lib_dir(diameter)], [here(), ".."]]],
- [] = [{F,D,RC} || {_,F} <- sort(find_files(Dirs, ".*\\.dia")),
+ [] = [{F,D,RC} || {_,F} <- sort(find_files(Dirs, ".*\\.dia$")),
D <- ?DICT0,
RC <- [make(F,D)],
RC /= ok].
@@ -184,17 +217,18 @@ make_name(Dict) ->
%% Compile example code under examples/code.
code(Config) ->
- Node = slave(hd(?NODES), here()),
+ Node = slave(compile, here()),
[] = rpc:call(Node,
?MODULE,
install,
- [proplists:get_value(priv_dir, Config)]).
+ [proplists:get_value(priv_dir, Config)]),
+ {ok, Node} = ct_slave:stop(compile).
%% Compile on another node since the code path may be modified.
install(PrivDir) ->
Top = install(here(), PrivDir),
Src = filename:join([Top, "examples", "code"]),
- Files = find_files([Src], ".*\\.erl"),
+ Files = find_files([Src], ".*\\.erl$"),
[] = [{F,E} || {_,F} <- Files,
{error, _, _} = E <- [compile:file(F, [warnings_as_errors,
return_errors])]].
@@ -226,7 +260,7 @@ install(Dir, PrivDir) ->
Inc = filename:join([Top, "include"]),
Gen = filename:join([Top, "src", "gen"]),
- Files = find_files([Inc, Gen], ".*\\.hrl"),
+ Files = find_files([Inc, Gen], ".*\\.hrl$"),
[] = [{F,E} || {_,F} <- Files,
B <- [filename:basename(F)],
D <- [filename:join([TmpInc, B])],
@@ -280,9 +314,10 @@ now_diff(_) ->
%% Start two nodes: one for the server, one for the client.
enslave(Config) ->
+ Prot = proplists:get_value(group, Config),
Dir = here(),
- Nodes = [{N, slave(N, Dir)} || N <- tl(?NODES)],
- ?util:write_priv(Config, nodes, Nodes).
+ Nodes = [{S, slave(N, Dir)} || S <- ?NODES, N <- [concat(Prot, S)]],
+ ?util:write_priv(Config, Prot, Nodes).
slave(Name, Dir) ->
{ok, Node} = ct_slave:start(Name, ?TIMEOUTS),
@@ -292,6 +327,9 @@ slave(Name, Dir) ->
[[Dir, filename:join([Dir, "..", "ebin"])]]),
Node.
+concat(Prot, Svc) ->
+ list_to_atom(atom_to_list(Prot) ++ atom_to_list(Svc)).
+
here() ->
filename:dirname(code:which(?MODULE)).
@@ -304,24 +342,25 @@ top(Dir, LibDir) ->
%% start/1
-start(server) ->
+start({server, Prot}) ->
ok = diameter:start(),
ok = server:start(),
- {ok, Ref} = server:listen(tcp),
- [_] = ?util:lport(tcp, Ref),
+ {ok, Ref} = server:listen(Prot),
+ [_] = ?util:lport(Prot, Ref),
ok;
-start(client) ->
+start({client = Svc, Prot}) ->
ok = diameter:start(),
- true = diameter:subscribe(client),
+ true = diameter:subscribe(Svc),
ok = client:start(),
- {ok, Ref} = client:connect(tcp),
+ {ok, Ref} = client:connect(Prot),
receive #diameter_event{info = {up, Ref, _, _, _}} -> ok end;
start(Config) ->
- Nodes = ?util:read_priv(Config, nodes),
+ Prot = proplists:get_value(group, Config),
+ Nodes = ?util:read_priv(Config, Prot),
[] = [RC || {T,N} <- Nodes,
- RC <- [rpc:call(N, ?MODULE, start, [T])],
+ RC <- [rpc:call(N, ?MODULE, start, [{T, Prot}])],
RC /= ok].
%% traffic/1
@@ -336,7 +375,8 @@ traffic(client) ->
receive {'DOWN', MRef, process, _, Reason} -> Reason end;
traffic(Config) ->
- Nodes = ?util:read_priv(Config, nodes),
+ Prot = proplists:get_value(group, Config),
+ Nodes = ?util:read_priv(Config, Prot),
[] = [RC || {T,N} <- Nodes,
RC <- [rpc:call(N, ?MODULE, traffic, [T])],
RC /= ok].
@@ -355,5 +395,6 @@ stop(Name)
{ok, _Node} = ct_slave:stop(Name),
ok;
-stop(_Config) ->
- [] = [RC || N <- ?NODES, RC <- [stop(N)], RC /= ok].
+stop(Config) ->
+ Prot = proplists:get_value(group, Config),
+ [] = [RC || N <- ?NODES, RC <- [stop(concat(Prot, N))], RC /= ok].
diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl
index dfd3253827..c1494dcdb1 100644
--- a/lib/diameter/test/diameter_failover_SUITE.erl
+++ b/lib/diameter/test/diameter_failover_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -47,6 +47,7 @@
send_discard_1/1,
send_discard_2/1,
stop_services/1,
+ empty/1,
stop/1]).
%% diameter callbacks
@@ -121,6 +122,7 @@ all() ->
send_discard_1,
send_discard_2,
stop_services,
+ empty,
stop].
%% ===========================================================================
@@ -147,6 +149,10 @@ stop_services(_Config) ->
T <- [diameter:stop_service(H)],
T /= ok].
+%% Ensure transports have been removed from request table.
+empty(_Config) ->
+ [] = ets:tab2list(diameter_request).
+
stop(_Config) ->
ok = diameter:stop().
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index a97c54fc04..4b67372016 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -43,7 +43,9 @@
send_protocol_error/1,
send_arbitrary/1,
send_unknown/1,
+ send_unknown_short/1,
send_unknown_mandatory/1,
+ send_unknown_short_mandatory/1,
send_noreply/1,
send_unsupported/1,
send_unsupported_app/1,
@@ -54,7 +56,8 @@
send_zero_avp_length/1,
send_invalid_avp_length/1,
send_invalid_reject/1,
- send_unrecognized_mandatory/1,
+ send_unexpected_mandatory_decode/1,
+ send_unexpected_mandatory/1,
send_long/1,
send_nopeer/1,
send_noapp/1,
@@ -266,7 +269,9 @@ tc() ->
send_protocol_error,
send_arbitrary,
send_unknown,
+ send_unknown_short,
send_unknown_mandatory,
+ send_unknown_short_mandatory,
send_noreply,
send_unsupported,
send_unsupported_app,
@@ -277,7 +282,8 @@ tc() ->
send_zero_avp_length,
send_invalid_avp_length,
send_invalid_reject,
- send_unrecognized_mandatory,
+ send_unexpected_mandatory_decode,
+ send_unexpected_mandatory,
send_long,
send_nopeer,
send_noapp,
@@ -447,6 +453,24 @@ send_unknown(Config) ->
data = <<17>>}]}
= lists:last(Avps).
+%% Ditto, and point the AVP length past the end of the message. Expect
+%% 5014.
+send_unknown_short(Config) ->
+ send_unknown_short(Config, false, ?INVALID_AVP_LENGTH).
+
+send_unknown_short(Config, M, RC) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
+ is_mandatory = M,
+ data = <<17>>}]}],
+ ['ASA', _SessionId, {'Result-Code', RC} | 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.
+
%% Ditto but set the M flag.
send_unknown_mandatory(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
@@ -461,6 +485,27 @@ send_unknown_mandatory(Config) ->
data = <<17>>}]
= As.
+%% Ditto, and point the AVP length past the end of the message. Expect
+%% 5014 instead of 5001.
+send_unknown_short_mandatory(Config) ->
+ send_unknown_short(Config, true, ?INVALID_AVP_LENGTH).
+
+%% Send an ACR containing an unexpected mandatory Session-Timeout.
+%% Expect 5001, and check that the value in Failed-AVP was decoded.
+send_unexpected_mandatory_decode(Config) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout
+ is_mandatory = true,
+ data = <<12:32>>}]}],
+ ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | 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.
+
%% Send an STR that the server ignores.
send_noreply(Config) ->
Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
@@ -527,9 +572,9 @@ send_invalid_reject(Config) ->
?answer_message(?TOO_BUSY)
= call(Config, Req).
-%% Send an STR containing a known AVP, but one that's not allowed and
-%% sets the M-bit.
-send_unrecognized_mandatory(Config) ->
+%% Send an STR containing a known AVP, but one that's not expected and
+%% that sets the M-bit.
+send_unexpected_mandatory(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
['STA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | _]
@@ -836,6 +881,26 @@ log(#diameter_packet{bin = Bin} = P, T)
%% prepare/4
prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+ when N == send_unknown_short_mandatory;
+ N == send_unknown_short ->
+ Req = prepare(Pkt, Caps, Group),
+
+ #diameter_packet{header = #diameter_header{length = L},
+ bin = Bin}
+ = E
+ = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
+
+ %% Find the unknown AVP data at the end of the message and alter
+ %% its length header.
+
+ {Padding, [17|_]} = lists:splitwith(fun(C) -> C == 0 end,
+ lists:reverse(binary_to_list(Bin))),
+
+ Offset = L - length(Padding) - 4,
+ <<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)
when N == send_long_avp_length;
N == send_short_avp_length;
N == send_zero_avp_length ->
@@ -876,8 +941,8 @@ 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_unrecognized_mandatory, #group{client_dict0 = Dict0}
- = Group) ->
+prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0}
+ = Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<V, Len:24, T/binary>>}
= E
@@ -997,7 +1062,9 @@ answer(Rec, [_|_], N)
N == send_short_avp_length;
N == send_zero_avp_length;
N == send_invalid_avp_length;
- N == send_invalid_reject ->
+ N == send_invalid_reject;
+ N == send_unknown_short_mandatory;
+ N == send_unexpected_mandatory_decode ->
Rec;
answer(Rec, [], _) ->
Rec.
diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk
index 54019fa46c..560c2aed50 100644
--- a/lib/diameter/vsn.mk
+++ b/lib/diameter/vsn.mk
@@ -18,5 +18,5 @@
# %CopyrightEnd%
APPLICATION = diameter
-DIAMETER_VSN = 1.6
+DIAMETER_VSN = 1.7
APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN)
diff --git a/lib/erl_interface/aclocal.m4 b/lib/erl_interface/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/erl_interface/aclocal.m4
+++ b/lib/erl_interface/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h
index a3eb437f88..3f3435977d 100644
--- a/lib/erl_interface/include/ei.h
+++ b/lib/erl_interface/include/ei.h
@@ -39,7 +39,7 @@
#include <stdio.h> /* Need type FILE */
#include <errno.h> /* Need EHOSTUNREACH, ENOMEM, ... */
-#if !defined(__WIN32__) && !defined(VXWORKS) || (defined(VXWORKS) && defined(HAVE_SENS))
+#if !(defined(__WIN32__) || defined(_WIN32)) && !defined(VXWORKS) || (defined(VXWORKS) && defined(HAVE_SENS))
# include <netdb.h>
#endif
diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl
index 22f5b8945a..9a3873f46d 100644
--- a/lib/hipe/cerl/cerl_prettypr.erl
+++ b/lib/hipe/cerl/cerl_prettypr.erl
@@ -63,7 +63,8 @@
seq_arg/1, seq_body/1, string_lit/1, try_arg/1,
try_body/1, try_vars/1, try_evars/1, try_handler/1,
tuple_es/1, type/1, values_es/1, var_name/1,
- map_es/1, map_pair_key/1, map_pair_val/1, map_pair_op/1
+ c_map/1, map_arg/1, map_es/1, is_c_map_empty/1,
+ c_map_pair/2, map_pair_key/1, map_pair_val/1, map_pair_op/1
]).
-define(PAPER, 76).
@@ -489,7 +490,13 @@ lay_literal(Node, Ctxt) ->
%% `lay_cons' will check for strings.
lay_cons(Node, Ctxt);
V when is_tuple(V) ->
- lay_tuple(Node, Ctxt)
+ lay_tuple(Node, Ctxt);
+ M when is_map(M), map_size(M) =:= 0 ->
+ text("~{}~");
+ M when is_map(M) ->
+ lay_map(c_map([c_map_pair(abstract(K),abstract(V))
+ || {K,V} <- maps:to_list(M)]),
+ Ctxt)
end.
lay_var(Node, Ctxt) ->
@@ -596,10 +603,17 @@ lay_tuple(Node, Ctxt) ->
floating(text("}")))).
lay_map(Node, Ctxt) ->
+ Arg = map_arg(Node),
+ After = case is_c_map_empty(Arg) of
+ true -> floating(text("}~"));
+ false ->
+ beside(floating(text(" | ")),
+ beside(lay(Arg,Ctxt),
+ floating(text("}~"))))
+ end,
beside(floating(text("~{")),
- beside(par(seq(map_es(Node), floating(text(",")),
- Ctxt, fun lay/2)),
- floating(text("}~")))).
+ beside(par(seq(map_es(Node), floating(text(",")), Ctxt, fun lay/2)),
+ After)).
lay_map_pair(Node, Ctxt) ->
K = map_pair_key(Node),
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 47b8dc766a..67661130a5 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -209,6 +209,7 @@
type_is_defined/4,
record_field_diffs_to_string/2,
subst_all_vars_to_any/1,
+ subst_all_remote/2,
lift_list_to_pos_empty/1,
is_opaque_type/2,
is_erl_type/1,
@@ -2985,16 +2986,19 @@ inf_union(U1, U2, Opaques) ->
List = [A,B,F,I,L,N,T,M,Map],
inf_union_collect(List, Opaque, InfFun, [], [])
end,
- O1 = OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end),
- O2 = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end),
- Union = inf_union(U1, U2, 0, [], Opaques),
- t_sup([O1, O2, Union]).
+ {O1, ThrowList1} =
+ OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end),
+ {O2, ThrowList2}
+ = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end),
+ {Union, ThrowList3} = inf_union(U1, U2, 0, [], [], Opaques),
+ ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3),
+ case t_sup([O1, O2, Union]) of
+ ?none when ThrowList =/= [] -> throw(hd(ThrowList));
+ Sup -> Sup
+ end.
inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) ->
- case t_sup(InfList) of
- ?none when ThrowList =/= [] -> throw(hd(lists:flatten(ThrowList)));
- Sup -> Sup
- end;
+ {t_sup(InfList), lists:usort(ThrowList)};
inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) ->
inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList);
inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) ->
@@ -3005,19 +3009,21 @@ inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) ->
inf_union_collect(L, Opaque, InfFun, InfList, [N|ThrowList])
end.
-inf_union([?none|Left1], [?none|Left2], N, Acc, Opaques) ->
- inf_union(Left1, Left2, N, [?none|Acc], Opaques);
-inf_union([T1|Left1], [T2|Left2], N, Acc, Opaques) ->
- case t_inf(T1, T2, Opaques) of
- ?none -> inf_union(Left1, Left2, N, [?none|Acc], Opaques);
- T -> inf_union(Left1, Left2, N+1, [T|Acc], Opaques)
+inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) ->
+ inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques);
+inf_union([T1|Left1], [T2|Left2], N, Acc, ThrowList, Opaques) ->
+ try t_inf(T1, T2, Opaques) of
+ ?none -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques);
+ T -> inf_union(Left1, Left2, N+1, [T|Acc], ThrowList, Opaques)
+ catch throw:N when is_integer(N) ->
+ inf_union(Left1, Left2, N, [?none|Acc], [N|ThrowList], Opaques)
end;
-inf_union([], [], N, Acc, _Opaques) ->
- if N =:= 0 -> ?none;
+inf_union([], [], N, Acc, ThrowList, _Opaques) ->
+ if N =:= 0 -> {?none, ThrowList};
N =:= 1 ->
[Type] = [T || T <- Acc, T =/= ?none],
- Type;
- N >= 2 -> ?union(lists:reverse(Acc))
+ {Type, ThrowList};
+ N >= 2 -> {?union(lists:reverse(Acc)), ThrowList}
end.
inf_bitstr(U1, B1, U2, B2) ->
@@ -3156,6 +3162,18 @@ t_subst_aux(?union(List), VarMap) ->
t_subst_aux(T, _VarMap) ->
T.
+-spec subst_all_remote(erl_type(), erl_type()) -> erl_type().
+
+subst_all_remote(Type0, Substitute) ->
+ Map =
+ fun(Type) ->
+ case erl_types:t_is_remote(Type) of
+ true -> Substitute;
+ false -> Type
+ end
+ end,
+ erl_types:t_map(Map, Type0).
+
%%-----------------------------------------------------------------------------
%% Unification
%%
@@ -4469,7 +4487,9 @@ get_mod_record([{FieldName, DeclType}|Left1],
[{FieldName, ModType}|Left2], Acc) ->
ModTypeNoVars = subst_all_vars_to_any(ModType),
case
- t_is_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType)
+ contains_remote(ModTypeNoVars)
+ orelse contains_remote(DeclType)
+ orelse t_is_subtype(ModTypeNoVars, DeclType)
of
false -> {error, FieldName};
true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc])
@@ -4483,6 +4503,10 @@ get_mod_record(DeclFields, [], Acc) ->
get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) ->
{error, FieldName2}.
+contains_remote(Type) ->
+ TypeNoRemote = subst_all_remote(Type, t_none()),
+ not t_is_equal(Type, TypeNoRemote).
+
fields_from_form([], _TypeNames, _RecDict, _VarDict) ->
{[], []};
fields_from_form([{Name, Type}|Tail], TypeNames, RecDict,
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index dcd547fd5f..4691662f9f 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -1125,6 +1125,49 @@ trans_fun([{trim,N,NY}|Instructions], Env) ->
trans_fun([{line,_}|Instructions], Env) ->
trans_fun(Instructions,Env);
%%--------------------------------------------------------------------
+%% Map instructions added in Spring 2014 (17.0).
+%%--------------------------------------------------------------------
+trans_fun([{test,has_map_fields,{f,Lbl},Map,{list,Keys}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ %% We assume that hipe_icode:mk_call has no side-effects, and reuse
+ %% the help function of get_map_elements below, discarding the value
+ %% assignment instruction list.
+ {TestInstructions, _GetInstructions, Env2} =
+ trans_map_query(MapVar, map_label(Lbl), Env1,
+ lists:flatten([[K, {r, 0}] || K <- Keys])),
+ [MapMove, TestInstructions | trans_fun(Instructions, Env2)];
+trans_fun([{get_map_elements,{f,Lbl},Map,{list,KVPs}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ {TestInstructions, GetInstructions, Env2} =
+ trans_map_query(MapVar, map_label(Lbl), Env1, KVPs),
+ [MapMove, TestInstructions, GetInstructions | trans_fun(Instructions, Env2)];
+%%--- put_map_assoc ---
+trans_fun([{put_map_assoc,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ TempMapVar = mk_var(new),
+ TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar),
+ {PutInstructions, Env2}
+ = case Lbl > 0 of
+ true ->
+ gen_put_map_instrs(exists, assoc, TempMapVar, Dst, Lbl, Pairs, Env1);
+ false ->
+ gen_put_map_instrs(new, assoc, TempMapVar, Dst, new, Pairs, Env1)
+ end,
+ [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
+%%--- put_map_exact ---
+trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ TempMapVar = mk_var(new),
+ TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar),
+ {PutInstructions, Env2}
+ = case Lbl > 0 of
+ true ->
+ gen_put_map_instrs(exists, exact, TempMapVar, Dst, Lbl, Pairs, Env1);
+ false ->
+ gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1)
+ end,
+ [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
+%%--------------------------------------------------------------------
%%--- ERROR HANDLING ---
%%--------------------------------------------------------------------
trans_fun([X|_], _) ->
@@ -1504,6 +1547,102 @@ trans_type_test2(function2, Lbl, Arg, Arity, Env) ->
hipe_icode:label_name(True), map_label(Lbl)),
{[Move1,Move2,I,True],Env2}.
+%%
+%% Handles the get_map_elements instruction and the has_map_fields
+%% test instruction.
+%%
+trans_map_query(_MapVar, _FailLabel, Env, []) ->
+ {[], [], Env};
+trans_map_query(MapVar, FailLabel, Env, [Key,Val|KVPs]) ->
+ {Move,KeyVar,Env1} = mk_move_and_var(Key,Env),
+ PassLabel = mk_label(new),
+ BoolVar = hipe_icode:mk_new_var(),
+ ValVar = mk_var(Val),
+ IsKeyCall = hipe_icode:mk_call([BoolVar], maps, is_key, [KeyVar, MapVar],
+ remote),
+ TrueTest = hipe_icode:mk_if('=:=', [BoolVar, hipe_icode:mk_const(true)],
+ hipe_icode:label_name(PassLabel), FailLabel),
+ GetCall = hipe_icode:mk_call([ValVar], maps, get, [KeyVar, MapVar], remote),
+ {TestList, GetList, Env2} = trans_map_query(MapVar, FailLabel, Env1, KVPs),
+ {[Move, IsKeyCall, TrueTest, PassLabel|TestList], [GetCall|GetList], Env2}.
+
+%%
+%% Generates a fail label if necessary when translating put_map_* instructions.
+%%
+gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) ->
+ TrueLabel = mk_label(new),
+ IsMapCode = hipe_icode:mk_type([TempMapVar], map,
+ hipe_icode:label_name(TrueLabel), map_label(FailLbl)),
+ DstMapVar = mk_var(Dst),
+ {ReturnLbl, PutInstructions, Env1}
+ = case Op of
+ assoc ->
+ trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []);
+ exact ->
+ trans_put_map_exact(TempMapVar, DstMapVar,
+ map_label(FailLbl), Pairs, Env, [])
+ end,
+ {[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1};
+gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) ->
+ TrueLabel = mk_label(new),
+ FailLbl = mk_label(new),
+ IsMapCode = hipe_icode:mk_type([TempMapVar], map,
+ hipe_icode:label_name(TrueLabel),
+ hipe_icode:label_name(FailLbl)),
+ DstMapVar = mk_var(Dst),
+ {ReturnLbl, PutInstructions, Env1}
+ = case Op of
+ assoc ->
+ trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []);
+ exact ->
+ trans_put_map_exact(TempMapVar, DstMapVar,
+ hipe_icode:label_name(FailLbl), Pairs, Env, [])
+ end,
+ Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error),
+ {[IsMapCode, TrueLabel, PutInstructions, FailLbl, Fail, ReturnLbl], Env1}.
+
+%%-----------------------------------------------------------------------
+%% This function generates the instructions needed to insert several
+%% (Key, Value) pairs into an existing map, each recursive call inserts
+%% one (Key, Value) pair.
+%%-----------------------------------------------------------------------
+trans_put_map_assoc(MapVar, DestMapVar, [], Env, Acc) ->
+ MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar),
+ ReturnLbl = mk_label(new),
+ GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)),
+ {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env};
+trans_put_map_assoc(MapVar, DestMapVar, [Key, Value | Rest], Env, Acc) ->
+ {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
+ {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
+ BifCall = hipe_icode:mk_call([MapVar], maps, put,
+ [KeyVar, ValVar, MapVar], remote),
+ trans_put_map_assoc(MapVar, DestMapVar, Rest, Env2,
+ [BifCall, MoveVal, MoveKey | Acc]).
+
+%%-----------------------------------------------------------------------
+%% This function generates the instructions needed to update several
+%% (Key, Value) pairs in an existing map, each recursive call inserts
+%% one (Key, Value) pair.
+%%-----------------------------------------------------------------------
+trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) ->
+ MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar),
+ ReturnLbl = mk_label(new),
+ GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)),
+ {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env};
+trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) ->
+ SuccLbl = mk_label(new),
+ {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
+ {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
+ IsKey = hipe_icode:mk_new_var(),
+ BifCallIsKey = hipe_icode:mk_call([IsKey], maps, is_key,
+ [KeyVar, MapVar], remote),
+ IsKeyTest = hipe_icode:mk_if('=:=', [IsKey, hipe_icode:mk_const(true)],
+ hipe_icode:label_name(SuccLbl), FLbl),
+ BifCallPut = hipe_icode:mk_call([MapVar], maps, put,
+ [KeyVar, ValVar, MapVar], remote),
+ Acc1 = [BifCallPut, SuccLbl, IsKeyTest, BifCallIsKey, MoveVal, MoveKey | Acc],
+ trans_put_map_exact(MapVar, DestMapVar, FLbl, Rest, Env2, Acc1).
+
%%-----------------------------------------------------------------------
%% trans_puts(Code, Environment) ->
%% {Movs, Code, Vars, NewEnv}
diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile
index acb2849d0d..009f503abb 100644
--- a/lib/hipe/test/Makefile
+++ b/lib/hipe/test/Makefile
@@ -10,7 +10,8 @@ MODULES= \
# .erl files for these modules are automatically generated
GEN_MODULES= \
- bs_SUITE
+ bs_SUITE \
+ maps_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl
new file mode 100644
index 0000000000..14d8320cdf
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl
@@ -0,0 +1,20 @@
+-module(maps_build_and_match_aliasing).
+-export([test/0]).
+
+test() ->
+ M1 = id(#{a=>1,b=>2,c=>3,d=>4}),
+ #{c:=C1=_=_=C2} = M1,
+ true = C1 =:= C2,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1,
+ #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1,
+ #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1,
+ #{c:=C=_=3=_=C} = M1,
+
+ M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}),
+ #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2,
+ #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2,
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl
new file mode 100644
index 0000000000..2abfa4e5b3
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl
@@ -0,0 +1,17 @@
+-module(maps_build_and_match_empty_val).
+-export([test/0]).
+
+test() ->
+ F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end,
+ ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl
new file mode 100644
index 0000000000..dc2c63fab2
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl
@@ -0,0 +1,40 @@
+-module(maps_build_and_match_literals).
+-export([test/0]).
+
+test() ->
+ #{} = id(#{}),
+ #{1:=a} = id(#{1=>a}),
+ #{1:=a,2:=b} = id(#{1=>a,2=>b}),
+ #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}),
+ #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}),
+
+ #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}),
+
+ #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =)
+
+ #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} =
+ id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}),
+
+ M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first},
+ M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} =
+ id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}),
+
+ %% nil key
+ #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}),
+
+ %% error case
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl
new file mode 100644
index 0000000000..dae6f64e5f
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl
@@ -0,0 +1,16 @@
+-module(maps_build_and_match_over_alloc).
+-export([test/0]).
+
+test() ->
+ Ls = id([1,2,3]),
+ V0 = [a|Ls],
+ M0 = id(#{ "a" => V0 }),
+ #{ "a" := V1 } = M0,
+ V2 = id([c|Ls]),
+ M2 = id(#{ "a" => V2 }),
+ #{ "a" := V3 } = M2,
+ {[a,1,2,3],[c,1,2,3]} = id({V1,V3}),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl
new file mode 100644
index 0000000000..284f69e06c
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl
@@ -0,0 +1,23 @@
+-module(maps_build_and_match_val).
+-export([test/0]).
+
+test() ->
+ F = fun
+ (#{ "hi" := first, v := V}) -> {1,V};
+ (#{ "hi" := second, v := V}) -> {2,V}
+ end,
+
+
+ {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})),
+ {2,"second"} = F(id(#{"hi"=>second,v=>"second"})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl
new file mode 100644
index 0000000000..df0f77ea47
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl
@@ -0,0 +1,7 @@
+-module(maps_expand_map_update).
+-export([test/0]).
+
+test() ->
+ M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>},
+ #{<<"hello">> := <<"les gens">>} = M,
+ ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_export.erl b/lib/hipe/test/maps_SUITE_data/maps_export.erl
new file mode 100644
index 0000000000..4d43fc96ed
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_export.erl
@@ -0,0 +1,11 @@
+-module(maps_export).
+-export([test/0]).
+
+test() ->
+ Raclette = id(#{}),
+ case brie of brie -> Fromage = Raclette end,
+ Raclette = Fromage#{},
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl
new file mode 100644
index 0000000000..b2d749796a
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl
@@ -0,0 +1,23 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_get_map_elements).
+
+-export([test/0]).
+
+test() ->
+ {A, B} = id({"hej", <<123>>}),
+ Map = maps:from_list([{a, A}, {b, B}]),
+ #{a := A, b := B} = id(Map),
+ false = test_pattern(Map),
+ true = test_pattern(#{b => 1, a => "hej"}),
+ case Map of
+ #{a := C, b := <<124>>} -> yay;
+ _ -> C = B, nay
+ end,
+ C = id(B),
+ ok.
+
+id(X) -> X.
+
+test_pattern(#{a := _, b := 1}) -> true;
+test_pattern(#{}) -> false.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl
new file mode 100644
index 0000000000..61a0eaa1e7
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl
@@ -0,0 +1,31 @@
+-module(maps_guard_bifs).
+-export([test/0]).
+
+test() ->
+ true = map_guard_empty(),
+ true = map_guard_empty_2(),
+ true = map_guard_head(#{a=>1}),
+ false = map_guard_head([]),
+ true = map_guard_body(#{a=>1}),
+ false = map_guard_body({}),
+ true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }),
+ false = map_guard_pattern("list"),
+ true = map_guard_tautology(),
+ true = map_guard_ill_map_size(),
+ ok.
+
+map_guard_empty() when is_map(#{}); false -> true.
+
+map_guard_empty_2() when true; #{} andalso false -> true.
+
+map_guard_head(M) when is_map(M) -> true;
+map_guard_head(_) -> false.
+
+map_guard_body(M) -> is_map(M).
+
+map_guard_pattern(#{}) -> true;
+map_guard_pattern(_) -> false.
+
+map_guard_tautology() when #{} =:= #{}; true -> true.
+
+map_guard_ill_map_size() when true; map_size(0) -> true.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl
new file mode 100644
index 0000000000..9f6eb3a04e
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl
@@ -0,0 +1,36 @@
+-module(maps_guard_fun).
+-export([test/0]).
+
+test() ->
+ F1 = fun
+ (#{s:=v,v:=V}) -> {v,V};
+ (#{s:=t,v:={V,V}}) -> {t,V};
+ (#{s:=l,v:=[V,V]}) -> {l,V}
+ end,
+
+ F2 = fun
+ (#{s:=T,v:={V,V}}) -> {T,V};
+ (#{s:=T,v:=[V,V]}) -> {T,V};
+ (#{s:=T,v:=V}) -> {T,V}
+ end,
+ V = <<"hi">>,
+
+ {v,V} = F1(#{s=>v,v=>V}),
+ {t,V} = F1(#{s=>t,v=>{V,V}}),
+ {l,V} = F1(#{s=>l,v=>[V,V]}),
+
+ {v,V} = F2(#{s=>v,v=>V}),
+ {t,V} = F2(#{s=>t,v=>{V,V}}),
+ {l,V} = F2(#{s=>l,v=>[V,V]}),
+
+ %% error case
+ case (catch F1(#{s=>none,v=>none})) of
+ {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok;
+ {'EXIT', {function_clause,[{?MODULE,_,1,[#{s:=none,v:=none}]}|_]}} -> ok;
+ {'EXIT', {function_clause,[Frame|_]}}
+ when is_tuple(Frame), element(1, Frame) =:= ?MODULE ->
+ test_server:comment("Unexpected trace format, probably using HiPE");
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl
new file mode 100644
index 0000000000..f84ba19c86
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl
@@ -0,0 +1,54 @@
+-module(maps_guard_receive).
+-export([test/0]).
+
+test() ->
+ M0 = #{ id => 0 },
+ Pid = spawn_link(fun() -> guard_receive_loop() end),
+ Big = 36893488147419103229,
+ B1 = <<"some text">>,
+ B2 = <<"was appended">>,
+ B3 = <<B1/binary, B2/binary>>,
+
+ #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}),
+ #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}),
+ #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}),
+ #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}),
+ #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}),
+ #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}),
+ #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}),
+
+
+ %% update old maps and check id update
+ #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}),
+ #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}),
+
+ %% cleanup
+ done = call(Pid, done),
+ ok.
+
+call(Pid, M) ->
+ Pid ! {self(), M}, receive {Pid, Res} -> Res end.
+
+guard_receive_loop() ->
+ receive
+ {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) ->
+ Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=add, in:={X,Y}}} ->
+ Pid ! {self(), #{ id=>Id+1, res=>X+Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X-Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X div Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X * Y}},
+ guard_receive_loop();
+ {Pid, done} ->
+ Pid ! {self(), done};
+ {Pid, Other} ->
+ Pid ! {error, Other},
+ guard_receive_loop()
+ end.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl
new file mode 100644
index 0000000000..4eb18dcea1
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl
@@ -0,0 +1,35 @@
+-module(maps_guard_sequence).
+-export([test/0]).
+
+test() ->
+ {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}),
+ {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}),
+ {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}),
+ {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}),
+ {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}),
+
+ {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})),
+ {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})),
+ {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})),
+ {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})),
+ {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})),
+
+ %% error case
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})),
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})),
+ ok.
+
+map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}.
+
+map_guard_sequence_2(#{ a:=3 }=M) -> {1, M};
+map_guard_sequence_2(#{ a:=4 }=M) -> {2, M};
+map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M};
+map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M};
+map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl
new file mode 100644
index 0000000000..254c1c2984
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl
@@ -0,0 +1,14 @@
+-module(maps_guard_update).
+-export([test/0]).
+
+test() ->
+ error = map_guard_update(#{},#{}),
+ first = map_guard_update(#{}, #{x=>first}),
+ second = map_guard_update(#{y=>old}, #{x=>second,y=>old}),
+ third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}),
+ ok.
+
+map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first;
+map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second;
+map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third;
+map_guard_update(_, _) -> error.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl
new file mode 100644
index 0000000000..61653aa519
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl
@@ -0,0 +1,46 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_has_map_fields).
+
+-export([test/0]).
+
+test() ->
+ false = has_a_field(#{}),
+ false = has_a_field(#{b => 2}),
+ true = has_a_field(#{a => 3}),
+ true = has_a_field(#{b => c, a => false}),
+
+ false = has_a_b_field(#{a => true}),
+ false = has_a_b_field(#{b => a}),
+ true = has_a_b_field(#{a => 1, b => 2}),
+ true = has_a_b_field(#{b => 3, a => 4}),
+
+ false = has_binary_field(#{}),
+ false = has_binary_field(#{#{} => yay}),
+ true = has_binary_field(#{<<"true">> => false}),
+
+ false = has_binary_but_no_map_field(#{}),
+ false = has_map_but_no_binary_field(#{}),
+ false = has_binary_but_no_map_field(#{#{} => 1}),
+ false = has_map_but_no_binary_field(#{<<"true">> => true}),
+ true = has_binary_but_no_map_field(#{<<"true">> => false}),
+ true = has_map_but_no_binary_field(#{#{} => 1}),
+ false = has_binary_but_no_map_field(#{<<"true">> => true, #{} => 1}),
+ false = has_map_but_no_binary_field(#{<<"true">> => true, #{} => 1}),
+ ok.
+
+has_a_field(#{a := _}) -> true;
+has_a_field(#{}) -> false.
+
+has_a_b_field(#{a := _, b := _}) -> true;
+has_a_b_field(#{}) -> false.
+
+has_binary_field(#{<<"true">> := _}) -> true;
+has_binary_field(#{}) -> false.
+
+has_map_but_no_binary_field(#{<<"true">> := _}) -> false;
+has_map_but_no_binary_field(#{} = M) -> maps:is_key(#{}, M).
+
+has_binary_but_no_map_field(#{<<"true">> := _} = M) ->
+ not maps:is_key(#{}, M);
+has_binary_but_no_map_field(#{}) -> false.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_is_map.erl b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl
new file mode 100644
index 0000000000..e84f4b8c44
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl
@@ -0,0 +1,24 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_is_map).
+
+-export([test/0]).
+
+test() ->
+ true = test_is_map(#{}),
+ false = test_is_map(<<"hej">>),
+ true = test_is_map_guard(#{a => b}),
+ false = test_is_map_guard(3),
+ true = test_is_map_with_binary_guard(#{"a" => <<"b">>}),
+ false = test_is_map_with_binary_guard(12),
+ ok.
+
+test_is_map(X) ->
+ is_map(X).
+
+test_is_map_guard(Map) when is_map(Map) -> true;
+test_is_map_guard(_) -> false.
+
+test_is_map_with_binary_guard(B) when is_binary(B) -> false;
+test_is_map_with_binary_guard(#{}) -> true;
+test_is_map_with_binary_guard(_) -> false.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl
new file mode 100644
index 0000000000..ad2c726d65
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl
@@ -0,0 +1,6 @@
+-module(maps_list_comprehension).
+-export([test/0]).
+
+test() ->
+ [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]],
+ ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl
new file mode 100644
index 0000000000..25c8e5d4c7
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl
@@ -0,0 +1,29 @@
+-module(maps_map_size).
+-export([test/0]).
+
+test() ->
+ 0 = map_size(id(#{})),
+ 1 = map_size(id(#{a=>1})),
+ 1 = map_size(id(#{a=>"wat"})),
+ 2 = map_size(id(#{a=>1, b=>2})),
+ 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})),
+
+ true = map_is_size(#{a=>1}, 1),
+ true = map_is_size(#{a=>1, a=>2}, 1),
+ M = #{ "a" => 1, "b" => 2},
+ true = map_is_size(M, 2),
+ false = map_is_size(M, 3),
+ true = map_is_size(M#{ "a" => 2}, 2),
+ false = map_is_size(M#{ "c" => 2}, 2),
+
+ %% Error cases.
+ {'EXIT',{badarg,_}} = (catch map_size([])),
+ {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)),
+ {'EXIT',{badarg,_}} = (catch map_size(1)),
+ ok.
+
+map_is_size(M,N) when map_size(M) =:= N -> true;
+map_is_size(_,_) -> false.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
new file mode 100644
index 0000000000..31abf15d49
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
@@ -0,0 +1,41 @@
+-module(maps_map_sort_literals).
+-export([test/0]).
+
+test() ->
+ % test relation
+
+ %% size order
+ true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}),
+ true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}),
+ false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}),
+
+ %% key order
+ true = id(#{ a => 1 }) < id(#{ b => 1}),
+ false = id(#{ b => 1 }) < id(#{ a => 1}),
+ true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}),
+ true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}),
+ true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}),
+ true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}),
+ false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}),
+ false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}),
+ false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}),
+
+ %% value order
+ true = id(#{ a => 1 }) < id(#{ a => 2}),
+ false = id(#{ a => 2 }) < id(#{ a => 1}),
+ false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}),
+ true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}),
+
+ true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}),
+
+ %% lists:sort
+
+ SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}],
+ [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]),
+ [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs),
+ [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)),
+
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl
new file mode 100644
index 0000000000..29a6a29290
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl
@@ -0,0 +1,24 @@
+-module(maps_match_and_update_literals).
+-export([test/0]).
+
+test() ->
+ Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1},
+ #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [
+ {1,2},{3,4},{5,6},{7,8}
+ ]),
+ M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat}),
+ M1 = id(#{}),
+ M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat},
+ M0 = M2,
+
+ #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number },
+ ok.
+
+loop_match_and_update_literals_x_q(Map, []) -> Map;
+loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) ->
+ loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs).
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl
new file mode 100644
index 0000000000..72ac9ce078
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl
@@ -0,0 +1,23 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_put_map_assoc).
+
+-export([test/0]).
+
+test() ->
+ true = assoc_guard(#{}),
+ false = assoc_guard(not_a_map),
+ #{a := true} = assoc_update(#{}),
+ {'EXIT', {badarg, [{?MODULE, assoc_update, 1, _}|_]}}
+ = (catch assoc_update(not_a_map)),
+ ok = assoc_guard_clause(#{}),
+ {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}}
+ = (catch assoc_guard_clause(not_a_map)),
+ ok.
+
+assoc_guard(M) when is_map(M#{a => b}) -> true;
+assoc_guard(_) -> false.
+
+assoc_update(M) -> M#{a => true}.
+
+assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl
new file mode 100644
index 0000000000..1cfcd80180
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl
@@ -0,0 +1,28 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_put_map_exact).
+
+-export([test/0]).
+
+test() ->
+ false = exact_guard(#{b => a}),
+ false = exact_guard(not_a_map),
+ true = exact_guard(#{a => false}),
+ #{a := true} = exact_update(#{a => false}),
+ {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}}
+ = (catch exact_update(not_a_map)),
+ {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}}
+ = (catch exact_update(#{})),
+ ok = exact_guard_clause(#{a => yes}),
+ {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}}
+ = (catch exact_guard_clause(#{})),
+ {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}}
+ = (catch exact_guard_clause(not_a_map)),
+ ok.
+
+exact_guard(M) when is_map(M#{a := b}) -> true;
+exact_guard(_) -> false.
+
+exact_update(M) -> M#{a := true}.
+
+exact_guard_clause(M) when is_map(M#{a := 42}) -> ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl
new file mode 100644
index 0000000000..cc7c1353de
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl
@@ -0,0 +1,22 @@
+-module(maps_update_assoc).
+-export([test/0]).
+
+test() ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1=>42,2=>100,4=>[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{3.0=>new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0:=wrong,3.0=>new},
+
+ %% Errors cases.
+ BadMap = id(badmap),
+ {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl
new file mode 100644
index 0000000000..6e5acb3283
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl
@@ -0,0 +1,32 @@
+-module(maps_update_exact).
+-export([test/0]).
+
+test() ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1:=42,2:=100,4:=[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]},
+
+ M2 = M0#{3.0:=new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0=>wrong,3.0:=new},
+ true = M2 =/= M0#{3=>right,3.0:=new},
+ #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new},
+
+ M3 = id(#{ 1 => val}),
+ #{1 := update2,1.0 := new_val4} = M3#{
+ 1.0 => new_val1, 1 := update, 1=> update3,
+ 1 := update2, 1.0 := new_val2, 1.0 => new_val3,
+ 1.0 => new_val4 },
+
+ %% Errors cases.
+ {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })),
+ {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl
new file mode 100644
index 0000000000..87aea3d8e1
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl
@@ -0,0 +1,13 @@
+-module(maps_update_literals).
+-export([test/0]).
+
+test() ->
+ Map = #{x=>1,y=>2,z=>3,q=>4},
+ #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [
+ {"a","1"},{"b","2"},{"c","3"},{"d","4"}
+ ]),
+ ok.
+
+loop_update_literals_x_q(Map, []) -> Map;
+loop_update_literals_x_q(Map, [{X,Q}|Vs]) ->
+ loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs).
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl
new file mode 100644
index 0000000000..181e3f18f7
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl
@@ -0,0 +1,32 @@
+-module(maps_update_map_expressions).
+-export([test/0]).
+
+test() ->
+ M = maps:new(),
+ X = id(fondue),
+ M1 = #{ a := 1 } = M#{a => 1},
+ #{ b := {X} } = M1#{ a := 1, b => {X} },
+
+ #{ b := 2 } = (maps:new())#{ b => 2 },
+
+ #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 },
+ #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 },
+
+ %% Test need to be in a fun.
+ %% This tests that let expr optimisation in sys_core_fold
+ %% covers maps correctly.
+ F = fun() ->
+ M0 = id(#{ "a" => [1,2,3] }),
+ #{ "a" := _ } = M0,
+ M0#{ "a" := b }
+ end,
+
+ #{ "a" := b } = F(),
+
+ %% Error cases, FIXME: should be 'badmap'?
+ {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }),
+ {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_values.erl b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl
new file mode 100644
index 0000000000..bbad5ac19e
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl
@@ -0,0 +1,28 @@
+-module(maps_update_values).
+-export([test/0]).
+
+test() ->
+ V0 = id(1337),
+ M0 = #{ a => 1, val => V0},
+ V1 = get_val(M0),
+ M1 = M0#{ val := [V0,V1], "wazzup" => 42 },
+ [1337, {some_val, 1337}] = get_val(M1),
+
+ N = 110,
+ List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)],
+
+ {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun
+ ({V2,V3},{Old2,Old3,Mi}) ->
+ ok = check_val(Mi,Old2,Old3),
+ #{ val1 := Old2, val2 := Old3 } = Mi,
+ {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}}
+ end, {none, none, #{val1=>none,val2=>none}},List),
+ ok.
+
+get_val(#{ "wazzup" := _, val := V}) -> V;
+get_val(#{ val := V }) -> {some_val, V}.
+
+check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl
new file mode 100644
index 0000000000..76b2a91f94
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl
@@ -0,0 +1,27 @@
+-module(maps_warn_pair_key_overloaded).
+-export([test/0]).
+
+test() ->
+ #{ "hi1" := 42 } = id(#{ "hi1" => 1, "hi1" => 42 }),
+
+ #{ "hi1" := 1337, "hi2" := [2], "hi3" := 3 } = id(#{
+ "hi1" => erlang:atom_to_binary(?MODULE,utf8),
+ "hi1" => erlang:binary_to_atom(<<"wazzup">>,utf8),
+ "hi1" => erlang:binary_to_float(<<"3.1416">>),
+ "hi1" => erlang:float_to_binary(3.1416),
+ "hi2" => erlang:pid_to_list(self()),
+ "hi3" => erlang:float_to_binary(3.1416),
+ "hi2" => lists:subtract([1,2],[1]),
+ "hi3" => +3,
+ "hi1" => erlang:min(1,2),
+ "hi1" => erlang:hash({1,2},35),
+ "hi1" => erlang:phash({1,2},33),
+ "hi1" => erlang:phash2({1,2},34),
+ "hi1" => erlang:integer_to_binary(1337),
+ "hi1" => erlang:binary_to_integer(<<"1337">>),
+ "hi4" => erlang:float_to_binary(3.1416)
+ }),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl
new file mode 100644
index 0000000000..6cb0366314
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl
@@ -0,0 +1,9 @@
+-module(maps_warn_useless_build).
+-export([test/0]).
+
+test() ->
+ [#{ a => id(I)} || I <- [1,2,3]],
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index e29144f014..596c0d77f4 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2002</year><year>2013</year>
+ <year>2002</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -32,7 +32,37 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 5.10</title>
+ <section><title>Inets 5.10.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Correct distirbing mode for httpd:reload_config/2</p>
+ <p>
+ Own Id: OTP-11914</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Improved handling of invalid strings in the HTTP request
+ line.</p>
+ <p>
+ Impact: May improve memory consumption</p>
+ <p>
+ Own Id: OTP-11925 Aux Id: Sequence 12601 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 5.10</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 88e08be789..5ae6760f08 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -1116,8 +1116,16 @@ handle_http_body(Body, #state{headers = Headers,
{new_body, NewBody}]),
NewHeaders = http_chunk:handle_headers(Headers,
ChunkedHeaders),
- handle_response(State#state{headers = NewHeaders,
- body = NewBody})
+ case Body of
+ <<>> ->
+ handle_response(State#state{headers = NewHeaders,
+ body = NewBody});
+ _ ->
+ {NewBody2, NewRequest} =
+ stream(NewBody, Request, Code),
+ handle_response(State#state{headers = NewHeaders,
+ body = NewBody2})
+ end
end;
Enc when Enc =:= "identity"; Enc =:= undefined ->
?hcrt("handle_http_body - identity", []),
@@ -1218,6 +1226,7 @@ handle_response(#state{request = Request,
handle_queue(State#state{request = undefined}, Data);
{ok, Msg, Data} ->
?hcrd("handle response - ok", []),
+ stream_remaining_body(Body, Request, StatusLine),
end_stream(StatusLine, Request),
NewState = maybe_send_answer(Request, Msg, State),
handle_queue(NewState, Data);
@@ -1648,6 +1657,10 @@ start_stream(_StatusLine, _Headers, Request) ->
?hcrt("start stream - no op", []),
{ok, Request}.
+stream_remaining_body(<<>>, _, _) ->
+ ok;
+stream_remaining_body(Body, Request, {_, Code, _}) ->
+ stream(Body, Request, Code).
%% Note the end stream message is handled by httpc_response and will
%% be sent by answer_request
diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl
index 97cf474ab9..53b776c4e7 100644
--- a/lib/inets/src/http_lib/http_internal.hrl
+++ b/lib/inets/src/http_lib/http_internal.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -26,6 +26,8 @@
-define(HTTP_MAX_BODY_SIZE, nolimit).
-define(HTTP_MAX_HEADER_SIZE, 10240).
-define(HTTP_MAX_URI_SIZE, nolimit).
+-define(HTTP_MAX_VERSION_STRING, 8).
+-define(HTTP_MAX_METHOD_STRING, 20).
-ifndef(HTTP_DEFAULT_SSL_KIND).
-define(HTTP_DEFAULT_SSL_KIND, essl).
diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl
index 6052ae9022..e8148ea362 100644
--- a/lib/inets/src/http_server/httpd.erl
+++ b/lib/inets/src/http_server/httpd.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -294,9 +294,13 @@ do_reload_config(ConfigList, Mode) ->
{ok, Config} ->
Address = proplists:get_value(bind_address, Config, any),
Port = proplists:get_value(port, Config, 80),
- block(Address, Port, Mode),
- reload(Config, Address, Port),
- unblock(Address, Port);
+ case block(Address, Port, Mode) of
+ ok ->
+ reload(Config, Address, Port),
+ unblock(Address, Port);
+ Error ->
+ Error
+ end;
Error ->
Error
end.
diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl
index e155498bb8..3da0343401 100644
--- a/lib/inets/src/http_server/httpd_manager.erl
+++ b/lib/inets/src/http_server/httpd_manager.erl
@@ -210,9 +210,10 @@ handle_call({block , Blocker, Mode, Timeout}, From,
handle_call({block , _, _, _}, _, State) ->
{reply, {error, blocked}, State};
-handle_call({unblock, Blocker}, _, #state{blocker_ref = {Blocker,_},
+handle_call({unblock, Blocker}, _, #state{blocker_ref = {Blocker, Monitor},
admin_state = blocked} = State) ->
-
+
+ erlang:demonitor(Monitor),
{reply, ok,
State#state{admin_state = unblocked, blocker_ref = undefined}};
@@ -247,37 +248,36 @@ handle_cast(Message, State) ->
handle_info(connections_terminated, #state{admin_state = shutting_down,
blocking_from = From} = State) ->
gen_server:reply(From, ok),
- {noreply, State#state{admin_state = blocked, blocking_from = undefined,
- blocker_ref = undefined}};
+ {noreply, State#state{admin_state = blocked, blocking_from = undefined}};
handle_info(connections_terminated, State) ->
{noreply, State};
-handle_info({block_timeout, non_disturbing},
+handle_info({block_timeout, non_disturbing, Blocker},
#state{admin_state = shutting_down,
blocking_from = From,
- blocker_ref = {_, Monitor}} = State) ->
+ blocker_ref = {_, Monitor} = Blocker} = State) ->
erlang:demonitor(Monitor),
gen_server:reply(From, {error, timeout}),
{noreply, State#state{admin_state = unblocked, blocking_from = undefined,
blocker_ref = undefined}};
-handle_info({block_timeout, disturbing},
+handle_info({block_timeout, disturbing, Blocker},
#state{admin_state = shutting_down,
blocking_from = From,
- blocker_ref = {_, Monitor},
+ blocker_ref = Blocker,
connection_sup = Sup} = State) ->
SupPid = whereis(Sup),
shutdown_connections(SupPid),
- erlang:demonitor(Monitor),
gen_server:reply(From, ok),
- {noreply, State#state{admin_state = blocked, blocker_ref = undefined,
+ {noreply, State#state{admin_state = blocked,
blocking_from = undefined}};
handle_info({block_timeout, _, _}, State) ->
{noreply, State};
handle_info({'DOWN', _, process, Pid, _Info},
#state{admin_state = Admin,
- blocker_ref = {Pid, _}} = State) when
+ blocker_ref = {Pid, Monitor}} = State) when
Admin =/= unblocked ->
+ erlang:demonitor(Monitor),
{noreply, State#state{admin_state = unblocked,
blocking_from = undefined,
blocker_ref = undefined}};
@@ -333,18 +333,16 @@ handle_new_connection(_UsageState, _AdminState, State, _Handler) ->
handle_block(disturbing, infinity,
#state{connection_sup = CSup,
- blocking_from = From,
- blocker_ref = {_, Monitor}} = State) ->
+ blocking_from = From} = State) ->
SupPid = whereis(CSup),
shutdown_connections(SupPid),
- erlang:demonitor(Monitor),
gen_server:reply(From, ok),
- {noreply, State#state{admin_state = blocked, blocker_ref = undefined,
+ {noreply, State#state{admin_state = blocked,
blocking_from = undefined}};
-handle_block(disturbing, Timeout, #state{connection_sup = CSup} = State) ->
+handle_block(disturbing, Timeout, #state{connection_sup = CSup, blocker_ref = Blocker} = State) ->
Manager = self(),
spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end),
- erlang:send_after(Timeout, self(), {block_timeout, disturbing}),
+ erlang:send_after(Timeout, self(), {block_timeout, disturbing, Blocker}),
{noreply, State#state{admin_state = shutting_down}};
handle_block(non_disturbing, infinity,
@@ -354,10 +352,10 @@ handle_block(non_disturbing, infinity,
{noreply, State#state{admin_state = shutting_down}};
handle_block(non_disturbing, Timeout,
- #state{connection_sup = CSup} = State) ->
+ #state{connection_sup = CSup, blocker_ref = Blocker} = State) ->
Manager = self(),
spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end),
- erlang:send_after(Timeout, self(), {block_timeout, non_disturbing}),
+ erlang:send_after(Timeout, self(), {block_timeout, non_disturbing, Blocker}),
{noreply, State#state{admin_state = shutting_down}}.
handle_reload(undefined, #state{config_file = undefined} = State) ->
diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl
index 5ba79b2706..712c73599f 100644
--- a/lib/inets/src/http_server/httpd_request.erl
+++ b/lib/inets/src/http_server/httpd_request.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -44,26 +44,26 @@
%%%=========================================================================
parse([Bin, MaxSizes]) ->
?hdrt("parse", [{bin, Bin}, {max_sizes, MaxSizes}]),
- parse_method(Bin, [], MaxSizes, []);
+ parse_method(Bin, [], 0, proplists:get_value(max_method, MaxSizes), MaxSizes, []);
parse(Unknown) ->
?hdrt("parse", [{unknown, Unknown}]),
exit({bad_args, Unknown}).
%% Functions that may be returned during the decoding process
%% if the input data is incompleate.
-parse_method([Bin, Method, MaxSizes, Result]) ->
- parse_method(Bin, Method, MaxSizes, Result).
+parse_method([Bin, Method, Current, Max, MaxSizes, Result]) ->
+ parse_method(Bin, Method, Current, Max, MaxSizes, Result).
-parse_uri([Bin, URI, CurrSize, MaxSizes, Result]) ->
- parse_uri(Bin, URI, CurrSize, MaxSizes, Result).
+parse_uri([Bin, URI, Current, Max, MaxSizes, Result]) ->
+ parse_uri(Bin, URI, Current, Max, MaxSizes, Result).
-parse_version([Bin, Rest, Version, MaxSizes, Result]) ->
- parse_version(<<Rest/binary, Bin/binary>>, Version, MaxSizes,
+parse_version([Bin, Rest, Version, Current, Max, MaxSizes, Result]) ->
+ parse_version(<<Rest/binary, Bin/binary>>, Version, Current, Max, MaxSizes,
Result).
-parse_headers([Bin, Rest, Header, Headers, CurrSize, MaxSizes, Result]) ->
+parse_headers([Bin, Rest, Header, Headers, Current, Max, MaxSizes, Result]) ->
parse_headers(<<Rest/binary, Bin/binary>>,
- Header, Headers, CurrSize, MaxSizes, Result).
+ Header, Headers, Current, Max, MaxSizes, Result).
whole_body([Bin, Body, Length]) ->
whole_body(<<Body/binary, Bin/binary>>, Length).
@@ -107,8 +107,12 @@ validate("POST", Uri, "HTTP/1." ++ _N) ->
validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 ->
validate_uri(Uri);
validate(Method, Uri, Version) ->
- {error, {not_supported, {Method, Uri, Version}}}.
-
+ case validate_version(Version) of
+ true ->
+ {error, {not_supported, {Method, Uri, Version}}};
+ false ->
+ {error, {bad_version, Version}}
+ end.
%%----------------------------------------------------------------------
%% The request is passed through the server as a record of type mod
%% create it.
@@ -131,104 +135,75 @@ update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)->
%%%========================================================================
%%% Internal functions
%%%========================================================================
-parse_method(<<>>, Method, MaxSizes, Result) ->
- ?hdrt("parse_method - empty bin",
- [{method, Method}, {max_sizes, MaxSizes}, {result, Result}]),
- {?MODULE, parse_method, [Method, MaxSizes, Result]};
-parse_method(<<?SP, Rest/binary>>, Method, MaxSizes, Result) ->
- ?hdrt("parse_method - SP begin",
- [{rest, Rest},
- {method, Method},
- {max_sizes, MaxSizes},
- {result, Result}]),
- parse_uri(Rest, [], 0, MaxSizes,
+parse_method(<<>>, Method, Current, Max, MaxSizes, Result) ->
+ {?MODULE, parse_method, [Method, Current, Max, MaxSizes, Result]};
+parse_method(<<?SP, Rest/binary>>, Method, _Current, _Max, MaxSizes, Result) ->
+ parse_uri(Rest, [], 0, proplists:get_value(max_uri, MaxSizes), MaxSizes,
[string:strip(lists:reverse(Method)) | Result]);
-parse_method(<<Octet, Rest/binary>>, Method, MaxSizes, Result) ->
- ?hdrt("parse_method",
- [{octet, Octet},
- {rest, Rest},
- {method, Method},
- {max_sizes, MaxSizes},
- {result, Result}]),
- parse_method(Rest, [Octet | Method], MaxSizes, Result).
-
-parse_uri(_, _, CurrSize, {MaxURI, _}, _)
- when (CurrSize > MaxURI) andalso (MaxURI =/= nolimit) ->
- ?hdrt("parse_uri",
- [{current_size, CurrSize},
- {max_uri, MaxURI}]),
+parse_method(<<Octet, Rest/binary>>, Method, Current, Max, MaxSizes, Result) when Current =< Max ->
+ parse_method(Rest, [Octet | Method], Current + 1, Max, MaxSizes, Result);
+parse_method(_, _, _, Max, _, _) ->
+ %% We do not know the version of the client as it comes after the
+ %% method send the lowest version in the response so that the client
+ %% will be able to handle it.
+ {error, {too_long, Max, 413, "Method unreasonably long"}, lowest_version()}.
+
+parse_uri(_, _, Current, MaxURI, _, _)
+ when (Current > MaxURI) andalso (MaxURI =/= nolimit) ->
%% We do not know the version of the client as it comes after the
%% uri send the lowest version in the response so that the client
%% will be able to handle it.
- HttpVersion = "HTTP/0.9",
- {error, {uri_too_long, MaxURI}, HttpVersion};
-parse_uri(<<>>, URI, CurrSize, MaxSizes, Result) ->
- ?hdrt("parse_uri - empty bin",
- [{uri, URI},
- {current_size, CurrSize},
- {max_sz, MaxSizes},
- {result, Result}]),
- {?MODULE, parse_uri, [URI, CurrSize, MaxSizes, Result]};
-parse_uri(<<?SP, Rest/binary>>, URI, _, MaxSizes, Result) ->
- ?hdrt("parse_uri - SP begin",
- [{uri, URI},
- {max_sz, MaxSizes},
- {result, Result}]),
- parse_version(Rest, [], MaxSizes,
+ {error, {too_long, MaxURI, 414, "URI unreasonably long"},lowest_version()};
+parse_uri(<<>>, URI, Current, Max, MaxSizes, Result) ->
+ {?MODULE, parse_uri, [URI, Current, Max, MaxSizes, Result]};
+parse_uri(<<?SP, Rest/binary>>, URI, _, _, MaxSizes, Result) ->
+ parse_version(Rest, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes,
[string:strip(lists:reverse(URI)) | Result]);
%% Can happen if it is a simple HTTP/0.9 request e.i "GET /\r\n\r\n"
-parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, MaxSizes, Result) ->
- ?hdrt("parse_uri - CR begin",
- [{uri, URI},
- {max_sz, MaxSizes},
- {result, Result}]),
- parse_version(Data, [], MaxSizes,
+parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, _, MaxSizes, Result) ->
+ parse_version(Data, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes,
[string:strip(lists:reverse(URI)) | Result]);
-parse_uri(<<Octet, Rest/binary>>, URI, CurrSize, MaxSizes, Result) ->
- ?hdrt("parse_uri",
- [{octet, Octet},
- {uri, URI},
- {curr_sz, CurrSize},
- {max_sz, MaxSizes},
- {result, Result}]),
- parse_uri(Rest, [Octet | URI], CurrSize + 1, MaxSizes, Result).
-
-parse_version(<<>>, Version, MaxSizes, Result) ->
- {?MODULE, parse_version, [<<>>, Version, MaxSizes, Result]};
-parse_version(<<?LF, Rest/binary>>, Version, MaxSizes, Result) ->
+parse_uri(<<Octet, Rest/binary>>, URI, Current, Max, MaxSizes, Result) ->
+ parse_uri(Rest, [Octet | URI], Current + 1, Max, MaxSizes, Result).
+
+parse_version(<<>>, Version, Current, Max, MaxSizes, Result) ->
+ {?MODULE, parse_version, [<<>>, Version, Current, Max, MaxSizes, Result]};
+parse_version(<<?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result) ->
%% If ?CR is is missing RFC2616 section-19.3
- parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result);
-parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result) ->
- parse_headers(Rest, [], [], 0, MaxSizes,
+ parse_version(<<?CR, ?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result);
+parse_version(<<?CR, ?LF, Rest/binary>>, Version, _, _, MaxSizes, Result) ->
+ parse_headers(Rest, [], [], 0, proplists:get_value(max_header, MaxSizes), MaxSizes,
[string:strip(lists:reverse(Version)) | Result]);
-parse_version(<<?CR>> = Data, Version, MaxSizes, Result) ->
- {?MODULE, parse_version, [Data, Version, MaxSizes, Result]};
-parse_version(<<Octet, Rest/binary>>, Version, MaxSizes, Result) ->
- parse_version(Rest, [Octet | Version], MaxSizes, Result).
-
-parse_headers(_, _, _, CurrSize, {_, MaxHeaderSize}, Result)
- when CurrSize > MaxHeaderSize, MaxHeaderSize =/= nolimit ->
+parse_version(<<?CR>> = Data, Version, Current, Max, MaxSizes, Result) ->
+ {?MODULE, parse_version, [Data, Version, Current, Max, MaxSizes, Result]};
+parse_version(<<Octet, Rest/binary>>, Version, Current, Max, MaxSizes, Result) when Current =< Max ->
+ parse_version(Rest, [Octet | Version], Current + 1, Max, MaxSizes, Result);
+parse_version(_, _, _, Max,_,_) ->
+ {error, {too_long, Max, 413, "Version string unreasonably long"}, lowest_version()}.
+
+parse_headers(_, _, _, Current, Max, _, Result)
+ when Max =/= nolimit andalso Current > Max ->
HttpVersion = lists:nth(3, lists:reverse(Result)),
- {error, {header_too_long, MaxHeaderSize}, HttpVersion};
+ {error, {too_long, Max, 413, "Headers unreasonably long"}, HttpVersion};
-parse_headers(<<>>, Header, Headers, CurrSize, MaxSizes, Result) ->
- {?MODULE, parse_headers, [<<>>, Header, Headers, CurrSize,
+parse_headers(<<>>, Header, Headers, Current, Max, MaxSizes, Result) ->
+ {?MODULE, parse_headers, [<<>>, Header, Headers, Current, Max,
MaxSizes, Result]};
-parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) ->
+parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) ->
%% If ?CR is is missing RFC2616 section-19.3
- parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize,
+ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max,
MaxSizes, Result);
-parse_headers(<<?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) ->
+parse_headers(<<?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) ->
%% If ?CR is is missing RFC2616 section-19.3
- parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize,
+ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max,
MaxSizes, Result);
-parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, Result) ->
+parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, _, Result) ->
NewResult = list_to_tuple(lists:reverse([Body, {#http_request_h{}, []} |
Result])),
{ok, NewResult};
-parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _,
+parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, _,
_, Result) ->
HTTPHeaders = [lists:reverse(Header) | Headers],
RequestHeaderRcord =
@@ -238,52 +213,51 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _,
HTTPHeaders} | Result])),
{ok, NewResult};
-parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, CurrSize,
+parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, Current, Max,
MaxSizes, Result) ->
- {?MODULE, parse_headers, [Data, Header, Headers, CurrSize,
+ {?MODULE, parse_headers, [Data, Header, Headers, Current, Max,
MaxSizes, Result]};
-parse_headers(<<?LF>>, [], [], CurrSize, MaxSizes, Result) ->
+parse_headers(<<?LF>>, [], [], Current, Max, MaxSizes, Result) ->
%% If ?CR is is missing RFC2616 section-19.3
- parse_headers(<<?CR,?LF>>, [], [], CurrSize, MaxSizes, Result);
+ parse_headers(<<?CR,?LF>>, [], [], Current, Max, MaxSizes, Result);
%% There where no headers, which is unlikely to happen.
-parse_headers(<<?CR,?LF>>, [], [], _, _, Result) ->
+parse_headers(<<?CR,?LF>>, [], [], _, _, _, Result) ->
NewResult = list_to_tuple(lists:reverse([<<>>, {#http_request_h{}, []} |
Result])),
{ok, NewResult};
-parse_headers(<<?LF>>, Header, Headers, CurrSize,
+parse_headers(<<?LF>>, Header, Headers, Current, Max,
MaxSizes, Result) ->
%% If ?CR is is missing RFC2616 section-19.3
- parse_headers(<<?CR,?LF>>, Header, Headers, CurrSize, MaxSizes, Result);
+ parse_headers(<<?CR,?LF>>, Header, Headers, Current, Max, MaxSizes, Result);
-parse_headers(<<?CR,?LF>> = Data, Header, Headers, CurrSize,
+parse_headers(<<?CR,?LF>> = Data, Header, Headers, Current, Max,
MaxSizes, Result) ->
- {?MODULE, parse_headers, [Data, Header, Headers, CurrSize,
+ {?MODULE, parse_headers, [Data, Header, Headers, Current, Max,
MaxSizes, Result]};
-parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, CurrSize,
+parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, Current, Max,
MaxSizes, Result) ->
%% If ?CR is is missing RFC2616 section-19.3
- parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize,
+ parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, Current, Max,
MaxSizes, Result);
-parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize,
+parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, _, Max,
MaxSizes, Result) ->
parse_headers(Rest, [Octet], [lists:reverse(Header) | Headers],
- CurrSize + 1, MaxSizes, Result);
-
-parse_headers(<<?CR>> = Data, Header, Headers, CurrSize,
+ 0, Max, MaxSizes, Result);
+parse_headers(<<?CR>> = Data, Header, Headers, Current, Max,
MaxSizes, Result) ->
- {?MODULE, parse_headers, [Data, Header, Headers, CurrSize,
+ {?MODULE, parse_headers, [Data, Header, Headers, Current, Max,
MaxSizes, Result]};
-parse_headers(<<?LF>>, Header, Headers, CurrSize,
+parse_headers(<<?LF>>, Header, Headers, Current, Max,
MaxSizes, Result) ->
%% If ?CR is is missing RFC2616 section-19.3
- parse_headers(<<?CR, ?LF>>, Header, Headers, CurrSize,
+ parse_headers(<<?CR, ?LF>>, Header, Headers, Current, Max,
MaxSizes, Result);
-parse_headers(<<Octet, Rest/binary>>, Header, Headers,
- CurrSize, MaxSizes, Result) ->
- parse_headers(Rest, [Octet | Header], Headers, CurrSize + 1,
+parse_headers(<<Octet, Rest/binary>>, Header, Headers, Current,
+ Max, MaxSizes, Result) ->
+ parse_headers(Rest, [Octet | Header], Headers, Current + 1, Max,
MaxSizes, Result).
whole_body(Body, Length) ->
@@ -326,6 +300,14 @@ validate_path([".." | Rest], N, RequestURI) ->
validate_path([_ | Rest], N, RequestURI) ->
validate_path(Rest, N + 1, RequestURI).
+validate_version("HTTP/1.1") ->
+ true;
+validate_version("HTTP/1.0") ->
+ true;
+validate_version("HTTP/0.9") ->
+ true;
+validate_version(_) ->
+ false.
%%----------------------------------------------------------------------
%% There are 3 possible forms of the reuqest URI
%%
@@ -430,3 +412,5 @@ tag([$:|Rest], Tag) ->
tag([Chr|Rest], Tag) ->
tag(Rest, [Chr|Tag]).
+lowest_version()->
+ "HTTP/0.9".
diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl
index bd37066ff6..b3c9cbc46a 100644
--- a/lib/inets/src/http_server/httpd_request_handler.erl
+++ b/lib/inets/src/http_server/httpd_request_handler.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -123,7 +123,8 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) ->
{_, Status} = httpd_manager:new_connection(Manager),
- MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]},
+ MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize},
+ {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]},
State = #state{mod = Mod,
manager = Manager,
@@ -207,23 +208,15 @@ handle_info({Proto, Socket, Data},
set_new_data_size(cancel_request_timeout(State), NewDataSize)
end,
handle_http_msg(Result, NewState);
-
- {error, {uri_too_long, MaxSize}, Version} ->
- NewModData = ModData#mod{http_version = Version},
- httpd_response:send_status(NewModData, 414, "URI too long"),
- Reason = io_lib:format("Uri too long, max size is ~p~n",
- [MaxSize]),
- error_log(Reason, NewModData),
- {stop, normal, State#state{response_sent = true,
- mod = NewModData}};
- {error, {header_too_long, MaxSize}, Version} ->
+ {error, {too_long, MaxSize, ErrCode, ErrStr}, Version} ->
NewModData = ModData#mod{http_version = Version},
- httpd_response:send_status(NewModData, 413, "Header too long"),
- Reason = io_lib:format("Header too long, max size is ~p~n",
- [MaxSize]),
+ httpd_response:send_status(NewModData, ErrCode, ErrStr),
+ Reason = io_lib:format("~p: ~p max size is ~p~n",
+ [ErrCode, ErrStr, MaxSize]),
error_log(Reason, NewModData),
{stop, normal, State#state{response_sent = true,
mod = NewModData}};
+
NewMFA ->
http_transport:setopts(SockType, Socket, [{active, once}]),
case NewDataSize of
@@ -382,6 +375,11 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body},
400, URI),
Reason = io_lib:format("Malformed syntax in URI: ~p~n", [URI]),
error_log(Reason, ModData),
+ {stop, normal, State#state{response_sent = true}};
+ {error, {bad_version, Ver}} ->
+ httpd_response:send_status(ModData#mod{http_version = "HTTP/0.9"}, 400, Ver),
+ Reason = io_lib:format("Malformed syntax version: ~p~n", [Ver]),
+ error_log(Reason, ModData),
{stop, normal, State#state{response_sent = true}}
end;
handle_http_msg({ChunkedHeaders, Body},
@@ -549,7 +547,8 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData,
MaxHeaderSize = max_header_size(ModData#mod.config_db),
MaxURISize = max_uri_size(ModData#mod.config_db),
- MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]},
+ MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize},
+ {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]},
TmpState = State#state{mod = NewModData,
mfa = MFA,
max_keep_alive_request = decrease(Max),
diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src
index dd081962cc..5499596bbd 100644
--- a/lib/inets/src/inets_app/inets.appup.src
+++ b/lib/inets/src/inets_app/inets.appup.src
@@ -17,11 +17,20 @@
%% %CopyrightEnd%
{"%VSN%",
[
- {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]},
+ {"5.10",
+ [{load_module, httpd, soft_purge, soft_purge, []},
+ {load_module, httpd_manager, soft_purge, soft_purge, []},
+ {load_module, httpd_request, soft_purge, soft_purge, []},
+ {load_module, httpd_request_handler, soft_purge, soft_purge,
+ []}]},
{<<"5\\..*">>,[{restart_application, inets}]}
],
[
- {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]},
+ {"5.10",
+ [{load_module, httpd, soft_purge, soft_purge, []},
+ {load_module, httpd_manager, soft_purge, soft_purge, []},
+ {load_module, httpd_request, soft_purge, soft_purge, []},
+ {load_module, httpd_request_handler, soft_purge, soft_purge, []}]},
{<<"5\\..*">>,[{restart_application, inets}]}
]
}.
diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl
index c5920a3968..d4a3f28f38 100644
--- a/lib/inets/test/http_format_SUITE.erl
+++ b/lib/inets/test/http_format_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -356,7 +356,10 @@ http_request(Config) when is_list(Config) ->
"HTTP/1.1",
{#http_request_h{host = "www.erlang.org", te = []},
["te: ","host:www.erlang.org"]}, <<>>} =
- parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead),
+ parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE},
+ {max_version, ?HTTP_MAX_VERSION_STRING},
+ {max_method, ?HTTP_MAX_METHOD_STRING}]],
+ HttpHead),
HttpHead1 = ["GET http://www.erlang.org HTTP/1.1" ++
[?CR], [?LF, ?CR, ?LF]],
@@ -364,7 +367,9 @@ http_request(Config) when is_list(Config) ->
"http://www.erlang.org",
"HTTP/1.1",
{#http_request_h{}, []}, <<>>} =
- parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead1),
+ parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE},
+ {max_version, ?HTTP_MAX_VERSION_STRING},
+ {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead1),
HttpHead2 = ["GET http://www.erlang.org HTTP/1.1" ++
@@ -373,7 +378,9 @@ http_request(Config) when is_list(Config) ->
"http://www.erlang.org",
"HTTP/1.1",
{#http_request_h{}, []}, <<>>} =
- parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead2),
+ parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE},
+ {max_version, ?HTTP_MAX_VERSION_STRING},
+ {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead2),
%% Note the following body is not related to the headers above
HttpBody = ["<HTML>\n<HEAD>\n<TITLE> dummy </TITLE>\n</HEAD>\n<BODY>\n",
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index b1b799c953..c535d59b9f 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -27,15 +27,14 @@
-include_lib("kernel/include/file.hrl").
-include_lib("common_test/include/ct.hrl").
-include("inets_test_lib.hrl").
-
+-include("http_internal.hrl").
%% Note: This directive should only be used in test suites.
-compile(export_all).
-define(URL_START, "http://").
-define(TLS_URL_START, "https://").
-define(NOT_IN_USE_PORT, 8997).
--define(LF, $\n).
--define(HTTP_MAX_HEADER_SIZE, 10240).
+
-record(sslsocket, {fd = nil, pid = nil}).
%%--------------------------------------------------------------------
%% Common Test interface functions -----------------------------------
@@ -94,6 +93,8 @@ only_simulated() ->
empty_set_cookie,
trace,
stream_once,
+ stream_single_chunk,
+ stream_no_length,
no_content_204,
tolerate_missing_CR,
userinfo,
@@ -387,6 +388,22 @@ stream_once(Config) when is_list(Config) ->
Request2 = {url(group_name(Config), "/once_chunked.html", Config), []},
stream_test(Request2, {stream, {self, once}}).
+%%-------------------------------------------------------------------------
+stream_single_chunk() ->
+ [{doc, "Test the option stream for asynchrony requests"}].
+stream_single_chunk(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/single_chunk.html", Config), []},
+ stream_test(Request, {stream, self}).
+%%-------------------------------------------------------------------------
+stream_no_length() ->
+ [{doc, "Test the option stream for asynchrony requests with HTTP 1.0 "
+ "body end on closed connection" }].
+stream_no_length(Config) when is_list(Config) ->
+ Request1 = {url(group_name(Config), "/http_1_0_no_length_single.html", Config), []},
+ stream_test(Request1, {stream, self}),
+ Request2 = {url(group_name(Config), "/http_1_0_no_length_multiple.html", Config), []},
+ stream_test(Request2, {stream, self}).
+
%%-------------------------------------------------------------------------
redirect_multiple_choises() ->
@@ -1047,7 +1064,7 @@ stream_test(Request, To) ->
ct:fail(Msg)
end,
- Body == binary_to_list(StreamedBody).
+ Body = binary_to_list(StreamedBody).
url(http, End, Config) ->
Port = ?config(port, Config),
@@ -1226,7 +1243,10 @@ dummy_server_init(Caller, ip_comm, Inet, _) ->
{ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]),
{ok, Port} = inet:port(ListenSocket),
Caller ! {port, Port},
- dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]},
+ dummy_ipcomm_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE},
+ {max_header, ?HTTP_MAX_HEADER_SIZE},
+ {max_version,?HTTP_MAX_VERSION_STRING},
+ {max_method, ?HTTP_MAX_METHOD_STRING}]]},
[], ListenSocket);
dummy_server_init(Caller, ssl, Inet, SSLOptions) ->
@@ -1238,7 +1258,10 @@ dummy_ssl_server_init(Caller, BaseOpts, Inet) ->
{ok, ListenSocket} = ssl:listen(0, [Inet | BaseOpts]),
{ok, {_, Port}} = ssl:sockname(ListenSocket),
Caller ! {port, Port},
- dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]},
+ dummy_ssl_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE},
+ {max_method, ?HTTP_MAX_METHOD_STRING},
+ {max_version,?HTTP_MAX_VERSION_STRING},
+ {max_method, ?HTTP_MAX_METHOD_STRING}]]},
[], ListenSocket).
dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) ->
@@ -1268,6 +1291,7 @@ dummy_ssl_server_loop(MFA, Handlers, ListenSocket) ->
From ! {stopped, self()}
after 0 ->
{ok, Socket} = ssl:transport_accept(ListenSocket),
+ ok = ssl:ssl_accept(Socket, infinity),
HandlerPid = dummy_request_handler(MFA, Socket),
ssl:controlling_process(Socket, HandlerPid),
HandlerPid ! ssl_controller,
@@ -1314,10 +1338,16 @@ handle_request(Module, Function, Args, Socket) ->
stop ->
stop;
<<>> ->
- {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]};
+ {httpd_request, parse, [[<<>>, [{max_uri, ?HTTP_MAX_URI_SIZE},
+ {max_header, ?HTTP_MAX_HEADER_SIZE},
+ {max_version,?HTTP_MAX_VERSION_STRING},
+ {max_method, ?HTTP_MAX_METHOD_STRING}]]]};
Data ->
handle_request(httpd_request, parse,
- [Data |[?HTTP_MAX_HEADER_SIZE]], Socket)
+ [Data, [{max_uri, ?HTTP_MAX_URI_SIZE},
+ {max_header, ?HTTP_MAX_HEADER_SIZE},
+ {max_version,?HTTP_MAX_VERSION_STRING},
+ {max_method, ?HTTP_MAX_METHOD_STRING}]], Socket)
end;
NewMFA ->
NewMFA
@@ -1675,6 +1705,30 @@ handle_uri(_,"/once_chunked.html",_,_,Socket,_) ->
http_chunk:encode("obar</BODY></HTML>")),
http_chunk:encode_last();
+handle_uri(_,"/single_chunk.html",_,_,Socket,_) ->
+ Chunk = "HTTP/1.1 200 ok\r\n" ++
+ "Transfer-Encoding:Chunked\r\n\r\n" ++
+ http_chunk:encode("<HTML><BODY>fo") ++
+ http_chunk:encode("obar</BODY></HTML>") ++
+ http_chunk:encode_last(),
+ send(Socket, Chunk);
+
+handle_uri(_,"/http_1_0_no_length_single.html",_,_,Socket,_) ->
+ Body = "HTTP/1.0 200 ok\r\n"
+ "Content-type:text/plain\r\n\r\n"
+ "single packet",
+ send(Socket, Body),
+ close(Socket);
+
+handle_uri(_,"/http_1_0_no_length_multiple.html",_,_,Socket,_) ->
+ Head = "HTTP/1.0 200 ok\r\n"
+ "Content-type:text/plain\r\n\r\n"
+ "multiple packets, ",
+ send(Socket, Head),
+ %% long body to make sure it will be sent in multiple tcp packets
+ send(Socket, string:copies("other multiple packets ", 200)),
+ close(Socket);
+
handle_uri(_,"/once.html",_,_,Socket,_) ->
Head = "HTTP/1.1 200 ok\r\n" ++
"Content-Length:32\r\n\r\n",
diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl
index fbe65145dc..1fcc5f257e 100644
--- a/lib/inets/test/httpd_basic_SUITE.erl
+++ b/lib/inets/test/httpd_basic_SUITE.erl
@@ -32,9 +32,9 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [
- uri_too_long_414,
+ [uri_too_long_414,
header_too_long_413,
+ entity_too_long,
erl_script_nocache_opt,
script_nocache,
escaped_url_in_error_body,
@@ -63,15 +63,13 @@ end_per_group(_GroupName, Config) ->
%% variable, but should NOT alter/remove any existing entries.
%%--------------------------------------------------------------------
init_per_suite(Config) ->
- tsp("init_per_suite -> entry with"
- "~n Config: ~p", [Config]),
inets_test_lib:stop_apps([inets]),
inets_test_lib:start_apps([inets]),
PrivDir = ?config(priv_dir, Config),
DataDir = ?config(data_dir, Config),
-
+
Dummy =
-"<HTML>
+ "<HTML>
<HEAD>
<TITLE>/index.html</TITLE>
</HEAD>
@@ -79,7 +77,7 @@ init_per_suite(Config) ->
DUMMY
</BODY>
</HTML>",
-
+
DummyFile = filename:join([PrivDir,"dummy.html"]),
CgiDir = filename:join(PrivDir, "cgi-bin"),
ok = file:make_dir(CgiDir),
@@ -116,8 +114,6 @@ DUMMY
%% Description: Cleanup after the whole suite
%%--------------------------------------------------------------------
end_per_suite(_Config) ->
- tsp("end_per_suite -> entry with"
- "~n Config: ~p", [_Config]),
inets:stop(),
ok.
@@ -134,8 +130,6 @@ end_per_suite(_Config) ->
%% variable, but should NOT alter/remove any existing entries.
%%--------------------------------------------------------------------
init_per_testcase(Case, Config) ->
- tsp("init_per_testcase(~w) -> entry with"
- "~n Config: ~p", [Case, Config]),
Config.
@@ -147,22 +141,18 @@ init_per_testcase(Case, Config) ->
%% A list of key/value pairs, holding the test case configuration.
%% Description: Cleanup after each test case
%%--------------------------------------------------------------------
-end_per_testcase(Case, Config) ->
- tsp("end_per_testcase(~w) -> entry with"
- "~n Config: ~p", [Case, Config]),
+end_per_testcase(_Case, Config) ->
Config.
%%-------------------------------------------------------------------------
%% Test cases starts here.
%%-------------------------------------------------------------------------
-uri_too_long_414(doc) ->
- ["Test that too long uri's get 414 HTTP code"];
-uri_too_long_414(suite) ->
- [];
+uri_too_long_414() ->
+ [{doc, "Test that too long uri's get 414 HTTP code"}].
uri_too_long_414(Config) when is_list(Config) ->
HttpdConf = ?config(httpd_conf, Config),
- {ok, Pid} = inets:start(httpd, [{port, 0}, {max_uri_size, 10}
+ {ok, Pid} = inets:start(httpd, [{max_uri_size, 10}
| HttpdConf]),
Info = httpd:info(Pid),
Port = proplists:get_value(port, Info),
@@ -178,17 +168,12 @@ uri_too_long_414(Config) when is_list(Config) ->
{version, "HTTP/0.9"}]),
inets:stop(httpd, Pid).
-
-%%-------------------------------------------------------------------------
%%-------------------------------------------------------------------------
-
-header_too_long_413(doc) ->
- ["Test that too long headers's get 413 HTTP code"];
-header_too_long_413(suite) ->
- [];
+header_too_long_413() ->
+ [{doc,"Test that too long headers's get 413 HTTP code"}].
header_too_long_413(Config) when is_list(Config) ->
HttpdConf = ?config(httpd_conf, Config),
- {ok, Pid} = inets:start(httpd, [{port, 0}, {max_header_size, 10}
+ {ok, Pid} = inets:start(httpd, [{max_header_size, 10}
| HttpdConf]),
Info = httpd:info(Pid),
Port = proplists:get_value(port, Info),
@@ -202,8 +187,72 @@ header_too_long_413(Config) when is_list(Config) ->
inets:stop(httpd, Pid).
%%-------------------------------------------------------------------------
+
+entity_too_long() ->
+ [{doc, "Test that too long versions and method strings are rejected"}].
+entity_too_long(Config) when is_list(Config) ->
+ HttpdConf = ?config(httpd_conf, Config),
+ {ok, Pid} = inets:start(httpd, HttpdConf),
+ Info = httpd:info(Pid),
+ Port = proplists:get_value(port, Info),
+ Address = proplists:get_value(bind_address, Info),
+
+ %% Not so long but wrong
+ ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
+ "GET / " ++
+ lists:duplicate(5, $A) ++ "\r\n\r\n",
+ [{statuscode, 400},
+ %% Server will send lowest version
+ %% as it will not get to the
+ %% client version
+ %% before aborting
+ {version, "HTTP/0.9"}]),
+
+ %% Too long
+ ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
+ "GET / " ++
+ lists:duplicate(100, $A) ++ "\r\n\r\n",
+ [{statuscode, 413},
+ %% Server will send lowest version
+ %% as it will not get to the
+ %% client version
+ %% before aborting
+ {version, "HTTP/0.9"}]),
+ %% Not so long but wrong
+ ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
+ lists:duplicate(5, $A) ++ " / "
+ "HTTP/1.1\r\n\r\n",
+ [{statuscode, 501},
+ %% Server will send lowest version
+ %% as it will not get to the
+ %% client version
+ %% before aborting
+ {version, "HTTP/1.1"}]),
+ %% Too long
+ ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
+ lists:duplicate(100, $A) ++ " / "
+ "HTTP/1.1\r\n\r\n",
+ [{statuscode, 413},
+ %% Server will send lowest version
+ %% as it will not get to the
+ %% client version
+ %% before aborting
+ {version, "HTTP/0.9"}]),
+ inets:stop(httpd, Pid).
+
%%-------------------------------------------------------------------------
+script_nocache() ->
+ [{doc,"Test nocache option for mod_cgi and mod_esi"}].
+script_nocache(Config) when is_list(Config) ->
+ Normal = {no_header, "cache-control"},
+ NoCache = {header, "cache-control", "no-cache"},
+ verify_script_nocache(Config, false, false, Normal, Normal),
+ verify_script_nocache(Config, true, false, NoCache, Normal),
+ verify_script_nocache(Config, false, true, Normal, NoCache),
+ verify_script_nocache(Config, true, true, NoCache, NoCache).
+
+%%-------------------------------------------------------------------------
erl_script_nocache_opt(doc) ->
["Test that too long headers's get 413 HTTP code"];
erl_script_nocache_opt(suite) ->
@@ -225,155 +274,49 @@ erl_script_nocache_opt(Config) when is_list(Config) ->
inets:stop(httpd, Pid).
%%-------------------------------------------------------------------------
-%%-------------------------------------------------------------------------
-script_nocache(doc) ->
- ["Test nocache option for mod_cgi and mod_esi"];
-script_nocache(suite) ->
- [];
-script_nocache(Config) when is_list(Config) ->
- Normal = {no_header, "cache-control"},
- NoCache = {header, "cache-control", "no-cache"},
- verify_script_nocache(Config, false, false, Normal, Normal),
- verify_script_nocache(Config, true, false, NoCache, Normal),
- verify_script_nocache(Config, false, true, Normal, NoCache),
- verify_script_nocache(Config, true, true, NoCache, NoCache),
- ok.
-verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) ->
- HttpdConf = ?config(httpd_conf, Config),
- CgiScript = ?config(cgi_printenv, Config),
- CgiDir = ?config(cgi_dir, Config),
- {ok, Pid} = inets:start(httpd, [{port, 0},
- {script_alias,
- {"/cgi-bin/", CgiDir ++ "/"}},
- {script_nocache, CgiNoCache},
- {erl_script_alias,
- {"/cgi-bin/erl", [httpd_example,io]}},
- {erl_script_nocache, EsiNoCache}
- | HttpdConf]),
- Info = httpd:info(Pid),
- Port = proplists:get_value(port, Info),
- Address = proplists:get_value(bind_address, Info),
- ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
- "GET /cgi-bin/" ++ CgiScript ++
- " HTTP/1.0\r\n\r\n",
- [{statuscode, 200},
- CgiOption,
- {version, "HTTP/1.0"}]),
- ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
- "GET /cgi-bin/erl/httpd_example:get "
- "HTTP/1.0\r\n\r\n",
- [{statuscode, 200},
- EsiOption,
- {version, "HTTP/1.0"}]),
- inets:stop(httpd, Pid).
-
-
-%%-------------------------------------------------------------------------
%%-------------------------------------------------------------------------
-escaped_url_in_error_body(doc) ->
- ["Test Url-encoding see OTP-8940"];
-escaped_url_in_error_body(suite) ->
- [];
-escaped_url_in_error_body(Config) when is_list(Config) ->
- %% <CONDITIONAL-SKIP>
- %% This skip is due to a problem on windows with long path's
- %% If a path is too long file:open fails with, for example, eio.
- %% Until that problem is fixed, we skip this case...
- Skippable = [win32],
- Condition = fun() -> ?OS_BASED_SKIP(Skippable) end,
- ?NON_PC_TC_MAYBE_SKIP(Config, Condition),
- %% </CONDITIONAL-SKIP>
-
- tsp("escaped_url_in_error_body -> entry"),
+escaped_url_in_error_body() ->
+ [{doc, "Test Url-encoding see OTP-8940"}].
+escaped_url_in_error_body(Config) when is_list(Config) ->
HttpdConf = ?config(httpd_conf, Config),
{ok, Pid} = inets:start(httpd, [{port, 0} | HttpdConf]),
Info = httpd:info(Pid),
Port = proplists:get_value(port, Info),
- _Address = proplists:get_value(bind_address, Info),
-
- %% Request 1
- tss(1000),
- tsp("escaped_url_in_error_body -> request 1"),
URL1 = ?URL_START ++ integer_to_list(Port),
- %% Make sure the server is ok, by making a request for a valid page
- case httpc:request(get, {URL1 ++ "/dummy.html", []},
- [{url_encode, false},
- {version, "HTTP/1.0"}],
- [{full_result, false}]) of
- {ok, {200, _}} ->
- %% Don't care about the the body, just that we get a ok response
- ok;
- {ok, {StatusCode1, Body1}} ->
- tsf({unexpected_ok_1, StatusCode1, Body1})
- end,
-
- %% Request 2
- tss(1000),
- tsp("escaped_url_in_error_body -> request 2"),
- %% Make sure the server is ok, by making a request for a valid page
- case httpc:request(get, {URL1 ++ "/dummy.html", []},
- [{url_encode, true},
- {version, "HTTP/1.0"}],
- [{full_result, false}]) of
- {ok, {200, _}} ->
- %% Don't care about the the body, just that we get a ok response
- ok;
- {ok, {StatusCode2, Body2}} ->
- tsf({unexpected_ok_2, StatusCode2, Body2})
- end,
-
- %% Request 3
- tss(1000),
- tsp("escaped_url_in_error_body -> request 3"),
+
+ %% Sanity check
+ {ok, {200, _}} = httpc:request(get, {URL1 ++ "/dummy.html", []},
+ [{url_encode, false},
+ {version, "HTTP/1.0"}],
+ [{full_result, false}]),
+ {ok, {200, _}} = httpc:request(get, {URL1 ++ "/dummy.html", []},
+ [{url_encode, true},
+ {version, "HTTP/1.0"}],
+ [{full_result, false}]),
+
%% Ask for a non-existing page(1)
Path = "/<b>this_is_bold<b>",
HTMLEncodedPath = http_util:html_encode(Path),
URL2 = URL1 ++ Path,
- case httpc:request(get, {URL2, []},
- [{url_encode, true},
- {version, "HTTP/1.0"}],
- [{full_result, false}]) of
- {ok, {404, Body3}} ->
- case find_URL_path(string:tokens(Body3, " ")) of
- HTMLEncodedPath ->
- ok;
- BadPath3 ->
- tsf({unexpected_path_3, HTMLEncodedPath, BadPath3})
- end;
- {ok, UnexpectedOK3} ->
- tsf({unexpected_ok_3, UnexpectedOK3})
- end,
+ {ok, {404, Body3}} = httpc:request(get, {URL2, []},
+ [{url_encode, true},
+ {version, "HTTP/1.0"}],
+ [{full_result, false}]),
- %% Request 4
- tss(1000),
- tsp("escaped_url_in_error_body -> request 4"),
- %% Ask for a non-existing page(2)
- case httpc:request(get, {URL2, []},
- [{url_encode, false},
- {version, "HTTP/1.0"}],
- [{full_result, false}]) of
- {ok, {404, Body4}} ->
- case find_URL_path(string:tokens(Body4, " ")) of
- HTMLEncodedPath ->
- ok;
- BadPath4 ->
- tsf({unexpected_path_4, HTMLEncodedPath, BadPath4})
- end;
- {ok, UnexpectedOK4} ->
- tsf({unexpected_ok_4, UnexpectedOK4})
- end,
- tss(1000),
- tsp("escaped_url_in_error_body -> stop inets"),
- inets:stop(httpd, Pid),
- tsp("escaped_url_in_error_body -> done"),
- ok.
+ HTMLEncodedPath = find_URL_path(string:tokens(Body3, " ")),
+ {ok, {404, Body4}} = httpc:request(get, {URL2, []},
+ [{url_encode, false},
+ {version, "HTTP/1.0"}],
+ [{full_result, false}]),
+
+ HTMLEncodedPath = find_URL_path(string:tokens(Body4, " ")),
+ inets:stop(httpd, Pid).
%%-------------------------------------------------------------------------
-%%-------------------------------------------------------------------------
keep_alive_timeout(doc) ->
["Test the keep_alive_timeout option"];
@@ -393,7 +336,6 @@ keep_alive_timeout(Config) when is_list(Config) ->
inets:stop(httpd, Pid).
%%-------------------------------------------------------------------------
-%%-------------------------------------------------------------------------
script_timeout(doc) ->
["Test the httpd script_timeout option"];
@@ -423,12 +365,10 @@ verify_script_timeout(Config, ScriptTimeout, StatusCode) ->
{version, "HTTP/1.0"}]),
inets:stop(httpd, Pid).
-
-%%-------------------------------------------------------------------------
%%-------------------------------------------------------------------------
-slowdose(doc) ->
- ["Testing minimum bytes per second option"];
+slowdose() ->
+ [{doc, "Testing minimum bytes per second option"}].
slowdose(Config) when is_list(Config) ->
HttpdConf = ?config(httpd_conf, Config),
{ok, Pid} = inets:start(httpd, [{port, 0}, {minimum_bytes_per_second, 200}|HttpdConf]),
@@ -439,6 +379,40 @@ slowdose(Config) when is_list(Config) ->
after 6000 ->
{error, closed} = gen_tcp:send(Socket, "Hey")
end.
+
+%%-------------------------------------------------------------------------
+%% Internal functions
+%%-------------------------------------------------------------------------
+
+verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) ->
+ HttpdConf = ?config(httpd_conf, Config),
+ CgiScript = ?config(cgi_printenv, Config),
+ CgiDir = ?config(cgi_dir, Config),
+ {ok, Pid} = inets:start(httpd, [{port, 0},
+ {script_alias,
+ {"/cgi-bin/", CgiDir ++ "/"}},
+ {script_nocache, CgiNoCache},
+ {erl_script_alias,
+ {"/cgi-bin/erl", [httpd_example,io]}},
+ {erl_script_nocache, EsiNoCache}
+ | HttpdConf]),
+ Info = httpd:info(Pid),
+ Port = proplists:get_value(port, Info),
+ Address = proplists:get_value(bind_address, Info),
+ ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
+ "GET /cgi-bin/" ++ CgiScript ++
+ " HTTP/1.0\r\n\r\n",
+ [{statuscode, 200},
+ CgiOption,
+ {version, "HTTP/1.0"}]),
+ ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(),
+ "GET /cgi-bin/erl/httpd_example:get "
+ "HTTP/1.0\r\n\r\n",
+ [{statuscode, 200},
+ EsiOption,
+ {version, "HTTP/1.0"}]),
+ inets:stop(httpd, Pid).
+
find_URL_path([]) ->
"";
find_URL_path(["URL", URL | _]) ->
@@ -446,21 +420,6 @@ find_URL_path(["URL", URL | _]) ->
find_URL_path([_ | Rest]) ->
find_URL_path(Rest).
-
-tsp(F) ->
- inets_test_lib:tsp(F).
-tsp(F, A) ->
- inets_test_lib:tsp(F, A).
-
-tsf(Reason) ->
- inets_test_lib:tsf(Reason).
-
-tss(Time) ->
- inets_test_lib:tss(Time).
-
-
-
-
skip(Reason) ->
{skip, Reason}.
diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl
index 706d014bda..9790623b6f 100644
--- a/lib/inets/test/httpd_block.erl
+++ b/lib/inets/test/httpd_block.erl
@@ -111,8 +111,7 @@ block_disturbing_active_timeout_not_released(Type, Port, Host, Node) ->
process_flag(trap_exit, true),
Poller = long_poll(Type, Host, Port, Node, 200, 60000),
ct:sleep(15000),
- Blocker = blocker(Node, Host, Port, 50000),
- await_normal_process_exit(Blocker, "blocker", 50000),
+ ok = httpd_block(undefined, Port, disturbing, 50000),
await_normal_process_exit(Poller, "poller", 30000),
blocked = get_admin_state(Node, Host, Port),
process_flag(trap_exit, false),
@@ -123,8 +122,7 @@ block_disturbing_active_timeout_released(Type, Port, Host, Node) ->
process_flag(trap_exit, true),
Poller = long_poll(Type, Host, Port, Node, 200, 40000),
ct:sleep(5000),
- Blocker = blocker(Node, Host, Port, 10000),
- await_normal_process_exit(Blocker, "blocker", 15000),
+ ok = httpd_block(undefined, Port, disturbing, 10000),
await_suite_failed_process_exit(Poller, "poller", 40000,
connection_closed),
blocked = get_admin_state(Node, Host, Port),
diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl
index ed466fd727..36a5bb9e71 100644
--- a/lib/inets/test/httpd_test_lib.erl
+++ b/lib/inets/test/httpd_test_lib.erl
@@ -103,7 +103,7 @@ verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, T
try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of
{ok, Socket} ->
- SendRes = inets_test_lib:send(SocketType, Socket, RequestStr),
+ ok = inets_test_lib:send(SocketType, Socket, RequestStr),
State = case inets_regexp:match(RequestStr, "printenv") of
nomatch ->
#state{};
diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl
index 3e1a1a3845..19c2bc129e 100644
--- a/lib/inets/test/old_httpd_SUITE.erl
+++ b/lib/inets/test/old_httpd_SUITE.erl
@@ -182,22 +182,24 @@ groups() ->
%% ip_load_medium,
%% ip_load_heavy,
%%ip_dos_hostname,
- ip_time_test
- %% Replaced by load_config
- %% ip_restart_no_block,
- %% ip_restart_disturbing_block,
- %% ip_restart_non_disturbing_block,
- %% ip_block_disturbing_idle,
- %% ip_block_non_disturbing_idle,
- %% ip_block_503,
- %% ip_block_disturbing_active,
- %% ip_block_non_disturbing_active,
- %% ip_block_disturbing_active_timeout_not_released,
- %% ip_block_disturbing_active_timeout_released,
- %% ip_block_non_disturbing_active_timeout_not_released,
- %% ip_block_non_disturbing_active_timeout_released,
- %% ip_block_disturbing_blocker_dies,
- %% ip_block_non_disturbing_blocker_dies
+ ip_time_test,
+ %% Only used through load_config
+ %% but we still need these tests
+ %% should be cleaned up and moved to new test suite
+ ip_restart_no_block,
+ ip_restart_disturbing_block,
+ ip_restart_non_disturbing_block,
+ ip_block_disturbing_idle,
+ ip_block_non_disturbing_idle,
+ ip_block_503,
+ ip_block_disturbing_active,
+ ip_block_non_disturbing_active,
+ ip_block_disturbing_active_timeout_not_released,
+ ip_block_disturbing_active_timeout_released,
+ ip_block_non_disturbing_active_timeout_not_released,
+ ip_block_non_disturbing_active_timeout_released,
+ ip_block_disturbing_blocker_dies,
+ ip_block_non_disturbing_blocker_dies
]},
{ssl, [], [{group, essl}]},
{essl, [],
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index cbcf0362c9..bbd86c3eb3 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -18,6 +18,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 5.10
+INETS_VSN = 5.10.1
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index 4a48a5c3d8..50e1cc290c 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -361,7 +361,7 @@ fe80::204:acff:fe17:bf38
</item>
<tag><c>send_dvi</c></tag>
<item>
- <p>Average packet size deviation in bytes received sent from the socket.</p>
+ <p>Average packet size deviation in bytes sent from the socket.</p>
</item>
<tag><c>send_max</c></tag>
<item>
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index 49a93d2c70..00c6bc33d6 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -4,7 +4,7 @@
<appref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -35,7 +35,7 @@
Erlang/OTP consists of Kernel and STDLIB. The Kernel application
contains the following services:</p>
<list type="bulleted">
- <item>application controller, see <c>application(3)</c></item>
+ <item>application controller, see <seealso marker="application">application(3)</seealso></item>
<item><c>code</c></item>
<item><c>disk_log</c></item>
<item><c>dist_ac</c>, distributed application controller</item>
@@ -66,8 +66,8 @@
<section>
<title>Configuration</title>
<p>The following configuration parameters are defined for the Kernel
- application. See <c>app(3)</c> for more information about
- configuration parameters.</p>
+ application. See <seealso marker="app">app(4)</seealso> for more
+ information about configuration parameters.</p>
<taglist>
<tag><c>browser_cmd = string() | {M,F,A}</c></tag>
<item>
@@ -93,7 +93,8 @@
<item><c>Time = integer()>0</c></item>
<item><c>Nodes = [node() | {node(),...,node()}]</c></item>
</list>
- <p>The parameter is described in <c>application(3)</c>, function
+ <p>The parameter is described in
+ <seealso marker="application">application(3)</seealso>, function
<c>load/2</c>.</p>
</item>
<tag><c>dist_auto_connect = Value</c></tag>
@@ -105,11 +106,13 @@
<taglist>
<tag><c>never</c></tag>
<item>Connections are never automatically established, they
- must be explicitly connected. See <c>net_kernel(3)</c>.</item>
+ must be explicitly connected. See
+ <seealso marker="net_kernel">net_kernel(3)</seealso>.</item>
<tag><c>once</c></tag>
<item>Connections will be established automatically, but only
once per node. If a node goes down, it must thereafter be
- explicitly connected. See <c>net_kernel(3)</c>.</item>
+ explicitly connected. See
+ <seealso marker="net_kernel">net_kernel(3)</seealso>.</item>
</taglist>
</item>
<tag><c>permissions = [Perm]</c></tag>
@@ -121,7 +124,8 @@
<item><c>ApplName = atom()</c></item>
<item><c>Bool = boolean()</c></item>
</list>
- <p>Permissions are described in <c>application(3)</c>, function
+ <p>Permissions are described in
+ <seealso marker="application">application(3)</seealso>, function
<c>permit/2</c>.</p>
</item>
<tag><c>error_logger = Value</c></tag>
@@ -149,7 +153,8 @@
</item>
<tag><c>global_groups = [GroupTuple]</c></tag>
<item>
- <p>Defines global groups, see <c>global_group(3)</c>.</p>
+ <p>Defines global groups, see
+ <seealso marker="global_group">global_group(3)</seealso>.</p>
<list type="bulleted">
<item><c>GroupTuple = {GroupName, [Node]} | {GroupName, PublishType, [Node]}</c></item>
<item><c>GroupName = atom()</c></item>
@@ -160,18 +165,19 @@
<tag><c>inet_default_connect_options = [{Opt, Val}]</c></tag>
<item>
<p>Specifies default options for <c>connect</c> sockets,
- see <c>inet(3)</c>.</p>
+ see <seealso marker="inet">inet(3)</seealso>.</p>
</item>
<tag><c>inet_default_listen_options = [{Opt, Val}]</c></tag>
<item>
<p>Specifies default options for <c>listen</c> (and
- <c>accept</c>) sockets, see <c>inet(3)</c>.</p>
+ <c>accept</c>) sockets, see <seealso marker="inet">inet(3)</seealso>.</p>
</item>
<tag><c>{inet_dist_use_interface, ip_address()}</c></tag>
<item>
<p>If the host of an Erlang node has several network interfaces,
this parameter specifies which one to listen on. See
- <c>inet(3)</c> for the type definition of <c>ip_address()</c>.</p>
+ <seealso marker="inet">inet(3)</seealso> for the type definition
+ of <c>ip_address()</c>.</p>
</item>
<tag><c>{inet_dist_listen_min, First}</c></tag>
<item>
@@ -276,7 +282,8 @@ MaxT = TickTime + TickTime / 4</code>
<tag><c>start_boot_server = true | false</c></tag>
<item>
<p>Starts the <c>boot_server</c> if the parameter is <c>true</c>
- (see <c>erl_boot_server(3)</c>). This parameter should be
+ (see <seealso marker="erl_boot_server">erl_boot_server(3)</seealso>).
+ This parameter should be
set to <c>true</c> in an embedded system which uses this
service.</p>
<p>The default value is <c>false</c>.</p>
@@ -296,13 +303,15 @@ MaxT = TickTime + TickTime / 4</code>
<tag><c>start_disk_log = true | false</c></tag>
<item>
<p>Starts the <c>disk_log_server</c> if the parameter is
- <c>true</c> (see <c>disk_log(3)</c>). This parameter should be
+ <c>true</c> (see <seealso marker="disk_log">disk_log(3)</seealso>).
+ This parameter should be
set to true in an embedded system which uses this service.</p>
<p>The default value is <c>false</c>.</p>
</item>
<tag><c>start_pg2 = true | false</c></tag>
<item>
- <p>Starts the <c>pg2</c> server (see <c>pg2(3)</c>) if
+ <p>Starts the <c>pg2</c> server (see
+ <seealso marker="pg2">pg2(3)</seealso>) if
the parameter is <c>true</c>. This parameter should be set to
<c>true</c> in an embedded system which uses this service.</p>
<p>The default value is <c>false</c>.</p>
@@ -310,7 +319,8 @@ MaxT = TickTime + TickTime / 4</code>
<tag><c>start_timer = true | false</c></tag>
<item>
<p>Starts the <c>timer_server</c> if the parameter is
- <c>true</c> (see <c>timer(3)</c>). This parameter should be
+ <c>true</c> (see <seealso marker="stdlib:timer">timer(3)</seealso>).
+ This parameter should be
set to <c>true</c> in an embedded system which uses this
service.</p>
<p>The default value is <c>false</c>.</p>
@@ -351,6 +361,7 @@ MaxT = TickTime + TickTime / 4</code>
<seealso marker="pg2">pg2(3)</seealso>,
<seealso marker="rpc">rpc(3)</seealso>,
<seealso marker="seq_trace">seq_trace(3)</seealso>,
+ <seealso marker="stdlib:timer">timer(3)</seealso>,
<seealso marker="user">user(3)</seealso></p>
</section>
</appref>
diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl
index ed13035104..daad45b6c2 100644
--- a/lib/kernel/src/application_controller.erl
+++ b/lib/kernel/src/application_controller.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -829,12 +829,12 @@ handle_call({change_application_data, Applications, Config}, _From, S) ->
{reply, Error, S};
{'EXIT', R} ->
{reply, {error, R}, S};
- NewAppls ->
+ {NewAppls, NewConfig} ->
lists:foreach(fun(Appl) ->
ets:insert(ac_tab, {{loaded, Appl#appl.name},
Appl})
end, NewAppls),
- {reply, ok, S#state{conf_data = Config}}
+ {reply, ok, S#state{conf_data = NewConfig}}
end;
handle_call(prep_config_change, _From, S) ->
@@ -1550,18 +1550,19 @@ do_change_apps(Applications, Config, OldAppls) ->
end,
Errors),
- map(fun(Appl) ->
- AppName = Appl#appl.name,
- case is_loaded_app(AppName, Applications) of
- {true, Application} ->
- do_change_appl(make_appl(Application),
- Appl, SysConfig);
-
- %% ignored removed apps - handled elsewhere
- false ->
- Appl
- end
- end, OldAppls).
+ {map(fun(Appl) ->
+ AppName = Appl#appl.name,
+ case is_loaded_app(AppName, Applications) of
+ {true, Application} ->
+ do_change_appl(make_appl(Application),
+ Appl, SysConfig);
+
+ %% ignored removed apps - handled elsewhere
+ false ->
+ Appl
+ end
+ end, OldAppls),
+ SysConfig}.
is_loaded_app(AppName, [{application, AppName, App} | _]) ->
{true, {application, AppName, App}};
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index fc7ac08699..819554ce74 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -63,7 +63,10 @@ init(Ref, Parent, [Root,Mode0]) ->
process_flag(trap_exit, true),
Db = ets:new(code, [private]),
- foreach(fun (M) -> ets:insert(Db, {M,preloaded}) end, erlang:pre_loaded()),
+ foreach(fun (M) ->
+ %% Pre-loaded modules are always sticky.
+ ets:insert(Db, [{M,preloaded},{{sticky,M},true}])
+ end, erlang:pre_loaded()),
ets:insert(Db, init:fetch_loaded()),
Mode =
@@ -988,7 +991,7 @@ try_archive_subdirs(_Archive, Base, []) ->
%% the complete directory name.
%%
del_path(Name0,Path,NameDb) ->
- case catch to_list(Name0)of
+ case catch filename:join([to_list(Name0)]) of
{'EXIT',_} ->
{{error,bad_name},Path};
Name ->
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index f7a815882b..ef605d0bfe 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -182,6 +182,11 @@ size(Tuple, Seen0, Sum0) when is_tuple(Tuple) ->
Sum = Sum0 + 1 + tuple_size(Tuple),
tuple_size(1, tuple_size(Tuple), Tuple, Seen, Sum)
end;
+size(Map, Seen0, Sum) when is_map(Map) ->
+ case remember_term(Map, Seen0) of
+ seen -> {Sum,Seen0};
+ Seen -> map_size(Map, Seen, Sum)
+ end;
size(Fun, Seen0, Sum) when is_function(Fun) ->
case remember_term(Fun, Seen0) of
seen -> {Sum,Seen0};
@@ -203,6 +208,12 @@ tuple_size(I, Sz, Tuple, Seen0, Sum0) ->
{Sum,Seen} = size(element(I, Tuple), Seen0, Sum0),
tuple_size(I+1, Sz, Tuple, Seen, Sum).
+map_size(Map,Seen0,Sum0) ->
+ Kt = erts_internal:map_to_tuple_keys(Map),
+ Vs = maps:values(Map),
+ {Sum1,Seen1} = size(Kt,Seen0,Sum0),
+ fold_size(Vs,Seen1,Sum1+length(Vs)+3).
+
fun_size(Fun, Seen, Sum) ->
case erlang:fun_info(Fun, type) of
{type,external} ->
@@ -210,14 +221,14 @@ fun_size(Fun, Seen, Sum) ->
{type,local} ->
Sz = erts_debug:flat_size(fun() -> ok end),
{env,Env} = erlang:fun_info(Fun, env),
- fun_size_1(Env, Seen, Sum+Sz+length(Env))
+ fold_size(Env, Seen, Sum+Sz+length(Env))
end.
-fun_size_1([H|T], Seen0, Sum0) ->
+fold_size([H|T], Seen0, Sum0) ->
{Sum,Seen} = size(H, Seen0, Sum0),
- fun_size_1(T, Seen, Sum);
-fun_size_1([], Seen, Sum) -> {Sum,Seen}.
-
+ fold_size(T, Seen, Sum);
+fold_size([], Seen, Sum) -> {Sum,Seen}.
+
remember_term(Term, Seen) ->
case gb_trees:lookup(Term, Seen) of
none -> gb_trees:insert(Term, [Term], Seen);
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
index c6cbd1a0ef..4901206c8e 100644
--- a/lib/kernel/test/application_SUITE.erl
+++ b/lib/kernel/test/application_SUITE.erl
@@ -1076,10 +1076,13 @@ otp_1586(Conf) when is_list(Conf) ->
{ok, Fd} = file:open(filename:join(Dir, "app5.app"), [write]),
w_app5(Fd),
file:close(Fd),
- code:add_patha(Dir),
- ok = application:load(app4()),
- ok = application:unload(app4),
- ok.
+ try
+ true = code:add_patha(Dir),
+ ok = application:load(app4()),
+ ok = application:unload(app4)
+ after
+ _ = code:del_path(Dir)
+ end.
%%-----------------------------------------------------------------
%% Ticket: OTP-2078
@@ -1949,14 +1952,22 @@ config_change(Conf) when is_list(Conf) ->
%% Find out application data from boot script
Boot = filename:join([code:root_dir(), "bin", "start.boot"]),
{ok, Bin} = file:read_file(Boot),
- Appls = get_appls(binary_to_term(Bin)),
+ Appls0 = get_appls(binary_to_term(Bin)),
+
+ %% And add app1 in order to test OTP-11864 - included config files
+ %% not read for new (not already loaded) applications
+ Appls = [app1() | Appls0],
%% Simulate contents of "sys.config"
Config = [{stdlib, [{par1,sys},{par2,sys}]},
"t1",
"t2.config",
filename:join([DataDir, "subdir", "t3"]),
- {stdlib, [{par6,sys}]}],
+ {stdlib, [{par6,sys}]},
+ "t4.config"],
+
+ %% Check that app1 is not loaded
+ false = lists:keymember(app1,1,application:loaded_applications()),
%% Order application_controller to update configuration
ok = application_controller:change_application_data(Appls,
@@ -1971,6 +1982,13 @@ config_change(Conf) when is_list(Conf) ->
{value, {par5,t3}} = lists:keysearch(par5, 1, Env),
{value, {par6,sys}} = lists:keysearch(par6, 1, Env),
+ %% Check that app1 parameters are correctly set after loading
+ [] = application:get_all_env(app1),
+ application:load(app1()),
+ App1Env = application:get_all_env(app1),
+ {value, {par1,t4}} = lists:keysearch(par1, 1, App1Env),
+ application:unload(app1),
+
ok = file:set_cwd(CWD).
%% This function is stolen from SASL module release_handler, OTP R10B
@@ -1989,6 +2007,7 @@ get_appls([_ | T], Res) ->
get_appls([], Res) ->
Res.
+
persistent_env(suite) ->
[];
persistent_env(doc) ->
diff --git a/lib/kernel/test/application_SUITE_data/t4.config b/lib/kernel/test/application_SUITE_data/t4.config
new file mode 100644
index 0000000000..8b2bc52c01
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/t4.config
@@ -0,0 +1 @@
+[{app1, [{par1,t4}]}]. \ No newline at end of file
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 42b81d16b3..afedc17e57 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -37,8 +37,7 @@
native_early_modules/1, get_mode/1]).
-export([init_per_testcase/2, end_per_testcase/2,
- init_per_suite/1, end_per_suite/1,
- sticky_compiler/1]).
+ init_per_suite/1, end_per_suite/1]).
%% error_logger
-export([init/1,
@@ -55,7 +54,7 @@ all() ->
delete, purge, purge_many_exits, soft_purge, is_loaded, all_loaded,
load_binary, dir_req, object_code, set_path_file,
upgrade,
- pa_pz_option, add_del_path, dir_disappeared,
+ sticky_dir, pa_pz_option, add_del_path, dir_disappeared,
ext_mod_dep, clash, load_cached, start_node_with_cache,
add_and_rehash, where_is_file_no_cache,
where_is_file_cached, purge_stacktrace, mult_lib_roots,
@@ -219,6 +218,13 @@ del_path(suite) -> [];
del_path(doc) -> [];
del_path(Config) when is_list(Config) ->
P = code:get_path(),
+ try
+ del_path_1(P)
+ after
+ code:set_path(P)
+ end.
+
+del_path_1(P) ->
test_server:format("Initial code:get_path()=~p~n",[P]),
{'EXIT',_} = (catch code:del_path(3)),
false = code:del_path(my_dummy_name),
@@ -226,19 +232,22 @@ del_path(Config) when is_list(Config) ->
Dir = filename:join([code:lib_dir(kernel),"ebin"]),
test_server:format("kernel dir: ~p~n",[Dir]),
-
true = code:del_path(kernel),
NewP = code:get_path(),
test_server:format("Path after removing 'kernel':~p~n",[NewP]),
ReferenceP = lists:delete(Dir,P),
test_server:format("Reference path:~p~n",[ReferenceP]),
NewP = ReferenceP, % check that dir is deleted
+ code:set_path(P),
+ %% An superfluous "/" should also work.
+ true = code:del_path("kernel/"),
+ NewP = ReferenceP, % check that dir is deleted
code:set_path(P),
+
true = code:del_path(Dir),
NewP1 = code:get_path(),
NewP1 = lists:delete(Dir,P), % check that dir is deleted
- code:set_path(P),
ok.
replace_path(suite) -> [];
@@ -577,35 +586,42 @@ sticky_dir(suite) -> [];
sticky_dir(doc) -> ["Test that a module with the same name as a module in ",
"a sticky directory cannot be loaded."];
sticky_dir(Config) when is_list(Config) ->
- MyDir=filename:dirname(code:which(?MODULE)),
- {ok, Node}=?t:start_node(sticky_dir, slave,[{args, "-pa \""++MyDir++"\""}]),
- File=filename:join([?config(data_dir, Config), "calendar"]),
- Ret=rpc:call(Node, ?MODULE, sticky_compiler, [File]),
+ Pa = filename:dirname(code:which(?MODULE)),
+ {ok,Node} = ?t:start_node(sticky_dir, slave, [{args,"-pa "++Pa}]),
+ Mods = [code,lists,erlang,init],
+ OutDir = filename:join(?config(priv_dir, Config), sticky_dir),
+ _ = file:make_dir(OutDir),
+ Ret = rpc:call(Node, erlang, apply,
+ [fun sticky_compiler/2,[Mods,OutDir]]),
case Ret of
- fail ->
- ?t:fail("c:c allowed a sticky module to be compiled and loaded.");
- ok ->
+ [] ->
ok;
Other ->
- test_server:format("Other: ~p",[Other])
+ io:format("~p\n", [Other]),
+ ?t:fail()
end,
- ?t:stop_node(Node).
+ ?t:stop_node(Node),
+ ok.
-sticky_compiler(File) ->
- Compiled=File++code:objfile_extension(),
- Dir=filename:dirname(File),
- code:add_patha(Dir),
- file:delete(Compiled),
- case c:c(File, [{outdir, Dir}]) of
- {ok, Module} ->
- case catch Module:test(apa) of
- {error, _} ->
- fail;
- {'EXIT', _} ->
- ok
- end;
- Other ->
- test_server:format("c:c(~p) returned: ~p",[File, Other]),
+sticky_compiler(Files, PrivDir) ->
+ code:add_patha(PrivDir),
+ Rets = [do_sticky_compile(F, PrivDir) || F <- Files],
+ [R || R <- Rets, R =/= ok].
+
+do_sticky_compile(Mod, Dir) ->
+ %% Make sure that the module is loaded. A module being sticky
+ %% only prevents it from begin reloaded, not from being loaded
+ %% from the wrong place to begin with.
+ Mod = Mod:module_info(module),
+ File = filename:append(Dir, atom_to_list(Mod)),
+ Src = io_lib:format("-module(~s).\n"
+ "-export([test/1]).\n"
+ "test(me) -> fail.\n", [Mod]),
+ ok = file:write_file(File++".erl", Src),
+ case c:c(File, [{outdir,Dir}]) of
+ {ok,Module} ->
+ Module:test(me);
+ {error,sticky_directory} ->
ok
end.
diff --git a/lib/kernel/test/code_SUITE_data/calendar.erl b/lib/kernel/test/code_SUITE_data/calendar.erl
deleted file mode 100644
index c1a4a1c12a..0000000000
--- a/lib/kernel/test/code_SUITE_data/calendar.erl
+++ /dev/null
@@ -1,23 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(calendar).
--export([test/1]).
-
-test(apa) ->
- {error, this_function_should_not_be_called}.
diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl
index 78f5e93fc3..1884e8cf58 100644
--- a/lib/kernel/test/kernel_SUITE.erl
+++ b/lib/kernel/test/kernel_SUITE.erl
@@ -95,10 +95,10 @@ appup_tests(App,{OkVsns,NokVsns}) ->
ok.
create_test_vsns(App) ->
- This = erlang:system_info(otp_release),
- FirstMajor = previous_major(This),
+ ThisMajor = erlang:system_info(otp_release),
+ FirstMajor = previous_major(ThisMajor),
SecondMajor = previous_major(FirstMajor),
- Ok = app_vsn(App,[FirstMajor]),
+ Ok = app_vsn(App,[ThisMajor,FirstMajor]),
Nok0 = app_vsn(App,[SecondMajor]),
Nok = case Ok of
[Ok1|_] ->
@@ -109,9 +109,9 @@ create_test_vsns(App) ->
{Ok,Nok}.
previous_major("17") ->
- "r16";
-previous_major("r"++Rel) ->
- "r"++previous_major(Rel);
+ "r16b";
+previous_major("r16b") ->
+ "r15b";
previous_major(Rel) ->
integer_to_list(list_to_integer(Rel)-1).
diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl
index 2c741232c4..123e849ccb 100644
--- a/lib/kernel/test/sendfile_SUITE.erl
+++ b/lib/kernel/test/sendfile_SUITE.erl
@@ -72,7 +72,12 @@ end_per_suite(Config) ->
file:delete(proplists:get_value(big_file, Config)).
init_per_group(async_threads,Config) ->
- [{sendfile_opts,[{use_threads,true}]}|Config];
+ case erlang:system_info(thread_pool_size) of
+ 0 ->
+ {skip,"No async threads"};
+ _ ->
+ [{sendfile_opts,[{use_threads,true}]}|Config]
+ end;
init_per_group(no_async_threads,Config) ->
[{sendfile_opts,[{use_threads,false}]}|Config].
diff --git a/lib/megaco/aclocal.m4 b/lib/megaco/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/megaco/aclocal.m4
+++ b/lib/megaco/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index a83e55ac62..fe2fd67d71 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.erl
@@ -1208,7 +1208,14 @@ handle_info(Done = #loader_done{worker_pid=WPid, table_name=Tab}, State0) ->
{value,{_,Worker}} = lists:keysearch(WPid,1,get_loaders(State0)),
add_loader(Tab,Worker,State1);
_ ->
- State1
+ DelState = State1#state{late_loader_queue=gb_trees:delete_any(Tab, LateQueue0)},
+ case ?catch_val({Tab, storage_type}) of
+ ram_copies ->
+ cast({disc_load, Tab, ram_only}),
+ DelState;
+ _ ->
+ DelState
+ end
end
end,
State3 = opt_start_worker(State2),
diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl
index 81b435c6dc..e27396731f 100644
--- a/lib/mnesia/src/mnesia_locker.erl
+++ b/lib/mnesia/src/mnesia_locker.erl
@@ -84,7 +84,7 @@ init(Parent) ->
register(?MODULE, self()),
process_flag(trap_exit, true),
?ets_new_table(mnesia_held_locks, [ordered_set, private, named_table]),
- ?ets_new_table(mnesia_tid_locks, [bag, private, named_table]),
+ ?ets_new_table(mnesia_tid_locks, [ordered_set, private, named_table]),
?ets_new_table(mnesia_sticky_locks, [set, private, named_table]),
?ets_new_table(mnesia_lock_queue, [bag, private, named_table, {keypos, 2}]),
@@ -131,9 +131,14 @@ send_release_tid(Nodes, Tid) ->
receive_release_tid_acc([Node | Nodes], Tid) ->
receive
{?MODULE, Node, {tid_released, Tid}} ->
- receive_release_tid_acc(Nodes, Tid);
- {mnesia_down, Node} ->
receive_release_tid_acc(Nodes, Tid)
+ after 0 ->
+ receive
+ {?MODULE, Node, {tid_released, Tid}} ->
+ receive_release_tid_acc(Nodes, Tid);
+ {mnesia_down, Node} ->
+ receive_release_tid_acc(Nodes, Tid)
+ end
end;
receive_release_tid_acc([], _Tid) ->
ok.
@@ -248,13 +253,13 @@ loop(State) ->
end.
set_lock(Tid, Oid, Op, []) ->
- ?ets_insert(mnesia_tid_locks, {Tid, Oid, Op}),
+ ?ets_insert(mnesia_tid_locks, {{Tid, Oid, Op}}),
?ets_insert(mnesia_held_locks, {Oid, Op, [{Op, Tid}]});
set_lock(Tid, Oid, read, [{Oid, Prev, Items}]) ->
- ?ets_insert(mnesia_tid_locks, {Tid, Oid, read}),
+ ?ets_insert(mnesia_tid_locks, {{Tid, Oid, read}}),
?ets_insert(mnesia_held_locks, {Oid, Prev, [{read, Tid}|Items]});
set_lock(Tid, Oid, write, [{Oid, _Prev, Items}]) ->
- ?ets_insert(mnesia_tid_locks, {Tid, Oid, write}),
+ ?ets_insert(mnesia_tid_locks, {{Tid, Oid, write}}),
?ets_insert(mnesia_held_locks, {Oid, write, [{write, Tid}|Items]});
set_lock(Tid, Oid, Op, undefined) ->
set_lock(Tid, Oid, Op, ?ets_lookup(mnesia_held_locks, Oid)).
@@ -294,7 +299,7 @@ try_lock(Tid, Op, SimpleOp, Lock, Pid, Oid) ->
?ets_insert(mnesia_lock_queue,
#queue{oid = Oid, tid = Tid, op = Op,
pid = Pid, lucky = Lucky}),
- ?ets_insert(mnesia_tid_locks, {Tid, Oid, {queued, Op}})
+ ?ets_insert(mnesia_tid_locks, {{Tid, Oid, {queued, Op}}})
end.
grant_lock(Tid, read, Lock, Oid = {Tab, Key}, Default)
@@ -493,7 +498,7 @@ set_read_lock_on_all_keys(Tid, From, Tab, IxKey, Pos) ->
?ets_insert(mnesia_lock_queue,
#queue{oid = Oid, tid = Tid, op = Op,
pid = From, lucky = Lucky}),
- ?ets_insert(mnesia_tid_locks, {Tid, Oid, {queued, Op}})
+ ?ets_insert(mnesia_tid_locks, {{Tid, Oid, {queued, Op}}})
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -509,7 +514,8 @@ release_remote_non_pending(Node, Pending) ->
%% running at the failed node and also simply remove all
%% queue'd requests back to the failed node
- AllTids = ?ets_match(mnesia_tid_locks, {'$1', '_', '_'}),
+ AllTids0 = ?ets_match(mnesia_tid_locks, {{'$1', '_', '_'}}),
+ AllTids = lists:usort(AllTids0),
Tids = [T || [T] <- AllTids, Node == node(T#tid.pid), not lists:member(T, Pending)],
do_release_tids(Tids).
@@ -520,9 +526,10 @@ do_release_tids([]) ->
ok.
do_release_tid(Tid) ->
- Locks = ?ets_lookup(mnesia_tid_locks, Tid),
+ Objects = ets:select(mnesia_tid_locks, [{{{Tid, '_', '_'}}, [], ['$_']}]),
+ Locks = lists:map(fun({L}) -> L end, Objects),
?dbg("Release ~p ~p ~n", [Tid, Locks]),
- ?ets_delete(mnesia_tid_locks, Tid),
+ [?ets_delete(mnesia_tid_locks, L) || L <- Locks],
release_locks(Locks),
%% Removed queued locks which has had locks
UniqueLocks = keyunique(lists:sort(Locks),[]),
diff --git a/lib/mnesia/test/mnesia_qlc_test.erl b/lib/mnesia/test/mnesia_qlc_test.erl
index 5f46840ae9..9886754710 100644
--- a/lib/mnesia/test/mnesia_qlc_test.erl
+++ b/lib/mnesia/test/mnesia_qlc_test.erl
@@ -264,7 +264,7 @@ atomic_eval(Config) ->
?match({1,[{a,{a,9},91}]}, ok(Restart,[Pid3, Cursor])),
QC1 = ok(fun() -> qlc:cursor(Q1) end, []),
- ?match({'EXIT', _}, qlc:next_answers(QC1)),
+ ?match({'EXIT', _}, (catch qlc:next_answers(QC1))),
?match({aborted,_}, ok(fun()->qlc:next_answers(QC1)end,[])),
?verify_mnesia(Ns, []).
diff --git a/lib/mnesia/test/mnesia_test_lib.hrl b/lib/mnesia/test/mnesia_test_lib.hrl
index 281634c239..94a195f01f 100644
--- a/lib/mnesia/test/mnesia_test_lib.hrl
+++ b/lib/mnesia/test/mnesia_test_lib.hrl
@@ -46,15 +46,32 @@
-define(match(ExpectedRes,Expr),
fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- ?verbose("ok, ~n Result as expected:~p~n",[AcTuAlReS]),
- {success,AcTuAlReS};
- _ ->
- ?error("Not Matching Actual result was:~n ~p~n",
- [AcTuAlReS]),
- {fail,AcTuAlReS}
+ try Expr of
+ _AR_0 = ExpectedRes ->
+ ?verbose("ok, ~n Result as expected:~p~n",[_AR_0]),
+ {success,_AR_0};
+ _AR_0 ->
+ ?error("Not Matching Actual result was:~n ~p~n",[_AR_0]),
+ {fail,_AR_0}
+ catch
+ exit:{aborted, _ER_1} when
+ element(1, _ER_1) =:= node_not_running;
+ element(1, _ER_1) =:= bad_commit;
+ element(1, _ER_1) =:= cyclic ->
+ %% Need to re-raise these to restart transaction
+ erlang:raise(exit, {aborted, _ER_1}, erlang:get_stacktrace());
+ exit:_AR_1 ->
+ case fun(_AR_EXIT_) -> {'EXIT', _AR_EXIT_} end(_AR_1) of
+ _AR_2 = ExpectedRes ->
+ ?verbose("ok, ~n Result as expected:~p~n",[_AR_2]),
+ {success,_AR_2};
+ _AR_2 ->
+ ?error("Not Matching Actual result was:~n ~p~n", [_AR_2]),
+ {fail,_AR_2}
+ end;
+ _:_AR_1 ->
+ ?error("Not Matching Actual result was:~n ~p~n", [_AR_1]),
+ {fail,_AR_1}
end
end()).
diff --git a/lib/mnesia/test/mnesia_trans_access_test.erl b/lib/mnesia/test/mnesia_trans_access_test.erl
index 157e441b27..237984978e 100644
--- a/lib/mnesia/test/mnesia_trans_access_test.erl
+++ b/lib/mnesia/test/mnesia_trans_access_test.erl
@@ -677,7 +677,7 @@ check_res(sync_dirty, Res) when is_list(Res) ->
check_res(ets, Res) when is_list(Res) ->
Res;
check_res(Type,Res) ->
- ?match(bug,{Type,Res}).
+ ?match({bug, bug},{Type,Res}).
read_op(Oid) ->
case lists:reverse(mnesia:read(Oid)) of
@@ -1118,10 +1118,7 @@ create_live_table_index(Config, Storage) ->
ValPos = 3,
mnesia:dirty_write({Tab, 1, 2}),
- Fun = fun() ->
- ?match(ok, mnesia:write({Tab, 2, 2})),
- ok
- end,
+ Fun = fun() -> mnesia:write({Tab, 2, 2}) end,
?match({atomic, ok}, mnesia:transaction(Fun)),
?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)),
IRead = fun() -> lists:sort(mnesia:index_read(Tab, 2, ValPos)) end,
diff --git a/lib/observer/src/cdv_timer_cb.erl b/lib/observer/src/cdv_timer_cb.erl
index 9cdbfa05a9..d44592cf18 100644
--- a/lib/observer/src/cdv_timer_cb.erl
+++ b/lib/observer/src/cdv_timer_cb.erl
@@ -27,18 +27,21 @@
%% Defines
-define(COL_OWNER, 0).
--define(COL_MSG, ?COL_OWNER+1).
+-define(COL_NAME, ?COL_OWNER+1).
+-define(COL_MSG, ?COL_NAME+1).
-define(COL_TIME, ?COL_MSG+1).
%% Callbacks for cdv_virtual_list_wx
col_to_elem(id) -> col_to_elem(?COL_OWNER);
col_to_elem(?COL_OWNER) -> #timer.pid;
+col_to_elem(?COL_NAME) -> #timer.name;
col_to_elem(?COL_MSG) -> #timer.msg;
col_to_elem(?COL_TIME) -> #timer.time.
col_spec() ->
[{"Owner", ?wxLIST_FORMAT_LEFT, 110},
- {"Message", ?wxLIST_FORMAT_LEFT, 400},
+ {"Owner name", ?wxLIST_FORMAT_LEFT, 150},
+ {"Message", ?wxLIST_FORMAT_LEFT, 300},
{"Time left (ms)", ?wxLIST_FORMAT_RIGHT, 80}].
get_info(Owner) ->
diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl
index c5a7d9a2e5..bfe115a42e 100644
--- a/lib/observer/src/cdv_virtual_list_wx.erl
+++ b/lib/observer/src/cdv_virtual_list_wx.erl
@@ -269,7 +269,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click,
MenuId = ?ID_DETAILS + Col,
ColText = call(Holder, {get_row, self(), Row, Col}),
case ColText of
- "[]" -> [];
+ Empty when Empty=="[]"; Empty=="" -> [];
_ ->
What =
case catch list_to_integer(ColText) of
@@ -284,8 +284,13 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click,
end
end,
MenuCols),
- wxWindow:popupMenu(Panel, Menu),
- wxMenu:destroy(Menu),
+ case MenuItems of
+ [] ->
+ wxMenu:destroy(Menu);
+ _ ->
+ wxWindow:popupMenu(Panel, Menu),
+ wxMenu:destroy(Menu)
+ end,
{noreply,State#state{menu_items=MenuItems}};
handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}},
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index a08d27d070..99329b94e2 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -298,6 +298,7 @@ expand_binary(Pos) ->
%%--------------------------------------------------------------------
init([]) ->
ets:new(cdv_dump_index_table,[ordered_set,named_table,public]),
+ ets:new(cdv_reg_proc_table,[ordered_set,named_table,public]),
{ok, #state{}}.
%%--------------------------------------------------------------------
@@ -978,9 +979,20 @@ count() ->
%%-----------------------------------------------------------------
%% Page with all processes
procs_summary(File,WS) ->
- ParseFun = fun(Fd,Pid) ->
+ ParseFun = fun(Fd,Pid0) ->
+ Pid = list_to_pid(Pid0),
Proc = get_procinfo(Fd,fun main_procinfo/5,
- #proc{pid=list_to_pid(Pid)},WS),
+ #proc{pid=Pid},WS),
+ case Proc#proc.name of
+ undefined ->
+ true;
+ Name ->
+ %% Registered process - store to allow
+ %% lookup for timers connected to
+ %% registered name instead of pid.
+ ets:insert(cdv_reg_proc_table,{Name,Pid}),
+ ets:insert(cdv_reg_proc_table,{Pid0,Name})
+ end,
case Proc#proc.memory of
undefined -> Proc#proc{memory=Proc#proc.stack_heap};
_ -> Proc
@@ -1495,8 +1507,28 @@ get_internal_ets_tables(File,WS) ->
%%-----------------------------------------------------------------
%% Page with list of all timers
get_timers(File,Pid) ->
- ParseFun = fun(Fd,Id) -> get_timerinfo_1(Fd,#timer{pid=list_to_pid(Id)}) end,
- lookup_and_parse_index(File,{?timer,Pid},ParseFun,"timers").
+ ParseFun = fun(Fd,Id) -> get_timerinfo(Fd,Id) end,
+ T1 = lookup_and_parse_index(File,{?timer,Pid},ParseFun,"timers"),
+ T2 = case ets:lookup(cdv_reg_proc_table,Pid) of
+ [{_,Name}] ->
+ lookup_and_parse_index(File,{?timer,Name},ParseFun,"timers");
+ _ ->
+ []
+ end,
+ T1 ++ T2.
+
+get_timerinfo(Fd,Id) ->
+ case catch list_to_pid(Id) of
+ Pid when is_pid(Pid) ->
+ get_timerinfo_1(Fd,#timer{pid=Pid});
+ _ ->
+ case ets:lookup(cdv_reg_proc_table,Id) of
+ [{_,Pid}] when is_pid(Pid) ->
+ get_timerinfo_1(Fd,#timer{pid=Pid,name=Id});
+ [] ->
+ get_timerinfo_1(Fd,#timer{name=Id})
+ end
+ end.
get_timerinfo_1(Fd,Timer) ->
case line_head(Fd) of
diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl
index ae288ed573..0e2eba6dee 100644
--- a/lib/observer/src/crashdump_viewer.hrl
+++ b/lib/observer/src/crashdump_viewer.hrl
@@ -108,6 +108,7 @@
-record(timer,
{pid,
+ name,
msg,
time}).
diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl
index 59fe5b5670..7757dfea53 100644
--- a/lib/observer/src/observer_tv_table.erl
+++ b/lib/observer/src/observer_tv_table.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -409,7 +409,7 @@ handle_info({refresh, Min, Min}, State = #state{grid=Grid}) ->
wxListCtrl:refreshItem(Grid, Min), %% Avoid assert in wx below if Max is 0
{noreply, State};
handle_info({refresh, Min, Max}, State = #state{grid=Grid}) ->
- wxListCtrl:refreshItems(Grid, Min, Max),
+ Max > 0 andalso wxListCtrl:refreshItems(Grid, Min, Max),
{noreply, State};
handle_info(refresh_interval, State = #state{pid=Pid}) ->
diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
index ced26f7119..03ca1bf9c1 100644
--- a/lib/observer/src/observer_wx.erl
+++ b/lib/observer/src/observer_wx.erl
@@ -112,7 +112,8 @@ setup(#state{frame = Frame} = State) ->
observer_lib:create_menus(DefMenus, MenuBar, default),
wxFrame:setMenuBar(Frame, MenuBar),
- StatusBar = wxFrame:createStatusBar(Frame, []),
+ StatusBar = wxStatusBar:new(Frame),
+ wxFrame:setStatusBar(Frame, StatusBar),
wxFrame:setTitle(Frame, atom_to_list(node())),
wxStatusBar:setStatusText(StatusBar, atom_to_list(node())),
@@ -388,6 +389,7 @@ handle_info(_Info, State) ->
terminate(_Reason, #state{frame = Frame}) ->
wxFrame:destroy(Frame),
+ wx:destroy(),
ok.
code_change(_, _, State) ->
diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl
index 40dbe28d46..0eb4a92c53 100644
--- a/lib/observer/test/crashdump_helper.erl
+++ b/lib/observer/test/crashdump_helper.erl
@@ -35,7 +35,9 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) ->
register(aaaaaaaa,self()),
process_flag(save_calls,3),
ets:new(cdv_test_ordset_table,[ordered_set]),
- erlang:send_after(1000000,self(),cdv_test_timer_message),
+ erlang:send_after(1000000,self(),cdv_test_timer_message1),
+ erlang:send_after(1000000,aaaaaaaa,cdv_test_timer_message2),
+ erlang:send_after(1000000,noexistproc,cdv_test_timer_message3),
Port = hd(erlang:ports()),
Fun = fun() -> ok end,
Ref = make_ref(),
diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl
index e9567c82cb..03ab0c20e1 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -385,8 +385,14 @@ special(File,Procs) ->
{ok,[_Ets=#ets_table{}],[]} = crashdump_viewer:ets_tables(Pid),
io:format(" ets tables ok",[]),
- {ok,[_Timer=#timer{}],[]} = crashdump_viewer:timers(Pid),
- io:format(" timers ok",[]),
+
+ {ok,[#timer{pid=Pid0,name=undefined},
+ #timer{pid=Pid0,name="aaaaaaaa"}],[]} =
+ crashdump_viewer:timers(Pid),
+ {ok,AllTimers,_TimersTW} = crashdump_viewer:timers(all),
+ #timer{name="noexistproc"} =
+ lists:keyfind(undefined,#timer.pid,AllTimers),
+ io:format(" timers ok:",[]),
{ok,Mod1=#loaded_mod{},[]} =
crashdump_viewer:loaded_mod_details(atom_to_list(?helper_mod)),
diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl
index af07165456..5cf719acb1 100644
--- a/lib/observer/test/observer_SUITE.erl
+++ b/lib/observer/test/observer_SUITE.erl
@@ -45,7 +45,7 @@ all() ->
groups() ->
[{gui, [],
[basic
- %% , process_win, table_win
+ , process_win, table_win
]
}].
@@ -107,6 +107,10 @@ appup_file(Config) when is_list(Config) ->
basic(suite) -> [];
basic(doc) -> [""];
basic(Config) when is_list(Config) ->
+ timer:send_after(100, "foobar"), %% Otherwise the timer sever gets added to procs
+ ProcsBefore = processes(),
+ NumProcsBefore = length(ProcsBefore),
+
ok = observer:start(),
Notebook = setup_whitebox_testing(),
@@ -116,11 +120,11 @@ basic(Config) when is_list(Config) ->
0 = wxNotebook:getSelection(Notebook),
timer:sleep(500),
Check = fun(N, TestMore) ->
- ok = wxNotebook:advanceSelection(Notebook),
TestMore andalso
test_page(wxNotebook:getPageText(Notebook, N),
wxNotebook:getCurrentPage(Notebook)),
- timer:sleep(200)
+ timer:sleep(200),
+ ok = wxNotebook:advanceSelection(Notebook)
end,
%% Just verify that we can toogle trough all pages
[_|_] = [Check(N, false) || N <- lists:seq(1, Count)],
@@ -128,9 +132,22 @@ basic(Config) when is_list(Config) ->
Frame = get_top_level_parent(Notebook),
{W,H} = wxWindow:getSize(Frame),
wxWindow:setSize(Frame, W+10, H+10),
- [_|_] = [Check(N, true) || N <- lists:seq(1, Count)],
-
- ok = observer:stop().
+ [_|_] = [Check(N, true) || N <- lists:seq(0, Count-1)],
+
+ ok = observer:stop(),
+ timer:sleep(2000), %% stop is async
+ ProcsAfter = processes(),
+ NumProcsAfter = length(ProcsAfter),
+ if NumProcsAfter=/=NumProcsBefore ->
+ ct:log("Before but not after:~n~p~n",
+ [[{P,process_info(P)} || P <- ProcsBefore -- ProcsAfter]]),
+ ct:log("After but not before:~n~p~n",
+ [[{P,process_info(P)} || P <- ProcsAfter -- ProcsBefore]]),
+ ct:fail("leaking processes");
+ true ->
+ ok
+ end,
+ ok.
test_page("Load Charts" ++ _, _Window) ->
%% Just let it display some info and hopefully it doesn't crash
@@ -163,8 +180,11 @@ test_page("Processes" ++ _, _Window) ->
timer:sleep(1000), %% Give it time to refresh
ok;
-test_page("Table" ++ _, _Window) ->
+test_page(_Title = "Table" ++ _, _Window) ->
Tables = [ets:new(list_to_atom("Test-" ++ [C]), [public]) || C <- lists:seq($A, $Z)],
+ Table = lists:nth(3, Tables),
+ ets:insert(Table, [{N,100-N} || N <- lists:seq(1,100)]),
+
Active = get_active(),
Active ! refresh_interval,
ChangeSort = fun(N) ->
@@ -174,8 +194,6 @@ test_page("Table" ++ _, _Window) ->
end,
[ChangeSort(N) || N <- lists:seq(1,5) ++ [0]],
timer:sleep(1000),
- Table = lists:nth(3, Tables),
- ets:insert(Table, [{N,100-N} || N <- lists:seq(1,100)]),
Focus = #wx{event=#wxList{type=command_list_item_selected, itemIndex=2}},
Active ! Focus,
Activate = #wx{event=#wxList{type=command_list_item_activated, itemIndex=2}},
@@ -226,14 +244,12 @@ table_win(Config) when is_list(Config) ->
%% Modal can not test edit..
%% TPid = wx_object:get_pid(TObj),
%% TPid ! #wx{event=#wxList{type=command_list_item_activated, itemIndex=12}},
- timer:sleep(2000),
+ timer:sleep(3000),
wx_object:get_pid(TObj) ! #wx{event=#wxClose{type=close_window}},
observer:stop(),
ok.
-
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
get_top_level_parent(Window) ->
diff --git a/lib/odbc/aclocal.m4 b/lib/odbc/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/odbc/aclocal.m4
+++ b/lib/odbc/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl
index bfe5d39d53..b3b7afd1a9 100644
--- a/lib/reltool/test/reltool_server_SUITE.erl
+++ b/lib/reltool/test/reltool_server_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -1205,14 +1205,9 @@ create_slim(Config) ->
RootDir = code:root_dir(),
Erl = filename:join([RootDir, "bin", "erl"]),
- EscapedQuote =
- case os:type() of
- {win32,_} -> "\\\"";
- _ -> "\""
- end,
Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir,
"-boot", filename:join(TargetRelVsnDir,RelName),
- "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote],
+ "-sasl", "releases_dir", "\""++TargetRelDir++"\""],
{ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)),
?msym(RootDir, rpc:call(Node, code, root_dir, [])),
wait_for_app(Node,sasl,50),
diff --git a/lib/reltool/test/reltool_test_lib.erl b/lib/reltool/test/reltool_test_lib.erl
index 530d0a9985..fa12f19aa7 100644
--- a/lib/reltool/test/reltool_test_lib.erl
+++ b/lib/reltool/test/reltool_test_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -20,12 +20,13 @@
-compile(export_all).
-include("reltool_test_lib.hrl").
+-define(timeout, 20). % minutes
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
init_per_suite(Config) when is_list(Config)->
global:register_name(reltool_global_logger, group_leader()),
- incr_timetrap(Config, 10).
+ incr_timetrap(Config, ?timeout).
end_per_suite(Config) when is_list(Config)->
global:unregister_name(reltool_global_logger),
@@ -51,7 +52,7 @@ set_kill_timer(Config) ->
Time =
case lookup_config(tc_timeout, Config) of
[] ->
- timer:minutes(10);
+ timer:minutes(?timeout);
ConfigTime when is_integer(ConfigTime) ->
ConfigTime
end,
diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl
index 1d8bf45289..bd7414fbb4 100644
--- a/lib/sasl/test/release_handler_SUITE.erl
+++ b/lib/sasl/test/release_handler_SUITE.erl
@@ -1410,18 +1410,41 @@ upgrade_supervisor_fail(Conf) when is_list(Conf) ->
{error,{code_change_failed,_Pid,a_sup,_Vsn,
{error,{invalid_shutdown,brutal_kil}}}} =
- rpc:call(Node, release_handler, install_release, [RelVsn2]),
-
- %% Check that the upgrade is terminated - normally this would mean
- %% rollback, but since this testcase is very simplified the node
- %% is not started with heart supervision and will therefore not be
- %% restarted. So we just check that the node goes down.
+ rpc:call(Node, release_handler, install_release,
+ [RelVsn2, [{error_action,reboot}]]),
+
+ %% Check that the upgrade is terminated - normally this would be a
+ %% rollback, but
+ %%
+ %% 1. Default rollback is done with init:restart(), which does not
+ %% reboot the emulator, it only restarts the system inside the
+ %% running erlang node.
+ %%
+ %% 2. This does not work well on a slave node since, if timing is
+ %% right (bad), the slave node will get the nodedown from its
+ %% master (because distribution is terminated as part of
+ %% init:restart()) and then it will do halt() and thus never be
+ %% restarted (see slave:wloop/1)
+ %%
+ %% 3. Sometimes, though, init:restart() will manage to finish its
+ %% job before the nodedown is received, making the node
+ %% actually restart - in which case it might very well confuse
+ %% the next test case.
+ %%
+ %% 4. So, to avoid unstability we use {error_action,reboot} above,
+ %% to ensure that the node is actually stopped. Of course, in a
+ %% real system this must be used together with heart
+ %% supervision, and then the node will be restarted anyway. But
+ %% here in this simple test case we are satisfied to see that
+ %% the node terminates.
receive {nodedown,Node} -> ok
after 10000 -> ct:fail(failed_upgrade_never_restarted_node)
end,
ok.
+upgrade_supervisor_fail(cleanup,_Condf) ->
+ stop_node(node_name(upgrade_supervisor_fail)).
%% Test upgrade and downgrade of applications
eval_appup(Conf) when is_list(Conf) ->
@@ -2269,8 +2292,8 @@ create_p1g(Conf,TargetDir) ->
ok.
fix_version(SystemLib,App) ->
- FromVsn = vsn(App,current),
- ToVsn = vsn(App,old),
+ FromVsn = re:replace(vsn(App,current),"\\.","\\\\.",[{return,binary}]),
+ ToVsn = re:replace(vsn(App,old),"\\.","\\\\.",[{return,binary}]),
Rootname = filename:join([SystemLib,app_dir(App,old),ebin,atom_to_list(App)]),
AppFile = Rootname ++ ".app",
diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl
index f4455f7e9b..e91d220daf 100644
--- a/lib/sasl/test/sasl_SUITE.erl
+++ b/lib/sasl/test/sasl_SUITE.erl
@@ -73,10 +73,10 @@ appup_tests(App,{OkVsns,NokVsns}) ->
ok.
create_test_vsns(App) ->
- This = erlang:system_info(otp_release),
- FirstMajor = previous_major(This),
+ ThisMajor = erlang:system_info(otp_release),
+ FirstMajor = previous_major(ThisMajor),
SecondMajor = previous_major(FirstMajor),
- Ok = app_vsn(App,[FirstMajor]),
+ Ok = app_vsn(App,[ThisMajor,FirstMajor]),
Nok0 = app_vsn(App,[SecondMajor]),
Nok = case Ok of
[Ok1|_] ->
@@ -87,9 +87,9 @@ create_test_vsns(App) ->
{Ok,Nok}.
previous_major("17") ->
- "r16";
-previous_major("r"++Rel) ->
- "r"++previous_major(Rel);
+ "r16b";
+previous_major("r16b") ->
+ "r15b";
previous_major(Rel) ->
integer_to_list(list_to_integer(Rel)-1).
diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index 1d3a71e94e..49a4303e0b 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -1615,9 +1615,19 @@ no_sasl_relup(Config) when is_list(Config) ->
%% make_relup: Check that application start type is used in relup
app_start_type_relup(Config) when is_list(Config) ->
+ %% This might fail if some applications are not available, if so
+ %% skip the test case.
+ try create_script(latest_app_start_type2,Config) of
+ {Dir2,Name2} ->
+ app_start_type_relup(Dir2,Name2,Config)
+ catch throw:{error,Reason} ->
+ {skip,Reason}
+ end.
+
+app_start_type_relup(Dir2,Name2,Config) ->
PrivDir = ?config(priv_dir, Config),
{Dir1,Name1} = create_script(latest_app_start_type1,Config),
- {Dir2,Name2} = create_script(latest_app_start_type2,Config),
+
Release1 = filename:join(Dir1,Name1),
Release2 = filename:join(Dir2,Name2),
@@ -2242,9 +2252,13 @@ app_vsns(AppVsns) ->
[{App,app_vsn(App,Vsn)} || {App,Vsn} <- AppVsns] ++
[{App,app_vsn(App,Vsn),Type} || {App,Vsn,Type} <- AppVsns].
app_vsn(App,current) ->
- application:load(App),
- {ok,Vsn} = application:get_key(App,vsn),
- Vsn;
+ case application:load(App) of
+ Ok when Ok==ok; Ok=={error,{already_loaded,App}} ->
+ {ok,Vsn} = application:get_key(App,vsn),
+ Vsn;
+ Error ->
+ throw(Error)
+ end;
app_vsn(_App,Vsn) ->
Vsn.
diff --git a/lib/snmp/test/snmp_test_manager.erl b/lib/snmp/test/snmp_test_manager.erl
index 925ae77ab5..6d8673eecd 100644
--- a/lib/snmp/test/snmp_test_manager.erl
+++ b/lib/snmp/test/snmp_test_manager.erl
@@ -56,7 +56,7 @@
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
code_change/3, terminate/2]).
--record(state, {mgr, parent, req, agent_target_name}).
+-record(state, {parent, req, agent_target_name}).
-define(SERVER, ?MODULE).
-define(USER, ?MODULE).
@@ -130,10 +130,10 @@ init([Parent, Opts]) ->
do_init(Opts) ->
{MgrDir, MgrConf, MgrOpts, AgentTargetName, AgentConf} = parse_opts(Opts),
ok = snmp_config:write_manager_config(MgrDir, "", MgrConf),
- {ok, Pid} = snmpm:start_link(MgrOpts),
+ ok = snmpm:start_link(MgrOpts),
ok = snmpm:register_user(?USER, ?MODULE, self()),
ok = snmpm:register_agent(?USER, AgentTargetName, AgentConf),
- {ok, #state{mgr = Pid, agent_target_name = AgentTargetName}}.
+ {ok, #state{agent_target_name = AgentTargetName}}.
parse_opts(Opts) ->
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index bce02966ae..84d5e5c86e 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2004</year><year>2013</year>
+ <year>2004</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -29,6 +29,36 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 3.0.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed timeout bug in ssh:connect.</p>
+ <p>
+ Own Id: OTP-11908</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Option <c>max_sessions</c> added to
+ <c>ssh:daemon/{2,3}</c>. This option, if set, limits the
+ number of simultaneous connections accepted by the
+ daemon.</p>
+ <p>
+ Own Id: OTP-11885</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Ssh 3.0.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 7fbd70c87e..876eba598a 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2004</year><year>2013</year>
+ <year>2004</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -97,6 +97,8 @@
<seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/[2, 4]</seealso>.</p>
<p>Options are:</p>
<taglist>
+ <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag>
+ <item> IP version to use.</item>
<tag><c><![CDATA[{user_dir, string()}]]></c></tag>
<item>
<p>Sets the user directory i.e. the directory containing
@@ -230,6 +232,8 @@
port.</p>
<p>Options are:</p>
<taglist>
+ <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag>
+ <item> IP version to use when the host address is specified as <c>any</c>. </item>
<tag><c><![CDATA[{subsystems, [subsystem_spec()]]]></c></tag>
<item>
Provides specifications for handling of subsystems. The
@@ -307,18 +311,31 @@
<tag><c><![CDATA[{negotiation_timeout, integer()}]]></c></tag>
<item>
- <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes.
+ <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes. If the client fails to login within this time, the connection is closed.
+ </p>
+ </item>
+
+ <tag><c><![CDATA[{max_sessions, pos_integer()}]]></c></tag>
+ <item>
+ <p>The maximum number of simultaneous sessions that are accepted at any time for this daemon. This includes sessions that are being authorized. So if set to <c>N</c>, and <c>N</c> clients have connected but not started the login process, the <c>N+1</c> connection attempt will be aborted. If <c>N</c> connections are authenticated and still logged in, no more loggins will be accepted until one of the existing ones log out.
+ </p>
+ <p>The counter is per listening port, so if two daemons are started, one with <c>{max_sessions,N}</c> and the other with <c>{max_sessions,M}</c> there will be in total <c>N+M</c> connections accepted for the whole ssh application.
+ </p>
+ <p>Note that if <c>parallel_login</c> is <c>false</c>, only one client at a time may be in the authentication phase.
+ </p>
+ <p>As default, the option is not set. This means that the number is not limited.
</p>
</item>
<tag><c><![CDATA[{parallel_login, boolean()}]]></c></tag>
<item>
- <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited logins will be allowed simultanously. Note that this affects only the connections with authentication in progress, not the already authenticated connections.
+ <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited number of login attempts will be allowed simultanously.
+ </p>
+ <p>If the <c>max_sessions</c> option is set to <c>N</c> and <c>parallel_login</c> is set to <c>true</c>, the max number of simultaneous login attempts at any time is limited to <c>N-K</c> where <c>K</c> is the number of authenticated connections present at this daemon.
</p>
<warning>
- <p>Do not enable parallel_logins without protecting the server by other means like a firewall. If set to true, there is no protection against dos attacs.</p>
+ <p>Do not enable <c>parallel_logins</c> without protecting the server by other means, for example the <c>max_sessions</c> option or a firewall configuration. If set to <c>true</c>, there is no protection against DOS attacks.</p>
</warning>
-
</item>
<tag><c><![CDATA[{key_cb, atom()}]]></c></tag>
diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src
index 1917c95f5a..8269f89e40 100644
--- a/lib/ssh/src/ssh.appup.src
+++ b/lib/ssh/src/ssh.appup.src
@@ -19,9 +19,25 @@
{"%VSN%",
[
+ {"3.0.2", [{load_module, ssh_message, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_io, soft_purge, soft_purge, []}]},
+ {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []},
+ {load_module, ssh_acceptor, soft_purge, soft_purge, []},
+ {load_module, ssh_message, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_io, soft_purge, soft_purge, []}]},
{<<".*">>, [{restart_application, ssh}]}
],
[
+ {"3.0.2", [{load_module, ssh_message, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_io, soft_purge, soft_purge, []}]},
+ {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []},
+ {load_module, ssh_acceptor, soft_purge, soft_purge, []},
+ {load_module, ssh_message, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
+ {load_module, ssh_io, soft_purge, soft_purge, []}]},
{<<".*">>, [{restart_application, ssh}]}
]
}.
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index de6e8cc421..743c01a42c 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -1,7 +1,7 @@
%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -73,8 +73,8 @@ connect(Host, Port, Options, Timeout) ->
{SocketOptions, SshOptions} ->
{_, Transport, _} = TransportOpts =
proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}),
- Inet = proplists:get_value(inet, SshOptions, inet),
- try Transport:connect(Host, Port, [ {active, false}, Inet | SocketOptions], Timeout) of
+ ConnectionTimeout = proplists:get_value(connect_timeout, Options, infinity),
+ try Transport:connect(Host, Port, [ {active, false} | SocketOptions], ConnectionTimeout) of
{ok, Socket} ->
Opts = [{user_pid, self()}, {host, Host} | fix_idle_time(SshOptions)],
ssh_connection_handler:start_connection(client, Socket, Opts, Timeout);
@@ -255,8 +255,8 @@ do_start_daemon(Host, Port, Options, SocketOptions) ->
handle_options(Opts) ->
try handle_option(proplists:unfold(Opts), [], []) of
- {_,_} = Options ->
- Options
+ {Inet, Ssh} ->
+ {handle_ip(Inet), Ssh}
catch
throw:Error ->
Error
@@ -332,6 +332,8 @@ handle_option([{idle_time, _} = Opt | Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{rekey_limit, _} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
+handle_option([{max_sessions, _} = Opt|Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{negotiation_timeout, _} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) ->
@@ -366,6 +368,8 @@ handle_ssh_option({pref_public_key_algs, Value} = Opt) when is_list(Value), leng
end;
handle_ssh_option({connect_timeout, Value} = Opt) when is_integer(Value); Value == infinity ->
Opt;
+handle_ssh_option({max_sessions, Value} = Opt) when is_integer(Value), Value>0 ->
+ Opt;
handle_ssh_option({negotiation_timeout, Value} = Opt) when is_integer(Value); Value == infinity ->
Opt;
handle_ssh_option({parallel_login, Value} = Opt) when Value==true ; Value==false ->
@@ -428,13 +432,14 @@ handle_ssh_option(Opt) ->
throw({error, {eoptions, Opt}}).
handle_inet_option({active, _} = Opt) ->
- throw({error, {{eoptions, Opt}, "Ssh has built in flow control, "
- "and activ is handled internaly user is not allowd"
+ throw({error, {{eoptions, Opt}, "SSH has built in flow control, "
+ "and active is handled internally, user is not allowed"
"to specify this option"}});
-handle_inet_option({inet, Value} = Opt) when (Value == inet) or (Value == inet6) ->
- Opt;
+
+handle_inet_option({inet, Value}) when (Value == inet) or (Value == inet6) ->
+ Value;
handle_inet_option({reuseaddr, _} = Opt) ->
- throw({error, {{eoptions, Opt},"Is set internaly user is not allowd"
+ throw({error, {{eoptions, Opt},"Is set internally, user is not allowed"
"to specify this option"}});
%% Option verified by inet
handle_inet_option(Opt) ->
@@ -455,3 +460,17 @@ handle_pref_algs([H|T], Acc) ->
_ ->
false
end.
+
+handle_ip(Inet) -> %% Default to ipv4
+ case lists:member(inet, Inet) of
+ true ->
+ Inet;
+ false ->
+ case lists:member(inet6, Inet) of
+ true ->
+ Inet;
+ false ->
+ [inet | Inet]
+ end
+ end.
+
diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl
index e57b07cee8..7302196674 100644
--- a/lib/ssh/src/ssh_acceptor.erl
+++ b/lib/ssh/src/ssh_acceptor.erl
@@ -80,18 +80,36 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) ->
ListenSocket, AcceptTimeout)
end.
-handle_connection(_Callback, Address, Port, Options, Socket) ->
+handle_connection(Callback, Address, Port, Options, Socket) ->
SystemSup = ssh_system_sup:system_supervisor(Address, Port),
- {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options),
- ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup),
- Timeout = proplists:get_value(negotiation_timeout,
- proplists:get_value(ssh_opts, Options, []),
- 2*60*1000),
- ssh_connection_handler:start_connection(server, Socket,
- [{supervisors, [{system_sup, SystemSup},
- {subsystem_sup, SubSysSup},
- {connection_sup, ConnectionSup}]}
- | Options], Timeout).
+ SSHopts = proplists:get_value(ssh_opts, Options, []),
+ MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity),
+ case number_of_connections(SystemSup) < MaxSessions of
+ true ->
+ {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options),
+ ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup),
+ Timeout = proplists:get_value(negotiation_timeout, SSHopts, 2*60*1000),
+ ssh_connection_handler:start_connection(server, Socket,
+ [{supervisors, [{system_sup, SystemSup},
+ {subsystem_sup, SubSysSup},
+ {connection_sup, ConnectionSup}]}
+ | Options], Timeout);
+ false ->
+ Callback:close(Socket),
+ IPstr = if is_tuple(Address) -> inet:ntoa(Address);
+ true -> Address
+ end,
+ Str = try io_lib:format('~s:~p',[IPstr,Port])
+ catch _:_ -> "port "++integer_to_list(Port)
+ end,
+ error_logger:info_report("Ssh login attempt to "++Str++" denied due to option "
+ "max_sessions limits to "++ io_lib:write(MaxSessions) ++
+ " sessions."
+ ),
+ {error,max_sessions}
+ end.
+
+
handle_error(timeout) ->
ok;
@@ -117,3 +135,10 @@ handle_error(Reason) ->
String = lists:flatten(io_lib:format("Accept error: ~p", [Reason])),
error_logger:error_report(String),
exit({accept_failed, String}).
+
+
+number_of_connections(SystemSup) ->
+ length([X ||
+ {R,X,supervisor,[ssh_subsystem_sup]} <- supervisor:which_children(SystemSup),
+ is_reference(R)
+ ]).
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 322da50f21..06866392da 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -1482,8 +1482,7 @@ ssh_channel_info([ _ | Rest], Channel, Acc) ->
log_error(Reason) ->
Report = io_lib:format("Erlang ssh connection handler failed with reason: "
- "~p ~n, Stacktace: ~p ~n"
- "please report this to [email protected] \n",
+ "~p ~n, Stacktrace: ~p ~n",
[Reason, erlang:get_stacktrace()]),
error_logger:error_report(Report),
"Internal error".
diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl
index 832b144db9..35336bce8b 100644
--- a/lib/ssh/src/ssh_io.erl
+++ b/lib/ssh/src/ssh_io.erl
@@ -81,6 +81,8 @@ format(Fmt, Args) ->
trim(Line) when is_list(Line) ->
lists:reverse(trim1(lists:reverse(trim1(Line))));
+trim(Line) when is_binary(Line) ->
+ trim(unicode:characters_to_list(Line));
trim(Other) -> Other.
trim1([$\s|Cs]) -> trim(Cs);
diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl
index 8d6c77c0ed..76b57cb995 100644
--- a/lib/ssh/src/ssh_message.erl
+++ b/lib/ssh/src/ssh_message.erl
@@ -255,7 +255,7 @@ encode(#ssh_msg_ignore{data = Data}) ->
ssh_bits:encode([?SSH_MSG_IGNORE, Data], [byte, string]);
encode(#ssh_msg_unimplemented{sequence = Seq}) ->
- ssh_bits:encode([?SSH_MSG_IGNORE, Seq], [byte, uint32]);
+ ssh_bits:encode([?SSH_MSG_UNIMPLEMENTED, Seq], [byte, uint32]);
encode(#ssh_msg_debug{always_display = Bool,
message = Msg,
@@ -391,13 +391,6 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_REQUEST), ?UINT32(Len0), Name:Len0/binary,
data = Data};
%%% Unhandled message, also masked by same 1:st byte value as ?SSH_MSG_USERAUTH_INFO_REQUEST:
-decode(<<?BYTE(?SSH_MSG_USERAUTH_PK_OK), ?UINT32(Len), Alg:Len/binary, KeyBlob/binary>>) ->
- #ssh_msg_userauth_pk_ok{
- algorithm_name = Alg,
- key_blob = KeyBlob
- };
-
-%%% Unhandled message, also masked by same 1:st byte value as ?SSH_MSG_USERAUTH_INFO_REQUEST:
decode(<<?BYTE(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?UINT32(Len0), Prompt:Len0/binary,
?UINT32(Len1), Lang:Len1/binary>>) ->
#ssh_msg_userauth_passwd_changereq{
@@ -405,6 +398,13 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?UINT32(Len0), Prompt:Len0/b
languge = Lang
};
+%%% Unhandled message, also masked by same 1:st byte value as ?SSH_MSG_USERAUTH_INFO_REQUEST:
+decode(<<?BYTE(?SSH_MSG_USERAUTH_PK_OK), ?UINT32(Len), Alg:Len/binary, KeyBlob/binary>>) ->
+ #ssh_msg_userauth_pk_ok{
+ algorithm_name = Alg,
+ key_blob = KeyBlob
+ };
+
decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?UINT32(Num), Data/binary>>) ->
#ssh_msg_userauth_info_response{
num_responses = Num,
@@ -461,10 +461,19 @@ decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code),
language = Lang
};
+%% Accept bad disconnects from ancient openssh clients that doesn't send language tag. Use english as a work-around.
+decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code),
+ ?UINT32(Len0), Desc:Len0/binary>>) ->
+ #ssh_msg_disconnect{
+ code = Code,
+ description = unicode:characters_to_list(Desc),
+ language = <<"en">>
+ };
+
decode(<<?SSH_MSG_NEWKEYS>>) ->
#ssh_msg_newkeys{};
-decode(<<?BYTE(?SSH_MSG_IGNORE), Data/binary>>) ->
+decode(<<?BYTE(?SSH_MSG_IGNORE), ?UINT32(Len), Data:Len/binary>>) ->
#ssh_msg_ignore{data = Data};
decode(<<?BYTE(?SSH_MSG_UNIMPLEMENTED), ?UINT32(Seq)>>) ->
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index d2e52379fa..bf7fb4c73e 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -47,20 +47,28 @@ all() ->
daemon_already_started,
server_password_option,
server_userpassword_option,
- double_close].
+ double_close,
+ ssh_connect_timeout,
+ ssh_connect_arg4_timeout,
+ {group, hardening_tests}
+ ].
groups() ->
[{dsa_key, [], basic_tests()},
{rsa_key, [], basic_tests()},
{dsa_pass_key, [], [pass_phrase]},
{rsa_pass_key, [], [pass_phrase]},
- {internal_error, [], [internal_error]}
+ {internal_error, [], [internal_error]},
+ {hardening_tests, [], [max_sessions]}
].
+
basic_tests() ->
[send, close, peername_sockname,
exec, exec_compressed, shell, cli, known_hosts,
- idle_time, rekey, openssh_zlib_basic_test].
+ idle_time, rekey, openssh_zlib_basic_test,
+ misc_ssh_options, inet_option].
+
%%--------------------------------------------------------------------
init_per_suite(Config) ->
@@ -74,6 +82,8 @@ end_per_suite(_Config) ->
ssh:stop(),
crypto:stop().
%%--------------------------------------------------------------------
+init_per_group(hardening_tests, Config) ->
+ init_per_group(dsa_key, Config);
init_per_group(dsa_key, Config) ->
DataDir = ?config(data_dir, Config),
PrivDir = ?config(priv_dir, Config),
@@ -103,6 +113,8 @@ init_per_group(internal_error, Config) ->
init_per_group(_, Config) ->
Config.
+end_per_group(hardening_tests, Config) ->
+ end_per_group(dsa_key, Config);
end_per_group(dsa_key, Config) ->
PrivDir = ?config(priv_dir, Config),
ssh_test_lib:clean_dsa(PrivDir),
@@ -164,16 +176,47 @@ misc_ssh_options(Config) when is_list(Config) ->
SystemDir = filename:join(?config(priv_dir, Config), system),
UserDir = ?config(priv_dir, Config),
- CMiscOpt0 = [{connecect_timeout, 1000}, {ip_v6_disabled, false}, {user_dir, UserDir}],
- CMiscOpt1 = [{connecect_timeout, infinity}, {ip_v6_disabled, true}, {user_dir, UserDir}],
- SMiscOpt0 = [{ip_v6_disabled, false}, {user_dir, UserDir}, {system_dir, SystemDir}],
- SMiscOpt1 = [{ip_v6_disabled, true}, {user_dir, UserDir}, {system_dir, SystemDir}],
+ CMiscOpt0 = [{connect_timeout, 1000}, {user_dir, UserDir}],
+ CMiscOpt1 = [{connect_timeout, infinity}, {user_dir, UserDir}],
+ SMiscOpt0 = [{user_dir, UserDir}, {system_dir, SystemDir}],
+ SMiscOpt1 = [{user_dir, UserDir}, {system_dir, SystemDir}],
+
+ basic_test([{client_opts, CMiscOpt0}, {server_opts, SMiscOpt0}]),
+ basic_test([{client_opts, CMiscOpt1}, {server_opts, SMiscOpt1}]).
+
+%%--------------------------------------------------------------------
+inet_option() ->
+ [{doc, "Test configuring IPv4"}].
+inet_option(Config) when is_list(Config) ->
+ SystemDir = filename:join(?config(priv_dir, Config), system),
+ UserDir = ?config(priv_dir, Config),
- ClientOpts = ?config(client_opts, Config),
- ServerOpts = ?config(server_opts, Config),
+ ClientOpts = [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false}],
+ ServerOpts = [{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {failfun, fun ssh_test_lib:failfun/2}],
- basic_test([{client_opts, CMiscOpt0 ++ ClientOpts}, {server_opts, SMiscOpt0 ++ ServerOpts}]),
- basic_test([{client_opts, CMiscOpt1 ++ ClientOpts}, {server_opts, SMiscOpt1 ++ ServerOpts}]).
+ basic_test([{client_opts, [{inet, inet} | ClientOpts]},
+ {server_opts, [{inet, inet} | ServerOpts]}]).
+
+%%--------------------------------------------------------------------
+inet6_option() ->
+ [{doc, "Test configuring IPv6"}].
+inet6_option(Config) when is_list(Config) ->
+ SystemDir = filename:join(?config(priv_dir, Config), system),
+ UserDir = ?config(priv_dir, Config),
+
+ ClientOpts = [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false}],
+ ServerOpts = [{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {failfun, fun ssh_test_lib:failfun/2}],
+
+ basic_test([{client_opts, [{inet, inet6} | ClientOpts]},
+ {server_opts, [{inet, inet6} | ServerOpts]}]).
%%--------------------------------------------------------------------
exec() ->
@@ -620,6 +663,86 @@ double_close(Config) when is_list(Config) ->
ok = ssh:close(CM).
%%--------------------------------------------------------------------
+ssh_connect_timeout() ->
+ [{doc, "Test connect_timeout option in ssh:connect/4"}].
+ssh_connect_timeout(_Config) ->
+ ConnTimeout = 2000,
+ {error,{faked_transport,connect,TimeoutToTransport}} =
+ ssh:connect("localhost", 12345,
+ [{transport,{tcp,?MODULE,tcp_closed}},
+ {connect_timeout,ConnTimeout}],
+ 1000),
+ case TimeoutToTransport of
+ ConnTimeout -> ok;
+ Other ->
+ ct:log("connect_timeout is ~p but transport received ~p",[ConnTimeout,Other]),
+ {fail,"ssh:connect/4 wrong connect_timeout received in transport"}
+ end.
+
+%% Help for the test above
+connect(_Host, _Port, _Opts, Timeout) ->
+ {error, {faked_transport,connect,Timeout}}.
+
+
+%%--------------------------------------------------------------------
+ssh_connect_arg4_timeout() ->
+ [{doc, "Test fourth argument in ssh:connect/4"}].
+ssh_connect_arg4_timeout(_Config) ->
+ Timeout = 1000,
+ Parent = self(),
+ %% start the server
+ Server = spawn(fun() ->
+ {ok,Sl} = gen_tcp:listen(0,[]),
+ {ok,{_,Port}} = inet:sockname(Sl),
+ Parent ! {port,self(),Port},
+ Rsa = gen_tcp:accept(Sl),
+ ct:log("Server gen_tcp:accept got ~p",[Rsa]),
+ receive after 2*Timeout -> ok end %% let client timeout first
+ end),
+
+ %% Get listening port
+ Port = receive
+ {port,Server,ServerPort} -> ServerPort
+ end,
+
+ %% try to connect with a timeout, but "supervise" it
+ Client = spawn(fun() ->
+ T0 = now(),
+ Rc = ssh:connect("localhost",Port,[],Timeout),
+ ct:log("Client ssh:connect got ~p",[Rc]),
+ Parent ! {done,self(),Rc,T0}
+ end),
+
+ %% Wait for client reaction on the connection try:
+ receive
+ {done, Client, {error,_E}, T0} ->
+ Msp = ms_passed(T0, now()),
+ exit(Server,hasta_la_vista___baby),
+ Low = 0.9*Timeout,
+ High = 1.1*Timeout,
+ ct:log("Timeout limits: ~p--~p, timeout was ~p, expected ~p",[Low,High,Msp,Timeout]),
+ if
+ Low<Msp, Msp<High -> ok;
+ true -> {fail, "timeout not within limits"}
+ end;
+ {done, Client, {ok,_Ref}, _T0} ->
+ {fail,"ssh-connected ???"}
+ after
+ 5000 ->
+ exit(Server,hasta_la_vista___baby),
+ exit(Client,hasta_la_vista___baby),
+ {fail, "Didn't timeout"}
+ end.
+
+
+%% Help function
+%% N2-N1
+ms_passed(N1={_,_,M1}, N2={_,_,M2}) ->
+ {0,{0,Min,Sec}} = calendar:time_difference(calendar:now_to_local_time(N1),
+ calendar:now_to_local_time(N2)),
+ 1000 * (Min*60 + Sec + (M2-M1)/1000000).
+
+%%--------------------------------------------------------------------
openssh_zlib_basic_test() ->
[{doc, "Test basic connection with openssh_zlib"}].
@@ -639,6 +762,49 @@ openssh_zlib_basic_test(Config) ->
ssh:stop_daemon(Pid).
%%--------------------------------------------------------------------
+
+max_sessions(Config) ->
+ SystemDir = filename:join(?config(priv_dir, Config), system),
+ UserDir = ?config(priv_dir, Config),
+ MaxSessions = 2,
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{"carni", "meat"}]},
+ {parallel_login, true},
+ {max_sessions, MaxSessions}
+ ]),
+
+ Connect = fun() ->
+ R=ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false},
+ {user, "carni"},
+ {password, "meat"}
+ ]),
+ ct:log("Connection ~p up",[R])
+ end,
+
+ try [Connect() || _ <- lists:seq(1,MaxSessions)]
+ of
+ _ ->
+ ct:pal("Expect Info Report:",[]),
+ try Connect()
+ of
+ _ConnectionRef ->
+ ssh:stop_daemon(Pid),
+ {fail,"Too many connections accepted"}
+ catch
+ error:{badmatch,{error,"Connection closed"}} ->
+ ssh:stop_daemon(Pid),
+ ok
+ end
+ catch
+ error:{badmatch,{error,"Connection closed"}} ->
+ ssh:stop_daemon(Pid),
+ {fail,"Too few connections accepted"}
+ end.
+
+%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 9ffc59dbaf..8d1a7ae54f 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 3.0.1
+SSH_VSN = 3.0.3
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/internal_doc/ssl-implementation.txt b/lib/ssl/internal_doc/ssl-implementation.txt
deleted file mode 100644
index e5d6ac8cd0..0000000000
--- a/lib/ssl/internal_doc/ssl-implementation.txt
+++ /dev/null
@@ -1,52 +0,0 @@
-
-Important modules:
-
- module behaviour children
- ------ ---------
- ssl_app application ssl_sup
- ssl_sup supervisor ssl_server, ssl_broker_sup
- ssl_server gen_server -
- ssl_broker_sup supervisor ssl_broker
- ssl_broker gen_server -
-
-The ssl_server controls a port program that implements the SSL functionality.
-That port program uses the OpenSSL package.
-
-Each socket has a corresponding broker (listen, accept or connect). A broker
-is created and supervised by the ssl_broker_sup.
-
-All communication is between a user and a broker. The broker communicates
-with the ssl_server, that sends its commands to the port program and handles
-the port program responses, that are distributed to users through the
-brokers.
-
-There is a distinction between commands and data flow between the ssl_server
-and the port program. Each established connection between the user and the
-outside world consists of a local erlang socket (owned by the broker) that
-is read from and written to by the broker. At the other end of the local
-connection is a local socket in the port program.
-
-The "real" socket that connects to the outside world is in the port program
-(including listen sockets). The main purpose of the port program is to
-shuffle data between local sockets and outside world sockets, and detect and
-propagate read and write errors (including detection of closed sockets) to
-the ssl_server.
-
-There is documentation in the ssl_broker.erl module.
-
-There is also documentation in the esock.c and esock_openssl.c files.
-
-The ssl_pem.erl, ssl_pkix.erl and ssl_base64.erl modules are support
-modules for reading SSL certificates. Modules for parsing certificates
-are generated from ASN.1 modules in the `pkix' directory.
-
-The `examples' directory contains functions for generating certificates.
-Those certificates are used in the test suites.
-
-
-
-
-
-
-
-
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 131b615277..7c4c8ec2cc 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2013. All Rights Reserved.
+# Copyright Ericsson AB 1999-2014. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -66,6 +66,7 @@ MODULES= \
ssl_session \
ssl_session_cache \
ssl_socket \
+ ssl_listen_tracker_sup \
tls_record \
dtls_record \
ssl_record \
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 57f8dd86d3..508983ddac 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -202,13 +202,14 @@ hello(Hello = #client_hello{client_version = ClientVersion,
session_cache = Cache,
session_cache_cb = CacheCb,
ssl_options = SslOpts}) ->
- HashSign = ssl_handshake:select_hashsign(HashSigns, Cert),
case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
{Version, {Type, Session},
ConnectionStates,
#hello_extensions{ec_point_formats = EcPointFormats,
elliptic_curves = EllipticCurves} = ServerHelloExt} ->
+ HashSign = ssl_handshake:select_hashsign(HashSigns, Cert,
+ dtls_v1:corresponding_tls_version(Version)),
ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign},
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index 99839f6149..36681e2897 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -28,6 +28,7 @@
ssl_srp_primes,
ssl_alert,
ssl_socket,
+ ssl_listen_tracker_sup,
%% Erlang Distribution over SSL/TLS
inet_tls_dist,
ssl_tls_dist_proxy,
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index b0ef292c4e..b713f86c1e 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,33 +1,13 @@
%% -*- erlang -*-
{"%VSN%",
[
- {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []},
- {load_module, ssl_connection, soft_purge, soft_purge, []},
- {load_module, ssl_handshake, soft_purge, soft_purge, []},
- {load_module, tls_handshake, soft_purge, soft_purge, []},
- {load_module, tls_connection, soft_purge, soft_purge, []}]},
- {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []},
- {load_module, ssl_connection, soft_purge, soft_purge, []},
- {load_module, ssl_handshake, soft_purge, soft_purge, []},
- {load_module, tls_handshake, soft_purge, soft_purge, []},
- {load_module, tls_connection, soft_purge, soft_purge, []}]},
- {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]},
+ {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]},
{<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]},
{<<"4\\..*">>, [{restart_application, ssl}]},
{<<"3\\..*">>, [{restart_application, ssl}]}
],
[
- {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []},
- {load_module, ssl_connection, soft_purge, soft_purge, []},
- {load_module, ssl_handshake, soft_purge, soft_purge, []},
- {load_module, tls_handshake, soft_purge, soft_purge, []},
- {load_module, tls_connection, soft_purge, soft_purge, []}]},
- {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []},
- {load_module, ssl_connection, soft_purge, soft_purge, []},
- {load_module, ssl_handshake, soft_purge, soft_purge, []},
- {load_module, tls_handshake, soft_purge, soft_purge, []},
- {load_module, tls_connection, soft_purge, soft_purge, []}]},
- {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]},
+ {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]},
{<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]},
{<<"4\\..*">>, [{restart_application, ssl}]},
{<<"3\\..*">>, [{restart_application, ssl}]}
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 743753bf7d..d741fa63fb 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -97,17 +97,17 @@ connect(Socket, SslOptions) when is_port(Socket) ->
connect(Socket, SslOptions0, Timeout) when is_port(Socket) ->
{Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0,
{gen_tcp, tcp, tcp_closed, tcp_error}),
- EmulatedOptions = emulated_options(),
+ EmulatedOptions = ssl_socket:emulated_options(),
{ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
- try handle_options(SslOptions0 ++ SocketValues, client) of
+ try handle_options(SslOptions0 ++ SocketValues) of
{ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts,
connection_cb = ConnectionCb}} ->
- ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
+ ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()),
case ssl_socket:peername(Transport, Socket) of
{ok, {Address, Port}} ->
ssl_connection:connect(ConnectionCb, Address, Port, Socket,
- {SslOptions, EmOpts},
+ {SslOptions, emulated_socket_options(EmOpts, #socket_options{}), undefined},
self(), CbInfo, Timeout);
{error, Error} ->
{error, Error}
@@ -121,7 +121,7 @@ connect(Host, Port, Options) ->
connect(Host, Port, Options, infinity).
connect(Host, Port, Options, Timeout) ->
- try handle_options(Options, client) of
+ try handle_options(Options) of
{ok, Config} ->
do_connect(Host,Port,Config,Timeout)
catch
@@ -139,12 +139,15 @@ listen(_Port, []) ->
{error, nooptions};
listen(Port, Options0) ->
try
- {ok, Config} = handle_options(Options0, server),
+ {ok, Config} = handle_options(Options0),
ConnectionCb = connection_cb(Options0),
- #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb} = Config,
+ #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb,
+ ssl = SslOpts, emulated = EmOpts} = Config,
case Transport:listen(Port, Options) of
{ok, ListenSocket} ->
- {ok, #sslsocket{pid = {ListenSocket, Config}}};
+ ok = ssl_socket:setopts(Transport, ListenSocket, ssl_socket:internal_inet_values()),
+ {ok, Tracker} = ssl_socket:inherit_tracker(ListenSocket, EmOpts, SslOpts),
+ {ok, #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}}};
Err = {error, _} ->
Err
end
@@ -164,25 +167,20 @@ transport_accept(ListenSocket) ->
transport_accept(ListenSocket, infinity).
transport_accept(#sslsocket{pid = {ListenSocket,
- #config{transport_info = CbInfo,
+ #config{transport_info = {Transport,_,_, _} =CbInfo,
connection_cb = ConnectionCb,
- ssl = SslOpts}}}, Timeout) ->
- %% The setopt could have been invoked on the listen socket
- %% and options should be inherited.
- EmOptions = emulated_options(),
- {Transport,_,_, _} = CbInfo,
- {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions),
- ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()),
+ ssl = SslOpts,
+ emulated = Tracker}}}, Timeout) ->
case Transport:accept(ListenSocket, Timeout) of
{ok, Socket} ->
- ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues),
+ {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker),
{ok, Port} = ssl_socket:port(Transport, Socket),
ConnArgs = [server, "localhost", Port, Socket,
- {SslOpts, socket_options(SocketValues)}, self(), CbInfo],
+ {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), Tracker}, self(), CbInfo],
ConnectionSup = connection_sup(ConnectionCb),
case ConnectionSup:start_child(ConnArgs) of
{ok, Pid} ->
- ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport);
+ ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport, Tracker);
{error, Reason} ->
{error, Reason}
end;
@@ -213,26 +211,27 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
ssl_accept(#sslsocket{} = Socket, [], Timeout) ->
ssl_accept(#sslsocket{} = Socket, Timeout);
-ssl_accept(#sslsocket{} = Socket, SslOptions, Timeout) ->
+ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) ->
try
- {ok, #config{ssl = SSL}} = handle_options(SslOptions, server),
- ssl_connection:handshake(Socket, SSL, Timeout)
+ {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker),
+ SslOpts = handle_options(SslOpts0, InheritedSslOpts),
+ ssl_connection:handshake(Socket, {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, Timeout)
catch
Error = {error, _Reason} -> Error
end;
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
{Transport,_,_,_} =
proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}),
- EmulatedOptions = emulated_options(),
+ EmulatedOptions = ssl_socket:emulated_options(),
{ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
ConnetionCb = connection_cb(SslOptions),
- try handle_options(SslOptions ++ SocketValues, server) of
+ try handle_options(SslOptions ++ SocketValues) of
{ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} ->
- ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
+ ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()),
{ok, Port} = ssl_socket:port(Transport, Socket),
ssl_connection:ssl_accept(ConnetionCb, Port, Socket,
- {SslOpts, EmOpts},
- self(), CbInfo, Timeout)
+ {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined},
+ self(), CbInfo, Timeout)
catch
Error = {error, _Reason} -> Error
end.
@@ -301,7 +300,7 @@ connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
%%
%% Description: same as inet:peername/1.
%%--------------------------------------------------------------------
-peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)->
+peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)->
ssl_socket:peername(Transport, Socket);
peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) ->
ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn}
@@ -340,28 +339,28 @@ negotiated_next_protocol(#sslsocket{pid = Pid}) ->
ssl_connection:negotiated_next_protocol(Pid).
%%--------------------------------------------------------------------
--spec cipher_suites() -> [ssl_cipher:erl_cipher_suite()].
--spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:erl_cipher_suite()] | [string()].
-
+-spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:erl_cipher_suite()] |
+ [string()].
%% Description: Returns all supported cipher suites.
%%--------------------------------------------------------------------
-cipher_suites() ->
- cipher_suites(erlang).
-
cipher_suites(erlang) ->
Version = tls_record:highest_protocol_version([]),
- [suite_definition(S) || S <- ssl_cipher:suites(Version)];
-
+ ssl_cipher:filter_suites([suite_definition(S)
+ || S <- ssl_cipher:suites(Version)]);
cipher_suites(openssl) ->
Version = tls_record:highest_protocol_version([]),
- [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)];
+ [ssl_cipher:openssl_suite_name(S)
+ || S <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))];
cipher_suites(all) ->
Version = tls_record:highest_protocol_version([]),
- Supported = ssl_cipher:suites(Version)
+ Supported = ssl_cipher:all_suites(Version)
++ ssl_cipher:anonymous_suites()
++ ssl_cipher:psk_suites(Version)
++ ssl_cipher:srp_suites(),
- [suite_definition(S) || S <- Supported].
+ ssl_cipher:filter_suites([suite_definition(S) || S <- Supported]).
+
+cipher_suites() ->
+ cipher_suites(erlang).
%%--------------------------------------------------------------------
-spec getopts(#sslsocket{}, [gen_tcp:option_name()]) ->
@@ -371,7 +370,7 @@ cipher_suites(all) ->
%%--------------------------------------------------------------------
getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
ssl_connection:get_opts(Pid, OptionTags);
-getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}},
+getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket,
OptionTags) when is_list(OptionTags) ->
try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of
{ok, _} = Result ->
@@ -379,8 +378,8 @@ getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_
{error, InetError} ->
{error, {options, {socket_options, OptionTags, InetError}}}
catch
- _:_ ->
- {error, {options, {socket_options, OptionTags}}}
+ _:Error ->
+ {error, {options, {socket_options, OptionTags, Error}}}
end;
getopts(#sslsocket{}, OptionTags) ->
{error, {options, {socket_options, OptionTags}}}.
@@ -400,7 +399,7 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
{error, {options, {not_a_proplist, Options0}}}
end;
-setopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, Options) when is_list(Options) ->
+setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) ->
try ssl_socket:setopts(Transport, ListenSocket, Options) of
ok ->
ok;
@@ -429,10 +428,10 @@ shutdown(#sslsocket{pid = Pid}, How) ->
%%
%% Description: Same as inet:sockname/1
%%--------------------------------------------------------------------
-sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}}) when is_port(Listen) ->
+sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}) when is_port(Listen) ->
ssl_socket:sockname(Transport, Listen);
-sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) ->
+sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) ->
ssl_socket:sockname(Transport, Socket).
%%---------------------------------------------------------------
@@ -551,7 +550,8 @@ do_connect(Address, Port,
{Transport, _, _, _} = CbInfo,
try Transport:connect(Address, Port, SocketOpts, Timeout) of
{ok, Socket} ->
- ssl_connection:connect(ConnetionCb, Address, Port, Socket, {SslOpts,EmOpts},
+ ssl_connection:connect(ConnetionCb, Address, Port, Socket,
+ {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined},
self(), CbInfo, Timeout);
{error, Reason} ->
{error, Reason}
@@ -564,53 +564,47 @@ do_connect(Address, Port,
{error, {options, {socket_options, UserOpts}}}
end.
-handle_options(Opts0, _Role) ->
+%% Handle extra ssl options given to ssl_accept
+handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0,
+ cacertfile = CaCertFile0} = InheritedSslOpts) ->
+ RecordCB = record_cb(Protocol),
+ CaCerts = handle_option(cacerts, Opts0, CaCerts0),
+ {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts0, CaCerts),
+ CaCertFile = case proplists:get_value(cacertfile, Opts0, CaCertFile0) of
+ undefined ->
+ CaCertDefault;
+ CAFile ->
+ CAFile
+ end,
+ NewVerifyOpts = InheritedSslOpts#ssl_options{cacerts = CaCerts,
+ cacertfile = CaCertFile,
+ verify = Verify,
+ verify_fun = VerifyFun,
+ fail_if_no_peer_cert = FailIfNoPeerCert},
+ SslOpts1 = lists:foldl(fun(Key, PropList) ->
+ proplists:delete(Key, PropList)
+ end, Opts0, [cacerts, cacertfile, verify, verify_fun, fail_if_no_peer_cert]),
+ case handle_option(versions, SslOpts1, []) of
+ [] ->
+ new_ssl_options(SslOpts1, NewVerifyOpts, RecordCB);
+ Value ->
+ Versions = [RecordCB:protocol_version(Vsn) || Vsn <- Value],
+ new_ssl_options(proplists:delete(versions, SslOpts1),
+ NewVerifyOpts#ssl_options{versions = Versions}, record_cb(Protocol))
+ end.
+
+%% Handle all options in listen and connect
+handle_options(Opts0) ->
Opts = proplists:expand([{binary, [{mode, binary}]},
{list, [{mode, list}]}], Opts0),
assert_proplist(Opts),
RecordCb = record_cb(Opts),
ReuseSessionFun = fun(_, _, _, _) -> true end,
-
- DefaultVerifyNoneFun =
- {fun(_,{bad_cert, _}, UserState) ->
- {valid, UserState};
- (_,{extension, _}, UserState) ->
- {unknown, UserState};
- (_, valid, UserState) ->
- {valid, UserState};
- (_, valid_peer, UserState) ->
- {valid, UserState}
- end, []},
-
- VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun),
-
- UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false),
- UserVerifyFun = handle_option(verify_fun, Opts, undefined),
CaCerts = handle_option(cacerts, Opts, undefined),
- {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} =
- %% Handle 0, 1, 2 for backwards compatibility
- case proplists:get_value(verify, Opts, verify_none) of
- 0 ->
- {verify_none, false,
- ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
- 1 ->
- {verify_peer, false,
- ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
- 2 ->
- {verify_peer, true,
- ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
- verify_none ->
- {verify_none, false,
- ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
- verify_peer ->
- {verify_peer, UserFailIfNoPeerCert,
- ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
- Value ->
- throw({error, {options, {verify, Value}}})
- end,
-
+ {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts, CaCerts),
+
CertFile = handle_option(certfile, Opts, <<>>),
RecordCb = record_cb(Opts),
@@ -641,7 +635,8 @@ handle_options(Opts0, _Role) ->
user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined),
psk_identity = handle_option(psk_identity, Opts, undefined),
srp_identity = handle_option(srp_identity, Opts, undefined),
- ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), hd(Versions)),
+ ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []),
+ RecordCb:highest_protocol_version(Versions)),
%% Server side option
reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun),
reuse_sessions = handle_option(reuse_sessions, Opts, true),
@@ -656,7 +651,8 @@ handle_options(Opts0, _Role) ->
handle_option(client_preferred_next_protocols, Opts, undefined)),
log_alert = handle_option(log_alert, Opts, true),
server_name_indication = handle_option(server_name_indication, Opts, undefined),
- honor_cipher_order = handle_option(honor_cipher_order, Opts, false)
+ honor_cipher_order = handle_option(honor_cipher_order, Opts, false),
+ protocol = proplists:get_value(protocol, Opts, tls)
},
CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),
@@ -675,10 +671,10 @@ handle_options(Opts0, _Role) ->
proplists:delete(Key, PropList)
end, Opts, SslOptions),
- {SSLsock, Emulated} = emulated_options(SockOpts),
+ {Sock, Emulated} = emulated_options(SockOpts),
ConnetionCb = connection_cb(Opts),
- {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = SSLsock,
+ {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = Sock,
inet_user = SockOpts, transport_info = CbInfo, connection_cb = ConnetionCb
}}.
@@ -904,40 +900,24 @@ ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) ->
%% some trusted certs.
ca_cert_default(verify_peer, undefined, _) ->
"".
-
-emulated_options() ->
- [mode, packet, active, header, packet_size].
-
-internal_inet_values() ->
- [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}].
-
-socket_options(InetValues) ->
- #socket_options{
- mode = proplists:get_value(mode, InetValues, lists),
- header = proplists:get_value(header, InetValues, 0),
- active = proplists:get_value(active, InetValues, active),
- packet = proplists:get_value(packet, InetValues, 0),
- packet_size = proplists:get_value(packet_size, InetValues)
- }.
-
emulated_options(Opts) ->
- emulated_options(Opts, internal_inet_values(), #socket_options{}).
-
-emulated_options([{mode,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(mode,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt});
-emulated_options([{header,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(header,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{header=Opt});
-emulated_options([{active,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(active,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{active=Opt});
-emulated_options([{packet,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(packet,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt});
-emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(packet_size,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt});
+ emulated_options(Opts, ssl_socket:internal_inet_values(), ssl_socket:default_inet_values()).
+
+emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) ->
+ validate_inet_option(mode, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]);
+emulated_options([{header, Value} = Opt | Opts], Inet, Emulated) ->
+ validate_inet_option(header, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(header, Emulated)]);
+emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) ->
+ validate_inet_option(active, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]);
+emulated_options([{packet, Value} = Opt |Opts], Inet, Emulated) ->
+ validate_inet_option(packet, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(packet, Emulated)]);
+emulated_options([{packet_size, Value} = Opt | Opts], Inet, Emulated) ->
+ validate_inet_option(packet_size, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(packet_size, Emulated)]);
emulated_options([Opt|Opts], Inet, Emulated) ->
emulated_options(Opts, [Opt|Inet], Emulated);
emulated_options([], Inet,Emulated) ->
@@ -953,8 +933,11 @@ handle_cipher_option(Value, Version) when is_list(Value) ->
error:_->
throw({error, {options, {ciphers, Value}}})
end.
-binary_cipher_suites(Version, []) -> %% Defaults to all supported suits
- ssl_cipher:suites(Version);
+
+binary_cipher_suites(Version, []) ->
+ %% Defaults to all supported suites that does
+ %% not require explicit configuration
+ ssl_cipher:filter_suites(ssl_cipher:suites(Version));
binary_cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility
Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0],
binary_cipher_suites(Version, Ciphers);
@@ -963,14 +946,15 @@ binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) ->
binary_cipher_suites(Version, Ciphers);
binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) ->
- Supported0 = ssl_cipher:suites(Version)
+ All = ssl_cipher:suites(Version)
++ ssl_cipher:anonymous_suites()
++ ssl_cipher:psk_suites(Version)
++ ssl_cipher:srp_suites(),
- Supported = ssl_cipher:filter_suites(Supported0),
- case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported)] of
+ case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of
[] ->
- Supported; %% Defaults to all supported suits
+ %% Defaults to all supported suites that does
+ %% not require explicit configuration
+ ssl_cipher:filter_suites(ssl_cipher:suites(Version));
Ciphers ->
Ciphers
end;
@@ -1054,7 +1038,7 @@ record_cb(tls) ->
record_cb(dtls) ->
dtls_record;
record_cb(Opts) ->
- record_cb(proplists:get_value(protocol, Opts, tls)).
+ record_cb(proplists:get_value(protocol, Opts, tls)).
connection_sup(tls_connection) ->
tls_connection_sup;
@@ -1076,3 +1060,112 @@ assert_proplist([inet6 | Rest]) ->
assert_proplist(Rest);
assert_proplist([Value | _]) ->
throw({option_not_a_key_value_tuple, Value}).
+
+emulated_socket_options(InetValues, #socket_options{
+ mode = Mode,
+ header = Header,
+ active = Active,
+ packet = Packet,
+ packet_size = Size}) ->
+ #socket_options{
+ mode = proplists:get_value(mode, InetValues, Mode),
+ header = proplists:get_value(header, InetValues, Header),
+ active = proplists:get_value(active, InetValues, Active),
+ packet = proplists:get_value(packet, InetValues, Packet),
+ packet_size = proplists:get_value(packet_size, InetValues, Size)
+ }.
+
+new_ssl_options([], #ssl_options{} = Opts, _) ->
+ Opts;
+new_ssl_options([{verify_client_once, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{verify_client_once = validate_option(verify_client_once, Value)}, RecordCB);
+new_ssl_options([{depth, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{depth = validate_option(depth, Value)}, RecordCB);
+new_ssl_options([{cert, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{cert = validate_option(cert, Value)}, RecordCB);
+new_ssl_options([{certfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{certfile = validate_option(certfile, Value)}, RecordCB);
+new_ssl_options([{key, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{key = validate_option(key, Value)}, RecordCB);
+new_ssl_options([{keyfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{keyfile = validate_option(keyfile, Value)}, RecordCB);
+new_ssl_options([{password, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{password = validate_option(password, Value)}, RecordCB);
+new_ssl_options([{dh, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{dh = validate_option(dh, Value)}, RecordCB);
+new_ssl_options([{dhfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{dhfile = validate_option(dhfile, Value)}, RecordCB);
+new_ssl_options([{user_lookup_fun, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{user_lookup_fun = validate_option(user_lookup_fun, Value)}, RecordCB);
+new_ssl_options([{psk_identity, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{psk_identity = validate_option(psk_identity, Value)}, RecordCB);
+new_ssl_options([{srp_identity, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{srp_identity = validate_option(srp_identity, Value)}, RecordCB);
+new_ssl_options([{ciphers, Value} | Rest], #ssl_options{versions = Versions} = Opts, RecordCB) ->
+ Ciphers = handle_cipher_option(Value, RecordCB:highest_protocol_version(Versions)),
+ new_ssl_options(Rest,
+ Opts#ssl_options{ciphers = Ciphers}, RecordCB);
+new_ssl_options([{reuse_session, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{reuse_session = validate_option(reuse_session, Value)}, RecordCB);
+new_ssl_options([{reuse_sessions, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{reuse_sessions = validate_option(reuse_sessions, Value)}, RecordCB);
+new_ssl_options([{ssl_imp, _Value} | Rest], #ssl_options{} = Opts, RecordCB) -> %% Not used backwards compatibility
+ new_ssl_options(Rest, Opts, RecordCB);
+new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB);
+new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB);
+new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB);
+new_ssl_options([{next_protocols_advertised, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{next_protocols_advertised = validate_option(next_protocols_advertised, Value)}, RecordCB);
+new_ssl_options([{client_preferred_next_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{next_protocol_selector =
+ make_next_protocol_selector(validate_option(client_preferred_next_protocols, Value))}, RecordCB);
+new_ssl_options([{log_alert, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{log_alert = validate_option(log_alert, Value)}, RecordCB);
+new_ssl_options([{server_name_indication, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{server_name_indication = validate_option(server_name_indication, Value)}, RecordCB);
+new_ssl_options([{honor_cipher_order, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{honor_cipher_order = validate_option(honor_cipher_order, Value)}, RecordCB);
+new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) ->
+ throw({error, {options, {Key, Value}}}).
+
+
+handle_verify_options(Opts, CaCerts) ->
+ DefaultVerifyNoneFun =
+ {fun(_,{bad_cert, _}, UserState) ->
+ {valid, UserState};
+ (_,{extension, _}, UserState) ->
+ {unknown, UserState};
+ (_, valid, UserState) ->
+ {valid, UserState};
+ (_, valid_peer, UserState) ->
+ {valid, UserState}
+ end, []},
+ VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun),
+
+ UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false),
+ UserVerifyFun = handle_option(verify_fun, Opts, undefined),
+
+
+ %% Handle 0, 1, 2 for backwards compatibility
+ case proplists:get_value(verify, Opts, verify_none) of
+ 0 ->
+ {verify_none, false,
+ ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
+ 1 ->
+ {verify_peer, false,
+ ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
+ 2 ->
+ {verify_peer, true,
+ ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
+ verify_none ->
+ {verify_none, false,
+ ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun};
+ verify_peer ->
+ {verify_peer, UserFailIfNoPeerCert,
+ ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun};
+ Value ->
+ throw({error, {options, {verify, Value}}})
+ end.
diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl
index db1535b5ec..78dc98bc25 100644
--- a/lib/ssl/src/ssl_alert.erl
+++ b/lib/ssl/src/ssl_alert.erl
@@ -31,7 +31,7 @@
-include("ssl_record.hrl").
-include("ssl_internal.hrl").
--export([encode/3, alert_txt/1, reason_code/2]).
+-export([encode/3, decode/1, alert_txt/1, reason_code/2]).
%%====================================================================
%% Internal application API
@@ -41,12 +41,21 @@
-spec encode(#alert{}, ssl_record:ssl_version(), #connection_states{}) ->
{iolist(), #connection_states{}}.
%%
-%% Description:
+%% Description: Encodes an alert
%%--------------------------------------------------------------------
encode(#alert{} = Alert, Version, ConnectionStates) ->
ssl_record:encode_alert_record(Alert, Version, ConnectionStates).
%%--------------------------------------------------------------------
+-spec decode(binary()) -> [#alert{}] | #alert{}.
+%%
+%% Description: Decode alert(s), will return a singel own alert if peer
+%% sends garbage or too many warning alerts.
+%%--------------------------------------------------------------------
+decode(Bin) ->
+ decode(Bin, [], 0).
+
+%%--------------------------------------------------------------------
-spec reason_code(#alert{}, client | server) -> closed | {essl, string()}.
%%
%% Description: Returns the error reason that will be returned to the
@@ -71,6 +80,22 @@ alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}})
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
+
+%% It is very unlikely that an correct implementation will send more than one alert at the time
+%% So it there is more than 10 warning alerts we consider it an error
+decode(<<?BYTE(Level), ?BYTE(_), _/binary>>, _, N) when Level == ?WARNING, N > ?MAX_ALERTS ->
+ ?ALERT_REC(?FATAL, ?DECODE_ERROR);
+decode(<<?BYTE(Level), ?BYTE(Description), Rest/binary>>, Acc, N) when Level == ?WARNING ->
+ Alert = ?ALERT_REC(Level, Description),
+ decode(Rest, [Alert | Acc], N + 1);
+decode(<<?BYTE(Level), ?BYTE(Description), _Rest/binary>>, Acc, _) when Level == ?FATAL->
+ Alert = ?ALERT_REC(Level, Description),
+ lists:reverse([Alert | Acc]); %% No need to decode rest fatal alert will end the connection
+decode(<<?BYTE(_Level), _/binary>>, _, _) ->
+ ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER);
+decode(<<>>, Acc, _) ->
+ lists:reverse(Acc, []).
+
level_txt(?WARNING) ->
"Warning:";
level_txt(?FATAL) ->
diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl
index 2d1f323085..f4f1d74264 100644
--- a/lib/ssl/src/ssl_alert.hrl
+++ b/lib/ssl/src/ssl_alert.hrl
@@ -104,6 +104,8 @@
-define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}).
+-define(MAX_ALERTS, 10).
+
%% Alert
-record(alert, {
level,
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 78a328ace8..72467ea2a0 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -34,7 +34,8 @@
-export([security_parameters/2, security_parameters/3, suite_definition/1,
decipher/5, cipher/5,
- suite/1, suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0,
+ suite/1, suites/1, all_suites/1,
+ ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0,
openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]).
@@ -224,6 +225,11 @@ suites({3, 0}) ->
suites({3, N}) ->
tls_v1:suites(N).
+all_suites(Version) ->
+ suites(Version)
+ ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:psk_suites(Version)
+ ++ ssl_cipher:srp_suites().
%%--------------------------------------------------------------------
-spec anonymous_suites() -> [cipher_suite()].
%%
@@ -1013,7 +1019,8 @@ openssl_suite_name(Cipher) ->
%%--------------------------------------------------------------------
-spec filter(undefined | binary(), [cipher_suite()]) -> [cipher_suite()].
%%
-%% Description: .
+%% Description: Select the cipher suites that can be used together with the
+%% supplied certificate. (Server side functionality)
%%-------------------------------------------------------------------
filter(undefined, Ciphers) ->
Ciphers;
@@ -1047,7 +1054,7 @@ filter(DerCert, Ciphers) ->
%%--------------------------------------------------------------------
-spec filter_suites([cipher_suite()]) -> [cipher_suite()].
%%
-%% Description: filter suites for algorithms
+%% Description: Filter suites for algorithms supported by crypto.
%%-------------------------------------------------------------------
filter_suites(Suites = [{_,_,_}|_]) ->
Algos = crypto:supports(),
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index c2810a199f..4ac4e81d9e 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -37,7 +37,7 @@
%% Setup
-export([connect/8, ssl_accept/7, handshake/2, handshake/3,
- socket_control/4]).
+ socket_control/4, socket_control/5]).
%% User Events
-export([send/2, recv/3, close/1, shutdown/2,
@@ -50,7 +50,7 @@
%% SSL FSM state functions
-export([hello/3, abbreviated/3, certify/3, cipher/3, connection/3]).
%% SSL all state functions
--export([handle_sync_event/4, handle_info/3, terminate/3]).
+-export([handle_sync_event/4, handle_info/3, terminate/3, format_status/2]).
%%====================================================================
@@ -58,7 +58,10 @@
%%====================================================================
%%--------------------------------------------------------------------
-spec connect(tls_connection | dtls_connection,
- host(), inet:port_number(), port(), {#ssl_options{}, #socket_options{}},
+ host(), inet:port_number(), port(),
+ {#ssl_options{}, #socket_options{},
+ %% Tracker only needed on server side
+ undefined},
pid(), tuple(), timeout()) ->
{ok, #sslsocket{}} | {error, reason()}.
%%
@@ -73,9 +76,10 @@ connect(Connection, Host, Port, Socket, Options, User, CbInfo, Timeout) ->
end.
%%--------------------------------------------------------------------
-spec ssl_accept(tls_connection | dtls_connection,
- inet:port_number(), port(), {#ssl_options{}, #socket_options{}},
- pid(), tuple(), timeout()) ->
- {ok, #sslsocket{}} | {error, reason()}.
+ inet:port_number(), port(),
+ {#ssl_options{}, #socket_options{}, undefined | pid()},
+ pid(), tuple(), timeout()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Performs accept on an ssl listen socket. e.i. performs
%% ssl handshake.
@@ -102,7 +106,8 @@ handshake(#sslsocket{pid = Pid}, Timeout) ->
end.
%%--------------------------------------------------------------------
--spec handshake(#sslsocket{}, #ssl_options{}, timeout()) -> ok | {error, reason()}.
+-spec handshake(#sslsocket{}, {#ssl_options{},#socket_options{}},
+ timeout()) -> ok | {error, reason()}.
%%
%% Description: Starts ssl handshake with some new options
%%--------------------------------------------------------------------
@@ -121,9 +126,16 @@ handshake(#sslsocket{pid = Pid}, SslOptions, Timeout) ->
%% Description: Set the ssl process to own the accept socket
%%--------------------------------------------------------------------
socket_control(Connection, Socket, Pid, Transport) ->
+ socket_control(Connection, Socket, Pid, Transport, undefined).
+
+%--------------------------------------------------------------------
+-spec socket_control(tls_connection | dtls_connection, port(), pid(), atom(), pid()| undefined) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+%%--------------------------------------------------------------------
+socket_control(Connection, Socket, Pid, Transport, ListenTracker) ->
case Transport:controlling_process(Socket, Pid) of
ok ->
- {ok, ssl_socket:socket(Pid, Transport, Socket, Connection)};
+ {ok, ssl_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)};
{error, Reason} ->
{error, Reason}
end.
@@ -290,12 +302,11 @@ hello(#hello_request{}, #state{role = client} = State0, Connection) ->
{Record, State} = Connection:next_record(State0),
Connection:next_state(hello, hello, Record, State);
-hello({common_client_hello, Type, ServerHelloExt, HashSign},
- #state{session = #session{cipher_suite = CipherSuite},
- negotiated_version = Version} = State, Connection) ->
- {KeyAlg, _, _, _} = ssl_cipher:suite_definition(CipherSuite),
- NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version),
+hello({common_client_hello, Type, ServerHelloExt, NegotiatedHashSign},
+ State, Connection) ->
do_server_hello(Type, ServerHelloExt,
+ %% Note NegotiatedHashSign is only negotiated for real if
+ %% if TLS version is at least TLS-1.2
State#state{hashsign_algorithm = NegotiatedHashSign}, Connection);
hello(timeout, State, _) ->
@@ -316,6 +327,7 @@ abbreviated(#hello_request{}, State0, Connection) ->
abbreviated(#finished{verify_data = Data} = Finished,
#state{role = server,
negotiated_version = Version,
+ expecting_finished = true,
tls_handshake_history = Handshake,
session = #session{master_secret = MasterSecret},
connection_states = ConnectionStates0} =
@@ -328,7 +340,8 @@ abbreviated(#finished{verify_data = Data} = Finished,
ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0),
Connection:next_state_connection(abbreviated,
ack_connection(
- State#state{connection_states = ConnectionStates}));
+ State#state{connection_states = ConnectionStates,
+ expecting_finished = false}));
#alert{} = Alert ->
Connection:handle_own_alert(Alert, Version, abbreviated, State)
end;
@@ -348,7 +361,7 @@ abbreviated(#finished{verify_data = Data} = Finished,
finalize_handshake(State0#state{connection_states = ConnectionStates1},
abbreviated, Connection),
Connection:next_state_connection(abbreviated,
- ack_connection(State));
+ ack_connection(State#state{expecting_finished = false}));
#alert{} = Alert ->
Connection:handle_own_alert(Alert, Version, abbreviated, State0)
end;
@@ -359,7 +372,7 @@ abbreviated(#next_protocol{selected_protocol = SelectedProtocol},
#state{role = server, expecting_next_protocol_negotiation = true} = State0,
Connection) ->
{Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}),
- Connection:next_state(abbreviated, abbreviated, Record, State);
+ Connection:next_state(abbreviated, abbreviated, Record, State#state{expecting_next_protocol_negotiation = false});
abbreviated(timeout, State, _) ->
{next_state, abbreviated, State, hibernate };
@@ -432,7 +445,8 @@ certify(#server_key_exchange{exchange_keys = Keys},
calculate_secret(Params#server_key_params.params,
State#state{hashsign_algorithm = HashSign}, Connection);
false ->
- ?ALERT_REC(?FATAL, ?DECRYPT_ERROR)
+ Connection:handle_own_alert(?ALERT_REC(?FATAL, ?DECRYPT_ERROR),
+ Version, certify, State)
end
end;
@@ -441,8 +455,9 @@ certify(#server_key_exchange{} = Msg,
Connection:handle_unexpected_message(Msg, certify_server_keyexchange, State);
certify(#certificate_request{hashsign_algorithms = HashSigns},
- #state{session = #session{own_certificate = Cert}} = State0, Connection) ->
- HashSign = ssl_handshake:select_hashsign(HashSigns, Cert),
+ #state{session = #session{own_certificate = Cert},
+ negotiated_version = Version} = State0, Connection) ->
+ HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version),
{Record, State} = Connection:next_record(State0#state{client_certificate_requested = true}),
Connection:next_state(certify, certify, Record,
State#state{cert_hashsign_algorithm = HashSign});
@@ -559,7 +574,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS
tls_handshake_history = Handshake
} = State0, Connection) ->
- HashSign = ssl_handshake:select_cert_hashsign(CertHashSign, Algo, Version),
+ HashSign = ssl_handshake:select_hashsign_algs(CertHashSign, Algo, Version),
case ssl_handshake:certificate_verify(Signature, PublicKeyInfo,
Version, HashSign, MasterSecret, Handshake) of
valid ->
@@ -581,6 +596,7 @@ cipher(#finished{verify_data = Data} = Finished,
host = Host,
port = Port,
role = Role,
+ expecting_finished = true,
session = #session{master_secret = MasterSecret}
= Session0,
connection_states = ConnectionStates0,
@@ -591,7 +607,7 @@ cipher(#finished{verify_data = Data} = Finished,
MasterSecret, Handshake0) of
verified ->
Session = register_session(Role, Host, Port, Session0),
- cipher_role(Role, Data, Session, State, Connection);
+ cipher_role(Role, Data, Session, State#state{expecting_finished = false}, Connection);
#alert{} = Alert ->
Connection:handle_own_alert(Alert, Version, cipher, State)
end;
@@ -599,9 +615,10 @@ cipher(#finished{verify_data = Data} = Finished,
%% only allowed to send next_protocol message after change cipher spec
%% & before finished message and it is not allowed during renegotiation
cipher(#next_protocol{selected_protocol = SelectedProtocol},
- #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) ->
+ #state{role = server, expecting_next_protocol_negotiation = true,
+ expecting_finished = true} = State0, Connection) ->
{Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}),
- Connection:next_state(cipher, cipher, Record, State);
+ Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false});
cipher(timeout, State, _) ->
{next_state, cipher, State, hibernate};
@@ -641,12 +658,27 @@ handle_sync_event({application_data, Data}, From, StateName,
State#state{send_queue = queue:in({From, Data}, Queue)},
get_timeout(State)};
-handle_sync_event({start, Timeout}, StartFrom, hello, #state{protocol_cb = Connection} = State) ->
- Timer = start_or_recv_cancel_timer(Timeout, StartFrom),
- Connection:hello(start, State#state{start_or_recv_from = StartFrom,
- timer = Timer});
+handle_sync_event({start, Timeout}, StartFrom, hello, #state{role = Role,
+ protocol_cb = Connection,
+ ssl_options = SSLOpts} = State0) ->
+ try
+ State = ssl_config(SSLOpts, Role, State0),
+ Timer = start_or_recv_cancel_timer(Timeout, StartFrom),
+ Connection:hello(start, State#state{start_or_recv_from = StartFrom,
+ timer = Timer})
+ catch throw:Error ->
+ {stop, normal, {error, Error}, State0}
+ end;
-%% The two clauses below could happen if a server upgrades a socket in
+handle_sync_event({start, {Opts, EmOpts}, Timeout}, From, StateName, State) ->
+ try
+ handle_sync_event({start, Timeout}, From, StateName, State#state{socket_options = EmOpts,
+ ssl_options = Opts})
+ catch throw:Error ->
+ {stop, normal, {error, Error}, State}
+ end;
+
+%% These two clauses below could happen if a server upgrades a socket in
%% active mode. Note that in this case we are lucky that
%% controlling_process has been evalueated before receiving handshake
%% messages from client. The server should put the socket in passive
@@ -656,17 +688,16 @@ handle_sync_event({start, Timeout}, StartFrom, hello, #state{protocol_cb = Conne
%% they upgrade an active socket.
handle_sync_event({start,_}, _, connection, State) ->
{reply, connected, connection, State, get_timeout(State)};
-handle_sync_event({start,_}, _From, error, {Error, State = #state{}}) ->
- {stop, {shutdown, Error}, {error, Error}, State};
-
-handle_sync_event({start, Timeout}, StartFrom, StateName, State) ->
- Timer = start_or_recv_cancel_timer(Timeout, StartFrom),
- {next_state, StateName, State#state{start_or_recv_from = StartFrom,
- timer = Timer}, get_timeout(State)};
-handle_sync_event({start, Opts, Timeout}, From, StateName, #state{ssl_options = SslOpts} = State) ->
- NewOpts = new_ssl_options(Opts, SslOpts),
- handle_sync_event({start, Timeout}, From, StateName, State#state{ssl_options = NewOpts});
+handle_sync_event({start, Timeout}, StartFrom, StateName, #state{role = Role, ssl_options = SslOpts} = State0) ->
+ try
+ State = ssl_config(SslOpts, Role, State0),
+ Timer = start_or_recv_cancel_timer(Timeout, StartFrom),
+ {next_state, StateName, State#state{start_or_recv_from = StartFrom,
+ timer = Timer}, get_timeout(State)}
+ catch throw:Error ->
+ {stop, normal, {error, Error}, State0}
+ end;
handle_sync_event(close, _, StateName, #state{protocol_cb = Connection} = State) ->
%% Run terminate before returning
@@ -674,7 +705,6 @@ handle_sync_event(close, _, StateName, #state{protocol_cb = Connection} = State)
%% as intended.
(catch Connection:terminate(user_close, StateName, State)),
{stop, normal, ok, State#state{terminated = true}};
-
handle_sync_event({shutdown, How0}, _, StateName,
#state{transport_cb = Transport,
negotiated_version = Version,
@@ -696,13 +726,14 @@ handle_sync_event({shutdown, How0}, _, StateName,
Error ->
{stop, normal, Error, State}
end;
-
+handle_sync_event({recv, _N, _Timeout}, _RecvFrom, StateName,
+ #state{socket_options = #socket_options{active = Active}} = State) when Active =/= false ->
+ {reply, {error, einval}, StateName, State, get_timeout(State)};
handle_sync_event({recv, N, Timeout}, RecvFrom, connection = StateName,
#state{protocol_cb = Connection} = State0) ->
Timer = start_or_recv_cancel_timer(Timeout, RecvFrom),
Connection:passive_receive(State0#state{bytes_to_read = N,
start_or_recv_from = RecvFrom, timer = Timer}, StateName);
-
%% Doing renegotiate wait with handling request until renegotiate is
%% finished. Will be handled by next_state_is_connection/2.
handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) ->
@@ -710,26 +741,22 @@ handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) ->
{next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom,
timer = Timer},
get_timeout(State)};
-
handle_sync_event({new_user, User}, _From, StateName,
State =#state{user_application = {OldMon, _}}) ->
NewMon = erlang:monitor(process, User),
erlang:demonitor(OldMon, [flush]),
{reply, ok, StateName, State#state{user_application = {NewMon,User}},
get_timeout(State)};
-
handle_sync_event({get_opts, OptTags}, _From, StateName,
#state{socket = Socket,
transport_cb = Transport,
socket_options = SockOpts} = State) ->
OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []),
{reply, OptsReply, StateName, State, get_timeout(State)};
-
handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) ->
{reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)};
handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) ->
{reply, {ok, NextProtocol}, StateName, State, get_timeout(State)};
-
handle_sync_event({set_opts, Opts0}, _From, StateName0,
#state{socket_options = Opts1,
protocol_cb = Connection,
@@ -768,13 +795,10 @@ handle_sync_event({set_opts, Opts0}, _From, StateName0,
end
end
end;
-
handle_sync_event(renegotiate, From, connection, #state{protocol_cb = Connection} = State) ->
Connection:renegotiate(State#state{renegotiation = {true, From}});
-
handle_sync_event(renegotiate, _, StateName, State) ->
{reply, {error, already_renegotiating}, StateName, State, get_timeout(State)};
-
handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName,
#state{connection_states = ConnectionStates,
negotiated_version = Version} = State) ->
@@ -800,7 +824,6 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName,
error:Reason -> {error, Reason}
end,
{reply, Reply, StateName, State, get_timeout(State)};
-
handle_sync_event(info, _, StateName,
#state{negotiated_version = Version,
session = #session{cipher_suite = Suite}} = State) ->
@@ -808,14 +831,12 @@ handle_sync_event(info, _, StateName,
AtomVersion = tls_record:protocol_version(Version),
{reply, {ok, {AtomVersion, ssl:suite_definition(Suite)}},
StateName, State, get_timeout(State)};
-
handle_sync_event(session_info, _, StateName,
#state{session = #session{session_id = Id,
cipher_suite = Suite}} = State) ->
{reply, [{session_id, Id},
{cipher_suite, ssl:suite_definition(Suite)}],
StateName, State, get_timeout(State)};
-
handle_sync_event(peer_certificate, _, StateName,
#state{session = #session{peer_certificate = Cert}}
= State) ->
@@ -825,8 +846,9 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName,
#state{socket = Socket, transport_cb = Transport,
start_or_recv_from = StartFrom, role = Role,
protocol_cb = Connection,
- error_tag = ErrorTag} = State) when StateName =/= connection ->
- Connection:alert_user(Transport, Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role),
+ error_tag = ErrorTag,
+ tracker = Tracker} = State) when StateName =/= connection ->
+ Connection:alert_user(Transport, Tracker,Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role),
{stop, normal, State};
handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket,
@@ -876,7 +898,6 @@ terminate(_, _, #state{terminated = true}) ->
%% we want to guarantee that Transport:close has been called
%% when ssl:close/1 returns.
ok;
-
terminate({shutdown, transport_closed}, StateName, #state{send_queue = SendQueue,
renegotiation = Renegotiate} = State) ->
handle_unrecv_data(StateName, State),
@@ -889,7 +910,6 @@ terminate({shutdown, own_alert}, _StateName, #state{send_queue = SendQueue,
handle_trusted_certs_db(State),
notify_senders(SendQueue),
notify_renegotiater(Renegotiate);
-
terminate(Reason, connection, #state{negotiated_version = Version,
protocol_cb = Connection,
connection_states = ConnectionStates,
@@ -906,7 +926,6 @@ terminate(Reason, connection, #state{negotiated_version = Version,
_ ->
ok
end;
-
terminate(_Reason, _StateName, #state{transport_cb = Transport,
socket = Socket, send_queue = SendQueue,
renegotiation = Renegotiate} = State) ->
@@ -915,9 +934,50 @@ terminate(_Reason, _StateName, #state{transport_cb = Transport,
notify_renegotiater(Renegotiate),
Transport:close(Socket).
+format_status(normal, [_, State]) ->
+ [{data, [{"StateData", State}]}];
+format_status(terminate, [_, State]) ->
+ SslOptions = (State#state.ssl_options),
+ NewOptions = SslOptions#ssl_options{password = "***",
+ cert = "***",
+ cacerts = "***",
+ key = "***",
+ dh = "***",
+ psk_identity = "***",
+ srp_identity = "***"},
+ [{data, [{"StateData", State#state{connection_states = "***",
+ protocol_buffers = "***",
+ user_data_buffer = "***",
+ tls_handshake_history = "***",
+ session = "***",
+ private_key = "***",
+ diffie_hellman_params = "***",
+ diffie_hellman_keys = "***",
+ srp_params = "***",
+ srp_keys = "***",
+ premaster_secret = "***",
+ ssl_options = NewOptions
+ }}]}].
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
+ssl_config(Opts, Role, State) ->
+ {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} =
+ ssl_config:init(Opts, Role),
+ Handshake = ssl_handshake:init_handshake_history(),
+ TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}),
+ Session = State#state.session,
+ State#state{tls_handshake_history = Handshake,
+ session = Session#session{own_certificate = OwnCert,
+ time_stamp = TimeStamp},
+ file_ref_db = FileRefHandle,
+ cert_db_ref = Ref,
+ cert_db = CertDbHandle,
+ session_cache = CacheHandle,
+ private_key = Key,
+ diffie_hellman_params = DHParams,
+ ssl_options = Opts}.
+
do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} =
ServerHelloExt,
#state{negotiated_version = Version,
@@ -983,9 +1043,6 @@ server_hello_done(State, Connection) ->
HelloDone = ssl_handshake:server_hello_done(),
Connection:send_handshake(HelloDone, State).
-
-
-
handle_peer_cert(Role, PeerCert, PublicKeyInfo,
#state{session = #session{cipher_suite = CipherSuite} = Session} = State0,
Connection) ->
@@ -1559,60 +1616,6 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0
session = Session}, cipher, Connection),
Connection:next_state_connection(cipher, ack_connection(State#state{session = Session})).
-negotiated_hashsign(undefined, Algo, Version) ->
- default_hashsign(Version, Algo);
-negotiated_hashsign(HashSign = {_, _}, _, _) ->
- HashSign.
-
-%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms
-%% If the client does not send the signature_algorithms extension, the
-%% server MUST do the following:
-%%
-%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA,
-%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had
-%% sent the value {sha1,rsa}.
-%%
-%% - If the negotiated key exchange algorithm is one of (DHE_DSS,
-%% DH_DSS), behave as if the client had sent the value {sha1,dsa}.
-%%
-%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA,
-%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}.
-
-default_hashsign(_Version = {Major, Minor}, KeyExchange)
- when Major >= 3 andalso Minor >= 3 andalso
- (KeyExchange == rsa orelse
- KeyExchange == dhe_rsa orelse
- KeyExchange == dh_rsa orelse
- KeyExchange == ecdhe_rsa orelse
- KeyExchange == ecdh_rsa orelse
- KeyExchange == srp_rsa) ->
- {sha, rsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == rsa;
- KeyExchange == dhe_rsa;
- KeyExchange == dh_rsa;
- KeyExchange == ecdhe_rsa;
- KeyExchange == ecdh_rsa;
- KeyExchange == srp_rsa ->
- {md5sha, rsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == ecdhe_ecdsa;
- KeyExchange == ecdh_ecdsa ->
- {sha, ecdsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == dhe_dss;
- KeyExchange == dh_dss;
- KeyExchange == srp_dss ->
- {sha, dsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == dh_anon;
- KeyExchange == ecdh_anon;
- KeyExchange == psk;
- KeyExchange == dhe_psk;
- KeyExchange == rsa_psk;
- KeyExchange == srp_anon ->
- {null, anon}.
-
select_curve(#state{client_ecc = {[Curve|_], _}}) ->
{namedCurve, Curve};
select_curve(_) ->
@@ -1874,13 +1877,14 @@ make_premaster_secret({MajVer, MinVer}, rsa) ->
make_premaster_secret(_, _) ->
undefined.
-%% One day this can be maps instead, but we have to be backwards compatible for now
-new_ssl_options(New, Old) ->
- new_ssl_options(tuple_to_list(New), tuple_to_list(Old), []).
+negotiated_hashsign(undefined, Alg, Version) ->
+ %% Not negotiated choose default
+ case is_anonymous(Alg) of
+ true ->
+ {null, anon};
+ false ->
+ ssl_handshake:select_hashsign_algs(Alg, Version)
+ end;
+negotiated_hashsign(HashSign = {_, _}, _, _) ->
+ HashSign.
-new_ssl_options([], [], Acc) ->
- list_to_tuple(lists:reverse(Acc));
-new_ssl_options([undefined | Rest0], [Head1| Rest1], Acc) ->
- new_ssl_options(Rest0, Rest1, [Head1 | Acc]);
-new_ssl_options([Head0 | Rest0], [_| Rest1], Acc) ->
- new_ssl_options(Rest0, Rest1, [Head0 | Acc]).
diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl
index b01c6cb1b3..c544a0591f 100644
--- a/lib/ssl/src/ssl_connection.hrl
+++ b/lib/ssl/src/ssl_connection.hrl
@@ -77,8 +77,10 @@
terminated = false ::boolean(),
allow_renegotiate = true ::boolean(),
expecting_next_protocol_negotiation = false ::boolean(),
+ expecting_finished = false ::boolean(),
next_protocol = undefined :: undefined | binary(),
- client_ecc % {Curves, PointFmt}
+ client_ecc, % {Curves, PointFmt}
+ tracker :: pid() %% Tracker process for listen socket
}).
-define(DEFAULT_DIFFIE_HELLMAN_PARAMS,
diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl
index 22614a2d34..58efeaf892 100644
--- a/lib/ssl/src/ssl_dist_sup.erl
+++ b/lib/ssl/src/ssl_dist_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -45,9 +45,11 @@ start_link() ->
init([]) ->
SessionCertManager = session_and_cert_manager_child_spec(),
ConnetionManager = connection_manager_child_spec(),
+ ListenOptionsTracker = listen_options_tracker_child_spec(),
ProxyServer = proxy_server_child_spec(),
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager,
+ {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager,
+ ListenOptionsTracker,
ProxyServer]}}.
%%--------------------------------------------------------------------
@@ -68,7 +70,7 @@ connection_manager_child_spec() ->
StartFunc = {tls_connection_sup, start_link_dist, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [ssl_connection],
+ Modules = [tls_connection_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
@@ -81,3 +83,11 @@ proxy_server_child_spec() ->
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
+listen_options_tracker_child_spec() ->
+ Name = ssl_socket_dist,
+ StartFunc = {ssl_listen_tracker_sup, start_link_dist, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 1108edcf48..fc67d2c28d 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -73,7 +73,8 @@
]).
%% MISC
--export([select_version/3, prf/5, select_hashsign/2, select_cert_hashsign/3,
+-export([select_version/3, prf/5, select_hashsign/3,
+ select_hashsign_algs/2, select_hashsign_algs/3,
premaster_secret/2, premaster_secret/3, premaster_secret/4]).
%%====================================================================
@@ -590,23 +591,25 @@ prf({3,1}, Secret, Label, Seed, WantedLength) ->
{ok, tls_v1:prf(?MD5SHA, Secret, Label, Seed, WantedLength)};
prf({3,_N}, Secret, Label, Seed, WantedLength) ->
{ok, tls_v1:prf(?SHA256, Secret, Label, Seed, WantedLength)}.
+
+
%%--------------------------------------------------------------------
--spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary()) ->
- [{atom(), atom()}] | undefined.
+-spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary(), ssl_record:ssl_version()) ->
+ {atom(), atom()} | undefined.
%%
%% Description:
%%--------------------------------------------------------------------
-select_hashsign(_, undefined) ->
+select_hashsign(_, undefined, _Version) ->
{null, anon};
-select_hashsign(undefined, Cert) ->
+select_hashsign(undefined, Cert, Version) ->
#'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
#'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
- select_cert_hashsign(undefined, Algo, {undefined, undefined});
-select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) ->
+ select_hashsign_algs(undefined, Algo, Version);
+select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, Version) ->
#'OTPCertificate'{tbsCertificate = TBSCert} =public_key:pkix_decode_cert(Cert, otp),
#'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
- DefaultHashSign = {_, Sign} = select_cert_hashsign(undefined, Algo, {undefined, undefined}),
+ DefaultHashSign = {_, Sign} = select_hashsign_algs(undefined, Algo, Version),
case lists:filter(fun({sha, dsa}) ->
true;
({_, dsa}) ->
@@ -622,26 +625,59 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) ->
[HashSign| _] ->
HashSign
end.
+
%%--------------------------------------------------------------------
--spec select_cert_hashsign(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version() | {undefined, undefined}) ->
+-spec select_hashsign_algs(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version()) ->
{atom(), atom()}.
+%% Description: For TLS 1.2 hash function and signature algorithm pairs can be
+%% negotiated with the signature_algorithms extension,
+%% for previous versions always use appropriate defaults.
+%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms
+%% If the client does not send the signature_algorithms extension, the
+%% server MUST do the following: (e.i defaults for TLS 1.2)
+%%
+%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA,
+%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had
+%% sent the value {sha1,rsa}.
+%%
+%% - If the negotiated key exchange algorithm is one of (DHE_DSS,
+%% DH_DSS), behave as if the client had sent the value {sha1,dsa}.
%%
-%% Description: For TLS 1.2 selected cert_hash_sign will be recived
-%% in the handshake message, for previous versions use appropriate defaults.
-%% This function is also used by select_hashsign to extract
-%% the alogrithm of the server cert key.
+%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA,
+%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}.
+
%%--------------------------------------------------------------------
-select_cert_hashsign(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso
+select_hashsign_algs(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso
Major >= 3 andalso Minor >= 3 ->
HashSign;
-select_cert_hashsign(undefined,?'id-ecPublicKey', _) ->
+select_hashsign_algs(undefined, ?rsaEncryption, {Major, Minor}) when Major >= 3 andalso Minor >= 3 ->
+ {sha, rsa};
+select_hashsign_algs(undefined,?'id-ecPublicKey', _) ->
{sha, ecdsa};
-select_cert_hashsign(undefined, ?rsaEncryption, _) ->
+select_hashsign_algs(undefined, ?rsaEncryption, _) ->
{md5sha, rsa};
-select_cert_hashsign(undefined, ?'id-dsa', _) ->
+select_hashsign_algs(undefined, ?'id-dsa', _) ->
{sha, dsa}.
+-spec select_hashsign_algs(atom(), ssl_record:ssl_version()) -> {atom(), atom()}.
+%% Wrap function to keep the knowledge of the default values in
+%% one place only
+select_hashsign_algs(Alg, Version) when (Alg == rsa orelse
+ Alg == dhe_rsa orelse
+ Alg == dh_rsa orelse
+ Alg == ecdhe_rsa orelse
+ Alg == ecdh_rsa orelse
+ Alg == srp_rsa) ->
+ select_hashsign_algs(undefined, ?rsaEncryption, Version);
+select_hashsign_algs(Alg, Version) when (Alg == dhe_dss orelse
+ Alg == dh_dss orelse
+ Alg == srp_dss) ->
+ select_hashsign_algs(undefined, ?'id-dsa', Version);
+select_hashsign_algs(Alg, Version) when (Alg == ecdhe_ecdsa orelse
+ Alg == ecdh_ecdsa) ->
+ select_hashsign_algs(undefined, ?'id-ecPublicKey', Version).
+
%%--------------------------------------------------------------------
-spec master_secret(atom(), ssl_record:ssl_version(), #session{} | binary(), #connection_states{},
client | server) -> {binary(), #connection_states{}} | #alert{}.
@@ -1017,12 +1053,9 @@ decode_suites('3_bytes', Dec) ->
%%-------------Cipeher suite handling --------------------------------
available_suites(UserSuites, Version) ->
- case UserSuites of
- [] ->
- ssl_cipher:suites(Version);
- _ ->
- UserSuites
- end.
+ lists:filtermap(fun(Suite) ->
+ lists:member(Suite, ssl_cipher:all_suites(Version))
+ end, UserSuites).
available_suites(ServerCert, UserSuites, Version, Curve) ->
ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version))
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 8bf5b30a83..fd0d87bd5f 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -116,14 +116,6 @@
honor_cipher_order = false
}).
--record(config, {ssl, %% SSL parameters
- inet_user, %% User set inet options
- emulated, %% #socket_option{} emulated
- inet_ssl, %% inet options for internal ssl socket
- transport_info, %% Callback info
- connection_cb
- }).
-
-record(socket_options,
{
mode = list,
@@ -133,6 +125,15 @@
active = true
}).
+-record(config, {ssl, %% SSL parameters
+ inet_user, %% User set inet options
+ emulated, %% Emulated option list or "inherit_tracker" pid
+ inet_ssl, %% inet options for internal ssl socket
+ transport_info, %% Callback info
+ connection_cb
+ }).
+
+
-type state_name() :: hello | abbreviated | certify | cipher | connection.
-type gen_fsm_state_return() :: {next_state, state_name(), term()} |
{next_state, state_name(), term(), timeout()} |
diff --git a/lib/ssl/src/ssl_listen_tracker_sup.erl b/lib/ssl/src/ssl_listen_tracker_sup.erl
new file mode 100644
index 0000000000..29f40e846d
--- /dev/null
+++ b/lib/ssl/src/ssl_listen_tracker_sup.erl
@@ -0,0 +1,71 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Supervisor for a listen options tracker
+%%----------------------------------------------------------------------
+-module(ssl_listen_tracker_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0, start_link_dist/0]).
+-export([start_child/1, start_child_dist/1]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+start_link() ->
+ supervisor:start_link({local, tracker_name(normal)}, ?MODULE, []).
+
+start_link_dist() ->
+ supervisor:start_link({local, tracker_name(dist)}, ?MODULE, []).
+
+start_child(Args) ->
+ supervisor:start_child(tracker_name(normal), Args).
+
+start_child_dist(Args) ->
+ supervisor:start_child(tracker_name(dist), Args).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+init(_O) ->
+ RestartStrategy = simple_one_for_one,
+ MaxR = 0,
+ MaxT = 3600,
+
+ Name = undefined, % As simple_one_for_one is used.
+ StartFunc = {ssl_socket, start_link, []},
+ Restart = temporary, % E.g. should not be restarted
+ Shutdown = 4000,
+ Modules = [ssl_socket],
+ Type = worker,
+
+ ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules},
+ {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}.
+
+tracker_name(normal) ->
+ ?MODULE;
+tracker_name(dist) ->
+ list_to_atom(atom_to_list(?MODULE) ++ "dist").
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index fbc73e0e42..66dfdf86a9 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -52,8 +52,8 @@
last_delay_timer = {undefined, undefined}%% Keep for testing purposes
}).
--define('24H_in_msec', 8640000).
--define('24H_in_sec', 8640).
+-define('24H_in_msec', 86400000).
+-define('24H_in_sec', 86400).
-define(GEN_UNIQUE_ID_MAX_TRIES, 10).
-define(SESSION_VALIDATION_INTERVAL, 60000).
-define(CLEAR_PEM_CACHE, 120000).
@@ -282,8 +282,13 @@ handle_cast({register_session, Host, Port, Session},
session_cache_cb = CacheCb} = State) ->
TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}),
NewSession = Session#session{time_stamp = TimeStamp},
- CacheCb:update(Cache, {{Host, Port},
- NewSession#session.session_id}, NewSession),
+ case CacheCb:select_session(Cache, {Host, Port}) of
+ no_session ->
+ CacheCb:update(Cache, {{Host, Port},
+ NewSession#session.session_id}, NewSession);
+ Sessions ->
+ register_unique_session(Sessions, NewSession, CacheCb, Cache, {Host, Port})
+ end,
{noreply, State};
handle_cast({register_session, Port, Session},
@@ -494,3 +499,34 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) ->
_ ->
ok
end.
+
+%% Do not let dumb clients create a gigantic session table
+register_unique_session(Sessions, Session, CacheCb, Cache, PartialKey) ->
+ case exists_equivalent(Session , Sessions) of
+ true ->
+ ok;
+ false ->
+ CacheCb:update(Cache, {PartialKey,
+ Session#session.session_id}, Session)
+ end.
+
+exists_equivalent(_, []) ->
+ false;
+exists_equivalent(#session{
+ peer_certificate = PeerCert,
+ own_certificate = OwnCert,
+ compression_method = Compress,
+ cipher_suite = CipherSuite,
+ srp_username = SRP,
+ ecc = ECC} ,
+ [#session{
+ peer_certificate = PeerCert,
+ own_certificate = OwnCert,
+ compression_method = Compress,
+ cipher_suite = CipherSuite,
+ srp_username = SRP,
+ ecc = ECC} | _]) ->
+ true;
+exists_equivalent(Session, [ _ | Rest]) ->
+ exists_equivalent(Session, Rest).
+
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index b0e9943e6d..7337225bc4 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -377,7 +377,7 @@ cipher(Version, Fragment,
ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version),
{CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}.
%%--------------------------------------------------------------------
--spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}}.
+-spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}.
%%
%% Description: Payload decryption
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl
index 87ed233c0a..6aab35d6da 100644
--- a/lib/ssl/src/ssl_record.hrl
+++ b/lib/ssl/src/ssl_record.hrl
@@ -70,7 +70,7 @@
-define(INITIAL_BYTES, 5).
--define(MAX_SEQENCE_NUMBER, 18446744073709552000). %% math:pow(2, 64) - 1 = 1.8446744073709552e19
+-define(MAX_SEQENCE_NUMBER, 18446744073709551615). %% (1 bsl 64) - 1 = 18446744073709551615
%% Sequence numbers can not wrap so when max is about to be reached we should renegotiate.
%% We will renegotiate a little before so that there will be sequence numbers left
%% for the rehandshake and a little data. Currently we decided to renegotiate a little more
diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/ssl_socket.erl
index 1b6e637cd3..55eb569b20 100644
--- a/lib/ssl/src/ssl_socket.erl
+++ b/lib/ssl/src/ssl_socket.erl
@@ -1,20 +1,73 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
-module(ssl_socket).
+-behaviour(gen_server).
+
-include("ssl_internal.hrl").
-include("ssl_api.hrl").
--export([socket/4, setopts/3, getopts/3, peername/2, sockname/2, port/2]).
+-export([socket/5, setopts/3, getopts/3, peername/2, sockname/2, port/2]).
+-export([emulated_options/0, internal_inet_values/0, default_inet_values/0,
+ init/1, start_link/3, terminate/2, inherit_tracker/3, get_emulated_opts/1,
+ set_emulated_opts/2, get_all_opts/1, handle_call/3, handle_cast/2,
+ handle_info/2, code_change/3]).
+
+-record(state, {
+ emulated_opts,
+ port,
+ ssl_opts
+ }).
-socket(Pid, Transport, Socket, ConnectionCb) ->
+%%--------------------------------------------------------------------
+%%% Internal API
+%%--------------------------------------------------------------------
+socket(Pid, Transport, Socket, ConnectionCb, Tracker) ->
#sslsocket{pid = Pid,
%% "The name "fd" is keept for backwards compatibility
- fd = {Transport, Socket, ConnectionCb}}.
-
+ fd = {Transport, Socket, ConnectionCb, Tracker}}.
+setopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
+ {SockOpts, EmulatedOpts} = split_options(Options),
+ ok = set_emulated_opts(Tracker, EmulatedOpts),
+ inet:setopts(ListenSocket, SockOpts);
+setopts(_, #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_},
+ emulated = Tracker}}}, Options) ->
+ {SockOpts, EmulatedOpts} = split_options(Options),
+ ok = set_emulated_opts(Tracker, EmulatedOpts),
+ Transport:setopts(ListenSocket, SockOpts);
+%%% Following clauses will not be called for emulated options, they are handled in the connection process
setopts(gen_tcp, Socket, Options) ->
inet:setopts(Socket, Options);
setopts(Transport, Socket, Options) ->
Transport:setopts(Socket, Options).
+getopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
+ {SockOptNames, EmulatedOptNames} = split_options(Options),
+ EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames),
+ SocketOpts = get_socket_opts(ListenSocket, SockOptNames, inet),
+ {ok, EmulatedOpts ++ SocketOpts};
+getopts(Transport, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
+ {SockOptNames, EmulatedOptNames} = split_options(Options),
+ EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames),
+ SocketOpts = get_socket_opts(ListenSocket, SockOptNames, Transport),
+ {ok, EmulatedOpts ++ SocketOpts};
+%%% Following clauses will not be called for emulated options, they are handled in the connection process
getopts(gen_tcp, Socket, Options) ->
inet:getopts(Socket, Options);
getopts(Transport, Socket, Options) ->
@@ -34,3 +87,151 @@ port(gen_tcp, Socket) ->
inet:port(Socket);
port(Transport, Socket) ->
Transport:port(Socket).
+
+emulated_options() ->
+ [mode, packet, active, header, packet_size].
+
+internal_inet_values() ->
+ [{packet_size,0}, {packet, 0}, {header, 0}, {active, false}, {mode,binary}].
+
+default_inet_values() ->
+ [{packet_size, 0}, {packet,0}, {header, 0}, {active, true}, {mode, list}].
+
+inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = false} = SslOpts) ->
+ ssl_listen_tracker_sup:start_child([ListenSocket, EmOpts, SslOpts]);
+inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = true} = SslOpts) ->
+ ssl_listen_tracker_sup:start_child_dist([ListenSocket, EmOpts, SslOpts]).
+
+get_emulated_opts(TrackerPid) ->
+ call(TrackerPid, get_emulated_opts).
+set_emulated_opts(TrackerPid, InetValues) ->
+ call(TrackerPid, {set_emulated_opts, InetValues}).
+get_all_opts(TrackerPid) ->
+ call(TrackerPid, get_all_opts).
+
+%%====================================================================
+%% ssl_listen_tracker_sup API
+%%====================================================================
+
+start_link(Port, SockOpts, SslOpts) ->
+ gen_server:start_link(?MODULE, [Port, SockOpts, SslOpts], []).
+
+%%--------------------------------------------------------------------
+-spec init(list()) -> {ok, #state{}}.
+%% Possible return values not used now.
+%% | {ok, #state{}, timeout()} | ignore | {stop, term()}.
+%%
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([Port, Opts, SslOpts]) ->
+ process_flag(trap_exit, true),
+ true = link(Port),
+ {ok, #state{emulated_opts = Opts, port = Port, ssl_opts = SslOpts}}.
+
+%%--------------------------------------------------------------------
+-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}.
+%% Possible return values not used now.
+%% {reply, reply(), #state{}, timeout()} |
+%% {noreply, #state{}} |
+%% {noreply, #state{}, timeout()} |
+%% {stop, reason(), reply(), #state{}} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call({set_emulated_opts, Opts0}, _From,
+ #state{emulated_opts = Opts1} = State) ->
+ Opts = do_set_emulated_opts(Opts0, Opts1),
+ {reply, ok, State#state{emulated_opts = Opts}};
+handle_call(get_emulated_opts, _From,
+ #state{emulated_opts = Opts} = State) ->
+ {reply, {ok, Opts}, State};
+handle_call(get_all_opts, _From,
+ #state{emulated_opts = EmOpts,
+ ssl_opts = SslOpts} = State) ->
+ {reply, {ok, EmOpts, SslOpts}, State}.
+
+%%--------------------------------------------------------------------
+-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}.
+%% Possible return values not used now.
+%% | {noreply, #state{}, timeout()} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(_, State)->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+-spec handle_info(msg(), #state{}) -> {stop, reason(), #state{}}.
+%% Possible return values not used now.
+%% {noreply, #state{}}.
+%% |{noreply, #state{}, timeout()} |
+%%
+%%
+%% Description: Handling all non call/cast messages
+%%-------------------------------------------------------------------
+handle_info({'EXIT', Port, _}, #state{port = Port} = State) ->
+ {stop, normal, State}.
+
+
+%%--------------------------------------------------------------------
+-spec terminate(reason(), #state{}) -> ok.
+%%
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%--------------------------------------------------------------------
+-spec code_change(term(), #state{}, list()) -> {ok, #state{}}.
+%%
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+call(Pid, Msg) ->
+ gen_server:call(Pid, Msg, infinity).
+
+split_options(Opts) ->
+ split_options(Opts, emulated_options(), [], []).
+split_options([], _, SocketOpts, EmuOpts) ->
+ {SocketOpts, EmuOpts};
+split_options([{Name, _} = Opt | Opts], Emu, SocketOpts, EmuOpts) ->
+ case lists:member(Name, Emu) of
+ true ->
+ split_options(Opts, Emu, SocketOpts, [Opt | EmuOpts]);
+ false ->
+ split_options(Opts, Emu, [Opt | SocketOpts], EmuOpts)
+ end;
+split_options([Name | Opts], Emu, SocketOptNames, EmuOptNames) ->
+ case lists:member(Name, Emu) of
+ true ->
+ split_options(Opts, Emu, SocketOptNames, [Name | EmuOptNames]);
+ false ->
+ split_options(Opts, Emu, [Name | SocketOptNames], EmuOptNames)
+ end.
+
+do_set_emulated_opts([], Opts) ->
+ Opts;
+do_set_emulated_opts([{Name,_} = Opt | Rest], Opts) ->
+ do_set_emulated_opts(Rest, [Opt | proplists:delete(Name, Opts)]).
+
+get_socket_opts(_, [], _) ->
+ [];
+get_socket_opts(ListenSocket, SockOptNames, Cb) ->
+ {ok, Opts} = Cb:getopts(ListenSocket, SockOptNames),
+ Opts.
+
+get_emulated_opts(TrackerPid, EmOptNames) ->
+ {ok, EmOpts} = get_emulated_opts(TrackerPid),
+ lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts),
+ Value end,
+ EmOptNames).
diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl
index e1aeb11ca4..7cccf8d5a5 100644
--- a/lib/ssl/src/ssl_sup.erl
+++ b/lib/ssl/src/ssl_sup.erl
@@ -47,8 +47,10 @@ init([]) ->
TLSConnetionManager = tls_connection_manager_child_spec(),
%% Not supported yet
%%DTLSConnetionManager = tls_connection_manager_child_spec(),
-
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager]}}.
+ %% Handles emulated options so that they inherited by the accept socket, even when setopts is performed on
+ %% the listen socket
+ ListenOptionsTracker = listen_options_tracker_child_spec(),
+ {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager, ListenOptionsTracker]}}.
manager_opts() ->
@@ -85,7 +87,7 @@ tls_connection_manager_child_spec() ->
StartFunc = {tls_connection_sup, start_link, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [tls_connection, ssl_connection],
+ Modules = [tls_connection_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
@@ -98,6 +100,17 @@ tls_connection_manager_child_spec() ->
%% Type = supervisor,
%% {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+listen_options_tracker_child_spec() ->
+ Name = ssl_socket,
+ StartFunc = {ssl_listen_tracker_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+
session_cb_init_args() ->
case application:get_env(ssl, session_cb_init_args) of
{ok, Args} when is_list(Args) ->
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index ffa04ee8ba..26de51985a 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -53,7 +53,7 @@
%% Alert and close handling
-export([send_alert/2, handle_own_alert/4, handle_close_alert/3,
handle_normal_shutdown/3, handle_unexpected_message/3,
- workaround_transport_delivery_problems/2, alert_user/5, alert_user/8
+ workaround_transport_delivery_problems/2, alert_user/6, alert_user/9
]).
%% Data handling
@@ -66,18 +66,18 @@
%% gen_fsm callbacks
-export([init/1, hello/2, certify/2, cipher/2,
abbreviated/2, connection/2, handle_event/3,
- handle_sync_event/4, handle_info/3, terminate/3, code_change/4]).
+ handle_sync_event/4, handle_info/3, terminate/3, code_change/4, format_status/2]).
%%====================================================================
%% Internal application API
%%====================================================================
-start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts,
+start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts,
User, {CbModule, _,_, _} = CbInfo,
Timeout) ->
try
{ok, Pid} = tls_connection_sup:start_child([Role, Host, Port, Socket,
Opts, User, CbInfo]),
- {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule),
+ {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker),
ok = ssl_connection:handshake(SslSocket, Timeout),
{ok, SslSocket}
catch
@@ -85,13 +85,13 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts,
Error
end;
-start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts,
+start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts,
User, {CbModule, _,_, _} = CbInfo,
Timeout) ->
try
{ok, Pid} = tls_connection_sup:start_child_dist([Role, Host, Port, Socket,
Opts, User, CbInfo]),
- {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule),
+ {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker),
ok = ssl_connection:handshake(SslSocket, Timeout),
{ok, SslSocket}
catch
@@ -144,29 +144,10 @@ send_change_cipher(Msg, #state{connection_states = ConnectionStates0,
start_link(Role, Host, Port, Socket, Options, User, CbInfo) ->
{ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}.
-init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) ->
+init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
process_flag(trap_exit, true),
- State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo),
- Handshake = ssl_handshake:init_handshake_history(),
- TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}),
- try ssl_config:init(SSLOpts0, Role) of
- {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} ->
- Session = State0#state.session,
- State = State0#state{
- tls_handshake_history = Handshake,
- session = Session#session{own_certificate = OwnCert,
- time_stamp = TimeStamp},
- file_ref_db = FileRefHandle,
- cert_db_ref = Ref,
- cert_db = CertDbHandle,
- session_cache = CacheHandle,
- private_key = Key,
- diffie_hellman_params = DHParams},
- gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State))
- catch
- throw:Error ->
- gen_fsm:enter_loop(?MODULE, [], error, {Error,State0}, get_timeout(State0))
- end.
+ State = initial_state(Role, Host, Port, Socket, Options, User, CbInfo),
+ gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)).
%%--------------------------------------------------------------------
%% Description:There should be one instance of this function for each
@@ -208,11 +189,11 @@ hello(Hello = #client_hello{client_version = ClientVersion,
session_cache = Cache,
session_cache_cb = CacheCb,
ssl_options = SslOpts}) ->
- HashSign = ssl_handshake:select_hashsign(HashSigns, Cert),
case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
{Version, {Type, Session},
ConnectionStates, ServerHelloExt} ->
+ HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version),
ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign},
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
@@ -342,8 +323,7 @@ handle_info(Msg, StateName, State) ->
%% Reason. The return value is ignored.
%%--------------------------------------------------------------------
terminate(Reason, StateName, State) ->
- ssl_connection:terminate(Reason, StateName, State).
-
+ catch ssl_connection:terminate(Reason, StateName, State).
%%--------------------------------------------------------------------
%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState}
@@ -352,6 +332,9 @@ terminate(Reason, StateName, State) ->
code_change(_OldVsn, StateName, State, _Extra) ->
{ok, StateName, State}.
+format_status(Type, Data) ->
+ ssl_connection:format_status(Type, Data).
+
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
@@ -362,22 +345,13 @@ encode_handshake(Handshake, Version, ConnectionStates0, Hist0) ->
ssl_record:encode_handshake(Frag, Version, ConnectionStates0),
{Encoded, ConnectionStates, Hist}.
-
encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) ->
ssl_record:encode_change_cipher_spec(Version, ConnectionStates).
-
-
decode_alerts(Bin) ->
- decode_alerts(Bin, []).
-
-decode_alerts(<<?BYTE(Level), ?BYTE(Description), Rest/binary>>, Acc) ->
- A = ?ALERT_REC(Level, Description),
- decode_alerts(Rest, [A | Acc]);
-decode_alerts(<<>>, Acc) ->
- lists:reverse(Acc, []).
+ ssl_alert:decode(Bin).
-initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User,
+initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User,
{CbModule, DataTag, CloseTag, ErrorTag}) ->
ConnectionStates = ssl_record:init_connection_states(Role),
@@ -391,9 +365,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User,
Monitor = erlang:monitor(process, User),
#state{socket_options = SocketOptions,
- %% We do not want to save the password in the state so that
- %% could be written in the clear into error logs.
- ssl_options = SSLOptions#ssl_options{password = undefined},
+ ssl_options = SSLOptions,
session = #session{is_resumable = new},
transport_cb = CbModule,
data_tag = DataTag,
@@ -411,7 +383,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User,
renegotiation = {false, first},
start_or_recv_from = undefined,
send_queue = queue:new(),
- protocol_cb = ?MODULE
+ protocol_cb = ?MODULE,
+ tracker = Tracker
}.
next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) ->
@@ -420,10 +393,13 @@ next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = S
next_state(_,Next, no_record, State) ->
{next_state, Next, State, get_timeout(State)};
-next_state(_,Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) ->
- Alerts = decode_alerts(EncAlerts),
- handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)});
-
+next_state(Current, Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, #state{negotiated_version = Version} = State) ->
+ case decode_alerts(EncAlerts) of
+ Alerts = [_|_] ->
+ handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)});
+ #alert{} = Alert ->
+ handle_own_alert(Alert, Version, Current, State)
+ end;
next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
State0 = #state{protocol_buffers =
#protocol_buffers{tls_handshake_buffer = Buf0} = Buffers,
@@ -468,12 +444,16 @@ next_state(_, StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, St
next_state(StateName, StateName, Record, State)
end;
next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} =
- _ChangeCipher,
- #state{connection_states = ConnectionStates0} = State0) ->
+ _ChangeCipher,
+ #state{connection_states = ConnectionStates0} = State0)
+ when Next == cipher; Next == abbreviated ->
ConnectionStates1 =
ssl_record:activate_pending_connection_state(ConnectionStates0, read),
{Record, State} = next_record(State0#state{connection_states = ConnectionStates1}),
- next_state(Current, Next, Record, State);
+ next_state(Current, Next, Record, State#state{expecting_finished = true});
+next_state(Current, _Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} =
+ _ChangeCipher, #state{negotiated_version = Version} = State) ->
+ handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Version, Current, State);
next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) ->
%% Ignore unknown type
{Record, State} = next_record(State0),
@@ -513,7 +493,7 @@ next_record(State) ->
next_record_if_active(State =
#state{socket_options =
- #socket_options{active = false}}) ->
+ #socket_options{active = false}}) ->
{no_record ,State};
next_record_if_active(State) ->
@@ -577,7 +557,8 @@ read_application_data(Data, #state{user_application = {_Mon, Pid},
bytes_to_read = BytesToRead,
start_or_recv_from = RecvFrom,
timer = Timer,
- user_data_buffer = Buffer0} = State0) ->
+ user_data_buffer = Buffer0,
+ tracker = Tracker} = State0) ->
Buffer1 = if
Buffer0 =:= <<>> -> Data;
Data =:= <<>> -> Buffer0;
@@ -585,7 +566,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid},
end,
case get_data(SOpts, BytesToRead, Buffer1) of
{ok, ClientData, Buffer} -> % Send data
- SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom),
+ SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom, Tracker),
cancel_timer(Timer),
State = State0#state{user_data_buffer = Buffer,
start_or_recv_from = undefined,
@@ -606,7 +587,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid},
{passive, Buffer} ->
next_record_if_active(State0#state{user_data_buffer = Buffer});
{error,_Reason} -> %% Invalid packet in packet mode
- deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom),
+ deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker),
{stop, normal, State0}
end.
@@ -661,8 +642,8 @@ decode_packet(Type, Buffer, PacketOpts) ->
%% HTTP headers using the {packet, httph} option, we don't do any automatic
%% switching of states.
deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packet=Type},
- Data, Pid, From) ->
- send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data)),
+ Data, Pid, From, Tracker) ->
+ send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data, Tracker)),
SO = case Data of
{P, _, _, _} when ((P =:= http_request) or (P =:= http_response)),
((Type =:= http) or (Type =:= http_bin)) ->
@@ -682,20 +663,20 @@ deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packe
end.
format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet,
- header = Header}, Data) ->
+ header = Header}, Data, _) ->
{ok, do_format_reply(Mode, Packet, Header, Data)};
format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet,
- header = Header}, Data) ->
- {ssl, ssl_socket:socket(self(), Transport, Socket, ?MODULE),
+ header = Header}, Data, Tracker) ->
+ {ssl, ssl_socket:socket(self(), Transport, Socket, ?MODULE, Tracker),
do_format_reply(Mode, Packet, Header, Data)}.
-deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From) ->
- send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data)).
+deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker) ->
+ send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data, Tracker)).
-format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data) ->
+format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data, _) ->
{error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}};
-format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data) ->
- {ssl_error, ssl_socket:socket(self(), Transport, Socket, ?MODULE),
+format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker) ->
+ {ssl_error, ssl_socket:socket(self(), Transport, Socket, ?MODULE, Tracker),
{invalid_packet, do_format_reply(Mode, raw, 0, Data)}}.
do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode
@@ -751,7 +732,11 @@ handle_tls_handshake(Handle, StateName,
handle_tls_handshake(Handle, NextStateName, State);
{stop, _,_} = Stop ->
Stop
- end.
+ end;
+
+handle_tls_handshake(_Handle, _StateName, #state{}) ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)).
+
write_application_data(Data0, From,
#state{socket = Socket,
negotiated_version = Version,
@@ -835,10 +820,10 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName,
#state{socket = Socket, transport_cb = Transport,
ssl_options = SslOpts, start_or_recv_from = From, host = Host,
port = Port, session = Session, user_application = {_Mon, Pid},
- role = Role, socket_options = Opts} = State) ->
+ role = Role, socket_options = Opts, tracker = Tracker} = State) ->
invalidate_session(Role, Host, Port, Session),
log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
- alert_user(Transport, Socket, StateName, Opts, Pid, From, Alert, Role),
+ alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role),
{stop, normal, State};
handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
@@ -859,36 +844,37 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert,
{Record, State} = next_record(State0),
next_state(StateName, connection, Record, State);
-handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, StateName,
+%% Gracefully log and ignore all other warning alerts
+handle_alert(#alert{level = ?WARNING} = Alert, StateName,
#state{ssl_options = SslOpts} = State0) ->
log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
{Record, State} = next_record(State0),
next_state(StateName, StateName, Record, State).
-alert_user(Transport, Socket, connection, Opts, Pid, From, Alert, Role) ->
- alert_user(Transport,Socket, Opts#socket_options.active, Pid, From, Alert, Role);
-alert_user(Transport, Socket,_, _, _, From, Alert, Role) ->
- alert_user(Transport, Socket, From, Alert, Role).
+alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role) ->
+ alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role);
+alert_user(Transport, Tracker, Socket,_, _, _, From, Alert, Role) ->
+ alert_user(Transport, Tracker, Socket, From, Alert, Role).
-alert_user(Transport, Socket, From, Alert, Role) ->
- alert_user(Transport, Socket, false, no_pid, From, Alert, Role).
+alert_user(Transport, Tracker, Socket, From, Alert, Role) ->
+ alert_user(Transport, Tracker, Socket, false, no_pid, From, Alert, Role).
-alert_user(_,_, false = Active, Pid, From, Alert, Role) ->
+alert_user(_, _, _, false = Active, Pid, From, Alert, Role) ->
%% If there is an outstanding ssl_accept | recv
%% From will be defined and send_or_reply will
%% send the appropriate error message.
ReasonCode = ssl_alert:reason_code(Alert, Role),
send_or_reply(Active, Pid, From, {error, ReasonCode});
-alert_user(Transport, Socket, Active, Pid, From, Alert, Role) ->
+alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role) ->
case ssl_alert:reason_code(Alert, Role) of
closed ->
send_or_reply(Active, Pid, From,
{ssl_closed, ssl_socket:socket(self(),
- Transport, Socket, ?MODULE)});
+ Transport, Socket, ?MODULE, Tracker)});
ReasonCode ->
send_or_reply(Active, Pid, From,
{ssl_error, ssl_socket:socket(self(),
- Transport, Socket, ?MODULE), ReasonCode})
+ Transport, Socket, ?MODULE, Tracker), ReasonCode})
end.
log_alert(true, Info, Alert) ->
@@ -921,15 +907,17 @@ handle_own_alert(Alert, Version, StateName,
handle_normal_shutdown(Alert, _, #state{socket = Socket,
transport_cb = Transport,
start_or_recv_from = StartFrom,
+ tracker = Tracker,
role = Role, renegotiation = {false, first}}) ->
- alert_user(Transport, Socket, StartFrom, Alert, Role);
+ alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role);
handle_normal_shutdown(Alert, StateName, #state{socket = Socket,
socket_options = Opts,
transport_cb = Transport,
user_application = {_Mon, Pid},
+ tracker = Tracker,
start_or_recv_from = RecvFrom, role = Role}) ->
- alert_user(Transport, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role).
+ alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role).
handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) ->
Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE),
diff --git a/lib/ssl/src/tls_connection_sup.erl b/lib/ssl/src/tls_connection_sup.erl
index 6f0d8a7262..7a637c212a 100644
--- a/lib/ssl/src/tls_connection_sup.erl
+++ b/lib/ssl/src/tls_connection_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -59,7 +59,7 @@ init(_O) ->
StartFunc = {tls_connection, start_link, []},
Restart = temporary, % E.g. should not be restarted
Shutdown = 4000,
- Modules = [tls_connection],
+ Modules = [tls_connection, ssl_connection],
Type = worker,
ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules},
diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl
index 4da08e9c51..f50ea22f39 100644
--- a/lib/ssl/src/tls_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -154,21 +154,24 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version,
sequence_number = Seq,
security_parameters = SecParams} = ReadState0,
CompressAlg = SecParams#security_parameters.compression_algorithm,
- {PlainFragment, Mac, ReadState1} = ssl_record:decipher(Version, CipherFragment, ReadState0),
- MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1),
- case ssl_record:is_correct_mac(Mac, MacHash) of
- true ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg,
- PlainFragment, CompressionS0),
- ConnnectionStates = ConnnectionStates0#connection_states{
- current_read = ReadState1#connection_state{
- sequence_number = Seq + 1,
- compression_state = CompressionS1}},
- {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
- false ->
- ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
- end.
-
+ case ssl_record:decipher(Version, CipherFragment, ReadState0) of
+ {PlainFragment, Mac, ReadState1} ->
+ MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1),
+ case ssl_record:is_correct_mac(Mac, MacHash) of
+ true ->
+ {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg,
+ PlainFragment, CompressionS0),
+ ConnnectionStates = ConnnectionStates0#connection_states{
+ current_read = ReadState1#connection_state{
+ sequence_number = Seq + 1,
+ compression_state = CompressionS1}},
+ {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ false ->
+ ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ end;
+ #alert{} = Alert ->
+ Alert
+ end.
%%--------------------------------------------------------------------
-spec protocol_version(tls_atom_version() | tls_version()) ->
tls_version() | tls_atom_version().
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index 067417d163..7a5f9c1b38 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -183,23 +183,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor},
-spec suites(1|2|3) -> [ssl_cipher:cipher_suite()].
-suites(Minor) when Minor == 1; Minor == 2->
- case sufficent_ec_support() of
- true ->
- all_suites(Minor);
- false ->
- no_ec_suites(Minor)
- end;
-
-suites(Minor) when Minor == 3 ->
- case sufficent_ec_support() of
- true ->
- all_suites(3) ++ all_suites(2);
- false ->
- no_ec_suites(3) ++ no_ec_suites(2)
- end.
-
-all_suites(Minor) when Minor == 1; Minor == 2->
+suites(Minor) when Minor == 1; Minor == 2 ->
[
?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA,
@@ -235,7 +219,7 @@ all_suites(Minor) when Minor == 1; Minor == 2->
?TLS_RSA_WITH_DES_CBC_SHA
];
-all_suites(3) ->
+suites(3) ->
[
?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384,
?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384,
@@ -254,33 +238,7 @@ all_suites(3) ->
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256,
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256,
?TLS_RSA_WITH_AES_128_CBC_SHA256
- ].
-
-no_ec_suites(Minor) when Minor == 1; Minor == 2->
- [
- ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA,
- ?TLS_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_RC4_128_SHA,
- ?TLS_RSA_WITH_RC4_128_MD5,
- ?TLS_DHE_RSA_WITH_DES_CBC_SHA,
- ?TLS_RSA_WITH_DES_CBC_SHA
- ];
-no_ec_suites(3) ->
- [
- ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256,
- ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256,
- ?TLS_RSA_WITH_AES_256_CBC_SHA256,
- ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256,
- ?TLS_RSA_WITH_AES_128_CBC_SHA256
- ].
+ ] ++ suites(2).
%%--------------------------------------------------------------------
%%% Internal functions
@@ -442,7 +400,3 @@ enum_to_oid(27) -> ?brainpoolP384r1;
enum_to_oid(28) -> ?brainpoolP512r1;
enum_to_oid(_) ->
undefined.
-
-sufficent_ec_support() ->
- CryptoSupport = crypto:supports(),
- proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)).
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index 0947657ca7..15a7e118ff 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -32,6 +32,7 @@
v2_crls = true,
ecc_certs = false,
issuing_distribution_point = false,
+ crl_port = 8000,
openssl_cmd = "openssl"}).
@@ -57,6 +58,8 @@ make_config([{default_bits, Bits}|T], C) when is_integer(Bits) ->
make_config(T, C#config{default_bits = Bits});
make_config([{v2_crls, Bool}|T], C) when is_boolean(Bool) ->
make_config(T, C#config{v2_crls = Bool});
+make_config([{crl_port, Port}|T], C) when is_integer(Port) ->
+ make_config(T, C#config{crl_port = Port});
make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) ->
make_config(T, C#config{ecc_certs = Bool});
make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) ->
@@ -423,7 +426,7 @@ ca_cnf(C) ->
"[crl_section]\n"
%% intentionally invalid
"URI.1=http://localhost/",C#config.commonName,"/crl.pem\n"
- "URI.2=http://localhost:8000/",C#config.commonName,"/crl.pem\n"
+ "URI.2=http://localhost:",integer_to_list(C#config.crl_port),"/",C#config.commonName,"/crl.pem\n"
"\n"
"[user_cert_digital_signature_only]\n"
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 8e3d2e4b80..1da4e88077 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -115,12 +115,14 @@ options_tests() ->
reuseaddr,
tcp_reuseaddr,
honor_server_cipher_order,
- honor_client_cipher_order
+ honor_client_cipher_order,
+ ciphersuite_vs_version,
+ unordered_protocol_versions_server,
+ unordered_protocol_versions_client
].
api_tests() ->
- [new_options_in_accept,
- connection_info,
+ [connection_info,
peername,
peercert,
peercert_with_client_cert,
@@ -138,7 +140,9 @@ api_tests() ->
ssl_accept_timeout,
ssl_recv_timeout,
versions_option,
- server_name_indication_option
+ server_name_indication_option,
+ accept_pool,
+ new_options_in_accept
].
session_tests() ->
@@ -187,7 +191,11 @@ error_handling_tests()->
tcp_error_propagation_in_active_mode,
tcp_connect,
tcp_connect_big,
- close_transport_accept
+ close_transport_accept,
+ recv_active,
+ recv_active_once,
+ recv_error_handling,
+ dont_crash_on_handshake_garbage
].
rizzo_tests() ->
@@ -240,6 +248,14 @@ end_per_group(_GroupName, Config) ->
Config.
%%--------------------------------------------------------------------
+init_per_testcase(Case, Config) when Case == unordered_protocol_versions_client;
+ Case == unordered_protocol_versions_server->
+ case proplists:get_value(supported, ssl:versions()) of
+ ['tlsv1.2' | _] ->
+ Config;
+ _ ->
+ {skip, "TLS 1.2 need but not supported on this platform"}
+ end;
init_per_testcase(no_authority_key_identifier, Config) ->
%% Clear cach so that root cert will not
%% be found.
@@ -330,14 +346,15 @@ new_options_in_accept() ->
[{doc,"Test that you can set ssl options in ssl_accept/3 and not tcp upgrade"}].
new_options_in_accept(Config) when is_list(Config) ->
ClientOpts = ?config(client_opts, Config),
- ServerOpts = ?config(server_opts, Config),
+ ServerOpts0 = ?config(server_dsa_opts, Config),
+ [_ , _ | ServerSslOpts] = ?config(server_opts, Config), %% Remove non ssl opts
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
- {ssl_opts, [{versions, [sslv3]},
- {ciphers,[{rsa,rc4_128,sha}]}]}, %% To be set in ssl_accept/3
+ {ssl_extra_opts, [{versions, [sslv3]},
+ {ciphers,[{rsa,rc4_128,sha}]} | ServerSslOpts]}, %% To be set in ssl_accept/3
{mfa, {?MODULE, connection_info_result, []}},
- {options, ServerOpts}]),
+ {options, proplists:delete(cacertfile, ServerOpts0)}]),
Port = ssl_test_lib:inet_port(Server),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
@@ -396,6 +413,7 @@ protocol_versions() ->
protocol_versions(Config) when is_list(Config) ->
basic_test(Config).
+
%%--------------------------------------------------------------------
empty_protocol_versions() ->
[{doc,"Test to set an empty list of protocol versions in app environment."}].
@@ -1154,6 +1172,57 @@ close_transport_accept(Config) when is_list(Config) ->
Other ->
exit({?LINE, Other})
end.
+%%--------------------------------------------------------------------
+recv_active() ->
+ [{doc,"Test recv on active socket"}].
+
+recv_active(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server =
+ ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active, []}},
+ {options, [{active, true} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client =
+ ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active, []}},
+ {options, [{active, true} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+recv_active_once() ->
+ [{doc,"Test recv on active socket"}].
+
+recv_active_once(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server =
+ ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active_once, []}},
+ {options, [{active, once} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client =
+ ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active_once, []}},
+ {options, [{active, once} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
dh_params() ->
@@ -1177,7 +1246,7 @@ dh_params(Config) when is_list(Config) ->
{from, self()},
{mfa, {ssl_test_lib, send_recv_result_active, []}},
{options,
- [{ciphers,[{dhe_rsa,aes_256_cbc,sha,ignore}]} |
+ [{ciphers,[{dhe_rsa,aes_256_cbc,sha}]} |
ClientOpts]}]),
ssl_test_lib:check_result(Server, ok, Client, ok),
@@ -1276,7 +1345,7 @@ tcp_connect() ->
tcp_connect(Config) when is_list(Config) ->
ServerOpts = ?config(server_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
- TcpOpts = [binary, {reuseaddr, true}],
+ TcpOpts = [binary, {reuseaddr, true}, {active, false}],
Server = ssl_test_lib:start_upgrade_server_error([{node, ServerNode}, {port, 0},
{from, self()},
@@ -1302,6 +1371,7 @@ tcp_connect_big() ->
[{doc,"Test what happens when a tcp tries to connect, i,e. a bad big (ssl) packet is sent first"}].
tcp_connect_big(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
ServerOpts = ?config(server_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
TcpOpts = [binary, {reuseaddr, true}],
@@ -1327,7 +1397,9 @@ tcp_connect_big(Config) when is_list(Config) ->
{Server, {error, timeout}} ->
ct:fail("hangs");
{Server, {error, Error}} ->
- ct:log("Error ~p", [Error])
+ ct:log("Error ~p", [Error]);
+ {'EXIT', Server, _} ->
+ ok
end
end.
@@ -2559,6 +2631,81 @@ honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) ->
ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
+ciphersuite_vs_version(Config) when is_list(Config) ->
+
+ {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ ServerOpts = ?config(server_opts, Config),
+
+ Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {active, false}]),
+ ok = gen_tcp:send(Socket,
+ <<22, 3,0, 49:16, % handshake, SSL 3.0, length
+ 1, 45:24, % client_hello, length
+ 3,0, % SSL 3.0
+ 16#deadbeef:256, % 32 'random' bytes = 256 bits
+ 0, % no session ID
+ %% three cipher suites -- null, one with sha256 hash and one with sha hash
+ 6:16, 0,255, 0,61, 0,57,
+ 1, 0 % no compression
+ >>),
+ {ok, <<22, RecMajor:8, RecMinor:8, _RecLen:16, 2, HelloLen:24>>} = gen_tcp:recv(Socket, 9, 10000),
+ {ok, <<HelloBin:HelloLen/binary>>} = gen_tcp:recv(Socket, HelloLen, 5000),
+ ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin),
+ case ServerHello of
+ #server_hello{server_version = {3,0}, cipher_suite = <<0,57>>} ->
+ ok;
+ _ ->
+ ct:fail({unexpected_server_hello, ServerHello})
+ end.
+
+%%--------------------------------------------------------------------
+
+dont_crash_on_handshake_garbage() ->
+ [{doc, "Ensure SSL server worker thows an alert on garbage during handshake "
+ "instead of crashing and exposing state to user code"}].
+
+dont_crash_on_handshake_garbage(Config) ->
+ ServerOpts = ?config(server_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, []}},
+ {options, ServerOpts}]),
+ unlink(Server), monitor(process, Server),
+ Port = ssl_test_lib:inet_port(Server),
+
+ {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {active, false}]),
+
+ % Send hello and garbage record
+ ok = gen_tcp:send(Socket,
+ [<<22, 3,3, 49:16, 1, 45:24, 3,3, % client_hello
+ 16#deadbeef:256, % 32 'random' bytes = 256 bits
+ 0, 6:16, 0,255, 0,61, 0,57, 1, 0 >>, % some hello values
+
+ <<22, 3,3, 5:16, 92,64,37,228,209>> % garbage
+ ]),
+ % Send unexpected change_cipher_spec
+ ok = gen_tcp:send(Socket, <<20, 0,0,12, 111,40,244,7,137,224,16,109,197,110,249,152>>),
+
+ % Ensure we receive an alert, not sudden disconnect
+ {ok, <<21, _/binary>>} = drop_handshakes(Socket, 1000).
+
+drop_handshakes(Socket, Timeout) ->
+ {ok, <<RecType:8, _RecMajor:8, _RecMinor:8, RecLen:16>> = Header} = gen_tcp:recv(Socket, 5, Timeout),
+ {ok, <<Frag:RecLen/binary>>} = gen_tcp:recv(Socket, RecLen, Timeout),
+ case RecType of
+ 22 -> drop_handshakes(Socket, Timeout);
+ _ -> {ok, <<Header/binary, Frag/binary>>}
+ end.
+
+
+%%--------------------------------------------------------------------
hibernate() ->
[{doc,"Check that an SSL connection that is started with option "
@@ -2957,6 +3104,57 @@ versions_option(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
+unordered_protocol_versions_server() ->
+ [{doc,"Test that the highest protocol is selected even"
+ " when it is not first in the versions list."}].
+
+unordered_protocol_versions_server(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, [{versions, ['tlsv1.1', 'tlsv1.2']} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, ClientOpts}]),
+ CipherSuite = first_rsa_suite(ssl:cipher_suites()),
+ ServerMsg = ClientMsg = {ok, {'tlsv1.2', CipherSuite}},
+ ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg).
+
+%%--------------------------------------------------------------------
+unordered_protocol_versions_client() ->
+ [{doc,"Test that the highest protocol is selected even"
+ " when it is not first in the versions list."}].
+
+unordered_protocol_versions_client(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, ServerOpts }]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, [{versions, ['tlsv1.1', 'tlsv1.2']} | ClientOpts]}]),
+
+ CipherSuite = first_rsa_suite(ssl:cipher_suites()),
+ ServerMsg = ClientMsg = {ok, {'tlsv1.2', CipherSuite}},
+ ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg).
+
+%%--------------------------------------------------------------------
server_name_indication_option() ->
[{doc,"Test API server_name_indication option to connect."}].
@@ -2994,6 +3192,53 @@ server_name_indication_option(Config) when is_list(Config) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client0),
ssl_test_lib:close(Client1).
+%%--------------------------------------------------------------------
+
+accept_pool() ->
+ [{doc,"Test having an accept pool."}].
+accept_pool(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server0 = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {accepters, 3},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server0),
+ [Server1, Server2] = ssl_test_lib:accepters(2),
+
+ Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ClientOpts}
+ ]),
+
+ Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ClientOpts}
+ ]),
+
+ Client2 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ClientOpts}
+ ]),
+
+ ssl_test_lib:check_ok([Server0, Server1, Server2, Client0, Client1, Client2]),
+
+ ssl_test_lib:close(Server0),
+ ssl_test_lib:close(Server1),
+ ssl_test_lib:close(Server2),
+ ssl_test_lib:close(Client0),
+ ssl_test_lib:close(Client1),
+ ssl_test_lib:close(Client2).
+
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
@@ -3454,7 +3699,7 @@ run_suites(Ciphers, Version, Config, Type) ->
Result = lists:map(fun(Cipher) ->
cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end,
- Ciphers),
+ ssl_test_lib:filter_suites(Ciphers)),
case lists:flatten(Result) of
[] ->
ok;
@@ -3505,6 +3750,10 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
connection_info_result(Socket) ->
ssl:connection_info(Socket).
+version_info_result(Socket) ->
+ {ok, {Version, _}} = ssl:connection_info(Socket),
+ {ok, Version}.
+
connect_dist_s(S) ->
Msg = term_to_binary({erlang,term}),
ok = ssl:send(S, Msg).
@@ -3582,3 +3831,22 @@ version_option_test(Config, Version) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
+
+try_recv_active(Socket) ->
+ ssl:send(Socket, "Hello world"),
+ {error, einval} = ssl:recv(Socket, 11),
+ ok.
+try_recv_active_once(Socket) ->
+ {error, einval} = ssl:recv(Socket, 11),
+ ok.
+
+first_rsa_suite([{ecdhe_rsa, _, _} = Suite | _]) ->
+ Suite;
+first_rsa_suite([{dhe_rsa, _, _} = Suite| _]) ->
+ Suite;
+first_rsa_suite([{rsa, _, _} = Suite| _]) ->
+ Suite;
+first_rsa_suite([_ | Rest]) ->
+ first_rsa_suite(Rest).
+
+
diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl
index 4eacf3adfc..bad0949ec4 100644
--- a/lib/ssl/test/ssl_crl_SUITE.erl
+++ b/lib/ssl/test/ssl_crl_SUITE.erl
@@ -48,8 +48,8 @@ all() ->
].
groups() ->
- [{basic, [], basic_tests()},
- {v1_crl, [], v1_crl_tests()},
+ [{basic, [], basic_tests()},
+ {v1_crl, [], v1_crl_tests()},
{idp_crl, [], idp_crl_tests()}].
basic_tests() ->
@@ -72,8 +72,8 @@ init_per_suite(Config0) ->
_ ->
TLSVersion = ?config(tls_version, Config0),
OpenSSL_version = (catch os:cmd("openssl version")),
- ct:log("TLS version: ~p~nOpenSSL version: ~p~n~n~p:module_info(): ~p~n~nssh:module_info(): ~p~n",
- [TLSVersion, OpenSSL_version, ?MODULE, ?MODULE:module_info(), ssh:module_info()]),
+ ct:log("TLS version: ~p~nOpenSSL version: ~p~n~n~p:module_info(): ~p~n~nssl:module_info(): ~p~n",
+ [TLSVersion, OpenSSL_version, ?MODULE, ?MODULE:module_info(), ssl:module_info()]),
case ssl_test_lib:enough_openssl_crl_support(OpenSSL_version) of
false ->
{skip, io_lib:format("Bad openssl version: ~p",[OpenSSL_version])};
@@ -82,7 +82,13 @@ init_per_suite(Config0) ->
try crypto:start() of
ok ->
ssl:start(),
- [{watchdog, Dog}, {openssl_version,OpenSSL_version} | Config0]
+ {ok, Hostname0} = inet:gethostname(),
+ IPfamily =
+ case lists:member(list_to_atom(Hostname0), ct:get_config(ipv6_hosts,[])) of
+ true -> inet6;
+ false -> inet
+ end,
+ [{ipfamily,IPfamily}, {watchdog, Dog}, {openssl_version,OpenSSL_version} | Config0]
catch _C:_E ->
ct:log("crypto:start() caught ~p:~p",[_C,_E]),
{skip, "Crypto did not start"}
@@ -98,21 +104,23 @@ end_per_suite(_Config) ->
%%% Group init/end
init_per_group(Group, Config) ->
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
ssl:start(),
inets:start(),
CertDir = filename:join(?config(priv_dir, Config), Group),
DataDir = ?config(data_dir, Config),
ServerRoot = make_dir_path([?config(priv_dir,Config), Group, tmp]),
- Result = make_certs:all(DataDir, CertDir, cert_opts(Group)),
- ct:log("~p:~p~nmake_certs:all(~n DataDir=~p,~n CertDir=~p,~n ServerRoot=~p~n Opts=~p~n) returned ~p~n", [?MODULE,?LINE,DataDir, CertDir, ServerRoot, cert_opts(Group), Result]),
%% start a HTTP server to serve the CRLs
- {ok, Httpd} = inets:start(httpd, [{server_name, "localhost"}, {port, 8000},
+ {ok, Httpd} = inets:start(httpd, [{ipfamily, ?config(ipfamily,Config)},
+ {server_name, "localhost"}, {port, 0},
{server_root, ServerRoot},
{document_root, CertDir},
{modules, [mod_get]}
]),
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
+ [{port,Port}] = httpd:info(Httpd, [port]),
+ ct:log("~p:~p~nHTTPD IP family=~p, port=~p~n", [?MODULE, ?LINE, ?config(ipfamily,Config), Port]),
+ CertOpts = [{crl_port,Port}|cert_opts(Group)],
+ Result = make_certs:all(DataDir, CertDir, CertOpts),
+ ct:log("~p:~p~nmake_certs:all(~n DataDir=~p,~n CertDir=~p,~n ServerRoot=~p~n Opts=~p~n) returned ~p~n", [?MODULE,?LINE,DataDir, CertDir, ServerRoot, CertOpts, Result]),
[{make_cert_result, Result}, {cert_dir, CertDir}, {httpd, Httpd} | Config].
cert_opts(v1_crl) -> [{v2_crls, false}];
@@ -134,7 +142,6 @@ end_per_group(_GroupName, Config) ->
,ct:log("Stopped",[])
end,
inets:stop(),
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
Config.
%%%================================================================
@@ -481,7 +488,6 @@ fetch([]) ->
not_available;
fetch([{uniformResourceIdentifier, "http"++_=URL}|Rest]) ->
ct:log("~p:~p~ngetting CRL from ~p~n", [?MODULE,?LINE, URL]),
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
case httpc:request(get, {URL, []}, [], [{body_format, binary}]) of
{ok, {_Status, _Headers, Body}} ->
case Body of
diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl
index 6d020c472b..5f36842f9e 100644
--- a/lib/ssl/test/ssl_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_handshake_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -26,6 +26,7 @@
-include_lib("common_test/include/ct.hrl").
-include("ssl_internal.hrl").
-include("tls_handshake.hrl").
+-include_lib("public_key/include/public_key.hrl").
%%--------------------------------------------------------------------
%% Common Test interface functions -----------------------------------
@@ -36,7 +37,8 @@ all() -> [decode_hello_handshake,
decode_single_hello_extension_correctly,
decode_supported_elliptic_curves_hello_extension_correctly,
decode_unknown_hello_extension_correctly,
- encode_single_hello_sni_extension_correctly].
+ encode_single_hello_sni_extension_correctly,
+ select_proper_tls_1_2_rsa_default_hashsign].
%%--------------------------------------------------------------------
%% Test Cases --------------------------------------------------------
@@ -95,3 +97,11 @@ encode_single_hello_sni_extension_correctly(_Config) ->
HelloExt = <<ExtSize:16/unsigned-big-integer, SNI/binary>>,
Encoded = ssl_handshake:encode_hello_extensions(Exts),
HelloExt = Encoded.
+
+select_proper_tls_1_2_rsa_default_hashsign(_Config) ->
+ % RFC 5246 section 7.4.1.4.1 tells to use {sha1,rsa} as default signature_algorithm for RSA key exchanges
+ {sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,3}),
+ % Older versions use MD5/SHA1 combination
+ {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,2}),
+ {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,0}).
+
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 59f10d53a6..150b5037d7 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -67,7 +67,16 @@ run_server(Opts) ->
run_server(ListenSocket, Opts).
run_server(ListenSocket, Opts) ->
- do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts).
+ Accepters = proplists:get_value(accepters, Opts, 1),
+ run_server(ListenSocket, Opts, Accepters).
+
+run_server(ListenSocket, Opts, 1) ->
+ do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts);
+run_server(ListenSocket, Opts, N) ->
+ Pid = proplists:get_value(from, Opts),
+ Server = spawn(?MODULE, run_server, [ListenSocket, Opts, 1]),
+ Pid ! {accepter, N, Server},
+ run_server(ListenSocket, Opts, N-1).
do_run_server(_, {error, timeout} = Result, Opts) ->
Pid = proplists:get_value(from, Opts),
@@ -106,7 +115,7 @@ connect(#sslsocket{} = ListenSocket, Opts) ->
Node = proplists:get_value(node, Opts),
ReconnectTimes = proplists:get_value(reconnect_times, Opts, 0),
Timeout = proplists:get_value(timeout, Opts, infinity),
- SslOpts = proplists:get_value(ssl_opts, Opts, []),
+ SslOpts = proplists:get_value(ssl_extra_opts, Opts, []),
AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout, SslOpts),
case ReconnectTimes of
0 ->
@@ -177,10 +186,7 @@ run_client(Opts) ->
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
Options = proplists:get_value(options, Opts),
- ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]),
-ct:log("~p:~p~nnet_adm:ping(~p)=~p",[?MODULE,?LINE, Node,net_adm:ping(Node)]),
-%%ct:log("~p:~p~n~p:connect(~p, ~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Options, Node]),
-ct:log("~p:~p~n~p:connect(~p, ~p, ...)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]),
+ ct:log("~p:~p~n~p:connect(~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]),
case rpc:call(Node, Transport, connect, [Host, Port, Options]) of
{ok, Socket} ->
Pid ! {connected, Socket},
@@ -290,7 +296,16 @@ wait_for_result(Server, ServerMsg, Client, ClientMsg) ->
%% Unexpected
end.
-
+check_ok([]) ->
+ ok;
+check_ok(Pids) ->
+ receive
+ {Pid, ok} ->
+ check_ok(lists:delete(Pid, Pids));
+ Other ->
+ ct:fail({expected, {"pid()", ok}, got, Other})
+ end.
+
wait_for_result(Pid, Msg) ->
receive
{Pid, Msg} ->
@@ -679,6 +694,17 @@ run_client_error(Opts) ->
Error = rpc:call(Node, Transport, connect, [Host, Port, Options]),
Pid ! {self(), Error}.
+accepters(N) ->
+ accepters([], N).
+
+accepters(Acc, 0) ->
+ Acc;
+accepters(Acc, N) ->
+ receive
+ {accepter, _, Server} ->
+ accepters([Server| Acc], N-1)
+ end.
+
inet_port(Pid) when is_pid(Pid)->
receive
{Pid, {port, Port}} ->
@@ -846,25 +872,34 @@ psk_suites() ->
{psk, '3des_ede_cbc', sha},
{psk, aes_128_cbc, sha},
{psk, aes_256_cbc, sha},
+ {psk, aes_128_cbc, sha256},
+ {psk, aes_256_cbc, sha384},
{dhe_psk, rc4_128, sha},
{dhe_psk, '3des_ede_cbc', sha},
{dhe_psk, aes_128_cbc, sha},
{dhe_psk, aes_256_cbc, sha},
+ {dhe_psk, aes_128_cbc, sha256},
+ {dhe_psk, aes_256_cbc, sha384},
{rsa_psk, rc4_128, sha},
{rsa_psk, '3des_ede_cbc', sha},
{rsa_psk, aes_128_cbc, sha},
- {rsa_psk, aes_256_cbc, sha}],
+ {rsa_psk, aes_256_cbc, sha},
+ {rsa_psk, aes_128_cbc, sha256},
+ {rsa_psk, aes_256_cbc, sha384}
+],
ssl_cipher:filter_suites(Suites).
psk_anon_suites() ->
- [{psk, rc4_128, sha},
- {psk, '3des_ede_cbc', sha},
- {psk, aes_128_cbc, sha},
- {psk, aes_256_cbc, sha},
- {dhe_psk, rc4_128, sha},
- {dhe_psk, '3des_ede_cbc', sha},
- {dhe_psk, aes_128_cbc, sha},
- {dhe_psk, aes_256_cbc, sha}].
+ Suites =
+ [{psk, rc4_128, sha},
+ {psk, '3des_ede_cbc', sha},
+ {psk, aes_128_cbc, sha},
+ {psk, aes_256_cbc, sha},
+ {dhe_psk, rc4_128, sha},
+ {dhe_psk, '3des_ede_cbc', sha},
+ {dhe_psk, aes_128_cbc, sha},
+ {dhe_psk, aes_256_cbc, sha}],
+ ssl_cipher:filter_suites(Suites).
srp_suites() ->
Suites =
@@ -877,9 +912,11 @@ srp_suites() ->
ssl_cipher:filter_suites(Suites).
srp_anon_suites() ->
- [{srp_anon, '3des_ede_cbc', sha},
- {srp_anon, aes_128_cbc, sha},
- {srp_anon, aes_256_cbc, sha}].
+ Suites =
+ [{srp_anon, '3des_ede_cbc', sha},
+ {srp_anon, aes_128_cbc, sha},
+ {srp_anon, aes_256_cbc, sha}],
+ ssl_cipher:filter_suites(Suites).
srp_dss_suites() ->
Suites =
@@ -1089,3 +1126,13 @@ version_flag('tlsv1.2') ->
" -tls1_2 ";
version_flag(sslv3) ->
" -ssl3 ".
+
+filter_suites(Ciphers0) ->
+ Version = tls_record:highest_protocol_version([]),
+ Supported0 = ssl_cipher:suites(Version)
+ ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:psk_suites(Version)
+ ++ ssl_cipher:srp_suites(),
+ Supported1 = ssl_cipher:filter_suites(Supported0),
+ Supported2 = [ssl:suite_definition(S) || S <- Supported1],
+ [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)].
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index a7361755e5..d36e441c7a 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1341,7 +1341,7 @@ check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1.1';
{skip, "Known renegotiation bug in OpenSSL"};
"OpenSSL 1.0.1a" ++ _ ->
{skip, "Known renegotiation bug in OpenSSL"};
- "OpenSSL 1.0.1" ++ _ ->
+ "OpenSSL 1.0.1 " ++ _ ->
{skip, "Known renegotiation bug in OpenSSL"};
_ ->
check_sane_openssl_renegotaite(Config)
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index e08f5dff78..004cacf7fc 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 5.3.4
+SSL_VSN = 5.3.5
diff --git a/lib/stdlib/doc/src/erl_tar.xml b/lib/stdlib/doc/src/erl_tar.xml
index f81e36f810..7f25f5b7bc 100644
--- a/lib/stdlib/doc/src/erl_tar.xml
+++ b/lib/stdlib/doc/src/erl_tar.xml
@@ -35,10 +35,11 @@
<modulesummary>Unix 'tar' utility for reading and writing tar archives</modulesummary>
<description>
<p>The <c>erl_tar</c> module archives and extract files to and from
- a tar file. The tar file format is the POSIX extended tar file format
- specified in IEEE Std 1003.1 and ISO/IEC&nbsp;9945-1. That is the same
- format as used by <c>tar</c> program on Solaris, but is not the same
- as used by the GNU tar program.</p>
+ a tar file. <c>erl_tar</c> supports the <c>ustar</c> format
+ (IEEE Std 1003.1 and ISO/IEC&nbsp;9945-1). All modern <c>tar</c>
+ programs (including GNU tar) can read this format. To ensure that
+ that GNU tar produces a tar file that <c>erl_tar</c> can read,
+ give the <c>--format=ustar</c> option to GNU tar.</p>
<p>By convention, the name of a tar file should end in "<c>.tar</c>".
To abide to the convention, you'll need to add "<c>.tar</c>" yourself
to the name.</p>
@@ -65,6 +66,20 @@
</description>
<section>
+ <title>UNICODE SUPPORT</title>
+ <p>If <seealso
+ marker="kernel:file#native_name_encoding/0">file:native_name_encoding/0</seealso>
+ returns <c>utf8</c>, path names will be encoded in UTF-8 when
+ creating tar files and path names will be assumed to be encoded in
+ UTF-8 when extracting tar files.</p>
+
+ <p>If <seealso
+ marker="kernel:file#native_name_encoding/0">file:native_name_encoding/0</seealso>
+ returns <c>latin1</c>, no translation of path names will be
+ done.</p>
+ </section>
+
+ <section>
<title>LIMITATIONS</title>
<p>For maximum compatibility, it is safe to archive files with names
up to 100 characters in length. Such tar files can generally be
@@ -112,8 +127,8 @@
<fsummary>Add a file to an open tar file</fsummary>
<type>
<v>TarDescriptor = term()</v>
- <v>FilenameOrBin = Filename()|binary()</v>
- <v>Filename = filename()()</v>
+ <v>FilenameOrBin = filename()|binary()</v>
+ <v>Filename = filename()</v>
<v>NameInArchive = filename()</v>
<v>Options = [Option]</v>
<v>Option = dereference|verbose</v>
diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml
index 1713367bd8..848d57f3e6 100644
--- a/lib/stdlib/doc/src/gen_fsm.xml
+++ b/lib/stdlib/doc/src/gen_fsm.xml
@@ -115,7 +115,7 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4
If <c>FsmName={global,GlobalName}</c>, the gen_fsm is
registered globally as <c>GlobalName</c> using
<c>global:register_name/2</c>.
- If <c>EventMgrName={via,Module,ViaName}</c>, the event manager will
+ If <c>FsmName={via,Module,ViaName}</c>, the gen_fsm will
register with the registry represented by <c>Module</c>.
The <c>Module</c> callback should export the functions
<c>register_name/2</c>, <c>unregister_name/1</c>,
@@ -210,7 +210,7 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4
registered at another node, or</item>
<item><c>{global,GlobalName}</c>, if the gen_fsm is globally
registered.</item>
- <item><c>{via,Module,ViaName}</c>, if the event manager is registered
+ <item><c>{via,Module,ViaName}</c>, if the gen_fsm is registered
through an alternative process registry.</item>
</list>
<p><c>Event</c> is an arbitrary term which is passed as one of
diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml
index 4c83fde237..62c0394479 100644
--- a/lib/stdlib/doc/src/gen_server.xml
+++ b/lib/stdlib/doc/src/gen_server.xml
@@ -113,7 +113,7 @@ gen_server:abcast -----> Module:handle_cast/2
registered globally as <c>GlobalName</c> using
<c>global:register_name/2</c>. If no name is provided,
the gen_server is not registered.
- If <c>EventMgrName={via,Module,ViaName}</c>, the event manager will
+ If <c>ServerName={via,Module,ViaName}</c>, the gen_server will
register with the registry represented by <c>Module</c>.
The <c>Module</c> callback should export the functions
<c>register_name/2</c>, <c>unregister_name/1</c>,
diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml
index 76137e3dee..b37f7fd7fd 100644
--- a/lib/stdlib/doc/src/maps.xml
+++ b/lib/stdlib/doc/src/maps.xml
@@ -108,6 +108,26 @@
</func>
<func>
+ <name name="get" arity="3"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>
+ Returns the value <c><anno>Value</anno></c> associated with <c><anno>Key</anno></c> if
+ <c><anno>Map</anno></c> contains <c><anno>Key</anno></c>.
+ If no value is associated with <c><anno>Key</anno></c> then returns <c><anno>Default</anno></c>.
+ </p>
+ <p>Example:</p>
+ <code type="none">
+> Map = #{ key1 => val1, key2 => val2 }.
+#{key1 => val1,key2 => val2}
+> maps:get(key1, Map, "Default value").
+val1
+> maps:get(key3, Map, "Default value").
+"Default value"</code>
+ </desc>
+ </func>
+
+ <func>
<name name="is_key" arity="2"/>
<fsummary></fsummary>
<desc>
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index acde3ad5d6..3cfedfee97 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -244,17 +244,17 @@ expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
erlang:raise(error, {undef_record,Name}, stacktrace());
%% map
-expr({map,_, Binding,Es}, Bs0, Lf, Ef, RBs) ->
- {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, RBs),
+expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) ->
+ {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, none),
case Map0 of
#{} ->
- {Vs,Bs} = eval_map_fields(Es, Bs1, Lf, Ef),
+ {Vs,Bs2} = eval_map_fields(Es, Bs0, Lf, Ef),
Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) ->
maps:put(K, V, Mi);
({map_exact,K,V}, Mi) ->
maps:update(K, V, Mi)
end, Map0, Vs),
- ret_expr(Map1, Bs, RBs);
+ ret_expr(Map1, merge_bindings(Bs2, Bs1), RBs);
_ ->
erlang:raise(error, {badarg,Map0}, stacktrace())
end;
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 7c064ce902..39cc03cf7a 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -1046,9 +1046,10 @@ check_undefined_types(#lint{usage=Usage,types=Def}=St0) ->
Used = Usage#usage.used_types,
UTAs = dict:fetch_keys(Used),
Undef = [{TA,dict:fetch(TA, Used)} ||
- TA <- UTAs,
+ {T,_}=TA <- UTAs,
not dict:is_key(TA, Def),
- not is_default_type(TA)],
+ not is_default_type(TA),
+ not is_newly_introduced_var_arity_type(T)],
foldl(fun ({TA,L}, St) ->
add_error(L, {undefined_type,TA}, St)
end, St0, Undef).
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 1dc5fc52a7..e1ae3b7aea 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -848,10 +848,12 @@ build_fun(Line, Cs) ->
end.
check_clauses(Cs, Name, Arity) ->
- mapl(fun ({clause,L,N,As,G,B}) when N =:= Name, length(As) =:= Arity ->
- {clause,L,As,G,B};
- ({clause,L,_N,_As,_G,_B}) ->
- ret_err(L, "head mismatch") end, Cs).
+ [case C of
+ {clause,L,N,As,G,B} when N =:= Name, length(As) =:= Arity ->
+ {clause,L,As,G,B};
+ {clause,L,_N,_As,_G,_B} ->
+ ret_err(L, "head mismatch")
+ end || C <- Cs].
build_try(L,Es,Scs,{Ccs,As}) ->
{'try',L,Es,Scs,Ccs,As}.
@@ -861,17 +863,6 @@ ret_err(L, S) ->
{location,Location} = get_attribute(L, location),
return_error(Location, S).
-%% mapl(F,List)
-%% an alternative map which always maps from left to right
-%% and makes it possible to interrupt the mapping with throw on
-%% the first occurence from left as expected.
-%% can be removed when the jam machine (and all other machines)
-%% uses the standardized (Erlang 5.0) evaluation order (from left to right)
-mapl(F, [H|T]) ->
- V = F(H),
- [V | mapl(F,T)];
-mapl(_, []) ->
- [].
%% Convert between the abstract form of a term and a term.
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index 40b48d7999..acf7a5cd40 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -381,7 +381,12 @@ to_octal(Int, Count, Result) ->
to_octal(Int div 8, Count-1, [Int rem 8 + $0|Result]).
to_string(Str0, Count) ->
- Str = list_to_binary(Str0),
+ Str = case file:native_name_encoding() of
+ utf8 ->
+ unicode:characters_to_binary(Str0);
+ latin1 ->
+ list_to_binary(Str0)
+ end,
case byte_size(Str) of
Size when Size < Count ->
[Str|zeroes(Count-Size)];
@@ -392,9 +397,17 @@ to_string(Str0, Count) ->
pad_file(File) ->
{ok,Position} = file:position(File, {cur,0}),
- %% There must be at least one empty record at the end of the file.
- Zeros = zeroes(?block_size - (Position rem ?block_size)),
- file:write(File, Zeros).
+ %% There must be at least two zero records at the end.
+ Fill = case ?block_size - (Position rem ?block_size) of
+ Fill0 when Fill0 < 2*?record_size ->
+ %% We need to another block here to ensure that there
+ %% are at least two zero records at the end.
+ Fill0 + ?block_size;
+ Fill0 ->
+ %% Large enough.
+ Fill0
+ end,
+ file:write(File, zeroes(Fill)).
split_filename(Name) when length(Name) =< ?th_name_len ->
{"", Name};
@@ -608,7 +621,22 @@ typeflag(Bin) ->
%% Get the name of the file from the prefix and name fields of the
%% tar header.
-get_name(Bin) ->
+get_name(Bin0) ->
+ List0 = get_name_raw(Bin0),
+ case file:native_name_encoding() of
+ utf8 ->
+ Bin = list_to_binary(List0),
+ case unicode:characters_to_list(Bin) of
+ {error,_,_} ->
+ List0;
+ List when is_list(List) ->
+ List
+ end;
+ latin1 ->
+ List0
+ end.
+
+get_name_raw(Bin) ->
Name = from_string(Bin, ?th_name, ?th_name_len),
case binary_to_list(Bin, ?th_prefix+1, ?th_prefix+1) of
[0] ->
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index a266daa084..c0921e4cf1 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -488,7 +488,7 @@ badpattern(Reason) ->
error({badpattern,Reason}).
eval_read_file_info(File, file) ->
- file:read_file_info(File);
+ file:read_link_info(File);
eval_read_file_info(File, erl_prim_loader) ->
case erl_prim_loader:read_file_info(File) of
error -> {error, erl_prim_loader};
diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl
index fd6d56fa47..4ef1638e6d 100644
--- a/lib/stdlib/src/maps.erl
+++ b/lib/stdlib/src/maps.erl
@@ -23,7 +23,8 @@
fold/3,
map/2,
size/1,
- without/2
+ without/2,
+ get/3
]).
@@ -142,6 +143,21 @@ values(_) -> erlang:nif_error(undef).
%%% End of BIFs
+-spec get(Key, Map, Default) -> Value | Default when
+ Key :: term(),
+ Map :: map(),
+ Value :: term(),
+ Default :: term().
+
+get(Key, Map, Default) ->
+ case maps:find(Key, Map) of
+ {ok, Value} ->
+ Value;
+ error ->
+ Default
+ end.
+
+
-spec fold(Fun,Init,Map) -> Acc when
Fun :: fun((K, V, AccIn) -> AccOut),
Init :: term(),
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 39f6ce423a..a271229c59 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -85,7 +85,8 @@ MODULES= \
zip_SUITE \
random_unicode_list \
random_iolist \
- error_logger_forwarder
+ error_logger_forwarder \
+ maps_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index b91d14b5b8..b55324161b 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -1451,6 +1451,13 @@ eep43(Config) when is_list(Config) ->
" {Map#{a := B},Map#{a => c},Map#{d => e}} "
"end.",
{#{a => b},#{a => c},#{a => b,d => e}}),
+ check(fun () ->
+ lists:map(fun (X) -> X#{price := 0} end,
+ [#{hello => 0, price => nil}])
+ end,
+ "lists:map(fun (X) -> X#{price := 0} end,
+ [#{hello => 0, price => nil}]).",
+ [#{hello => 0, price => 0}]),
error_check("[camembert]#{}.", {badarg,[camembert]}),
error_check("#{} = 1.", {badmatch,1}),
ok.
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index d9512c0ef4..ea61b2082b 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -52,7 +52,7 @@
guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1,
otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1,
otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1,
- otp_11772/1, otp_11771/1,
+ otp_11772/1, otp_11771/1, otp_11872/1,
export_all/1,
bif_clash/1,
behaviour_basic/1, behaviour_multiple/1,
@@ -88,7 +88,7 @@ all() ->
otp_4886, otp_4988, otp_5091, otp_5276, otp_5338,
otp_5362, otp_5371, otp_7227, otp_5494, otp_5644,
otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254,
- otp_11772, otp_11771, export_all,
+ otp_11772, otp_11771, otp_11872, export_all,
bif_clash, behaviour_basic, behaviour_multiple,
otp_7550, otp_8051, format_warn, {group, on_load},
too_many_arguments, basic_errors, bin_syntax_errors, predef,
@@ -2630,6 +2630,29 @@ otp_11771(Config) when is_list(Config) ->
[]} = run_test2(Config, Ts, []),
ok.
+otp_11872(doc) ->
+ "OTP-11872. The type map() undefined when exported.";
+otp_11872(suite) -> [];
+otp_11872(Config) when is_list(Config) ->
+ Ts = <<"
+ -module(map).
+
+ -compile(export_all).
+
+ -export_type([map/0, product/0]).
+
+ -opaque map() :: dict().
+
+ -spec t() -> map().
+
+ t() ->
+ 1.
+ ">>,
+ {error,[{6,erl_lint,{undefined_type,{product,0}}}],
+ [{8,erl_lint,{new_var_arity_type,map}}]} =
+ run_test2(Config, Ts, []),
+ ok.
+
export_all(doc) ->
"OTP-7392. Warning for export_all.";
export_all(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index 4a67d68428..8203a03a7a 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -23,7 +23,7 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
wildcard_one/1,wildcard_two/1,wildcard_errors/1,
- fold_files/1,otp_5960/1,ensure_dir_eexist/1]).
+ fold_files/1,otp_5960/1,ensure_dir_eexist/1,symlinks/1]).
-import(lists, [foreach/2]).
@@ -43,7 +43,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[wildcard_one, wildcard_two, wildcard_errors,
- fold_files, otp_5960, ensure_dir_eexist].
+ fold_files, otp_5960, ensure_dir_eexist, symlinks].
groups() ->
[].
@@ -366,3 +366,39 @@ ensure_dir_eexist(Config) when is_list(Config) ->
?line {error, eexist} = filelib:ensure_dir(NeedFile),
?line {error, eexist} = filelib:ensure_dir(NeedFileB),
ok.
+
+symlinks(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Dir = filename:join(PrivDir, ?MODULE_STRING++"_symlinks"),
+ SubDir = filename:join(Dir, "sub"),
+ AFile = filename:join(SubDir, "a_file"),
+ Alias = filename:join(Dir, "symlink"),
+ ok = file:make_dir(Dir),
+ ok = file:make_dir(SubDir),
+ ok = file:write_file(AFile, "not that big\n"),
+ case file:make_symlink(AFile, Alias) of
+ {error, enotsup} ->
+ {skip, "Links not supported on this platform"};
+ {error, eperm} ->
+ {win32,_} = os:type(),
+ {skip, "Windows user not privileged to create symlinks"};
+ ok ->
+ ["sub","symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))),
+ ["symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))),
+ ok = file:delete(AFile),
+ %% The symlink should still be visible even when its target
+ %% has been deleted.
+ ["sub","symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))),
+ ["symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))),
+ ok
+ end.
+
+basenames(Dir, Files) ->
+ [begin
+ Dir = filename:dirname(F),
+ filename:basename(F)
+ end || F <- Files].
diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl
new file mode 100644
index 0000000000..c826ee731a
--- /dev/null
+++ b/lib/stdlib/test/maps_SUITE.erl
@@ -0,0 +1,69 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%----------------------------------------------------------------
+%%% Purpose: Test suite for the 'maps' module.
+%%%-----------------------------------------------------------------
+
+-module(maps_SUITE).
+
+-include_lib("test_server/include/test_server.hrl").
+
+% Default timetrap timeout (set in init_per_testcase).
+% This should be set relatively high (10-15 times the expected
+% max testcasetime).
+-define(default_timeout, ?t:minutes(4)).
+
+% Test server specific exports
+-export([all/0]).
+-export([suite/0]).
+-export([init_per_suite/1]).
+-export([end_per_suite/1]).
+-export([init_per_testcase/2]).
+-export([end_per_testcase/2]).
+
+-export([get3/1]).
+
+suite() ->
+ [{ct_hooks, [ts_install_cth]}].
+
+all() ->
+ [get3].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog=test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+end_per_testcase(_Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+get3(Config) when is_list(Config) ->
+ Map = #{ key1 => value1, key2 => value2 },
+ DefaultValue = "Default value",
+ ?line value1 = maps:get(key1, Map, DefaultValue),
+ ?line value2 = maps:get(key2, Map, DefaultValue),
+ ?line DefaultValue = maps:get(key3, Map, DefaultValue),
+ ok.
diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl
index 53a34511d9..59821220b4 100644
--- a/lib/stdlib/test/stdlib_SUITE.erl
+++ b/lib/stdlib/test/stdlib_SUITE.erl
@@ -94,10 +94,10 @@ appup_tests(App,{OkVsns,NokVsns}) ->
ok.
create_test_vsns(App) ->
- This = erlang:system_info(otp_release),
- FirstMajor = previous_major(This),
+ ThisMajor = erlang:system_info(otp_release),
+ FirstMajor = previous_major(ThisMajor),
SecondMajor = previous_major(FirstMajor),
- Ok = app_vsn(App,[FirstMajor]),
+ Ok = app_vsn(App,[ThisMajor,FirstMajor]),
Nok0 = app_vsn(App,[SecondMajor]),
Nok = case Ok of
[Ok1|_] ->
@@ -108,9 +108,9 @@ create_test_vsns(App) ->
{Ok,Nok}.
previous_major("17") ->
- "r16";
-previous_major("r"++Rel) ->
- "r"++previous_major(Rel);
+ "r16b";
+previous_major("r16b") ->
+ "r15b";
previous_major(Rel) ->
integer_to_list(list_to_integer(Rel)-1).
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 5bc34e35af..6349139925 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -23,7 +23,7 @@
create_long_names/1, bad_tar/1, errors/1, extract_from_binary/1,
extract_from_binary_compressed/1,
extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
- memory/1]).
+ memory/1,unicode/1]).
-include_lib("test_server/include/test_server.hrl").
-include_lib("kernel/include/file.hrl").
@@ -34,7 +34,7 @@ all() ->
[borderline, atomic, long_names, create_long_names,
bad_tar, errors, extract_from_binary,
extract_from_binary_compressed, extract_from_open_file,
- symlinks, open_add_close, cooked_compressed, memory].
+ symlinks, open_add_close, cooked_compressed, memory, unicode].
groups() ->
[].
@@ -73,6 +73,7 @@ borderline(Config) when is_list(Config) ->
?line lists:foreach(fun(Size) -> borderline_test(Size, TempDir) end,
[0, 1, 10, 13, 127, 333, Record-1, Record, Record+1,
+ Block-2*Record-1, Block-2*Record, Block-2*Record+1,
Block-Record-1, Block-Record, Block-Record+1,
Block-1, Block, Block+1,
Block+Record-1, Block+Record, Block+Record+1]),
@@ -726,6 +727,56 @@ memory(Config) when is_list(Config) ->
?line ok = delete_files([Name1,Name2]),
ok.
+%% Test filenames with characters outside the US ASCII range.
+unicode(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ do_unicode(PrivDir),
+ case has_transparent_naming() of
+ true ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Node = start_node(unicode, "+fnl -pa "++Pa),
+ ok = rpc:call(Node, erlang, apply,
+ [fun() -> do_unicode(PrivDir) end,[]]),
+ true = test_server:stop_node(Node),
+ ok;
+ false ->
+ ok
+ end.
+
+has_transparent_naming() ->
+ case os:type() of
+ {unix,darwin} -> false;
+ {unix,_} -> true;
+ _ -> false
+ end.
+
+do_unicode(PrivDir) ->
+ ok = file:set_cwd(PrivDir),
+ ok = file:make_dir("unicöde"),
+
+ Names = unicode_create_files(),
+ Tar = "unicöde.tar",
+ ok = erl_tar:create(Tar, ["unicöde"], []),
+ {ok,Names} = erl_tar:table(Tar, []),
+ _ = [ok = file:delete(Name) || Name <- Names],
+ ok = erl_tar:extract(Tar),
+ _ = [{ok,_} = file:read_file(Name) || Name <- Names],
+ _ = [ok = file:delete(Name) || Name <- Names],
+ ok = file:del_dir("unicöde"),
+ ok.
+
+unicode_create_files() ->
+ FileA = "unicöde/smörgåsbord",
+ ok = file:write_file(FileA, "yum!\n"),
+ [FileA|case file:native_name_encoding() of
+ utf8 ->
+ FileB = "unicöde/Хороший файл!",
+ ok = file:write_file(FileB, "But almost empty.\n"),
+ [FileB];
+ latin1 ->
+ []
+ end].
+
%% Delete the given list of files.
delete_files([]) -> ok;
delete_files([Item|Rest]) ->
@@ -791,3 +842,14 @@ make_temp_dir(Base, I) ->
ok -> Name;
{error,eexist} -> make_temp_dir(Base, I+1)
end.
+
+start_node(Name, Args) ->
+ [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ ct:log("Trying to start ~w@~s~n", [Name,Host]),
+ case test_server:start_node(Name, peer, [{args,Args}]) of
+ {error,Reason} ->
+ test_server:fail(Reason);
+ {ok,Node} ->
+ ct:log("Node ~p started~n", [Node]),
+ Node
+ end.
diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl
index c9996c954e..46a5ca48df 100644
--- a/lib/syntax_tools/src/erl_syntax.erl
+++ b/lib/syntax_tools/src/erl_syntax.erl
@@ -2071,7 +2071,7 @@ map_field_assoc_value(Node) ->
{map_field_assoc, _, _, Value} ->
Value;
_ ->
- (data(Node))#map_field_assoc.name
+ (data(Node))#map_field_assoc.value
end.
@@ -2129,7 +2129,7 @@ map_field_exact_value(Node) ->
{map_field_exact, _, _, Value} ->
Value;
_ ->
- (data(Node))#map_field_exact.name
+ (data(Node))#map_field_exact.value
end.
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl
index d4c54a72aa..6fb3e5ccfb 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl
@@ -24,12 +24,12 @@
init_per_group/2,end_per_group/2]).
%% Test cases
--export([app_test/1,appup_test/1,smoke_test/1,revert/1]).
+-export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [app_test,appup_test,smoke_test,revert].
+ [app_test,appup_test,smoke_test,revert,revert_map].
groups() ->
[].
@@ -109,6 +109,16 @@ revert_file(File, Path) ->
ok
end.
+%% Testing bug fix for reverting map_field_assoc
+revert_map(Config) ->
+ Dog = ?t:timetrap(?t:minutes(1)),
+ ?line [{map_field_assoc,16,{atom,17,name},{var,18,'Value'}}] =
+ erl_syntax:revert_forms([{tree,map_field_assoc,
+ {attr,16,[],none},
+ {map_field_assoc,
+ {atom,17,name},{var,18,'Value'}}}]),
+ ?line ?t:timetrap_cancel(Dog).
+
p_run(Test, List) ->
N = erlang:system_info(schedulers),
p_run_loop(Test, List, N, [], 0).
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 9b05bddf63..f63bfdec05 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -22,7 +22,7 @@
%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([run_test_case_apply/1,init_target_info/0,init_purify/0]).
--export([cover_compile/1,cover_analyse/3]).
+-export([cover_compile/1,cover_analyse/2]).
%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-export([get_loc/1,set_tc_state/1]).
@@ -80,8 +80,8 @@ init_purify() ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% cover_compile({App,Include,Exclude,Cross}) ->
-%% {ok,AnalyseModules} | {error,Reason}
+%% cover_compile(#cover{app=App,incl=Include,excl=Exclude,cross=Cross}) ->
+%% {ok,#cover{mods=AnalyseModules}} | {error,Reason}
%%
%% App = atom() , name of application to be compiled
%% Exclude = [atom()], list of modules to exclude
@@ -90,33 +90,35 @@ init_purify() ->
%% Cross = [atoms()], list of modules outside of App shat should be included
%% in the cover compilation, but that shall not be part of
%% the cover analysis for this application.
+%% AnalyseModules = [atom()], list of successfully compiled modules
%%
-%% Cover compile the given application. Return {ok,AnalyseMods} if application
-%% is found, else {error,application_not_found}.
+%% Cover compile the given application. Return {ok,CoverInfo} if
+%% compilation succeeds, else (if application is not found and there
+%% are no modules to compile) {error,application_not_found}.
-cover_compile({none,_Exclude,Include,Cross}) ->
+cover_compile(CoverInfo=#cover{app=none,incl=Include,cross=Cross}) ->
CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
CompileMods = Include++CrossMods,
case length(CompileMods) of
0 ->
io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
cover:start(), % start cover server anyway
- {ok,[]};
+ {ok,CoverInfo#cover{mods=[]}};
N ->
io:fwrite("Cover compiling ~w modules - "
"this may take some time... ",[N]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
- {ok,Include}
+ {ok,CoverInfo#cover{mods=Include}}
end;
-cover_compile({App,all,Include,Cross}) ->
+cover_compile(CoverInfo=#cover{app=App,excl=all,incl=Include,cross=Cross}) ->
CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
CompileMods = Include++CrossMods,
case length(CompileMods) of
0 ->
io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
cover:start(), % start cover server anyway
- {ok,[]};
+ {ok,CoverInfo#cover{mods=[]}};
N ->
io:fwrite("Cover compiling '~w' (~w files) - "
"this may take some time... ",[App,N]),
@@ -126,9 +128,9 @@ cover_compile({App,all,Include,Cross}) ->
"~tp\n", [App,CompileMods]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
- {ok,Include}
+ {ok,CoverInfo=#cover{mods=Include}}
end;
-cover_compile({App,Exclude,Include,Cross}) ->
+cover_compile(CoverInfo=#cover{app=App,excl=Exclude,incl=Include,cross=Cross}) ->
CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross),
case code:lib_dir(App) of
{error,bad_name} ->
@@ -146,7 +148,7 @@ cover_compile({App,Exclude,Include,Cross}) ->
"~tp\n", [App,Include]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
- {ok,Include}
+ {ok,CoverInfo#cover{mods=Include}}
end;
LibDir ->
EbinDir = filename:join([LibDir,"ebin"]),
@@ -158,13 +160,13 @@ cover_compile({App,Exclude,Include,Cross}) ->
0 ->
io:fwrite("WARNING: No modules to cover compile!\n\n",[]),
cover:start(), % start cover server anyway
- {ok,[]};
+ {ok,CoverInfo#cover{mods=[]}};
N ->
io:fwrite("Cover compiling '~w' (~w files) - "
"this may take some time... ",[App,N]),
do_cover_compile(CompileMods),
io:fwrite("done\n\n",[]),
- {ok,AnalyseMods}
+ {ok,CoverInfo#cover{mods=AnalyseMods}}
end
end.
@@ -174,9 +176,11 @@ module_names(Beams) ->
do_cover_compile(Modules) ->
- do_cover_compile1(lists:usort(Modules)). % remove duplicates
+ cover:start(),
+ pmap1(fun(M) -> do_cover_compile1(M) end,lists:usort(Modules)),
+ ok.
-do_cover_compile1([M|Rest]) ->
+do_cover_compile1(M) ->
case {code:is_sticky(M),code:is_loaded(M)} of
{true,_} ->
code:unstick_mod(M),
@@ -187,15 +191,13 @@ do_cover_compile1([M|Rest]) ->
io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n",
[M,Error])
end,
- code:stick_mod(M),
- do_cover_compile1(Rest);
+ code:stick_mod(M);
{false,false} ->
case code:load_file(M) of
{module,_} ->
- do_cover_compile1([M|Rest]);
+ do_cover_compile1(M);
Error ->
- io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]),
- do_cover_compile1(Rest)
+ io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error])
end;
{false,_} ->
case cover:compile_beam(M) of
@@ -204,23 +206,52 @@ do_cover_compile1([M|Rest]) ->
Error ->
io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n",
[M,Error])
- end,
- do_cover_compile1(Rest)
- end;
-do_cover_compile1([]) ->
- ok.
+ end
+ end.
+
+pmap1(Fun,List) ->
+ NTot = length(List),
+ NProcs = erlang:system_info(schedulers) * 2,
+ NPerProc = (NTot div NProcs) + 1,
+
+ {[],Pids} =
+ lists:foldr(
+ fun(_,{L,Ps}) ->
+ {L1,L2} = if length(L)>=NPerProc -> lists:split(NPerProc,L);
+ true -> {L,[]} % last chunk
+ end,
+ {P,_Ref} =
+ spawn_monitor(fun() ->
+ exit(lists:map(Fun,L1))
+ end),
+ {L2,[P|Ps]}
+ end,
+ {List,[]},
+ lists:seq(1,NProcs)),
+ collect(Pids,[]).
+
+collect([],Acc) ->
+ lists:append(Acc);
+collect([Pid|Pids],Acc) ->
+ receive
+ {'DOWN', _Ref, process, Pid, Result} ->
+ %% collect(lists:delete(Pid,Pids),[Result|Acc])
+ collect(Pids,[Result|Acc])
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% cover_analyse(Analyse,Modules,Stop) -> [{M,{Cov,NotCov,Details}}]
+%% cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop) ->
+%% [{M,{Cov,NotCov,Details}}]
%%
-%% Analyse = {details,Dir} | details | {overview,void()} | overview
+%% Dir = string()
+%% Analyse = details | overview
%% Modules = [atom()], the modules to analyse
%%
-%% Cover analysis. If Analyse=={details,Dir} analyse_to_file is used.
+%% Cover analysis. If Analyse==details analyse_to_file is used.
%%
-%% If Analyse=={overview,Dir} analyse_to_file is not used, only an
-%% overview containing the number of covered/not covered lines in each
-%% module.
+%% If Analyse==overview analyse_to_file is not used, only an overview
+%% containing the number of covered/not covered lines in each module.
%%
%% Also, cover data will be exported to a file called all.coverdata in
%% the given directory.
@@ -235,11 +266,11 @@ do_cover_compile1([]) ->
%% which means that the modules will stay cover compiled. Note that
%% this is only recommended if the erlang node is being terminated
%% after the test is completed.
-cover_analyse(Analyse,Modules,Stop) ->
- print(stdout, "Cover analysing...\n", []),
+cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop}) ->
+ io:fwrite(user, "Cover analysing... ", []),
DetailsFun =
case Analyse of
- {details,Dir} ->
+ details ->
case cover:export(filename:join(Dir,"all.coverdata")) of
ok ->
fun(M) ->
@@ -256,7 +287,7 @@ cover_analyse(Analyse,Modules,Stop) ->
Error ->
fun(_) -> Error end
end;
- {overview,Dir} ->
+ overview ->
case cover:export(filename:join(Dir,"all.coverdata")) of
ok ->
fun(_) -> undefined end;
@@ -264,17 +295,19 @@ cover_analyse(Analyse,Modules,Stop) ->
fun(_) -> Error end
end
end,
- R = pmap(
+ R = pmap2(
fun(M) ->
case cover:analyse(M,module) of
{ok,{M,{Cov,NotCov}}} ->
{M,{Cov,NotCov,DetailsFun(M)}};
Err ->
- io:fwrite("WARNING: Analysis failed for ~w. Reason: ~p\n",
+ io:fwrite(user,
+ "\nWARNING: Analysis failed for ~w. Reason: ~p\n",
[M,Err]),
{M,Err}
end
end, Modules),
+ io:fwrite(user, "done\n\n", []),
case Stop of
true ->
@@ -286,12 +319,12 @@ cover_analyse(Analyse,Modules,Stop) ->
end,
R.
-pmap(Fun,List) ->
+pmap2(Fun,List) ->
Collector = self(),
Pids = lists:map(fun(E) ->
spawn(fun() ->
- Collector ! {res,self(),Fun(E)}
- end)
+ Collector ! {res,self(),Fun(E)}
+ end)
end, List),
lists:map(fun(Pid) ->
receive
@@ -300,7 +333,6 @@ pmap(Fun,List) ->
end
end, Pids).
-
do_cover_for_node(Node,CoverFunc) ->
do_cover_for_node(Node,CoverFunc,true).
do_cover_for_node(Node,CoverFunc,StickUnstick) ->
@@ -444,7 +476,7 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
%% If this process (group leader of the test case) terminates before
%% all messages have been replied back to the io server, the io server
%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in
-%% io.erl (livrem OCH hangslen mao :)
+%% io.erl.
%%
%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader
@@ -673,7 +705,7 @@ handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) ->
spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
St;
handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc},
- config=Config,pid=Pid}=St) ->
+ config=Config,pid=Pid}=St) ->
R = case Reason of
{timetrap_timeout,TVal,_} ->
{timetrap,TVal};
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 5fbc47a813..c3550d4533 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -52,7 +52,9 @@
-export([reject_io_reqs/1, get_levels/0, set_levels/3]).
-export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]).
-export([create_priv_dir/1]).
--export([cover/2, cover/3, cover/8, cross_cover_analyse/2, trc/1, stop_trace/0]).
+-export([cover/1, cover/2, cover/3,
+ cover_compile/7, cover_analyse/2, cross_cover_analyse/2,
+ trc/1, stop_trace/0]).
-export([testcase_callback/1]).
-export([set_random_seed/1]).
-export([kill_slavenodes/0]).
@@ -409,11 +411,26 @@ cover(App, Analyse) when is_atom(App) ->
cover(CoverFile, Analyse) ->
cover(none, CoverFile, Analyse).
cover(App, CoverFile, Analyse) ->
- controller_call({cover,{App,CoverFile},Analyse,true}).
-cover(App, CoverFile, Exclude, Include, Cross, Export, Analyse, Stop) ->
- controller_call({cover,
- {App,{CoverFile,Exclude,Include,Cross,Export}},
- Analyse,Stop}).
+ {Excl,Incl,Cross} = read_cover_file(CoverFile),
+ CoverInfo = #cover{app=App,
+ file=CoverFile,
+ excl=Excl,
+ incl=Incl,
+ cross=Cross,
+ level=Analyse},
+ controller_call({cover,CoverInfo}).
+
+cover(CoverInfo) ->
+ controller_call({cover,CoverInfo}).
+
+cover_compile(App,File,Excl,Incl,Cross,Analyse,Stop) ->
+ cover_compile(#cover{app=App,
+ file=File,
+ excl=Excl,
+ incl=Incl,
+ cross=Cross,
+ level=Analyse,
+ stop=Stop}).
testcase_callback(ModFunc) ->
controller_call({testcase_callback,ModFunc}).
@@ -563,7 +580,7 @@ handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) ->
ExtraTools =
case State#state.cover of
false -> [];
- {App,Analyse,Stop} -> [{cover,App,Analyse,Stop}]
+ CoverInfo -> [{cover,CoverInfo}]
end,
ExtraTools1 =
case State#state.random_seed of
@@ -816,13 +833,13 @@ handle_call(stop_trace, _From, State) ->
{reply,R,State#state{trc=false}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% handle_call({cover,App,Analyse,Stop}, _, State) -> ok | {error,Reason}
+%% handle_call({cover,CoverInfo}, _, State) -> ok | {error,Reason}
%%
-%% All modules inn application App are cover compiled
-%% Analyse indicates on which level the coverage should be analysed
+%% Set specification of cover analysis to be used when running tests
+%% (see start_extra_tools/1 and stop_extra_tools/1)
-handle_call({cover,App,Analyse,Stop}, _From, State) ->
- {reply,ok,State#state{cover={App,Analyse,Stop}}};
+handle_call({cover,CoverInfo}, _From, State) ->
+ {reply,ok,State#state{cover=CoverInfo}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason}
@@ -1203,11 +1220,10 @@ elapsed_time(Before, After) ->
start_extra_tools(ExtraTools) ->
start_extra_tools(ExtraTools, []).
-start_extra_tools([{cover,App,Analyse,Stop} | ExtraTools], Started) ->
- case cover_compile(App) of
- {ok,AnalyseMods} ->
- start_extra_tools(ExtraTools,
- [{cover,App,Analyse,AnalyseMods,Stop}|Started]);
+start_extra_tools([{cover,CoverInfo} | ExtraTools], Started) ->
+ case start_cover(CoverInfo) of
+ {ok,NewCoverInfo} ->
+ start_extra_tools(ExtraTools,[{cover,NewCoverInfo}|Started]);
{error,_} ->
start_extra_tools(ExtraTools, Started)
end;
@@ -1226,8 +1242,8 @@ stop_extra_tools(ExtraTools) ->
end,
stop_extra_tools(ExtraTools, TestDir).
-stop_extra_tools([{cover,App,Analyse,AnalyseMods,Stop}|ExtraTools], TestDir) ->
- cover_analyse(App, Analyse, AnalyseMods, Stop, TestDir),
+stop_extra_tools([{cover,CoverInfo}|ExtraTools], TestDir) ->
+ stop_cover(CoverInfo,TestDir),
stop_extra_tools(ExtraTools, TestDir);
%%stop_extra_tools([_ | ExtraTools], TestDir) ->
%% stop_extra_tools(ExtraTools, TestDir);
@@ -1569,13 +1585,20 @@ do_test_cases(TopCases, SkipCases,
ok
end
end,
-
+ CoverLog =
+ case get(test_server_cover_log_dir) of
+ undefined ->
+ ?coverlog_name;
+ AbsLogDir ->
+ AbsLog = filename:join(AbsLogDir,?coverlog_name),
+ make_relative(AbsLog, TestDir)
+ end,
print(html,
"<p><ul>\n"
"<li><a href=\"~ts\">Full textual log</a></li>\n"
"<li><a href=\"~ts\">Coverage log</a></li>\n"
"<li><a href=\"~ts\">Unexpected I/O log</a></li>\n</ul></p>\n",
- [?suitelog_name,?coverlog_name,?unexpected_io_log]),
+ [?suitelog_name,CoverLog,?unexpected_io_log]),
print(html,
"<p>~ts</p>\n" ++
xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">",
@@ -5087,15 +5110,15 @@ pinfo(P) ->
%% Cover compilation
%% The compilation is executed on the target node
-cover_compile({App,{_File,Exclude,Include,Cross,_Export}}) ->
- cover_compile1({App,Exclude,Include,Cross});
+start_cover(#cover{}=CoverInfo) ->
+ cover_compile(CoverInfo);
+start_cover({log,CoverLogDir}=CoverInfo) ->
+ %% Cover is controlled by the framework - here's the log
+ put(test_server_cover_log_dir,CoverLogDir),
+ {ok,CoverInfo}.
-cover_compile({App,CoverFile}) ->
- {Exclude,Include,Cross} = read_cover_file(CoverFile),
- cover_compile1({App,Exclude,Include,Cross}).
-
-cover_compile1(What) ->
- test_server:cover_compile(What).
+cover_compile(CoverInfo) ->
+ test_server:cover_compile(CoverInfo).
%% Read the coverfile for an application and return a list of modules
%% that are members of the application but shall not be compiled
@@ -5163,25 +5186,45 @@ check_cross([]) ->
%%
%% This per application analysis writes the file cover.html in the
%% application's run.<timestamp> directory.
-cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) ->
+stop_cover(#cover{}=CoverInfo, TestDir) ->
+ cover_analyse(CoverInfo, TestDir);
+stop_cover(_CoverInfo, _TestDir) ->
+ %% Cover is probably controlled by the framework
+ ok.
+
+make_relative(AbsDir, VsDir) ->
+ DirTokens = filename:split(AbsDir),
+ VsTokens = filename:split(VsDir),
+ filename:join(make_relative1(DirTokens, VsTokens)).
+
+make_relative1([T | DirTs], [T | VsTs]) ->
+ make_relative1(DirTs, VsTs);
+make_relative1(Last = [_File], []) ->
+ Last;
+make_relative1(Last = [_File], VsTs) ->
+ Ups = ["../" || _ <- VsTs],
+ Ups ++ Last;
+make_relative1(DirTs, []) ->
+ DirTs;
+make_relative1(DirTs, VsTs) ->
+ Ups = ["../" || _ <- VsTs],
+ Ups ++ DirTs.
+
+
+cover_analyse(CoverInfo, TestDir) ->
write_default_cross_coverlog(TestDir),
{ok,CoverLog} = open_html_file(filename:join(TestDir, ?coverlog_name)),
write_coverlog_header(CoverLog),
+ #cover{app=App,
+ file=CoverFile,
+ excl=Excluded,
+ cross=Cross} = CoverInfo,
io:fwrite(CoverLog, "<h1>Coverage for application '~w'</h1>\n", [App]),
io:fwrite(CoverLog,
"<p><a href=\"~ts\">Coverdata collected over all tests</a></p>",
[?cross_coverlog_name]),
- {CoverFile,_Included,Excluded,Cross} =
- case CoverInfo of
- {File,Excl,Incl,Cr,Export} ->
- cover:export(Export),
- {File,Incl,Excl,Cr};
- File ->
- {Excl,Incl,Cr} = read_cover_file(File),
- {File,Incl,Excl,Cr}
- end,
io:fwrite(CoverLog, "<p>CoverFile: <code>~tp</code>\n", [CoverFile]),
write_cross_cover_info(TestDir,Cross),
@@ -5196,7 +5239,7 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) ->
io:fwrite(CoverLog, "<p>Excluded module(s): <code>~tp</code>\n", [Excluded]),
- Coverage = cover_analyse(Analyse, AnalyseMods, Stop),
+ Coverage = test_server:cover_analyse(TestDir, CoverInfo),
write_binary_file(filename:join(TestDir,?raw_coverlog_name),
term_to_binary(Coverage)),
@@ -5215,11 +5258,6 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) ->
write_binary_file(filename:join(TestDir, ?cover_total),
term_to_binary(TotPercent)).
-cover_analyse(Analyse, AnalyseMods, Stop) ->
- TestDir = get(test_server_log_dir_base),
- test_server:cover_analyse({Analyse,TestDir}, AnalyseMods, Stop).
-
-
%% Cover analysis - accumulated over multiple tests
%% This can be executed on any node after all tests are finished.
%% Analyse = overview | details
diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl
index 4e734a330b..bafeeaabfe 100644
--- a/lib/test_server/src/test_server_internal.hrl
+++ b/lib/test_server/src/test_server_internal.hrl
@@ -49,3 +49,12 @@
master,
cookie}).
+
+-record(cover, {app, % application; Name | none
+ file, % cover spec file
+ incl, % explicitly include modules
+ excl, % explicitly exclude modules
+ level, % analyse level; details | overview
+ mods, % actually cover compiled modules
+ stop=true, % stop cover after analyse; boolean()
+ cross}).% cross cover analyse info
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
index 582abb2153..acd47788db 100644
--- a/lib/test_server/src/test_server_node.erl
+++ b/lib/test_server/src/test_server_node.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -653,7 +653,7 @@ find_rel_linux(Rel) ->
end.
find_rel_suse(Rel, SuseRel) ->
- Root = "/usr/local/otp/releases/otp_beam_linux_sles",
+ Root = "/usr/local/otp/releases/sles",
case SuseRel of
"11" ->
%% Try both SuSE 11, SuSE 10 and SuSe 9 in that order.
@@ -673,10 +673,10 @@ find_rel_suse(Rel, SuseRel) ->
find_rel_suse_1(Rel, RootWc) ->
case erlang:system_info(wordsize) of
4 ->
- find_rel_suse_2(Rel, RootWc++"_i386");
+ find_rel_suse_2(Rel, RootWc++"_32");
8 ->
- find_rel_suse_2(Rel, RootWc++"_x64") ++
- find_rel_suse_2(Rel, RootWc++"_i386")
+ find_rel_suse_2(Rel, RootWc++"_64") ++
+ find_rel_suse_2(Rel, RootWc++"_32")
end.
find_rel_suse_2(Rel, RootWc) ->
diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl
index bc7d244c7c..d6d2e865e2 100644
--- a/lib/test_server/src/ts.erl
+++ b/lib/test_server/src/ts.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -641,16 +641,17 @@ get_last_app_tests([Dir|Dirs],RE,Acc) ->
NewAcc =
case re:run(Dir,RE,[{capture,all,list}]) of
{match,[Dir,AppStr]} ->
+ Dir1 = filename:dirname(Dir), % cover logs in ct_run.<t> dir
App = list_to_atom(AppStr),
case lists:keytake(App,1,Acc) of
{value,{App,LastDir},Rest} ->
- if Dir > LastDir ->
- [{App,Dir}|Rest];
+ if Dir1 > LastDir ->
+ [{App,Dir1}|Rest];
true ->
Acc
end;
false ->
- [{App,Dir} | Acc]
+ [{App,Dir1} | Acc]
end;
_ ->
Acc
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index ec5a1f4bc5..4e3c49c717 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -853,7 +853,6 @@ resulting regexp is surrounded by \\_< and \\_>."
"append_element"
"await_proc_exit"
"await_sched_wall_time_modifications"
- "bitstr_to_list"
"bump_reductions"
"call_on_load_function"
"cancel_timer"
@@ -899,7 +898,6 @@ resulting regexp is surrounded by \\_< and \\_>."
"hibernate"
"insert_element"
"is_builtin"
- "list_to_bitstr"
"load_nif"
"loaded"
"localtime"
diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl
index 353275ae3b..6870aefe5c 100644
--- a/lib/tools/test/xref_SUITE.erl
+++ b/lib/tools/test/xref_SUITE.erl
@@ -1098,7 +1098,6 @@ read_expected(Version) ->
{POS1+1,{FF,{mod17,fun17,0}}},
{POS1+2,{FF,{erlang,spawn,1}}},
{POS1+2,{FF,{read,local,0}}},
- {POS1+3,{FF,{erlang,binary_to_term,1}}},
{POS1+3,{FF,{erlang,spawn,1}}},
{POS1+4,{FF,{dist,func,0}}},
{POS1+4,{FF,{erlang,spawn,1}}},
@@ -1207,6 +1206,7 @@ read_expected(Version) ->
OKB1 = [{POS13+1,{FF,{erts_debug,apply,4}}},
{POS13+2,{FF,{erts_debug,apply,4}}},
{POS13+3,{FF,{erts_debug,apply,4}}},
+ {POS1+3, {FF,{erlang,binary_to_term,1}}},
{POS3+1, {FF,{erlang,spawn,3}}},
{POS3+2, {FF,{erlang,spawn,3}}},
{POS3+3, {FF,{erlang,spawn_link,3}}},
diff --git a/lib/wx/aclocal.m4 b/lib/wx/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/wx/aclocal.m4
+++ b/lib/wx/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/lib/wx/configure.in b/lib/wx/configure.in
index a96f1f2632..a96f1f2632 100755..100644
--- a/lib/wx/configure.in
+++ b/lib/wx/configure.in
diff --git a/otp_versions.table b/otp_versions.table
index a8a40df85a..1120add531 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,2 +1,3 @@
+OTP-17.0.2 : inets-5.10.1 ssh-3.0.2 # asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 erts-6.0.1 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 typer-0.9.7 webtool-0.8.10 wx-1.2 xmerl-1.3.7 :
OTP-17.0.1 : erts-6.0.1 typer-0.9.7 # asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 inets-5.10 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 webtool-0.8.10 wx-1.2 xmerl-1.3.7 :
OTP-17.0 : asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 erts-6.0 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 inets-5.10 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 typer-0.9.6 webtool-0.8.10 wx-1.2 xmerl-1.3.7 # :
diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml
index 37208710fe..0ca425da86 100644
--- a/system/doc/reference_manual/expressions.xml
+++ b/system/doc/reference_manual/expressions.xml
@@ -792,6 +792,244 @@ Expr1 -- Expr2</pre>
</section>
<section>
+ <title>Map Expressions</title>
+ <section>
+ <title>Creating Maps</title>
+ <p>
+ Constructing a new map is done by letting an expression <c>K</c> be associated with
+ another expression <c>V</c>:
+ </p>
+ <code>#{ K => V }</code>
+ <p>
+ New maps may include multiple associations at construction by listing every
+ association:
+ </p>
+ <code>#{ K1 => V1, .., Kn => Vn }</code>
+ <p>
+ An empty map is constructed by not associating any terms with each other:
+ </p>
+ <code>#{}</code>
+ <p>
+ All keys and values in the map are terms. Any expression is first evaluated and
+ then the resulting terms are used as <em>key</em> and <em>value</em> respectively.
+ </p>
+ <p>
+ Keys and values are separated by the <c>=></c> arrow and associations are
+ separated by <c>,</c>.
+ </p>
+
+ <p>
+ Examples:
+ </p>
+ <code>
+M0 = #{}, % empty map
+M1 = #{a => &lt;&lt;"hello"&gt;&gt;}, % single association with literals
+M2 = #{1 => 2, b => b}, % multiple associations with literals
+M3 = #{k => {A,B}}, % single association with variables
+M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code>
+ <p>
+ where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c>
+ are the resulting map terms.
+ </p>
+ <p>
+ If two matching keys are declared, the latter key will take precedence.
+ </p>
+ <p>
+ Example:
+ </p>
+
+<pre>
+1> <input>#{1 => a, 1 => b}.</input>
+#{1 => b }
+2> <input>#{1.0 => a, 1 => b}.</input>
+#{1 => b, 1.0 => a}
+</pre>
+ <p>
+ The order in which the expressions constructing the keys and their
+ associated values are evaluated is not defined. The syntactic order of
+ the key-value pairs in the construction is of no relevance, except in
+ the above mentioned case of two matching keys.
+ </p>
+ </section>
+
+ <section>
+ <title>Updating Maps</title>
+ <p>
+ Updating a map has similar syntax as constructing it.
+ </p>
+ <p>
+ An expression defining the map to be updated is put in front of the expression
+ defining the keys to be updated and their respective values.
+ </p>
+ <code>M#{ K => V }</code>
+ <p>
+ where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression.
+ </p>
+ <p>
+ If key <c>K</c> does not match any existing key in the map, a new association
+ will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches
+ an existing key in map <c>M</c> its associated value will be replaced by the
+ new value <c>V</c>. In both cases the evaluated map expression will return a new map.
+ </p>
+ <p>
+ If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown.
+ </p>
+ <p>
+ To only update an existing value, the following syntax is used,
+ </p>
+ <code>M#{ K := V } </code>
+ <p>
+ where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c>
+ is an expression which evaluates to an existing key in <c>M</c>.
+ </p>
+ <p>
+ If key <c>K</c> does not match any existing keys in map <c>M</c> an exception
+ of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c>
+ is present in map <c>M</c> its associated value will be replaced by the new
+ value <c>V</c> and the evaluated map expression returns a new map.
+ </p>
+ <p>
+ If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown.
+ </p>
+ <p>
+ Examples:
+ </p>
+ <code>
+M0 = #{},
+M1 = M0#{a => 0},
+M2 = M1#{a => 1, b => 2},
+M3 = M2#{"function" => fun() -> f() end},
+M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code>
+ <p>
+ where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well.
+ </p>
+ <p>
+ More Examples:
+ </p>
+<pre>
+1> <input>M = #{1 => a}.</input>
+#{1 => a }
+2> <input>M#{1.0 => b}.</input>
+#{1 => a, 1.0 => b}.
+3> <input>M#{1 := b}.</input>
+#{1 => b}
+4> <input>M#{1.0 := b}.</input>
+** exception error: bad argument
+</pre>
+ <p>
+ As in construction, the order in which the key and value expressions
+ are evaluated is not defined. The
+ syntactic order of the key-value pairs in the update is of no
+ relevance, except in the case where two keys match, in which
+ case the latter value is used.
+ </p>
+ </section>
+
+ <section>
+ <title>Maps in Patterns</title>
+ <p>
+ Matching of key-value associations from maps is done in the following way:
+ </p>
+
+ <code>#{ K := V } = M</code>
+ <p>
+ where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound
+ variables or a literals, and <c>V</c> can be any pattern with either bound or
+ unbound variables.
+ </p>
+ <p>
+ If the variable <c>V</c> is unbound, it will be bound to the value associated
+ with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable
+ <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>.
+ </p>
+ <p> Example: </p>
+<code>
+1> <input>M = #{"tuple" => {1,2}}.</input>
+#{"tuple" => {1,2}}
+2> <input>#{"tuple" := {1,B}} = M.</input>
+#{"tuple" => {1,2}}
+3> <input>B.</input>
+2.</code>
+ <p>
+ This will bind variable <c>B</c> to integer <c>2</c>.
+ </p>
+ <p>
+ Similarly, multiple values from the map may be matched:
+ </p>
+ <code>#{ K1 := V1, .., Kn := Vn } = M</code>
+ <p>
+ where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all
+ keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the
+ associated values of their respective keys.
+ </p>
+ <p>
+ If the matching conditions are not met, the match will fail, either with
+ </p>
+ <list>
+ <item>
+ a <c>badmatch</c> exception, if used in the context of the matching operator
+ as in the example,
+ </item>
+ <item>
+ or resulting in the next clause being tested in function heads and
+ case expressions.
+ </item>
+ </list>
+ <p>
+ Matching in maps only allows for <c>:=</c> as delimiters of associations.
+ The order in which keys are declared in matching has no relevance.
+ </p>
+ <p>
+ Duplicate keys are allowed in matching and will match each pattern associated
+ to the keys.
+ </p>
+ <code>#{ K := V1, K := V2 } = M</code>
+ <p>
+ Matching an expression against an empty map literal will match its type but
+ no variables will be bound:
+ </p>
+ <code>#{} = Expr</code>
+ <p>
+ This expression will match if the expression <c>Expr</c> is of type map, otherwise
+ it will fail with an exception <c>badmatch</c>.
+ </p>
+ <section>
+ <title>Matching syntax: Example with literals in function heads</title>
+ <p>
+ Matching of literals as keys are allowed in function heads.
+ </p>
+ <code>
+%% only start if not_started
+handle_call(start, From, #{ state := not_started } = S) ->
+...
+ {reply, ok, S#{ state := start }};
+
+%% only change if started
+handle_call(change, From, #{ state := start } = S) ->
+...
+ {reply, ok, S#{ state := changed }};</code>
+ </section>
+ </section>
+ <section>
+ <title>Maps in Guards</title>
+ <p>
+ Maps are allowed in guards as long as all sub-expressions are valid guard expressions.
+ </p>
+ <p>
+ Two guard BIFs handles maps:
+ </p>
+ <list>
+ <item>
+ <seealso marker="erts:erlang#is_map/1">is_map/1</seealso>
+ </item>
+ <item>
+ <seealso marker="erts:erlang#map_size/1">map_size/1</seealso>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
<marker id="bit_syntax"></marker>
<title>Bit Syntax Expressions</title>
<code type="none"><![CDATA[<<>>
diff --git a/system/doc/reference_manual/maps.xml b/system/doc/reference_manual/maps.xml
deleted file mode 100644
index 78808ce4a2..0000000000
--- a/system/doc/reference_manual/maps.xml
+++ /dev/null
@@ -1,274 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2014</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- The contents of this file are subject to the Erlang Public License,
- Version 1.1, (the "License"); you may not use this file except in
- compliance with the License. You should have received a copy of the
- Erlang Public License along with this software. If not, it can be
- retrieved online at http://www.erlang.org/.
-
- Software distributed under the License is distributed on an "AS IS"
- basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
- the License for the specific language governing rights and limitations
- under the License.
- </legalnotice>
-
- <title>Maps</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- <file>maps.xml</file>
- </header>
-
- <note>
- <p>Maps are considered experimental during OTP 17 and may be subject to change.</p>
- <p>The documentation below describes it being possible to use arbitrary
- expressions or variables as keys, this is <em>NOT</em> implemented in the current
- version of Erlang/OTP.</p>
- <p>Exceptions returns <c>badarg</c> instead of <c>badmap</c>, this will change in
- the future releases.</p>
- </note>
-
- <section>
- <title>Creating Maps</title>
- <p>
- Constructing a new map is done by letting an expression <c>K</c> be associated with
- another expression <c>V</c>:
- </p>
- <code>#{ K => V }</code>
- <p>
- New maps may include multiple associations at construction by listing every
- association:
- </p>
- <code>#{ K1 => V1, .., Kn => Vn }</code>
- <p>
- An empty map is constructed by not associating any terms with each other:
- </p>
- <code>#{}</code>
- <p>
- All keys and values in the map are terms. Any expression is first evaluated and
- then the resulting terms are used as <em>key</em> and <em>value</em> respectively.
- </p>
- <p>
- Keys and values are separated by the <c>=></c> arrow and associations are
- separated by <c>,</c>.
- </p>
-
- <p>
- Examples:
- </p>
- <code>
-M0 = #{}, % empty map
-M1 = #{a => &lt;&lt;"hello"&gt;&gt;}, % single association with literals
-M2 = #{1 => 2, b => b}, % multiple associations with literals
-M3 = #{k => {A,B}}, % single association with variables
-M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code>
- <p>
- where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c>
- are the resulting map terms.
- </p>
- <p>
- If two matching keys are declared, the latter key will take precedence.
- </p>
- <p>
- Example:
- </p>
-
-<pre>
-1> <input>#{1 => a, 1 => b}.</input>
-#{1 => b }
-2> <input>#{1.0 => a, 1 => b}.</input>
-#{1 => b, 1.0 => a}
-</pre>
- <p>
- The order in which the expressions constructing the keys and their
- associated values are evaluated is not defined. The syntactic order of
- the key-value pairs in the construction is of no relevance, except in
- the above mentioned case of two matching keys.
- </p>
- </section>
-
- <section>
- <title>Updating Maps</title>
- <p>
- Updating a map has similar syntax as constructing it.
- </p>
- <p>
- An expression defining the map to be updated is put in front of the expression
- defining the keys to be updated and their respective values.
- </p>
- <code>M#{ K => V }</code>
- <p>
- where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression.
- </p>
- <p>
- If key <c>K</c> does not match any existing key in the map, a new association
- will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches
- an existing key in map <c>M</c> its associated value will be replaced by the
- new value <c>V</c>. In both cases the evaluated map expression will return a new map.
- </p>
- <p>
- If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown.
- </p>
- <p>
- To only update an existing value, the following syntax is used,
- </p>
- <code>M#{ K := V } </code>
- <p>
- where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c>
- is an expression which evaluates to an existing key in <c>M</c>.
- </p>
- <p>
- If key <c>K</c> does not match any existing keys in map <c>M</c> an exception
- of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c>
- is present in map <c>M</c> its associated value will be replaced by the new
- value <c>V</c> and the evaluated map expression returns a new map.
- </p>
- <p>
- If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown.
- </p>
- <p>
- Examples:
- </p>
- <code>
-M0 = #{},
-M1 = M0#{a => 0},
-M2 = M1#{a => 1, b => 2},
-M3 = M2#{"function" => fun() -> f() end},
-M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code>
- <p>
- where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well.
- </p>
- <p>
- More Examples:
- </p>
-<pre>
-1> <input>M = #{1 => a}.</input>
-#{1 => a }
-2> <input>M#{1.0 => b}.</input>
-#{1 => a, 1.0 => b}.
-3> <input>M#{1 := b}.</input>
-#{1 => b}
-4> <input>M#{1.0 := b}.</input>
-** exception error: bad argument
-</pre>
- <p>
- As in construction, the order in which the key and value expressions
- are evaluated is not defined. The
- syntactic order of the key-value pairs in the update is of no
- relevance, except in the case where two keys match, in which
- case the latter value is used.
- </p>
- </section>
-
- <section>
- <title>Maps in Patterns</title>
- <p>
- Matching of key-value associations from maps is done in the following way:
- </p>
-
- <code>#{ K := V } = M</code>
- <p>
- where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound
- variables or a literals, and <c>V</c> can be any pattern with either bound or
- unbound variables.
- </p>
- <p>
- If the variable <c>V</c> is unbound, it will be bound to the value associated
- with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable
- <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>.
- </p>
- <p> Example: </p>
-<code>
-1> <input>M = #{"tuple" => {1,2}}.</input>
-#{"tuple" => {1,2}}
-2> <input>#{"tuple" := {1,B}} = M.</input>
-#{"tuple" => {1,2}}
-3> <input>B.</input>
-2.</code>
- <p>
- This will bind variable <c>B</c> to integer <c>2</c>.
- </p>
- <p>
- Similarly, multiple values from the map may be matched:
- </p>
- <code>#{ K1 := V1, .., Kn := Vn } = M</code>
- <p>
- where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all
- keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the
- associated values of their respective keys.
- </p>
- <p>
- If the matching conditions are not met, the match will fail, either with
- </p>
- <list>
- <item>
- a <c>badmatch</c> exception, if used in the context of the matching operator
- as in the example,
- </item>
- <item>
- or resulting in the next clause being tested in function heads and
- case expressions.
- </item>
- </list>
- <p>
- Matching in maps only allows for <c>:=</c> as delimiters of associations.
- The order in which keys are declared in matching has no relevance.
- </p>
- <p>
- Duplicate keys are allowed in matching and will match each pattern associated
- to the keys.
- </p>
- <code>#{ K := V1, K := V2 } = M</code>
- <p>
- Matching an expression against an empty map literal will match its type but
- no variables will be bound:
- </p>
- <code>#{} = Expr</code>
- <p>
- This expression will match if the expression <c>Expr</c> is of type map, otherwise
- it will fail with an exception <c>badmatch</c>.
- </p>
- <section>
- <title>Matching syntax: Example with literals in function heads</title>
- <p>
- Matching of literals as keys are allowed in function heads.
- </p>
- <code>
-%% only start if not_started
-handle_call(start, From, #{ state := not_started } = S) ->
-...
- {reply, ok, S#{ state := start }};
-
-%% only change if started
-handle_call(change, From, #{ state := start } = S) ->
-...
- {reply, ok, S#{ state := changed }};</code>
- </section>
- </section>
- <section>
- <title>Maps in Guards</title>
- <p>
- Maps are allowed in guards as long as all sub-expressions are valid guard expressions.
- </p>
- <p>
- Two guard BIFs handles maps:
- </p>
- <list>
- <item>
- <seealso marker="erts:erlang#is_map/1">is_map/1</seealso>
- </item>
- <item>
- <seealso marker="erts:erlang#map_size/1">map_size/1</seealso>
- </item>
- </list>
- </section>
-</chapter>
diff --git a/system/doc/reference_manual/part.xml b/system/doc/reference_manual/part.xml
index 36fb888748..ee8f3dd7eb 100644
--- a/system/doc/reference_manual/part.xml
+++ b/system/doc/reference_manual/part.xml
@@ -36,7 +36,6 @@
<xi:include href="typespec.xml"/>
<xi:include href="expressions.xml"/>
<xi:include href="macros.xml"/>
- <xi:include href="maps.xml"/>
<xi:include href="records.xml"/>
<xi:include href="errors.xml"/>
<xi:include href="processes.xml"/>
diff --git a/system/doc/reference_manual/xmlfiles.mk b/system/doc/reference_manual/xmlfiles.mk
index 181e6f8042..6886c8c7cf 100644
--- a/system/doc/reference_manual/xmlfiles.mk
+++ b/system/doc/reference_manual/xmlfiles.mk
@@ -24,7 +24,6 @@ REF_MAN_CHAPTER_FILES = \
functions.xml \
expressions.xml \
macros.xml \
- maps.xml \
records.xml \
errors.xml \
processes.xml \