aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/doc/src/Makefile3
-rw-r--r--lib/common_test/doc/src/common_test_app.xml26
-rw-r--r--lib/common_test/doc/src/ct_hooks.xml90
-rw-r--r--lib/common_test/doc/src/ct_hooks_chapter.xml74
-rw-r--r--lib/common_test/doc/src/ct_testspec.xml84
-rw-r--r--lib/common_test/doc/src/ref_man.xml1
-rw-r--r--lib/common_test/doc/src/write_test_chapter.xml2
-rw-r--r--lib/common_test/src/common_test.app.src1
-rw-r--r--lib/common_test/src/ct_framework.erl161
-rw-r--r--lib/common_test/src/ct_groups.erl14
-rw-r--r--lib/common_test/src/ct_hooks.erl141
-rw-r--r--lib/common_test/src/ct_run.erl27
-rw-r--r--lib/common_test/src/ct_testspec.erl35
-rw-r--r--lib/common_test/src/cth_conn_log.erl8
-rw-r--r--lib/common_test/src/cth_log_redirect.erl28
-rw-r--r--lib/common_test/src/cth_surefire.erl54
-rw-r--r--lib/common_test/src/test_server.erl10
-rw-r--r--lib/common_test/src/test_server_ctrl.erl116
-rw-r--r--lib/common_test/test/Makefile3
-rw-r--r--lib/common_test/test/ct_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_error_SUITE.erl8
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl1201
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl62
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl43
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl51
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl54
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl39
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl122
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl32
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl81
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl6
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl42
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl45
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec8
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl106
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl182
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl64
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl79
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl53
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl40
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl40
-rw-r--r--lib/common_test/test/ct_repeat_testrun_SUITE.erl5
-rw-r--r--lib/common_test/test/ct_surefire_SUITE.erl129
-rw-r--r--lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec2
-rw-r--r--lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec2
-rw-r--r--lib/common_test/test/ct_test_server_if_1_SUITE.erl1
-rw-r--r--lib/common_test/test/ct_test_support.erl24
-rw-r--r--lib/common_test/test/ct_testspec_2_SUITE.erl82
-rw-r--r--lib/compiler/doc/src/compile.xml2
-rw-r--r--lib/compiler/src/compile.erl30
-rw-r--r--lib/compiler/test/lc_SUITE.erl9
-rw-r--r--lib/crypto/c_src/crypto.c18
-rw-r--r--lib/crypto/doc/src/crypto.xml2
-rw-r--r--lib/crypto/src/crypto.erl23
-rw-r--r--lib/dialyzer/src/dialyzer.app.src4
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl113
-rw-r--r--lib/dialyzer/src/dialyzer_behaviours.erl13
-rw-r--r--lib/dialyzer/src/dialyzer_callgraph.erl94
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl14
-rw-r--r--lib/dialyzer/src/dialyzer_codeserver.erl204
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl52
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl40
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl3
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl138
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl33
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl99
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl118
-rw-r--r--lib/dialyzer/test/abstract_SUITE.erl6
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options2
-rw-r--r--lib/dialyzer/test/map_SUITE_data/dialyzer_options1
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/dialyzer_options2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/weird6
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl18
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl14
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl19
-rw-r--r--lib/dialyzer/test/plt_SUITE.erl23
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/chars4
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/anno.erl18
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/chars.erl32
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl57
-rw-r--r--lib/diameter/src/base/diameter_service.erl18
-rw-r--r--lib/diameter/src/base/diameter_sup.erl4
-rw-r--r--lib/diameter/src/base/diameter_traffic.erl263
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl28
-rw-r--r--lib/eldap/test/Makefile2
-rw-r--r--lib/eldap/test/eldap.cover3
-rw-r--r--lib/erl_interface/doc/src/erl_call.xml2
-rw-r--r--lib/hipe/cerl/erl_types.erl239
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_num_bif.erl217
-rw-r--r--lib/hipe/test/hipe_SUITE.erl6
-rw-r--r--lib/hipe/test/opt_verify_SUITE.erl39
-rw-r--r--lib/inets/doc/src/httpc.xml2
-rw-r--r--lib/inets/doc/src/notes.xml17
-rw-r--r--lib/inets/src/ftp/ftp.erl53
-rw-r--r--lib/inets/src/http_client/httpc.erl92
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl674
-rw-r--r--lib/inets/src/http_client/httpc_response.erl2
-rw-r--r--lib/inets/src/http_server/httpd_request_handler.erl4
-rw-r--r--lib/inets/src/inets_app/inets.appup.src4
-rw-r--r--lib/inets/test/httpc_SUITE.erl71
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/doc/src/heart.xml17
-rw-r--r--lib/kernel/src/error_logger.erl8
-rw-r--r--lib/kernel/src/file.erl2
-rw-r--r--lib/kernel/src/heart.erl15
-rw-r--r--lib/kernel/src/os.erl24
-rw-r--r--lib/kernel/src/rpc.erl14
-rw-r--r--lib/kernel/test/code_SUITE.erl36
-rw-r--r--lib/kernel/test/error_logger_SUITE.erl13
-rw-r--r--lib/kernel/test/rpc_SUITE.erl12
-rw-r--r--lib/mnesia/doc/src/notes.xml18
-rw-r--r--lib/mnesia/src/mnesia_checkpoint.erl7
-rw-r--r--lib/mnesia/src/mnesia_event.erl3
-rw-r--r--lib/mnesia/test/mnesia_evil_backup.erl43
-rw-r--r--lib/mnesia/vsn.mk2
-rw-r--r--lib/observer/src/cdv_bin_cb.erl2
-rw-r--r--lib/observer/src/cdv_detail_wx.erl2
-rw-r--r--lib/observer/src/crashdump_viewer.erl21
-rw-r--r--lib/observer/src/etop.erl24
-rw-r--r--lib/observer/src/etop_txt.erl24
-rw-r--r--lib/observer/src/observer_app_wx.erl8
-rw-r--r--lib/observer/src/observer_lib.erl26
-rw-r--r--lib/observer/src/observer_port_wx.erl27
-rw-r--r--lib/observer/src/observer_pro_wx.erl8
-rw-r--r--lib/observer/src/observer_procinfo.erl2
-rw-r--r--lib/observer/src/observer_tv_wx.erl9
-rw-r--r--lib/observer/src/observer_wx.erl10
-rw-r--r--lib/observer/test/observer_SUITE.erl17
-rw-r--r--lib/os_mon/src/memsup.erl1
-rw-r--r--lib/public_key/doc/src/public_key.xml38
-rw-r--r--lib/public_key/doc/src/using_public_key.xml253
-rw-r--r--lib/public_key/src/public_key.erl190
-rw-r--r--lib/public_key/test/public_key_SUITE.erl145
-rw-r--r--lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem17
-rw-r--r--lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem14
-rw-r--r--lib/public_key/test/public_key_SUITE_data/verify_hostname.conf16
-rw-r--r--lib/runtime_tools/doc/src/LTTng.xml2
-rw-r--r--lib/runtime_tools/src/observer_backend.erl7
-rw-r--r--lib/sasl/doc/src/systools.xml6
-rw-r--r--lib/sasl/src/systools_make.erl168
-rw-r--r--lib/sasl/src/systools_relup.erl150
-rwxr-xr-xlib/sasl/test/release_handler_SUITE_data/start3
-rwxr-xr-xlib/sasl/test/release_handler_SUITE_data/start_client3
-rw-r--r--lib/sasl/test/systools_SUITE.erl116
-rw-r--r--lib/snmp/src/app/snmp.appup.src8
-rw-r--r--lib/snmp/src/app/snmp.erl80
-rw-r--r--lib/snmp/src/compile/snmpc_lib.erl4
-rw-r--r--lib/snmp/src/compile/snmpc_mib_gram.yrl6
-rw-r--r--lib/snmp/test/snmp_compiler_test.erl32
-rw-r--r--lib/snmp/test/snmp_test_data/OTP14145-MIB.mib44
-rw-r--r--lib/snmp/vsn.mk4
-rw-r--r--lib/ssh/doc/src/ssh.xml58
-rw-r--r--lib/ssh/doc/src/using_ssh.xml2
-rw-r--r--lib/ssh/src/ssh.app.src1
-rw-r--r--lib/ssh/src/ssh.erl47
-rw-r--r--lib/ssh/src/ssh_auth.erl6
-rw-r--r--lib/ssh/src/ssh_cli.erl18
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl15
-rw-r--r--lib/ssh/src/ssh_dbg.erl66
-rw-r--r--lib/ssh/src/ssh_sftpd.erl55
-rw-r--r--lib/ssh/src/ssh_sftpd_file_api.erl2
-rw-r--r--lib/ssh/src/ssh_transport.erl125
-rw-r--r--lib/ssh/test/property_test/ssh_eqc_encode_decode.erl370
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE.erl30
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE.erl2
-rw-r--r--lib/ssh/test/ssh_options_SUITE.erl37
-rw-r--r--lib/ssh/test/ssh_property_test_SUITE.erl3
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE.erl41
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test4
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli5
-rw-r--r--lib/ssh/test/ssh_sftp_SUITE.erl4
-rw-r--r--lib/ssh/test/ssh_sftpd_SUITE.erl161
-rw-r--r--lib/ssh/test/ssh_test_lib.erl54
-rw-r--r--lib/ssh/test/ssh_to_openssh_SUITE.erl3
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE.erl4
-rw-r--r--lib/ssl/doc/src/ssl.xml8
-rw-r--r--lib/ssl/doc/src/ssl_session_cache_api.xml29
-rw-r--r--lib/ssl/src/Makefile15
-rw-r--r--lib/ssl/src/dtls_connection.erl139
-rw-r--r--lib/ssl/src/dtls_handshake.erl8
-rw-r--r--lib/ssl/src/dtls_socket.erl13
-rw-r--r--lib/ssl/src/dtls_udp_listener.erl62
-rw-r--r--lib/ssl/src/dtls_v1.erl15
-rw-r--r--lib/ssl/src/ssl.app.src15
-rw-r--r--lib/ssl/src/ssl.appup.src18
-rw-r--r--lib/ssl/src/ssl.erl107
-rw-r--r--lib/ssl/src/ssl_admin_sup.erl95
-rw-r--r--lib/ssl/src/ssl_certificate.erl16
-rw-r--r--lib/ssl/src/ssl_cipher.erl22
-rw-r--r--lib/ssl/src/ssl_config.erl52
-rw-r--r--lib/ssl/src/ssl_connection.erl98
-rw-r--r--lib/ssl/src/ssl_connection_sup.erl101
-rw-r--r--lib/ssl/src/ssl_crl.erl76
-rw-r--r--lib/ssl/src/ssl_dist_admin_sup.erl74
-rw-r--r--lib/ssl/src/ssl_dist_connection_sup.erl79
-rw-r--r--lib/ssl/src/ssl_dist_sup.erl42
-rw-r--r--lib/ssl/src/ssl_handshake.erl58
-rw-r--r--lib/ssl/src/ssl_handshake.hrl3
-rw-r--r--lib/ssl/src/ssl_internal.hrl5
-rw-r--r--lib/ssl/src/ssl_manager.erl209
-rw-r--r--lib/ssl/src/ssl_pem_cache.erl266
-rw-r--r--lib/ssl/src/ssl_pkix_db.erl72
-rw-r--r--lib/ssl/src/ssl_sup.erl86
-rw-r--r--lib/ssl/src/tls_connection.erl65
-rw-r--r--lib/ssl/src/tls_handshake.erl67
-rw-r--r--lib/ssl/src/tls_v1.erl18
-rw-r--r--lib/ssl/test/make_certs.erl4
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl143
-rw-r--r--lib/ssl/test/ssl_certificate_verify_SUITE.erl62
-rw-r--r--lib/ssl/test/ssl_handshake_SUITE.erl9
-rw-r--r--lib/ssl/test/ssl_npn_hello_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_pem_cache_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_test_lib.erl243
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl57
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/filename.xml27
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml167
-rw-r--r--lib/stdlib/doc/src/sys.xml4
-rw-r--r--lib/stdlib/src/edlin_expand.erl95
-rw-r--r--lib/stdlib/src/erl_eval.erl1
-rw-r--r--lib/stdlib/src/erl_parse.yrl11
-rw-r--r--lib/stdlib/src/escript.erl83
-rw-r--r--lib/stdlib/src/filename.erl36
-rw-r--r--lib/stdlib/src/gen_event.erl2
-rw-r--r--lib/stdlib/src/gen_statem.erl867
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl131
-rw-r--r--lib/stdlib/src/qlc.erl6
-rw-r--r--lib/stdlib/src/zip.erl62
-rw-r--r--lib/stdlib/test/edlin_expand_SUITE.erl79
-rw-r--r--lib/stdlib/test/escript_SUITE.erl15
-rwxr-xr-xlib/stdlib/test/escript_SUITE_data/two_lines2
-rw-r--r--lib/stdlib/test/filename_SUITE.erl69
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl105
-rw-r--r--lib/stdlib/test/io_SUITE.erl241
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl18
-rw-r--r--lib/stdlib/test/rand_SUITE.erl6
-rw-r--r--lib/stdlib/test/shell_SUITE.erl2
-rw-r--r--lib/stdlib/test/zip_SUITE.erl36
-rw-r--r--lib/tools/emacs/erlang-edoc.el6
-rw-r--r--lib/tools/emacs/erlang-skels.el14
-rw-r--r--lib/tools/examples/xref_examples.erl2
-rw-r--r--lib/typer/src/typer.app.src4
-rw-r--r--lib/typer/src/typer.erl22
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.erl33
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.hrl9
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_base.erlsrc144
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc38
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_list.erlsrc19
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc50
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc50
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc50
-rw-r--r--lib/xmerl/src/xmerl_scan.erl31
-rw-r--r--lib/xmerl/test/Makefile4
-rw-r--r--lib/xmerl/test/xmerl_SUITE.erl47
-rw-r--r--lib/xmerl/test/xmerl_sax_SUITE.erl6
-rw-r--r--lib/xmerl/test/xmerl_sax_std_SUITE.erl100
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE.erl245
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml17
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml18
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml34
272 files changed, 10754 insertions, 4522 deletions
diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile
index e495f587a3..152ece5d25 100644
--- a/lib/common_test/doc/src/Makefile
+++ b/lib/common_test/doc/src/Makefile
@@ -53,7 +53,8 @@ XML_REF3_FILES = ct.xml \
ct_slave.xml \
ct_property_test.xml \
ct_netconfc.xml \
- ct_hooks.xml
+ ct_hooks.xml \
+ ct_testspec.xml
XML_REF6_FILES = common_test_app.xml
XML_PART_FILES = part.xml
diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml
index 48ffe653e4..d407a0a53f 100644
--- a/lib/common_test/doc/src/common_test_app.xml
+++ b/lib/common_test/doc/src/common_test_app.xml
@@ -224,7 +224,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:end_per_suite-1"><c>end_per_suite/1</c></seealso>
+ must also be defined.</p>
<p>This configuration function is called as the first function in the
suite. It typically contains initializations that are common for
@@ -256,7 +258,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:init_per_suite-1"><c>init_per_suite/1</c></seealso>
+ must also be defined.</p>
<p>This function is called as the last test case in the
suite. It is meant to be used for cleaning up after
@@ -360,7 +364,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:end_per_group-2"><c>end_per_group/2</c></seealso>
+ must also be defined.</p>
<p>This configuration function is called before execution of a
test case group. It typically contains initializations that are
@@ -396,7 +402,9 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined, then <seealso
+ marker="#Module:init_per_group-2"><c>init_per_group/2</c></seealso>
+ must also be defined.</p>
<p>This function is called after the execution of a test case group
is finished. It is meant to be used for cleaning up after
@@ -427,7 +435,10 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined,
+ then <seealso marker="#Module:end_per_testcase-2">
+ <c>end_per_testcase/2</c></seealso> must also be
+ defined.</p>
<p>This function is called before each test case. Argument
<c>TestCase</c> is the test case name, and
@@ -454,7 +465,10 @@
</type>
<desc>
- <p>OPTIONAL</p>
+ <p>OPTIONAL; if this function is defined,
+ then <seealso marker="#Module:init_per_testcase-2">
+ <c>init_per_testcase/2</c></seealso> must also be
+ defined.</p>
<p>This function is called after each test case, and can be used
to clean up after
diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml
index c2cf29c530..a085f30262 100644
--- a/lib/common_test/doc/src/ct_hooks.xml
+++ b/lib/common_test/doc/src/ct_hooks.xml
@@ -208,9 +208,10 @@
</func>
<func>
- <name>Module:pre_init_per_group(GroupName, InitData, CTHState) -&gt; Result</name>
+ <name>Module:pre_init_per_group(SuiteName, GroupName, InitData, CTHState) -&gt; Result</name>
<fsummary>Called before init_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>InitData = Config | SkipOrFail</v>
<v>Config = NewConfig = [{Key,Value}]</v>
@@ -231,13 +232,19 @@
but for function
<seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso>
instead.</p>
+
+ <p>If <c>Module:pre_init_per_group/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_init_per_group(GroupName,
+ InitData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:post_init_per_group(GroupName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_init_per_group(SuiteName, GroupName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after init_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -258,13 +265,19 @@
but for function
<seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso>
instead.</p>
+
+ <p>If <c>Module:post_init_per_group/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_init_per_group(GroupName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:pre_init_per_testcase(TestcaseName, InitData, CTHState) -&gt; Result</name>
+ <name>Module:pre_init_per_testcase(SuiteName, TestcaseName, InitData, CTHState) -&gt; Result</name>
<fsummary>Called before init_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
<v>InitData = Config | SkipOrFail</v>
<v>Config = NewConfig = [{Key,Value}]</v>
@@ -286,6 +299,11 @@
<seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso>
instead.</p>
+ <p>If <c>Module:pre_init_per_testcase/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_init_per_testcase(TestcaseName,
+ InitData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
+
<p>CTHs cannot be added here right now. That feature may be added in
a later release, but it would right now break backwards
compatibility.</p>
@@ -293,9 +311,10 @@
</func>
<func>
- <name>Module:post_init_per_testcase(TestcaseName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_init_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after init_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -316,15 +335,21 @@
but for function
<seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso>
instead.</p>
+
+ <p>If <c>Module:post_init_per_testcase/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_init_per_testcase(TestcaseName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:pre_end_per_testcase(TestcaseName, InitData, CTHState) -&gt; Result</name>
+ <name>Module:pre_end_per_testcase(SuiteName, TestcaseName, EndData, CTHState) -&gt; Result</name>
<fsummary>Called before end_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
- <v>InitData = Config</v>
+ <v>EndData = Config</v>
<v>Config = NewConfig = [{Key,Value}]</v>
<v>CTHState = NewCTHState = term()</v>
<v>Result = {NewConfig, NewCTHState}</v>
@@ -345,14 +370,20 @@
<p>This function can not change the result of the test case by returning skip or fail
tuples, but it may insert items in <c>Config</c> that can be read in
- <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/4</c>.</p>
+ <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/5</c>.</p>
+
+ <p>If <c>Module:pre_end_per_testcase/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_end_per_testcase(TestcaseName,
+ EndData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:post_end_per_testcase(TestcaseName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_end_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after end_per_testcase.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestcaseName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -373,13 +404,19 @@
but for function
<seealso marker="common_test#Module:end_per_testcase-2"><c>end_per_testcase</c></seealso>
instead.</p>
+
+ <p>If <c>Module:post_end_per_testcase/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_end_per_testcase(TestcaseName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:pre_end_per_group(GroupName, EndData, CTHState) -&gt; Result</name>
+ <name>Module:pre_end_per_group(SuiteName, GroupName, EndData, CTHState) -&gt; Result</name>
<fsummary>Called before end_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>EndData = Config | SkipOrFail</v>
<v>Config = NewConfig = [{Key,Value}]</v>
@@ -400,13 +437,19 @@
but for function
<seealso marker="common_test#Module:end_per_group-2"><c>end_per_group</c></seealso>
instead.</p>
+
+ <p>If <c>Module:pre_end_per_group/4</c> is not exported, common_test
+ will attempt to call <c>Module:pre_end_per_group(GroupName,
+ EndData, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:post_end_per_group(GroupName, Config, Return, CTHState) -&gt; Result</name>
+ <name>Module:post_end_per_group(SuiteName, GroupName, Config, Return, CTHState) -&gt; Result</name>
<fsummary>Called after end_per_group.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>GroupName = atom()</v>
<v>Config = [{Key,Value}]</v>
<v>Return = NewReturn = Config | SkipOrFail | term()</v>
@@ -427,6 +470,11 @@
but for function
<seealso marker="common_test#Module:end_per_group-2">end_per_group</seealso>
instead.</p>
+
+ <p>If <c>Module:post_end_per_group/5</c> is not exported, common_test
+ will attempt to call <c>Module:post_end_per_group(GroupName,
+ Config, Return, CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
@@ -485,9 +533,10 @@
</func>
<func>
- <name>Module:on_tc_fail(TestName, Reason, CTHState) -&gt; NewCTHState</name>
+ <name>Module:on_tc_fail(SuiteName, TestName, Reason, CTHState) -&gt; NewCTHState</name>
<fsummary>Called after the CTH scope ends.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v>
<v>FuncName = atom()</v>
<v>GroupName = atom()</v>
@@ -505,7 +554,7 @@
<item><p>If <c>init_per_suite</c> fails, this function is called after
<seealso marker="#Module:post_init_per_suite-4"><c>post_init_per_suite</c></seealso>.</p></item>
<item><p>If a test case fails, this funcion is called after
- <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item>
+ <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item>
</list>
<p>If the failed test case belongs to a test case group, the first
@@ -519,13 +568,19 @@
For details, see section
<seealso marker="event_handler_chapter#events">Event Handling</seealso>
in the User's Guide.</p>
+
+ <p>If <c>Module:on_tc_fail/4</c> is not exported, common_test
+ will attempt to call <c>Module:on_tc_fail(TestName, Reason,
+ CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
<func>
- <name>Module:on_tc_skip(TestName, Reason, CTHState) -&gt; NewCTHState</name>
+ <name>Module:on_tc_skip(SuiteName, TestName, Reason, CTHState) -&gt; NewCTHState</name>
<fsummary>Called after the CTH scope ends.</fsummary>
<type>
+ <v>SuiteName = atom()</v>
<v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v>
<v>FuncName = atom()</v>
<v>GroupName = atom()</v>
@@ -542,9 +597,9 @@
<list type="bulleted">
<item><p>If <c>init_per_group</c> is skipped, this function is
called after
- <seealso marker="#Module:post_init_per_group-4"><c>post_init_per_group</c></seealso>.</p></item>
+ <seealso marker="#Module:post_init_per_group-5"><c>post_init_per_group</c></seealso>.</p></item>
<item><p>If a test case is skipped, this function is called after
- <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item>
+ <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item>
</list>
<p>If the skipped test case belongs to a test case group, the first
@@ -559,6 +614,11 @@
For details, see section
<seealso marker="event_handler_chapter#events">Event Handling</seealso>
in the User's Guide.</p>
+
+ <p>If <c>Module:on_tc_skip/4</c> is not exported, common_test
+ will attempt to call <c>Module:on_tc_skip(TestName, Reason,
+ CTHState)</c> instead. This is for backwards
+ compatibility.</p>
</desc>
</func>
diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml
index 0e4c35e11f..bfad96e489 100644
--- a/lib/common_test/doc/src/ct_hooks_chapter.xml
+++ b/lib/common_test/doc/src/ct_hooks_chapter.xml
@@ -38,7 +38,7 @@
extensions of the default behavior of <c>Common Test</c> using hooks
before and after all test suite calls. CTHs allow advanced <c>Common Test</c>
users to abstract out behavior that is common to multiple test suites
- without littering all test suites with library calls. this can be used
+ without littering all test suites with library calls. This can be used
for logging, starting, and monitoring external systems,
building C files needed by the tests, and so on.</p>
@@ -175,10 +175,10 @@
<row>
<cell><seealso marker="common_test#Module:init_per_group-2">
init_per_group/2</seealso></cell>
- <cell><seealso marker="ct_hooks#Module:post_init_per_group-4">
- post_init_per_group/4</seealso> is called</cell>
- <cell><seealso marker="ct_hooks#Module:post_end_per_suite-4">
- post_end_per_group/4</seealso> has been called for that group</cell>
+ <cell><seealso marker="ct_hooks#Module:post_init_per_group-5">
+ post_init_per_group/5</seealso> is called</cell>
+ <cell><seealso marker="ct_hooks#Module:post_end_per_group-5">
+ post_end_per_group/5</seealso> has been called for that group</cell>
</row>
<tcaption>Scope of a CTH</tcaption>
</table>
@@ -245,16 +245,18 @@
</list>
<p>
- This is done in the CTH functions called pre_&lt;name of function&gt;.
- These functions take the same three arguments, <c>Name</c>,
+ This is done in the CTH functions called <c>pre_&lt;name of function&gt;</c>.
+ These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable),
<c>Config</c>, and <c>CTHState</c>. The return value of the CTH function
is always a combination of a result for the suite/group/test and an
updated <c>CTHState</c>.</p>
<p>To let the test suite continue on executing, return the configuration
- list that you want the test to use as the result. To skip or
- fail the test, return a tuple with <c>skip</c> or <c>fail</c>, and a reason
- as the result.</p>
+ list that you want the test to use as the result.</p>
+
+ <p>All pre hooks, except <c>pre_end_per_testcase/4</c>, can
+ skip or fail the test by returning a tuple with <c>skip</c> or
+ <c>fail</c>, and a reason as the result.</p>
<p><em>Example:</em></p>
<code>
@@ -290,7 +292,7 @@
<p>
This is done in the CTH functions called <c>post_&lt;name of function&gt;</c>.
- These functions take the same four arguments, <c>Name</c>,
+ These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable),
<c>Config</c>, <c>Return</c>, and <c>CTHState</c>. <c>Config</c> in this
case is the same <c>Config</c> as the testcase is called with.
<c>Return</c> is the value returned by the testcase. If the testcase
@@ -308,7 +310,7 @@
<p><em>Example:</em></p>
<code>
- post_end_per_testcase(_TC, Config, {'EXIT',{_,_}}, CTHState) -&gt;
+ post_end_per_testcase(_Suite, _TC, Config, {'EXIT',{_,_}}, CTHState) -&gt;
case db:check_consistency() of
true ->
%% DB is good, pass the test.
@@ -317,7 +319,7 @@
%% DB is not good, mark as skipped instead of failing
{{skip, "DB is inconsisten!"}, CTHState}
end;
- post_end_per_testcase(_TC, Config, Return, CTHState) -&gt;
+ post_end_per_testcase(_Suite, _TC, Config, Return, CTHState) -&gt;
%% Do nothing if tc does not crash.
{Return, CTHState}.</code>
@@ -331,8 +333,8 @@
<title>Skip and Fail Hooks</title>
<p>
After any post hook has been executed for all installed CTHs,
- <seealso marker="ct_hooks#Module:on_tc_fail-3">on_tc_fail</seealso>
- or <seealso marker="ct_hooks#Module:on_tc_skip-3">on_tc_skip</seealso>
+ <seealso marker="ct_hooks#Module:on_tc_fail-4">on_tc_fail</seealso>
+ or <seealso marker="ct_hooks#Module:on_tc_skip-4">on_tc_skip</seealso>
is called if the testcase failed or was skipped, respectively.
You cannot affect the outcome of the tests any further at this point.
</p>
@@ -389,18 +391,18 @@
-export([pre_end_per_suite/3]).
-export([post_end_per_suite/4]).
- -export([pre_init_per_group/3]).
- -export([post_init_per_group/4]).
- -export([pre_end_per_group/3]).
- -export([post_end_per_group/4]).
+ -export([pre_init_per_group/4]).
+ -export([post_init_per_group/5]).
+ -export([pre_end_per_group/4]).
+ -export([post_end_per_group/5]).
- -export([pre_init_per_testcase/3]).
- -export([post_init_per_testcase/4]).
- -export([pre_end_per_testcase/3]).
- -export([post_end_per_testcase/4]).
+ -export([pre_init_per_testcase/4]).
+ -export([post_init_per_testcase/5]).
+ -export([pre_end_per_testcase/4]).
+ -export([post_end_per_testcase/5]).
- -export([on_tc_fail/3]).
- -export([on_tc_skip/3]).
+ -export([on_tc_fail/4]).
+ -export([on_tc_skip/4]).
-export([terminate/1]).
@@ -435,46 +437,46 @@
total = State#state.total + State#state.suite_total } }.
%% @doc Called before each init_per_group.
- pre_init_per_group(Group,Config,State) ->
+ pre_init_per_group(Suite,Group,Config,State) ->
{Config, State}.
%% @doc Called after each init_per_group.
- post_init_per_group(Group,Config,Return,State) ->
+ post_init_per_group(Suite,Group,Config,Return,State) ->
{Return, State}.
%% @doc Called before each end_per_group.
- pre_end_per_group(Group,Config,State) ->
+ pre_end_per_group(Suite,Group,Config,State) ->
{Config, State}.
%% @doc Called after each end_per_group.
- post_end_per_group(Group,Config,Return,State) ->
+ post_end_per_group(Suite,Group,Config,Return,State) ->
{Return, State}.
%% @doc Called before each init_per_testcase.
- pre_init_per_testcase(TC,Config,State) ->
+ pre_init_per_testcase(Suite,TC,Config,State) ->
{Config, State#state{ ts = now(), total = State#state.suite_total + 1 } }.
%% Called after each init_per_testcase (immediately before the test case).
- post_init_per_testcase(TC,Config,Return,State) ->
+ post_init_per_testcase(Suite,TC,Config,Return,State) ->
{Return, State}
%% @doc Called before each end_per_testcase (immediately after the test case).
- pre_end_per_testcase(TC,Config,State) ->
+ pre_end_per_testcase(Suite,TC,Config,State) ->
{Config, State}.
%% @doc Called after each end_per_testcase.
- post_end_per_testcase(TC,Config,Return,State) ->
- TCInfo = {testcase, TC, Return, timer:now_diff(now(), State#state.ts)},
+ post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ TCInfo = {testcase, Suite, TC, Return, timer:now_diff(now(), State#state.ts)},
{Return, State#state{ ts = undefined, tcs = [TCInfo | State#state.tcs] } }.
%% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group,
%% post_end_per_group and post_end_per_testcase if the suite, group or test case failed.
- on_tc_fail(TC, Reason, State) ->
+ on_tc_fail(Suite, TC, Reason, State) ->
State.
%% @doc Called when a test case is skipped by either user action
%% or due to an init function failing.
- on_tc_skip(TC, Reason, State) ->
+ on_tc_skip(Suite, TC, Reason, State) ->
State.
%% @doc Called when the scope of the CTH is done
diff --git a/lib/common_test/doc/src/ct_testspec.xml b/lib/common_test/doc/src/ct_testspec.xml
new file mode 100644
index 0000000000..36893f66cf
--- /dev/null
+++ b/lib/common_test/doc/src/ct_testspec.xml
@@ -0,0 +1,84 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2016</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>ct_testspec</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>ct_testspec.xml</file>
+ </header>
+ <module>ct_testspec</module>
+ <modulesummary>Parsing of test specifications for Common Test.
+ </modulesummary>
+
+<description>
+
+ <p>Parsing of test specifications for <c>Common Test</c>.</p>
+
+ <p>This module exports help functions for parsing of test specifications.</p>
+
+</description>
+
+ <funcs>
+ <func>
+ <name>get_tests(SpecsIn) -&gt; {ok, [{Specs,Tests}]} | {error, Reason}</name>
+ <fsummary>Parse the given test specification files and return the tests to run and skip.</fsummary>
+ <type>
+ <v>SpecsIn = [string()] | [[string()]]</v>
+ <v>Specs = [string()]</v>
+ <v>Test = [{Node,Run,Skip}]</v>
+ <v>Node = atom()</v>
+ <v>Run = {Dir,Suites,Cases}</v>
+ <v>Skip = {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment}</v>
+ <v>Dir = string()</v>
+ <v>Suites = atom | [atom()] | all</v>
+ <v>Cases = atom | [atom()] | all</v>
+ <v>Comment = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc><marker id="add_nodes-1"/>
+ <p>Parse the given test specification files and return the
+ tests to run and skip.</p>
+
+ <p>If <c>SpecsIn=[Spec1,Spec2,...]</c>, separate tests will be
+ created per specification. If
+ <c>SpecsIn=[[Spec1,Spec2,...]]</c>, all specifications will be
+ merge into one test.</p>
+
+ <p>For each test, a <c>{Specs,Tests}</c> element is returned,
+ where <c>Specs</c> is a list of all included test
+ specifications, and <c>Tests</c> specifies actual tests to
+ run/skip per node.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml
index d1567e2d3c..1ac20db5c2 100644
--- a/lib/common_test/doc/src/ref_man.xml
+++ b/lib/common_test/doc/src/ref_man.xml
@@ -47,6 +47,7 @@
<xi:include href="ct_slave.xml"/>
<xi:include href="ct_hooks.xml"/>
<xi:include href="ct_property_test.xml"/>
+ <xi:include href="ct_testspec.xml"/>
</application>
diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml
index f70bdb16c5..6a0d87bcaf 100644
--- a/lib/common_test/doc/src/write_test_chapter.xml
+++ b/lib/common_test/doc/src/write_test_chapter.xml
@@ -566,7 +566,7 @@
for the test cases in the group. After execution of the group is finished, function
<seealso marker="common_test#Module:end_per_group-2"><c>end_per_group(GroupName, Config)</c></seealso>
is called. This function is meant to be used for cleaning up after
- <c>init_per_group/2</c>.</p>
+ <c>init_per_group/2</c>. If the init function is defined, so must the end function be.</p>
<p>Whenever a group is executed, if <c>init_per_group</c> and
<c>end_per_group</c> do not exist in the suite, <c>Common Test</c> calls
diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src
index 77588af59b..dfa321c901 100644
--- a/lib/common_test/src/common_test.app.src
+++ b/lib/common_test/src/common_test.app.src
@@ -22,6 +22,7 @@
{vsn, "%VSN%"},
{modules, [ct_cover,
ct,
+ ct_default_gl,
ct_event,
ct_framework,
ct_ftp,
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 291a4d716c..43f1c9de0f 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -52,6 +52,10 @@
%%%
%%% @doc Test server framework callback, called by the test_server
%%% when a new test case is started.
+init_tc(_,{end_per_testcase_not_run,_},[Config]) ->
+ %% Testcase is completed (skipped or failed), but end_per_testcase
+ %% is not run - don't call pre-hook.
+ {ok,[Config]};
init_tc(Mod,EPTC={end_per_testcase,_},[Config]) ->
%% in case Mod == ct_framework, lookup the suite name
Suite = get_suite_name(Mod, Config),
@@ -62,7 +66,7 @@ init_tc(Mod,EPTC={end_per_testcase,_},[Config]) ->
Other
end;
-init_tc(Mod,Func0,Args) ->
+init_tc(Mod,Func0,Args) ->
%% in case Mod == ct_framework, lookup the suite name
Suite = get_suite_name(Mod, Args),
{Func,HookFunc} = case Func0 of
@@ -84,12 +88,15 @@ init_tc(Mod,Func0,Args) ->
andalso Func=/=end_per_group
andalso ct_util:get_testdata(skip_rest) of
true ->
+ initialize(false,Mod,Func,Args),
{auto_skip,"Repeated test stopped by force_stop option"};
_ ->
case ct_util:get_testdata(curr_tc) of
{Suite,{suite0_failed,{require,Reason}}} ->
+ initialize(false,Mod,Func,Args),
{auto_skip,{require_failed_in_suite0,Reason}};
{Suite,{suite0_failed,_}=Failure} ->
+ initialize(false,Mod,Func,Args),
{fail,Failure};
_ ->
ct_util:update_testdata(curr_tc,
@@ -118,16 +125,14 @@ init_tc(Mod,Func0,Args) ->
end,
init_tc1(Mod,Suite,Func,HookFunc,Args);
{failed,Seq,BadFunc} ->
- {auto_skip,{sequence_failed,Seq,BadFunc}}
+ initialize(false,Mod,Func,Args),
+ {auto_skip,{sequence_failed,Seq,BadFunc}}
end
end
end.
init_tc1(?MODULE,_,error_in_suite,_,[Config0]) when is_list(Config0) ->
- ct_logs:init_tc(false),
- ct_event:notify(#event{name=tc_start,
- node=node(),
- data={?MODULE,error_in_suite}}),
+ initialize(false,?MODULE,error_in_suite),
_ = ct_suite_init(?MODULE,error_in_suite,[],Config0),
case ?val(error,Config0) of
undefined ->
@@ -177,27 +182,21 @@ init_tc1(Mod,Suite,Func,HookFunc,[Config0]) when is_list(Config0) ->
ct_config:delete_default_config(testcase),
HookFunc
end,
- Initialize = fun() ->
- ct_logs:init_tc(false),
- ct_event:notify(#event{name=tc_start,
- node=node(),
- data={Mod,FuncSpec}})
- end,
case add_defaults(Mod,Func,AllGroups) of
Error = {suite0_failed,_} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
ct_util:set_testdata({curr_tc,{Suite,Error}}),
{error,Error};
Error = {group0_failed,_} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
{auto_skip,Error};
Error = {testcase0_failed,_} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
{auto_skip,Error};
{SuiteInfo,MergeResult} ->
case MergeResult of
{error,Reason} ->
- Initialize(),
+ initialize(false,Mod,FuncSpec),
{fail,Reason};
_ ->
init_tc2(Mod,Suite,Func,HookFunc1,
@@ -236,11 +235,8 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) ->
Conns ->
ct_util:silence_connections(Conns)
end,
- ct_logs:init_tc(Func == init_per_suite),
FuncSpec = group_or_func(Func,Config),
- ct_event:notify(#event{name=tc_start,
- node=node(),
- data={Mod,FuncSpec}}),
+ initialize((Func==init_per_suite),Mod,FuncSpec),
case catch configure(MergedInfo,MergedInfo,SuiteInfo,
FuncSpec,[],Config) of
@@ -268,6 +264,18 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) ->
end
end.
+initialize(RefreshLogs,Mod,Func,[Config]) when is_list(Config) ->
+ initialize(RefreshLogs,Mod,group_or_func(Func,Config));
+initialize(RefreshLogs,Mod,Func,_) ->
+ initialize(RefreshLogs,Mod,Func).
+
+initialize(RefreshLogs,Mod,FuncSpec) ->
+ ct_logs:init_tc(RefreshLogs),
+ ct_event:notify(#event{name=tc_start,
+ node=node(),
+ data={Mod,FuncSpec}}).
+
+
ct_suite_init(Suite,HookFunc,PostInitHook,Config) when is_list(Config) ->
case ct_hooks:init_tc(Suite,HookFunc,Config) of
NewConfig when is_list(NewConfig) ->
@@ -675,22 +683,35 @@ end_tc(Mod,Func,{Result,[Args]}, Return) ->
end_tc(Mod,Func,self(),Result,Args,Return).
end_tc(Mod,IPTC={init_per_testcase,_Func},_TCPid,Result,Args,Return) ->
- %% in case Mod == ct_framework, lookup the suite name
- Suite = get_suite_name(Mod, Args),
- case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of
- '$ct_no_change' ->
- ok;
- HookResult ->
- HookResult
+ case end_hook_func(IPTC,Return,IPTC) of
+ undefined -> ok;
+ _ ->
+ %% in case Mod == ct_framework, lookup the suite name
+ Suite = get_suite_name(Mod, Args),
+ case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of
+ '$ct_no_change' ->
+ ok;
+ HookResult ->
+ HookResult
+ end
end;
end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
%% in case Mod == ct_framework, lookup the suite name
Suite = get_suite_name(Mod, Args),
- {EPTC,Func} = case Func0 of
- {end_per_testcase,F} -> {true,F};
- _ -> {false,Func0}
- end,
+ {Func,FuncSpec,HookFunc} =
+ case Func0 of
+ {end_per_testcase_not_run,F} ->
+ %% Testcase is completed (skipped or failed), but
+ %% end_per_testcase is not run - don't call post-hook.
+ {F,F,undefined};
+ {end_per_testcase,F} ->
+ {F,F,Func0};
+ _ ->
+ FS = group_or_func(Func0,Args),
+ HF = end_hook_func(Func0,Return,FS),
+ {Func0,FS,HF}
+ end,
test_server:timetrap_cancel(),
@@ -717,20 +738,18 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
end,
ct_util:delete_suite_data(last_saved_config),
- {FuncSpec,HookFunc} =
- if not EPTC ->
- FS = group_or_func(Func,Args),
- {FS,FS};
- true ->
- {Func,Func0}
- end,
{Result1,FinalNotify} =
- case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of
- '$ct_no_change' ->
- {ok,Result};
- HookResult ->
- {HookResult,HookResult}
- end,
+ case HookFunc of
+ undefined ->
+ {ok,Result};
+ _ ->
+ case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of
+ '$ct_no_change' ->
+ {ok,Result};
+ HookResult ->
+ {HookResult,HookResult}
+ end
+ end,
FinalResult =
case get('$test_server_framework_test') of
undefined ->
@@ -821,6 +840,34 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) ->
end,
FinalResult.
+%% This is to make sure that no post_init_per_* is ever called if the
+%% corresponding pre_init_per_* was not called.
+%% The skip or fail reasons are those that can be returned from
+%% init_tc above in situations where we never came to call
+%% ct_hooks:init_tc/3, e.g. if suite/0 fails, then we never call
+%% ct_hooks:init_tc for init_per_suite, and thus we must not call
+%% ct_hooks:end_tc for init_per_suite either.
+end_hook_func({init_per_testcase,_},{auto_skip,{sequence_failed,_,_}},_) ->
+ undefined;
+end_hook_func({init_per_testcase,_},{auto_skip,"Repeated test stopped by force_stop option"},_) ->
+ undefined;
+end_hook_func({init_per_testcase,_},{fail,{config_name_already_in_use,_}},_) ->
+ undefined;
+end_hook_func({init_per_testcase,_},{auto_skip,{InfoFuncError,_}},_)
+ when InfoFuncError==testcase0_failed;
+ InfoFuncError==require_failed ->
+ undefined;
+end_hook_func(init_per_group,{auto_skip,{InfoFuncError,_}},_)
+ when InfoFuncError==group0_failed;
+ InfoFuncError==require_failed ->
+ undefined;
+end_hook_func(init_per_suite,{auto_skip,{require_failed_in_suite0,_}},_) ->
+ undefined;
+end_hook_func(init_per_suite,{auto_skip,{failed,{error,{suite0_failed,_}}}},_) ->
+ undefined;
+end_hook_func(_,_,Default) ->
+ Default.
+
%% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} |
%% {testcase_aborted,Reason} | testcase_aborted_or_killed |
%% {'EXIT',Reason} | {fail,Reason} | {failed,Reason} |
@@ -1339,25 +1386,25 @@ report(What,Data) ->
ok;
tc_done ->
{Suite,{Func,GrName},Result} = Data,
- Data1 = if GrName == undefined -> {Suite,Func,Result};
- true -> Data
- end,
+ FuncSpec = if GrName == undefined -> Func;
+ true -> {Func,GrName}
+ end,
%% Register the group leader for the process calling the report
%% function, making it possible for a hook function to print
%% in the test case log file
ReportingPid = self(),
ct_logs:register_groupleader(ReportingPid, group_leader()),
case Result of
- {failed, _} ->
- ct_hooks:on_tc_fail(What, Data1);
- {skipped,{failed,{_,init_per_testcase,_}}} ->
- ct_hooks:on_tc_skip(tc_auto_skip, Data1);
- {skipped,{require_failed,_}} ->
- ct_hooks:on_tc_skip(tc_auto_skip, Data1);
- {skipped,_} ->
- ct_hooks:on_tc_skip(tc_user_skip, Data1);
- {auto_skipped,_} ->
- ct_hooks:on_tc_skip(tc_auto_skip, Data1);
+ {failed, Reason} ->
+ ct_hooks:on_tc_fail(What, {Suite,FuncSpec,Reason});
+ {skipped,{failed,{_,init_per_testcase,_}}=Reason} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason});
+ {skipped,{require_failed,_}=Reason} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason});
+ {skipped,Reason} ->
+ ct_hooks:on_tc_skip(tc_user_skip, {Suite,FuncSpec,Reason});
+ {auto_skipped,Reason} ->
+ ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason});
_Else ->
ok
end,
diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl
index 1375e7dcc7..1c9faf6a70 100644
--- a/lib/common_test/src/ct_groups.erl
+++ b/lib/common_test/src/ct_groups.erl
@@ -442,17 +442,21 @@ make_conf(Mod, Name, Props, TestSpec) ->
ok
end,
{InitConf,EndConf,ExtraProps} =
- case erlang:function_exported(Mod,init_per_group,2) of
- true ->
- {{Mod,init_per_group},{Mod,end_per_group},[]};
- false ->
+ case {erlang:function_exported(Mod,init_per_group,2),
+ erlang:function_exported(Mod,end_per_group,2)} of
+ {false,false} ->
ct_logs:log("TEST INFO", "init_per_group/2 and "
"end_per_group/2 missing for group "
"~w in ~w, using default.",
[Name,Mod]),
{{ct_framework,init_per_group},
{ct_framework,end_per_group},
- [{suite,Mod}]}
+ [{suite,Mod}]};
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ {{Mod,init_per_group},{Mod,end_per_group},[]}
end,
{conf,[{name,Name}|Props++ExtraProps],InitConf,TestSpec,EndConf}.
diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl
index c9a4abb5ee..60d1ea2b1c 100644
--- a/lib/common_test/src/ct_hooks.erl
+++ b/lib/common_test/src/ct_hooks.erl
@@ -92,15 +92,17 @@ init_tc(Mod, end_per_suite, Config) ->
call(fun call_generic/3, Config, [pre_end_per_suite, Mod]);
init_tc(Mod, {init_per_group, GroupName, Properties}, Config) ->
maybe_start_locker(Mod, GroupName, Properties),
- call(fun call_generic/3, Config, [pre_init_per_group, GroupName]);
-init_tc(_Mod, {end_per_group, GroupName, _}, Config) ->
- call(fun call_generic/3, Config, [pre_end_per_group, GroupName]);
-init_tc(_Mod, {init_per_testcase,TC}, Config) ->
- call(fun call_generic/3, Config, [pre_init_per_testcase, TC]);
-init_tc(_Mod, {end_per_testcase,TC}, Config) ->
- call(fun call_generic/3, Config, [pre_end_per_testcase, TC]);
-init_tc(_Mod, TC = error_in_suite, Config) ->
- call(fun call_generic/3, Config, [pre_init_per_testcase, TC]).
+ call(fun call_generic_fallback/3, Config,
+ [pre_init_per_group, Mod, GroupName]);
+init_tc(Mod, {end_per_group, GroupName, _}, Config) ->
+ call(fun call_generic_fallback/3, Config,
+ [pre_end_per_group, Mod, GroupName]);
+init_tc(Mod, {init_per_testcase,TC}, Config) ->
+ call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]);
+init_tc(Mod, {end_per_testcase,TC}, Config) ->
+ call(fun call_generic_fallback/3, Config, [pre_end_per_testcase, Mod, TC]);
+init_tc(Mod, TC = error_in_suite, Config) ->
+ call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]).
%% @doc Called as each test case is completed. This includes all configuration
%% tests.
@@ -126,23 +128,23 @@ end_tc(Mod, init_per_suite, Config, _Result, Return) ->
end_tc(Mod, end_per_suite, Config, Result, _Return) ->
call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config],
'$ct_no_change');
-end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) ->
- call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config],
- '$ct_no_change');
+end_tc(Mod, {init_per_group, GroupName, _}, Config, _Result, Return) ->
+ call(fun call_generic_fallback/3, Return,
+ [post_init_per_group, Mod, GroupName, Config], '$ct_no_change');
end_tc(Mod, {end_per_group, GroupName, Properties}, Config, Result, _Return) ->
- Res = call(fun call_generic/3, Result,
- [post_end_per_group, GroupName, Config], '$ct_no_change'),
+ Res = call(fun call_generic_fallback/3, Result,
+ [post_end_per_group, Mod, GroupName, Config], '$ct_no_change'),
maybe_stop_locker(Mod, GroupName, Properties),
Res;
-end_tc(_Mod, {init_per_testcase,TC}, Config, Result, _Return) ->
- call(fun call_generic/3, Result, [post_init_per_testcase, TC, Config],
- '$ct_no_change');
-end_tc(_Mod, {end_per_testcase,TC}, Config, Result, _Return) ->
- call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config],
- '$ct_no_change');
-end_tc(_Mod, TC = error_in_suite, Config, Result, _Return) ->
- call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config],
- '$ct_no_change').
+end_tc(Mod, {init_per_testcase,TC}, Config, Result, _Return) ->
+ call(fun call_generic_fallback/3, Result,
+ [post_init_per_testcase, Mod, TC, Config], '$ct_no_change');
+end_tc(Mod, {end_per_testcase,TC}, Config, Result, _Return) ->
+ call(fun call_generic_fallback/3, Result,
+ [post_end_per_testcase, Mod, TC, Config], '$ct_no_change');
+end_tc(Mod, TC = error_in_suite, Config, Result, _Return) ->
+ call(fun call_generic_fallback/3, Result,
+ [post_end_per_testcase, Mod, TC, Config], '$ct_no_change').
%% Case = TestCase | {TestCase,GroupName}
@@ -181,15 +183,21 @@ call_terminate(#ct_hook_config{ module = Mod, state = State} = Hook, _, _) ->
{[],Hook}.
call_cleanup(#ct_hook_config{ module = Mod, state = State} = Hook,
- Reason, [Function, _Suite | Args]) ->
+ Reason, [Function | Args]) ->
NewState = catch_apply(Mod,Function, Args ++ [Reason, State],
- State),
+ State, true),
{Reason, Hook#ct_hook_config{ state = NewState } }.
-call_generic(#ct_hook_config{ module = Mod, state = State} = Hook,
- Value, [Function | Args]) ->
+call_generic(Hook, Value, Meta) ->
+ do_call_generic(Hook, Value, Meta, false).
+
+call_generic_fallback(Hook, Value, Meta) ->
+ do_call_generic(Hook, Value, Meta, true).
+
+do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook,
+ Value, [Function | Args], Fallback) ->
{NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State],
- {Value,State}),
+ {Value,State}, Fallback),
{NewValue, Hook#ct_hook_config{ state = NewState } }.
%% Generic call function
@@ -257,15 +265,15 @@ remove(Key,List) when is_list(List) ->
remove(_, Else) ->
Else.
-%% Translate scopes, i.e. init_per_group,group1 -> end_per_group,group1 etc
-scope([pre_init_per_testcase, TC|_]) ->
- [post_init_per_testcase, TC];
-scope([pre_end_per_testcase, TC|_]) ->
- [post_end_per_testcase, TC];
-scope([pre_init_per_group, GroupName|_]) ->
- [post_end_per_group, GroupName];
-scope([post_init_per_group, GroupName|_]) ->
- [post_end_per_group, GroupName];
+%% Translate scopes, i.e. is_tuplenit_per_group,group1 -> end_per_group,group1 etc
+scope([pre_init_per_testcase, SuiteName, TC|_]) ->
+ [post_init_per_testcase, SuiteName, TC];
+scope([pre_end_per_testcase, SuiteName, TC|_]) ->
+ [post_end_per_testcase, SuiteName, TC];
+scope([pre_init_per_group, SuiteName, GroupName|_]) ->
+ [post_end_per_group, SuiteName, GroupName];
+scope([post_init_per_group, SuiteName, GroupName|_]) ->
+ [post_end_per_group, SuiteName, GroupName];
scope([pre_init_per_suite, SuiteName|_]) ->
[post_end_per_suite, SuiteName];
scope([post_init_per_suite, SuiteName|_]) ->
@@ -273,14 +281,29 @@ scope([post_init_per_suite, SuiteName|_]) ->
scope(init) ->
none.
-terminate_if_scope_ends(HookId, [on_tc_skip,_Suite,{end_per_group,Name}],
+strip_config([post_init_per_testcase, SuiteName, TC|_]) ->
+ [post_init_per_testcase, SuiteName, TC];
+strip_config([post_end_per_testcase, SuiteName, TC|_]) ->
+ [post_end_per_testcase, SuiteName, TC];
+strip_config([post_init_per_group, SuiteName, GroupName|_]) ->
+ [post_init_per_group, SuiteName, GroupName];
+strip_config([post_end_per_group, SuiteName, GroupName|_]) ->
+ [post_end_per_group, SuiteName, GroupName];
+strip_config([post_init_per_suite, SuiteName|_]) ->
+ [post_init_per_suite, SuiteName];
+strip_config([post_end_per_suite, SuiteName|_]) ->
+ [post_end_per_suite, SuiteName];
+strip_config(Other) ->
+ Other.
+
+
+terminate_if_scope_ends(HookId, [on_tc_skip,Suite,{end_per_group,Name}],
Hooks) ->
- terminate_if_scope_ends(HookId, [post_end_per_group, Name], Hooks);
+ terminate_if_scope_ends(HookId, [post_end_per_group, Suite, Name], Hooks);
terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) ->
terminate_if_scope_ends(HookId, [post_end_per_suite, Suite], Hooks);
-terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] ->
- terminate_if_scope_ends(HookId,[Function,Tag],Hooks);
-terminate_if_scope_ends(HookId, Function, Hooks) ->
+terminate_if_scope_ends(HookId, Function0, Hooks) ->
+ Function = strip_config(Function0),
case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of
#ct_hook_config{ id = HookId, scope = Function} = Hook ->
terminate([Hook]),
@@ -384,21 +407,29 @@ pos(Id,[_|Rest],Num) ->
catch_apply(M,F,A, Default) ->
+ catch_apply(M,F,A,Default,false).
+catch_apply(M,F,A, Default, Fallback) ->
+ not erlang:module_loaded(M) andalso (catch M:module_info()),
+ case erlang:function_exported(M,F,length(A)) of
+ false when Fallback ->
+ catch_apply(M,F,tl(A),Default,false);
+ false ->
+ Default;
+ true ->
+ catch_apply(M,F,A)
+ end.
+
+catch_apply(M,F,A) ->
try
- erlang:apply(M,F,A)
+ erlang:apply(M,F,A)
catch _:Reason ->
- case erlang:get_stacktrace() of
- %% Return the default if it was the CTH module which did not have the function.
- [{M,F,A,_}|_] when Reason == undef ->
- Default;
- Trace ->
- ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p",
- [error,{Reason,Trace}]),
- throw({error_in_cth_call,
- lists:flatten(
- io_lib:format("~w:~w/~w CTH call failed",
- [M,F,length(A)]))})
- end
+ Trace = erlang:get_stacktrace(),
+ ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p",
+ [error,{Reason,Trace}]),
+ throw({error_in_cth_call,
+ lists:flatten(
+ io_lib:format("~w:~w/~w CTH call failed",
+ [M,F,length(A)]))})
end.
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index a049ef5695..cac176de3a 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -76,8 +76,8 @@
abort_if_missing_suites,
silent_connections = [],
stylesheet,
- multiply_timetraps = 1,
- scale_timetraps = false,
+ multiply_timetraps,
+ scale_timetraps,
create_priv_dir,
testspec_files = [],
current_testspec,
@@ -264,11 +264,11 @@ script_start1(Parent, Args) ->
[], Args),
Verbosity = verbosity_args2opts(Args),
MultTT = get_start_opt(multiply_timetraps,
- fun([MT]) -> list_to_integer(MT) end, 1, Args),
+ fun([MT]) -> list_to_integer(MT) end, Args),
ScaleTT = get_start_opt(scale_timetraps,
fun([CT]) -> list_to_atom(CT);
([]) -> true
- end, false, Args),
+ end, Args),
CreatePrivDir = get_start_opt(create_priv_dir,
fun([PD]) -> list_to_atom(PD);
([]) -> auto_per_tc
@@ -1055,8 +1055,8 @@ run_test2(StartOpts) ->
CoverStop = get_start_opt(cover_stop, value, StartOpts),
%% timetrap manipulation
- MultiplyTT = get_start_opt(multiply_timetraps, value, 1, StartOpts),
- ScaleTT = get_start_opt(scale_timetraps, value, false, StartOpts),
+ MultiplyTT = get_start_opt(multiply_timetraps, value, StartOpts),
+ ScaleTT = get_start_opt(scale_timetraps, value, StartOpts),
%% create unique priv dir names
CreatePrivDir = get_start_opt(create_priv_dir, value, StartOpts),
@@ -2280,8 +2280,19 @@ do_run_test(Tests, Skip, Opts0) ->
_Lower ->
ok
end,
- test_server_ctrl:multiply_timetraps(Opts0#opts.multiply_timetraps),
- test_server_ctrl:scale_timetraps(Opts0#opts.scale_timetraps),
+
+ case Opts0#opts.multiply_timetraps of
+ undefined -> MultTT = 1;
+ MultTT -> MultTT
+ end,
+ case Opts0#opts.scale_timetraps of
+ undefined -> ScaleTT = false;
+ ScaleTT -> ScaleTT
+ end,
+ ct_logs:log("TEST INFO","Timetrap time multiplier = ~w~n"
+ "Timetrap scaling enabled = ~w", [MultTT,ScaleTT]),
+ test_server_ctrl:multiply_timetraps(MultTT),
+ test_server_ctrl:scale_timetraps(ScaleTT),
test_server_ctrl:create_priv_dir(choose_val(
Opts0#opts.create_priv_dir,
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl
index 991abb0666..466a2c7658 100644
--- a/lib/common_test/src/ct_testspec.erl
+++ b/lib/common_test/src/ct_testspec.erl
@@ -26,7 +26,8 @@
-export([prepare_tests/1, prepare_tests/2,
collect_tests_from_list/2, collect_tests_from_list/3,
- collect_tests_from_file/2, collect_tests_from_file/3]).
+ collect_tests_from_file/2, collect_tests_from_file/3,
+ get_tests/1]).
-export([testspec_rec2list/1, testspec_rec2list/2]).
@@ -803,6 +804,31 @@ list_nodes(#testspec{nodes=NodeRefs}) ->
lists:map(fun({_Ref,Node}) -> Node end, NodeRefs).
+%%%-----------------------------------------------------------------
+%%% Parse the given test specs and return the complete set of specs
+%%% and tests to run/skip.
+%%% [Spec1,Spec2,...] means create separate tests per spec
+%%% [[Spec1,Spec2,...]] means merge all specs into one
+-spec get_tests(Specs) -> {ok,[{Specs,Tests}]} | {error,Reason} when
+ Specs :: [string()] | [[string()]],
+ Tests :: {Node,Run,Skip},
+ Node :: atom(),
+ Run :: {Dir,Suites,Cases},
+ Skip :: {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment},
+ Dir :: string(),
+ Suites :: atom | [atom()] | all,
+ Cases :: atom | [atom()] | all,
+ Comment :: string(),
+ Reason :: term().
+
+get_tests(Specs) ->
+ case collect_tests_from_file(Specs,true) of
+ Tests when is_list(Tests) ->
+ {ok,[{S,prepare_tests(R)} || {S,R} <- Tests]};
+ Error ->
+ Error
+ end.
+
%% -----------------------------------------------------
%% / \
%% | When adding test/config terms, remember to update |
@@ -1132,6 +1158,11 @@ handle_data(verbosity,Node,VLvls,_Spec) when is_list(VLvls) ->
VLvls1 = lists:map(fun(VLvl = {_Cat,_Lvl}) -> VLvl;
(Lvl) -> {'$unspecified',Lvl} end, VLvls),
[{Node,VLvls1}];
+handle_data(multiply_timetraps,Node,Mult,_Spec) when is_integer(Mult) ->
+ [{Node,Mult}];
+handle_data(scale_timetraps,Node,Scale,_Spec) when Scale == true;
+ Scale == false ->
+ [{Node,Scale}];
handle_data(silent_connections,Node,all,_Spec) ->
[{Node,[all]}];
handle_data(silent_connections,Node,Conn,_Spec) when is_atom(Conn) ->
@@ -1150,6 +1181,8 @@ should_be_added(Tag,Node,_Data,Spec) ->
Tag == label; Tag == auto_compile;
Tag == abort_if_missing_suites;
Tag == stylesheet; Tag == verbosity;
+ Tag == multiply_timetraps;
+ Tag == scale_timetraps;
Tag == silent_connections ->
lists:keymember(ref2node(Node,Spec#testspec.nodes),1,
read_field(Spec,Tag)) == false;
diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl
index 883da0da0a..ce8852b3ea 100644
--- a/lib/common_test/src/cth_conn_log.erl
+++ b/lib/common_test/src/cth_conn_log.erl
@@ -54,8 +54,8 @@
-include_lib("common_test/include/ct.hrl").
-export([init/2,
- pre_init_per_testcase/3,
- post_end_per_testcase/4]).
+ pre_init_per_testcase/4,
+ post_end_per_testcase/5]).
%%----------------------------------------------------------------------
%% Exported types
@@ -104,7 +104,7 @@ get_log_opts(Mod,Opts) ->
Hosts = proplists:get_value(hosts,Opts,[]),
{LogType,Hosts}.
-pre_init_per_testcase(TestCase,Config,CthState) ->
+pre_init_per_testcase(_Suite,TestCase,Config,CthState) ->
Logs =
lists:map(
fun({ConnMod,{LogType,Hosts}}) ->
@@ -158,7 +158,7 @@ pre_init_per_testcase(TestCase,Config,CthState) ->
ct_util:update_testdata(?MODULE, Update, [create]),
{Config,CthState}.
-post_end_per_testcase(TestCase,_Config,Return,CthState) ->
+post_end_per_testcase(_Suite,TestCase,_Config,Return,CthState) ->
Update =
fun(PrevUsers) ->
case lists:delete(TestCase, PrevUsers) of
diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl
index 6d77d7ee9e..eda090d4f5 100644
--- a/lib/common_test/src/cth_log_redirect.erl
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -28,10 +28,10 @@
%% CTH Callbacks
-export([id/1, init/2,
pre_init_per_suite/3, pre_end_per_suite/3, post_end_per_suite/4,
- pre_init_per_group/3, post_init_per_group/4,
- pre_end_per_group/3, post_end_per_group/4,
- pre_init_per_testcase/3, post_init_per_testcase/4,
- pre_end_per_testcase/3, post_end_per_testcase/4]).
+ pre_init_per_group/4, post_init_per_group/5,
+ pre_end_per_group/4, post_end_per_group/5,
+ pre_init_per_testcase/4, post_init_per_testcase/5,
+ pre_end_per_testcase/4, post_end_per_testcase/5]).
%% Event handler Callbacks
-export([init/1,
@@ -71,11 +71,11 @@ post_end_per_suite(_Suite, Config, Return, State) ->
set_curr_func(undefined, Config),
{Return, State}.
-pre_init_per_group(Group, Config, State) ->
+pre_init_per_group(_Suite, Group, Config, State) ->
set_curr_func({group,Group,init_per_group}, Config),
{Config, State}.
-post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) ->
+post_init_per_group(_Suite, Group, Config, Result, tc_log_async) when is_list(Config) ->
case lists:member(parallel,proplists:get_value(
tc_group_properties,Config,[])) of
true ->
@@ -83,33 +83,33 @@ post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) ->
false ->
{Result, tc_log_async}
end;
-post_init_per_group(_Group, _Config, Result, State) ->
+post_init_per_group(_Suite, _Group, _Config, Result, State) ->
{Result, State}.
-pre_init_per_testcase(TC, Config, State) ->
+pre_init_per_testcase(_Suite, TC, Config, State) ->
set_curr_func(TC, Config),
{Config, State}.
-post_init_per_testcase(_TC, _Config, Return, State) ->
+post_init_per_testcase(_Suite, _TC, _Config, Return, State) ->
{Return, State}.
-pre_end_per_testcase(_TC, Config, State) ->
+pre_end_per_testcase(_Suite, _TC, Config, State) ->
{Config, State}.
-post_end_per_testcase(_TC, _Config, Result, State) ->
+post_end_per_testcase(_Suite, _TC, _Config, Result, State) ->
%% Make sure that the event queue is flushed
%% before ending this test case.
gen_event:call(error_logger, ?MODULE, flush, 300000),
{Result, State}.
-pre_end_per_group(Group, Config, {tc_log, Group}) ->
+pre_end_per_group(_Suite, Group, Config, {tc_log, Group}) ->
set_curr_func({group,Group,end_per_group}, Config),
{Config, set_log_func(tc_log_async)};
-pre_end_per_group(Group, Config, State) ->
+pre_end_per_group(_Suite, Group, Config, State) ->
set_curr_func({group,Group,end_per_group}, Config),
{Config, State}.
-post_end_per_group(_Group, Config, Return, State) ->
+post_end_per_group(_Suite, _Group, Config, Return, State) ->
set_curr_func({group,undefined}, Config),
{Return, State}.
diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl
index 59b916851e..c4941948cc 100644
--- a/lib/common_test/src/cth_surefire.erl
+++ b/lib/common_test/src/cth_surefire.erl
@@ -33,16 +33,16 @@
-export([pre_end_per_suite/3]).
-export([post_end_per_suite/4]).
--export([pre_init_per_group/3]).
--export([post_init_per_group/4]).
--export([pre_end_per_group/3]).
--export([post_end_per_group/4]).
+-export([pre_init_per_group/4]).
+-export([post_init_per_group/5]).
+-export([pre_end_per_group/4]).
+-export([post_end_per_group/5]).
--export([pre_init_per_testcase/3]).
--export([post_end_per_testcase/4]).
+-export([pre_init_per_testcase/4]).
+-export([post_end_per_testcase/5]).
--export([on_tc_fail/3]).
--export([on_tc_skip/3]).
+-export([on_tc_fail/4]).
+-export([on_tc_skip/4]).
-export([terminate/1]).
@@ -116,29 +116,29 @@ pre_end_per_suite(_Suite,Config,State) ->
post_end_per_suite(_Suite,Config,Result,State) ->
{Result, end_tc(end_per_suite,Config,Result,State)}.
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(_Suite,Group,Config,State) ->
{Config, init_tc(State#state{ curr_group = [Group|State#state.curr_group]},
Config)}.
-post_init_per_group(_Group,Config,Result,State) ->
+post_init_per_group(_Suite,_Group,Config,Result,State) ->
{Result, end_tc(init_per_group,Config,Result,State)}.
-pre_end_per_group(_Group,Config,State) ->
+pre_end_per_group(_Suite,_Group,Config,State) ->
{Config, init_tc(State, Config)}.
-post_end_per_group(_Group,Config,Result,State) ->
+post_end_per_group(_Suite,_Group,Config,Result,State) ->
NewState = end_tc(end_per_group, Config, Result, State),
{Result, NewState#state{ curr_group = tl(NewState#state.curr_group)}}.
-pre_init_per_testcase(_TC,Config,State) ->
+pre_init_per_testcase(_Suite,_TC,Config,State) ->
{Config, init_tc(State, Config)}.
-post_end_per_testcase(TC,Config,Result,State) ->
+post_end_per_testcase(_Suite,TC,Config,Result,State) ->
{Result, end_tc(TC,Config, Result,State)}.
-on_tc_fail(_TC, _Res, State = #state{test_cases = []}) ->
+on_tc_fail(_Suite,_TC, _Res, State = #state{test_cases = []}) ->
State;
-on_tc_fail(_TC, Res, State) ->
+on_tc_fail(_Suite,_TC, Res, State) ->
TCs = State#state.test_cases,
TC = hd(TCs),
NewTC = TC#testcase{
@@ -146,10 +146,9 @@ on_tc_fail(_TC, Res, State) ->
{fail,lists:flatten(io_lib:format("~p",[Res]))} },
State#state{ test_cases = [NewTC | tl(TCs)]}.
-on_tc_skip({ConfigFunc,_GrName},{Type,_Reason} = Res, State0)
- when Type == tc_auto_skip; Type == tc_user_skip ->
- on_tc_skip(ConfigFunc, Res, State0);
-on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip ->
+on_tc_skip(Suite,{ConfigFunc,_GrName}, Res, State) ->
+ on_tc_skip(Suite,ConfigFunc, Res, State);
+on_tc_skip(Suite,Tc, Res, State0) ->
TcStr = atom_to_list(Tc),
State =
case State0#state.test_cases of
@@ -158,11 +157,7 @@ on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip ->
_ ->
State0
end,
- do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(State,[])));
-on_tc_skip(_Tc, _Res, State = #state{test_cases = []}) ->
- State;
-on_tc_skip(_Tc, Res, State) ->
- do_tc_skip(Res, State).
+ do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(set_suite(Suite,State),[]))).
do_tc_skip(Res, State) ->
TCs = State#state.test_cases,
@@ -209,6 +204,12 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite,
result = passed }|
State#state.test_cases],
tc_log = ""}. % so old tc_log is not set if next is on_tc_skip
+
+set_suite(Suite,#state{curr_suite=undefined}=State) ->
+ State#state{curr_suite=Suite, curr_suite_ts=?now};
+set_suite(_,State) ->
+ State.
+
close_suite(#state{ test_cases = [] } = State) ->
State;
close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) ->
@@ -228,7 +229,8 @@ close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) ->
testcases = lists:reverse(TCs),
log = SuiteLog,
url = SuiteUrl},
- State#state{ test_cases = [],
+ State#state{ curr_suite = undefined,
+ test_cases = [],
test_suites = [Suite | State#state.test_suites]}.
terminate(State = #state{ test_cases = [] }) ->
diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl
index 924086f2bd..be49191f2e 100644
--- a/lib/common_test/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
@@ -778,9 +778,9 @@ spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid,
%% if init_per_testcase fails, the test case
%% should be skipped
try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[CurrConf]}, Why),
- do_init_tc_call(Mod,{end_per_testcase,Func},
+ do_init_tc_call(Mod,{end_per_testcase_not_run,Func},
[CurrConf],{ok,[CurrConf]}),
- do_end_tc_call(Mod,{end_per_testcase,Func},
+ do_end_tc_call(Mod,{end_per_testcase_not_run,Func},
{Pid,Skip,[CurrConf]}, Why) end of
_ -> ok
catch
@@ -1151,14 +1151,14 @@ do_end_tc_call(Mod, IPTC={init_per_testcase,Func}, Res, Return) ->
Args
end,
EPTCInitRes =
- case do_init_tc_call(Mod,{end_per_testcase,Func},
+ case do_init_tc_call(Mod,{end_per_testcase_not_run,Func},
IPTCEndRes,Return) of
{ok,EPTCInitConfig} when is_list(EPTCInitConfig) ->
{Return,EPTCInitConfig};
_ ->
- Return
+ {Return,IPTCEndRes}
end,
- do_end_tc_call1(Mod, {end_per_testcase,Func},
+ do_end_tc_call1(Mod, {end_per_testcase_not_run,Func},
EPTCInitRes, Return);
_Ok ->
do_end_tc_call1(Mod, IPTC, Res, Return)
diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index b52e4bef9b..39c523f8b3 100644
--- a/lib/common_test/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -2051,17 +2051,21 @@ add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
%% we'll add end_per_suite here even if it's not exported
%% (and simply let the call fail if it's missing)
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}];
- false ->
+ case {erlang:function_exported(LastMod, end_per_suite, 1),
+ erlang:function_exported(LastMod, init_per_suite, 1)} of
+ {false,false} ->
%% let's call a "fake" end_per_suite if it exists
case erlang:function_exported(FwMod, end_per_suite, 1) of
true ->
[{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
false ->
[{conf,LastRef,[],{LastMod,end_per_suite}}]
- end
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ [{conf,LastRef,[],{LastMod,end_per_suite}}]
end.
do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
@@ -2070,11 +2074,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
_ -> ok
end,
{Init,NextMod,NextRef} =
- case erlang:function_exported(Mod, init_per_suite, 1) of
- true ->
- Ref = make_ref(),
- {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref};
- false ->
+ case {erlang:function_exported(Mod, init_per_suite, 1),
+ erlang:function_exported(Mod, end_per_suite, 1)} of
+ {false,false} ->
%% let's call a "fake" init_per_suite if it exists
case erlang:function_exported(FwMod, init_per_suite, 1) of
true ->
@@ -2083,8 +2085,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
{FwMod,init_per_suite}}],Mod,Ref};
false ->
{[],Mod,undefined}
- end
-
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ Ref = make_ref(),
+ {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref}
end,
Cases =
if LastRef==undefined ->
@@ -2094,10 +2101,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
true ->
%% we'll add end_per_suite here even if it's not exported
%% (and simply let the call fail if it's missing)
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- [{conf,LastRef,[],{LastMod,end_per_suite}}|Init];
- false ->
+ case {erlang:function_exported(LastMod, end_per_suite, 1),
+ erlang:function_exported(LastMod, init_per_suite, 1)} of
+ {false,false} ->
%% let's call a "fake" end_per_suite if it exists
case erlang:function_exported(FwMod, end_per_suite, 1) of
true ->
@@ -2105,8 +2111,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
{FwMod,end_per_suite}}|Init];
false ->
[{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
- end
- end
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ [{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
+ end
end,
{Cases,NextMod,NextRef}.
@@ -2115,11 +2126,9 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
No when No==undefined ; No==skipped_suite ->
{[],Mod,skipped_suite};
_Ref ->
- case erlang:function_exported(LastMod, end_per_suite, 1) of
- true ->
- {[{conf,LastRef,[],{LastMod,end_per_suite}}],
- Mod,skipped_suite};
- false ->
+ case {erlang:function_exported(LastMod, end_per_suite, 1),
+ erlang:function_exported(LastMod, init_per_suite, 1)} of
+ {false,false} ->
case erlang:function_exported(FwMod, end_per_suite, 1) of
true ->
%% let's call "fake" end_per_suite if it exists
@@ -2128,7 +2137,13 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
false ->
{[{conf,LastRef,[],{LastMod,end_per_suite}}],
Mod,skipped_suite}
- end
+ end;
+ _ ->
+ %% If any of these exist, the other should too
+ %% (required and documented). If it isn't, it will fail
+ %% with reason 'undef'.
+ {[{conf,LastRef,[],{LastMod,end_per_suite}}],
+ Mod,skipped_suite}
end
end.
@@ -2924,22 +2939,21 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status)
exit(framework_error);
%% sequential execution of test case finished
{Time,RetVal,_} ->
+ RetTag =
+ if is_tuple(RetVal) -> element(1,RetVal);
+ true -> undefined
+ end,
{Failed,Status1} =
- case Time of
- died ->
- {true,update_status(failed, Mod, Func, Status)};
- _ when is_tuple(RetVal) ->
- case element(1, RetVal) of
- R when R=='EXIT'; R==failed ->
- {true,update_status(failed, Mod, Func, Status)};
- R when R==skip; R==skipped ->
- {false,update_status(skipped, Mod, Func, Status)};
- _ ->
- {false,update_status(ok, Mod, Func, Status)}
- end;
- _ ->
- {false,update_status(ok, Mod, Func, Status)}
- end,
+ case RetTag of
+ Skip when Skip==skip; Skip==skipped ->
+ {false,update_status(skipped, Mod, Func, Status)};
+ Fail when Fail=='EXIT'; Fail==failed ->
+ {true,update_status(failed, Mod, Func, Status)};
+ _ when Time==died, RetVal=/=ok ->
+ {true,update_status(failed, Mod, Func, Status)};
+ _ ->
+ {false,update_status(ok, Mod, Func, Status)}
+ end,
case check_prop(sequence, Mode) of
false ->
stop_minor_log_file(),
@@ -3794,7 +3808,15 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
{died,{timetrap_timeout,TimetrapTimeout}} ->
progress(failed, Num, Mod, Func, GrName, Loc,
timetrap_timeout, TimetrapTimeout, Comment, Style);
- {died,Reason} ->
+ {died,{Skip,Reason}} when Skip==skip; Skip==skipped ->
+ %% died in init_per_testcase
+ progress(skip, Num, Mod, Func, GrName, Loc, Reason,
+ Time, Comment, Style);
+ {died,Reason} when Reason=/=ok ->
+ %% (If Reason==ok it means that process died in
+ %% end_per_testcase after successfully completing the
+ %% test case itself - then we shall not fail, but a
+ %% warning will be issued in the comment field.)
progress(failed, Num, Mod, Func, GrName, Loc, Reason,
Time, Comment, Style);
{_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped;
@@ -3943,6 +3965,9 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
{ReportTag,Reason1}}]),
+ TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
+ true -> "~w"
+ end, [Time]),
ReasonStr = escape_chars(reason_to_string(Reason1)),
ReasonStr1 = lists:flatten([string:strip(S,left) ||
S <- string:tokens(ReasonStr,[$\n])]),
@@ -3957,10 +3982,10 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
_ -> xhtml("<br>(","<br />(") ++ to_string(Comment) ++ ")"
end,
print(html,
- "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
+ "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
"<td><font color=\"~ts\">SKIPPED</font></td>"
"<td>~ts~ts</td></tr>\n",
- [Time,Color,ReasonStr2,Comment1]),
+ [TimeStr,Color,ReasonStr2,Comment1]),
FormatLoc = test_server_sup:format_loc(Loc),
print(minor, "=== Location: ~ts", [FormatLoc]),
print(minor, "=== Reason: ~ts", [ReasonStr1]),
@@ -4098,6 +4123,9 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
Comment0, {St0,St1}) ->
print(minor, "successfully completed test case", []),
test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]),
+ TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
+ true -> "~w"
+ end, [Time]),
Comment =
case RetVal of
{comment,RetComment} ->
@@ -4116,10 +4144,10 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
end,
print(major, "=elapsed ~p", [Time]),
print(html,
- "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>"
+ "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>"
"<td><font color=\"green\">Ok</font></td>"
"~ts</tr>\n",
- [Time,Comment]),
+ [TimeStr,Comment]),
print(minor,
escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])),
[]),
diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index b1eddfedd7..2f0fc2e05a 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -70,7 +70,8 @@ MODULES= \
test_server_SUITE \
test_server_test_lib \
ct_release_test_SUITE \
- ct_log_SUITE
+ ct_log_SUITE \
+ ct_SUITE
ERL_FILES= $(MODULES:%=%.erl)
HRL_FILES= test_server_test_lib.hrl
diff --git a/lib/common_test/test/ct_SUITE.erl b/lib/common_test/test/ct_SUITE.erl
new file mode 100644
index 0000000000..eb98c2544f
--- /dev/null
+++ b/lib/common_test/test/ct_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ct_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+all() ->
+ [app_file, appup_file].
+
+%%%-----------------------------------------------------------------
+%%% Test cases
+
+app_file(_Config) ->
+ ok = test_server:app_test(common_test),
+ ok.
+
+appup_file(_Config) ->
+ ok = test_server:appup_test(common_test).
+
diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl
index fae23484e6..621f3b6d2d 100644
--- a/lib/common_test/test/ct_error_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE.erl
@@ -1531,17 +1531,17 @@ test_events(config_func_errors) ->
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}},
- {?eh,test_stats,{0,1,{0,0}}},
+ {?eh,test_stats,{0,0,{0,1}}},
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}},
- {?eh,test_stats,{0,2,{0,0}}},
+ {?eh,test_stats,{1,0,{0,1}}},
[{?eh,tc_start,{config_func_error_1_SUITE,{init_per_group,g1,[]}}},
{?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g1,[]},ok}},
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}},
- {?eh,test_stats,{0,3,{0,0}}},
+ {?eh,test_stats,{1,0,{0,2}}},
{?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g1,[]}}},
{?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g1,[]},ok}}],
@@ -1549,7 +1549,7 @@ test_events(config_func_errors) ->
{?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g2,[]},ok}},
{?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}},
{?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}},
- {?eh,test_stats,{0,4,{0,0}}},
+ {?eh,test_stats,{2,0,{0,2}}},
{?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g2,[]}}},
{?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g2,[]},ok}}],
diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl
index 690d0af1bb..93bcb8fe52 100644
--- a/lib/common_test/test/ct_hooks_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE.erl
@@ -70,22 +70,25 @@ suite() ->
all() ->
all(suite).
-all(suite) ->
+all(suite) ->
lists:reverse(
[
one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init,
faulty_cth_exit_in_init, faulty_cth_exit_in_id,
- faulty_cth_exit_in_init_scope_suite, minimal_cth,
- minimal_and_maximal_cth, faulty_cth_undef,
+ faulty_cth_exit_in_init_scope_suite, minimal_cth,
+ minimal_and_maximal_cth, faulty_cth_undef,
scope_per_suite_cth, scope_per_group_cth, scope_suite_cth,
- scope_per_suite_state_cth, scope_per_group_state_cth,
+ scope_per_suite_state_cth, scope_per_group_state_cth,
scope_suite_state_cth,
fail_pre_suite_cth, double_fail_pre_suite_cth,
fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth,
+ skip_pre_init_tc_cth,
skip_post_suite_cth, recover_post_suite_cth, update_config_cth,
- state_update_cth, options_cth, same_id_cth,
+ state_update_cth, options_cth, same_id_cth,
fail_n_skip_with_minimal_cth, prio_cth, no_config,
- data_dir, cth_log
+ no_init_suite_config, no_init_config, no_end_config,
+ failed_sequence, repeat_force_stop, config_clash,
+ callbacks_on_skip, fallback, data_dir, cth_log
]
).
@@ -96,10 +99,10 @@ all(suite) ->
%%%-----------------------------------------------------------------
%%%
-one_cth(Config) when is_list(Config) ->
+one_cth(Config) when is_list(Config) ->
do_test(one_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth], Config).
-two_cth(Config) when is_list(Config) ->
+two_cth(Config) when is_list(Config) ->
do_test(two_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth,empty_cth],
Config).
@@ -119,13 +122,13 @@ minimal_cth(Config) when is_list(Config) ->
minimal_and_maximal_cth(Config) when is_list(Config) ->
do_test(minimal_and_maximal_cth, "ct_cth_empty_SUITE.erl",
[minimal_cth, empty_cth],Config).
-
+
faulty_cth_undef(Config) when is_list(Config) ->
do_test(faulty_cth_undef, "ct_cth_empty_SUITE.erl",
[undef_cth],Config).
faulty_cth_exit_in_init_scope_suite(Config) when is_list(Config) ->
- do_test(faulty_cth_exit_in_init_scope_suite,
+ do_test(faulty_cth_exit_in_init_scope_suite,
"ct_exit_in_init_scope_suite_cth_SUITE.erl",
[],Config).
@@ -190,6 +193,10 @@ skip_post_suite_cth(Config) when is_list(Config) ->
do_test(skip_post_suite_cth, "ct_cth_empty_SUITE.erl",
[skip_post_suite_cth],Config).
+skip_pre_init_tc_cth(Config) ->
+ do_test(skip_pre_init_tc_cth, "ct_cth_empty_SUITE.erl",
+ [skip_pre_init_tc_cth],Config).
+
recover_post_suite_cth(Config) when is_list(Config) ->
do_test(recover_post_suite_cth, "ct_cth_fail_per_suite_SUITE.erl",
[recover_post_suite_cth],Config).
@@ -205,7 +212,7 @@ state_update_cth(Config) when is_list(Config) ->
options_cth(Config) when is_list(Config) ->
do_test(options_cth, "ct_cth_empty_SUITE.erl",
[{empty_cth,[test]}],Config).
-
+
same_id_cth(Config) when is_list(Config) ->
do_test(same_id_cth, "ct_cth_empty_SUITE.erl",
[same_id_cth,same_id_cth],Config).
@@ -223,13 +230,24 @@ no_config(Config) when is_list(Config) ->
do_test(no_config, "ct_no_config_SUITE.erl",
[verify_config_cth],Config).
+no_init_suite_config(Config) when is_list(Config) ->
+ do_test(no_init_suite_config, "ct_no_init_suite_config_SUITE.erl",
+ [empty_cth],Config).
+
+no_init_config(Config) when is_list(Config) ->
+ do_test(no_init_config, "ct_no_init_config_SUITE.erl",[empty_cth],Config).
+
+no_end_config(Config) when is_list(Config) ->
+ do_test(no_end_config, "ct_no_end_config_SUITE.erl",[empty_cth],Config).
+
data_dir(Config) when is_list(Config) ->
do_test(data_dir, "ct_data_dir_SUITE.erl",
[verify_data_dir_cth],Config).
-cth_log(Config) when is_list(Config) ->
+cth_log(Config) when is_list(Config) ->
%% test that cth_log_redirect writes properly to
%% unexpected I/O log
+ ct:timetrap({minutes,10}),
StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config),
Logdir = proplists:get_value(logdir, StartOpts),
UnexpIoLogs =
@@ -253,29 +271,57 @@ cth_log(Config) when is_list(Config) ->
end, UnexpIoLogs),
ok.
+%% OTP-10599 adds the Suite argument as first argument to all hook
+%% callbacks that did not have a Suite argument from before. This test
+%% checks that ct_hooks will fall back to old versions of callbacks if
+%% new versions are not exported.
+fallback(Config) ->
+ do_test(fallback, "all_hook_callbacks_SUITE.erl",[fallback_cth], Config).
+
+%% Test that expected callbacks, and only those, are called when tests
+%% are skipped in different ways
+callbacks_on_skip(Config) ->
+ do_test(callbacks_on_skip, {spec,"skip.spec"},[skip_cth], Config).
+
+%% Test that expected callbacks, and only those, are called when tests
+%% are skipped due to failed sequence
+failed_sequence(Config) ->
+ do_test(failed_sequence, "seq_SUITE.erl", [skip_cth], Config).
+
+%% Test that expected callbacks, and only those, are called when tests
+%% are skipped due to {force_stop,skip_rest} option
+repeat_force_stop(Config) ->
+ do_test(repeat_force_stop, "repeat_SUITE.erl", [skip_cth], Config, ok, 2,
+ [{force_stop,skip_rest},{duration,"000009"}]).
+
+%% Test that expected callbacks, and only those, are called when a test
+%% are fails due to clash in config alias names
+config_clash(Config) ->
+ do_test(config_clash, "config_clash_SUITE.erl", [skip_cth], Config).
%%%-----------------------------------------------------------------
%%% HELP FUNCTIONS
%%%-----------------------------------------------------------------
-do_test(Tag, SWC, CTHs, Config) ->
- do_test(Tag, SWC, CTHs, Config, ok).
-do_test(Tag, SWC, CTHs, Config, {error,_} = Res) ->
- do_test(Tag, SWC, CTHs, Config, Res, 1);
-do_test(Tag, SWC, CTHs, Config, Res) ->
- do_test(Tag, SWC, CTHs, Config, Res, 2).
+do_test(Tag, WTT, CTHs, Config) ->
+ do_test(Tag, WTT, CTHs, Config, ok).
+do_test(Tag, WTT, CTHs, Config, {error,_} = Res) ->
+ do_test(Tag, WTT, CTHs, Config, Res, 1,[]);
+do_test(Tag, WTT, CTHs, Config, Res) ->
+ do_test(Tag, WTT, CTHs, Config, Res, 2,[]).
-do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) ->
-
+do_test(Tag, WhatToTest, CTHs, Config, Res, EC, ExtraOpts) when is_list(WhatToTest) ->
+ do_test(Tag, {suite,WhatToTest}, CTHs, Config, Res, EC, ExtraOpts);
+do_test(Tag, {WhatTag,Wildcard}, CTHs, Config, Res, EC, ExtraOpts) ->
DataDir = ?config(data_dir, Config),
- Suites = filelib:wildcard(
- filename:join([DataDir,"cth/tests",SuiteWildCard])),
- {Opts,ERPid} = setup([{suite,Suites},
- {ct_hooks,CTHs},{label,Tag}], Config),
+ Files = filelib:wildcard(
+ filename:join([DataDir,"cth/tests",Wildcard])),
+ {Opts,ERPid} =
+ setup([{WhatTag,Files},{ct_hooks,CTHs},{label,Tag}|ExtraOpts], Config),
Res = ct_test_support:run(Opts, Config),
Events = ct_test_support:get_events(ERPid, Config),
- ct_test_support:log_events(Tag,
+ ct_test_support:log_events(Tag,
reformat(Events, ?eh),
?config(priv_dir, Config),
Opts),
@@ -323,12 +369,12 @@ test_events(one_empty_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{empty_cth,post_init_per_testcase,[test_case,'$proplist','_',[]]}},
- {?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -355,12 +401,12 @@ test_events(two_empty_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -402,7 +448,7 @@ test_events(minimal_cth) ->
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -423,10 +469,10 @@ test_events(minimal_and_maximal_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_suite,[ct_cth_empty_SUITE,'$proplist','_',[]]}},
@@ -452,11 +498,11 @@ test_events(faulty_cth_undef) ->
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case,
{failed, FailReason}}},
{?eh,cth,{'_',on_tc_skip,'_'}},
-
+
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,end_per_suite,
{failed, FailReason}}},
{?eh,cth,{'_',on_tc_skip,'_'}},
-
+
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
@@ -512,10 +558,10 @@ test_events(scope_per_suite_cth) ->
{?eh,tc_done,{ct_scope_per_suite_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_per_suite_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_cth_SUITE,test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_per_suite_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_suite_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[ct_scope_per_suite_cth_SUITE,'$proplist',[]]}},
@@ -538,10 +584,10 @@ test_events(scope_suite_cth) ->
{?eh,tc_done,{ct_scope_suite_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_suite_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_suite_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_cth_SUITE,test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_suite_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_suite_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist','_',[]]}},
@@ -561,20 +607,20 @@ test_events(scope_per_group_cth) ->
[{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}},
{?eh,cth,{'_',id,[[]]}},
{?eh,cth,{'_',init,['_',[]]}},
- {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}},
+ {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,group1, '$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}},
- {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}},
+ {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','_',[]]}},
{?eh,cth,{'_',terminate,[[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},ok}}],
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -592,10 +638,10 @@ test_events(scope_per_suite_state_cth) ->
{?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_state_cth_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_state_cth_SUITE,test_case,'$proplist',ok,[test]]}},
{?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[ct_scope_per_suite_state_cth_SUITE,'$proplist',[test]]}},
@@ -618,10 +664,10 @@ test_events(scope_suite_state_cth) ->
{?eh,tc_done,{ct_scope_suite_state_cth_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_scope_suite_state_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_suite_state_cth_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_state_cth_SUITE,test_case,'$proplist',ok,[test]]}},
{?eh,tc_done,{ct_scope_suite_state_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_suite_state_cth_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist',[test]]}},
{?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist','_',[test]]}},
@@ -641,20 +687,20 @@ test_events(scope_per_group_state_cth) ->
[{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]}}},
{?eh,cth,{'_',id,[[test]]}},
{?eh,cth,{'_',init,['_',[test]]}},
- {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}},
+ {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist','$proplist',[test]]}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_state_cth_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_state_cth_SUITE,test_case,'$proplist',ok,[test]]}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]}}},
- {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[test]]}},
- {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[test]]}},
+ {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist',[test]]}},
+ {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist','_',[test]]}},
{?eh,cth,{'_',terminate,[[test]]}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]},ok}}],
-
+
{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,end_per_suite}},
{?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -666,7 +712,7 @@ test_events(fail_pre_suite_cth) ->
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',init,['_',[]]}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',
@@ -674,27 +720,27 @@ test_events(fail_pre_suite_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,
{failed, {error,"Test failure"}}}},
{?eh,cth,{'_',on_tc_fail,
- [init_per_suite,{failed,"Test failure"},[]]}},
+ [ct_cth_empty_SUITE,init_per_suite,"Test failure",[]]}},
+
-
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case,
{failed,{ct_cth_empty_SUITE,init_per_suite,
{failed,"Test failure"}}}}},
{?eh,cth,{'_',on_tc_skip,
- [test_case, {tc_auto_skip,
+ [ct_cth_empty_SUITE,test_case, {tc_auto_skip,
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}},[]]}},
-
+
{?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite,
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}}},
{?eh,cth,{'_',on_tc_skip,
- [end_per_suite, {tc_auto_skip,
+ [ct_cth_empty_SUITE,end_per_suite, {tc_auto_skip,
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}},[]]}},
-
+
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth, {'_',terminate,[[]]}},
{?eh,stop_logging,[]}
@@ -727,17 +773,17 @@ test_events(fail_post_suite_cth) ->
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,
{failed,{error,"Test failure"}}}},
- {?eh,cth,{'_',on_tc_fail,[init_per_suite, {failed,"Test failure"}, []]}},
+ {?eh,cth,{'_',on_tc_fail,[ct_cth_empty_SUITE,init_per_suite, "Test failure", []]}},
{?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case,
{failed,{ct_cth_empty_SUITE,init_per_suite,
{failed,"Test failure"}}}}},
- {?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}},
-
+ {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_auto_skip,'_'},[]]}},
+
{?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite,
{failed, {ct_cth_empty_SUITE, init_per_suite,
{failed, "Test failure"}}}}},
- {?eh,cth,{'_',on_tc_skip,[end_per_suite,{tc_auto_skip,'_'},[]]}},
+ {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,end_per_suite,{tc_auto_skip,'_'},[]]}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth, {'_',terminate,[[]]}},
@@ -754,11 +800,11 @@ test_events(skip_pre_suite_cth) ->
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',{skip,"Test skip"},[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}},
{?eh,cth,{'_',on_tc_skip,
- [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}},
+ [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}},
{?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}},
- {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}},
-
+ {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_user_skip,"Test skip"},[]]}},
+
{?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -772,31 +818,33 @@ test_events(skip_pre_end_cth) ->
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,init_per_suite}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,init_per_suite,ok}},
-
+
[{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}},
{?eh,cth,{'_',id,[[]]}},
{?eh,cth,{'_',init,['_',[]]}},
- {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}},
+ {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}},
- {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}},
+ {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','_',[]]}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},
{skipped,"Test skip"}}}],
- {?eh,cth,{'_',on_tc_skip,[{end_per_group,group1},
- {tc_user_skip,{skipped,"Test skip"}},
+ {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE,
+ {end_per_group,group1},
+ {tc_user_skip,"Test skip"},
[]]}},
{?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}},
{?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,
{skipped,"Test skip"}}},
- {?eh,cth,{'_',on_tc_skip,[end_per_suite,
- {tc_user_skip,{skipped,"Test skip"}},
+ {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE,
+ end_per_suite,
+ {tc_user_skip,"Test skip"},
[]]}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth,{'_',terminate,[[]]}},
@@ -808,24 +856,59 @@ test_events(skip_post_suite_cth) ->
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',init,['_',[]]}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}},
{?eh,cth,{'_',on_tc_skip,
- [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}},
+ [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}},
{?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}},
- {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}},
-
+ {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_user_skip,"Test skip"},[]]}},
+
{?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}},
-
+
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth,{'_',terminate,[[]]}},
{?eh,stop_logging,[]}
];
+test_events(skip_pre_init_tc_cth) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,['_',[]]}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [ct_cth_empty_SUITE,test_case,'$proplist',
+ {skip,"Skipped in pre_init_per_testcase"},
+ []]}},
+ {?eh,tc_done,{ct_cth_empty_SUITE,test_case,
+ {skipped,"Skipped in pre_init_per_testcase"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [ct_cth_empty_SUITE,test_case,
+ {tc_user_skip,"Skipped in pre_init_per_testcase"},
+ []]}},
+ {?eh,test_stats,{0,0,{1,0}}},
+ {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [ct_cth_empty_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
test_events(recover_post_suite_cth) ->
Suite = ct_cth_fail_per_suite_SUITE,
[
@@ -840,11 +923,11 @@ test_events(recover_post_suite_cth) ->
{?eh,tc_start,{Suite,test_case}},
{?eh,cth,{'_',pre_init_per_testcase,
- [test_case, not_contains([tc_status]),[]]}},
+ [Suite,test_case, not_contains([tc_status]),[]]}},
{?eh,cth,{'_',post_end_per_testcase,
- [test_case, contains([tc_status]),'_',[]]}},
+ [Suite,test_case, contains([tc_status]),'_',[]]}},
{?eh,tc_done,{Suite,test_case,ok}},
-
+
{?eh,tc_start,{Suite,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[Suite,not_contains([tc_status]),[]]}},
@@ -861,7 +944,7 @@ test_events(update_config_cth) ->
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',init,['_',[]]}},
-
+
{?eh,tc_start,{ct_update_config_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,
[ct_update_config_SUITE,contains([]),[]]}},
@@ -876,13 +959,15 @@ test_events(update_config_cth) ->
{?eh,tc_start,{ct_update_config_SUITE, {init_per_group,group1,[]}}},
{?eh,cth,{'_',pre_init_per_group,
- [group1,contains(
+ [ct_update_config_SUITE,
+ group1,contains(
[post_init_per_suite,
init_per_suite,
pre_init_per_suite]),
[]]}},
{?eh,cth,{'_',post_init_per_group,
- [group1,
+ [ct_update_config_SUITE,
+ group1,
contains(
[post_init_per_suite,
init_per_suite,
@@ -898,7 +983,8 @@ test_events(update_config_cth) ->
{?eh,tc_start,{ct_update_config_SUITE,test_case}},
{?eh,cth,{'_',pre_init_per_testcase,
- [test_case,contains(
+ [ct_update_config_SUITE,
+ test_case,contains(
[post_init_per_group,
init_per_group,
pre_init_per_group,
@@ -907,7 +993,8 @@ test_events(update_config_cth) ->
pre_init_per_suite]),
[]]}},
{?eh,cth,{'_',post_end_per_testcase,
- [test_case,contains(
+ [ct_update_config_SUITE,
+ test_case,contains(
[init_per_testcase,
pre_init_per_testcase,
post_init_per_group,
@@ -921,7 +1008,8 @@ test_events(update_config_cth) ->
{?eh,tc_start,{ct_update_config_SUITE, {end_per_group,group1,[]}}},
{?eh,cth,{'_',pre_end_per_group,
- [group1,contains(
+ [ct_update_config_SUITE,
+ group1,contains(
[post_init_per_group,
init_per_group,
pre_init_per_group,
@@ -930,7 +1018,8 @@ test_events(update_config_cth) ->
pre_init_per_suite]),
[]]}},
{?eh,cth,{'_',post_end_per_group,
- [group1,
+ [ct_update_config_SUITE,
+ group1,
contains(
[pre_end_per_group,
post_init_per_group,
@@ -941,7 +1030,7 @@ test_events(update_config_cth) ->
pre_init_per_suite]),
ok,[]]}},
{?eh,tc_done,{ct_update_config_SUITE,{end_per_group,group1,[]},ok}},
-
+
{?eh,tc_start,{ct_update_config_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,
[ct_update_config_SUITE,contains(
@@ -974,7 +1063,7 @@ test_events(state_update_cth) ->
{?eh,cth,{'_',init,['_',[]]}},
{?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{'_',init_per_suite}},
-
+
{?eh,tc_done,{'_',end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,cth,{'_',terminate,[contains(
@@ -1018,10 +1107,10 @@ test_events(options_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[test]]}},
- {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[test]]}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[test]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[test]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
[ct_cth_empty_SUITE,'$proplist',[test]]}},
@@ -1051,14 +1140,14 @@ test_events(same_id_cth) ->
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}},
{?eh,tc_start,{ct_cth_empty_SUITE,test_case}},
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
{negative,
- {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}},
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}},
+ {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}},
{negative,
- {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}},
+ {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}},
-
+
{?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}},
{?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{negative,
@@ -1094,11 +1183,13 @@ test_events(fail_n_skip_with_minimal_cth) ->
{?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case2,{skipped,"skip it"}}},
{?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,test_case3}},
{?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case3,{skipped,"skip it"}}},
- {?eh,cth,{empty_cth,on_tc_skip,[{test_case2,group2},
- {tc_user_skip,{skipped,"skip it"}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE,
+ {test_case2,group2},
+ {tc_user_skip,"skip it"},
[]]}},
- {?eh,cth,{empty_cth,on_tc_skip,[{test_case3,group2},
- {tc_user_skip,{skipped,"skip it"}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE,
+ {test_case3,group2},
+ {tc_user_skip,"skip it"},
[]]}},
{?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,{end_per_group,
group2,[parallel]}}},
@@ -1115,17 +1206,25 @@ test_events(fail_n_skip_with_minimal_cth) ->
];
test_events(prio_cth) ->
-
- GenPre = fun(Func,States) ->
- [{?eh,cth,{'_',Func,['_','_',State]}} ||
+ GenPre = fun(Func,States) when Func==pre_init_per_suite;
+ Func==pre_end_per_suite ->
+ [{?eh,cth,{'_',Func,['_','_',State]}} ||
+ State <- States];
+ (Func,States) ->
+ [{?eh,cth,{'_',Func,['_','_','_',State]}} ||
State <- States]
end,
- GenPost = fun(Func,States) ->
- [{?eh,cth,{'_',Func,['_','_','_',State]}} ||
+ GenPost = fun(Func,States) when Func==post_init_per_suite;
+ Func==post_end_per_suite ->
+ [{?eh,cth,{'_',Func,['_','_','_',State]}} ||
+ State <- States];
+ (Func,States) ->
+ [{?eh,cth,{'_',Func,['_','_','_','_',State]}} ||
State <- States]
- end,
-
+
+ end,
+
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++
@@ -1136,7 +1235,7 @@ test_events(prio_cth) ->
[[1100,100],[600,200],[600,600],[700],[800],[900],[1000],
[1200,1050],[1100],[1200]]) ++
[{?eh,tc_done,{ct_cth_prio_SUITE,init_per_suite,ok}},
-
+
[{?eh,tc_start,{ct_cth_prio_SUITE,{init_per_group,'_',[]}}}] ++
GenPre(pre_init_per_group,
@@ -1147,7 +1246,7 @@ test_events(prio_cth) ->
[900],[900,900],[500,900],[1000],[1200,1050],
[1100],[1200]]) ++
[{?eh,tc_done,{ct_cth_prio_SUITE,{init_per_group,'_',[]},ok}}] ++
-
+
[{?eh,tc_start,{ct_cth_prio_SUITE,test_case}}] ++
GenPre(pre_init_per_testcase,
[[1100,100],[600,200],[600,600],[600],[700],[800],
@@ -1161,7 +1260,7 @@ test_events(prio_cth) ->
[{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}},
{?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++
- GenPre(pre_end_per_group,
+ GenPre(pre_end_per_group,
lists:reverse(
[[1100,100],[600,200],[600,600],[600],[700],[800],
[900],[900,900],[500,900],[1000],[1200,1050],
@@ -1200,30 +1299,30 @@ test_events(no_config) ->
{?eh,tc_done,{ct_framework,init_per_suite,ok}},
{?eh,tc_start,{ct_no_config_SUITE,test_case_1}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_1,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_case_1,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_1,'$proplist',ok,[]]}},
+ [ct_no_config_SUITE,test_case_1,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_no_config_SUITE,test_case_1,ok}},
{?eh,test_stats,{1,0,{0,0}}},
[{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_init_per_group,
- [test_group,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_init_per_group,
- [test_group,'$proplist','$proplist',[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist','$proplist',[]]}},
{?eh,tc_done,{ct_framework,
{init_per_group,test_group,'$proplist'},ok}},
{?eh,tc_start,{ct_no_config_SUITE,test_case_2}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_2,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_case_2,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_2,'$proplist',ok,[]]}},
+ [ct_no_config_SUITE,test_case_2,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_no_config_SUITE,test_case_2,ok}},
{?eh,test_stats,{2,0,{0,0}}},
{?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_end_per_group,
- [test_group,'$proplist',[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist',[]]}},
{?eh,cth,{empty_cth,post_end_per_group,
- [test_group,'$proplist',ok,[]]}},
+ [ct_no_config_SUITE,test_group,'$proplist',ok,[]]}},
{?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}],
{?eh,tc_start,{ct_framework,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
@@ -1236,6 +1335,166 @@ test_events(no_config) ->
{?eh,stop_logging,[]}
];
+test_events(no_init_suite_config) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{ct_no_init_suite_config_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [ct_no_init_suite_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_no_init_suite_config_SUITE,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_suite_config_SUITE,
+ init_per_suite,
+ {undef,'_'},[]]}},
+ {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,test_case,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [ct_no_init_suite_config_SUITE,
+ test_case,
+ {tc_auto_skip,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}},
+ []]}},
+ {?eh,test_stats,{0,0,{0,1}}},
+ {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,end_per_suite,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [ct_no_init_suite_config_SUITE,
+ end_per_suite,
+ {tc_auto_skip,
+ {failed,{ct_no_init_suite_config_SUITE,init_per_suite,
+ {'EXIT',{undef,'_'}}}}},
+ []]}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
+test_events(no_init_config) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_no_init_config_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [ct_no_init_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_no_init_config_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{ct_no_init_config_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_no_init_config_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [ct_no_init_config_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,test_case_1,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ [{?eh,tc_start,{ct_no_init_config_SUITE,{init_per_group,test_group,[]}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [ct_no_init_config_SUITE,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [ct_no_init_config_SUITE,test_group,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,{init_per_group,test_group,[]},
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_config_SUITE,
+ {init_per_group,test_group},
+ {undef,'_'},[]]}},
+ {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{test_case_2,test_group},
+ {failed,{ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE,
+ {test_case_2,test_group},
+ {tc_auto_skip,
+ {failed,
+ {ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}},
+ []]}},
+ {?eh,test_stats,{1,0,{0,1}}},
+ {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{end_per_group,test_group},
+ {failed,{ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE,
+ {end_per_group,test_group},
+ {tc_auto_skip,
+ {failed,
+ {ct_no_init_config_SUITE,init_per_group,
+ {'EXIT',{undef,'_'}}}}},
+ []]}}],
+ {?eh,tc_start,{ct_no_init_config_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [ct_no_init_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [ct_no_init_config_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_init_config_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
+test_events(no_end_config) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [ct_no_end_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [ct_no_end_config_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_no_end_config_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [ct_no_end_config_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,test_case_1,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ [{?eh,tc_start,{ct_no_end_config_SUITE,
+ {init_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,
+ {init_per_group,test_group,'$proplist'},ok}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,test_case_2}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [ct_no_end_config_SUITE,test_case_2,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [ct_no_end_config_SUITE,test_case_2,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,test_case_2,ok}},
+ {?eh,test_stats,{2,0,{0,0}}},
+ {?eh,tc_start,{ct_no_end_config_SUITE,
+ {end_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_end_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_group,
+ [ct_no_end_config_SUITE,test_group,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,{end_per_group,test_group,[]},
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,[ct_no_end_config_SUITE,
+ {end_per_group,test_group},
+ {undef,'_'},[]]}}],
+ {?eh,tc_start,{ct_no_end_config_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [ct_no_end_config_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [ct_no_end_config_SUITE,'$proplist','_',[]]}},
+ {?eh,tc_done,{ct_no_end_config_SUITE,end_per_suite,
+ {failed,{error,{undef,'_'}}}}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
test_events(data_dir) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
@@ -1250,30 +1509,30 @@ test_events(data_dir) ->
{?eh,tc_done,{ct_framework,init_per_suite,ok}},
{?eh,tc_start,{ct_data_dir_SUITE,test_case_1}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_data_dir_SUITE,test_case_1,ok}},
{?eh,test_stats,{1,0,{0,0}}},
[{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_init_per_group,
- [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_init_per_group,
- [test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_framework,
{init_per_group,test_group,'$proplist'},ok}},
{?eh,tc_start,{ct_data_dir_SUITE,test_case_2}},
{?eh,cth,{empty_cth,pre_init_per_testcase,
- [test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_end_per_testcase,
- [test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_data_dir_SUITE,test_case_2,ok}},
{?eh,test_stats,{2,0,{0,0}}},
{?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}},
{?eh,cth,{empty_cth,pre_end_per_group,
- [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,cth,{empty_cth,post_end_per_group,
- [test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
+ [ct_data_dir_SUITE,test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}},
{?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}],
{?eh,tc_start,{ct_framework,end_per_suite}},
{?eh,cth,{empty_cth,pre_end_per_suite,
@@ -1300,16 +1559,654 @@ test_events(cth_log) ->
[{suite,cth_log_SUITE},parallel]}}},
{?eh,tc_done,{ct_framework,{end_per_group,g1,
[{suite,cth_log_SUITE},parallel]},ok}}]},
-
+
{?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
];
+test_events(fallback) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,init_per_suite,ok}},
+
+ [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [fallback_nosuite,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [fallback_nosuite,test_group,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,
+ {init_per_group,test_group,'$proplist'},ok}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',ok,[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}},
+ {?eh,cth,{empty_cth,pre_end_per_group,
+ [fallback_nosuite,test_group,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_group,
+ [fallback_nosuite,test_group,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}],
+ {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [fallback_nosuite,test_case,'$proplist','_',[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [fallback_nosuite,test_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [fallback_nosuite,test_case,'$proplist','_',[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}},
+ {?eh,test_stats,{2,0,{0,0}}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,skip_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [fallback_nosuite,skip_case,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [fallback_nosuite,skip_case,'$proplist',
+ {skip,"Skipped in init_per_testcase/2"},[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,skip_case,
+ {skipped,"Skipped in init_per_testcase/2"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [fallback_nosuite,skip_case,
+ {tc_user_skip,"Skipped in init_per_testcase/2"},
+ []]}},
+ {?eh,test_stats,{2,0,{1,0}}},
+ {?eh,tc_start,{all_hook_callbacks_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [all_hook_callbacks_SUITE,'$proplist','_',[]]}},
+ {?eh,tc_done,{all_hook_callbacks_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
+test_events(callbacks_on_skip) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events =
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{6,6,15}},
+
+ %% all_hook_callbacks_SUITE is skipped in spec
+ %% Only the on_tc_skip callback shall be called
+ {?eh,tc_user_skip,{all_hook_callbacks_SUITE,all,"Skipped in spec"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [all_hook_callbacks_SUITE,all,
+ {tc_user_skip,"Skipped in spec"},
+ []]}},
+ {?eh,test_stats,{0,0,{1,0}}},
+
+ %% skip_init_SUITE is skipped in its init_per_suite function
+ %% No group- or testcase-functions shall be called.
+ {?eh,tc_start,{skip_init_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [skip_init_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [skip_init_SUITE,
+ '$proplist',
+ {skip,"Skipped in init_per_suite/1"},
+ []]}},
+ {?eh,tc_done,{skip_init_SUITE,init_per_suite,
+ {skipped,"Skipped in init_per_suite/1"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_init_SUITE,init_per_suite,
+ {tc_user_skip,"Skipped in init_per_suite/1"},
+ []]}},
+ {?eh,tc_user_skip,{skip_init_SUITE,test_case,"Skipped in init_per_suite/1"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_init_SUITE,test_case,
+ {tc_user_skip,"Skipped in init_per_suite/1"},
+ []]}},
+ {?eh,test_stats,{0,0,{2,0}}},
+ {?eh,tc_user_skip,{skip_init_SUITE,end_per_suite,
+ "Skipped in init_per_suite/1"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_init_SUITE,end_per_suite,
+ {tc_user_skip,"Skipped in init_per_suite/1"},
+ []]}},
+
+ %% skip_req_SUITE is auto-skipped since a 'require' statement
+ %% returned by suite/0 is not fulfilled.
+ %% No group- or testcase-functions shall be called.
+ {?eh,tc_start,{skip_req_SUITE,init_per_suite}},
+ {?eh,tc_done,{skip_req_SUITE,init_per_suite,
+ {auto_skipped,{require_failed_in_suite0,
+ {not_available,whatever}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_req_SUITE,init_per_suite,
+ {tc_auto_skip,{require_failed_in_suite0,
+ {not_available,whatever}}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_req_SUITE,test_case,{require_failed_in_suite0,
+ {not_available,whatever}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_req_SUITE,test_case,
+ {tc_auto_skip,{require_failed_in_suite0,
+ {not_available,whatever}}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,1}}},
+ {?eh,tc_auto_skip,{skip_req_SUITE,end_per_suite,
+ {require_failed_in_suite0,
+ {not_available,whatever}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_req_SUITE,end_per_suite,
+ {tc_auto_skip,{require_failed_in_suite0,
+ {not_available,whatever}}},
+ []]}},
+
+ %% skip_fail_SUITE is auto-skipped since the suite/0 function
+ %% retuns a faluty format.
+ %% No group- or testcase-functions shall be called.
+ {?eh,tc_start,{skip_fail_SUITE,init_per_suite}},
+ {?eh,tc_done,{skip_fail_SUITE,init_per_suite,
+ {failed,{error,{suite0_failed,bad_return_value}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_fail_SUITE,init_per_suite,
+ {tc_auto_skip,
+ {failed,{error,{suite0_failed,bad_return_value}}}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_fail_SUITE,test_case,
+ {failed,{error,{suite0_failed,bad_return_value}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_fail_SUITE,test_case,
+ {tc_auto_skip,
+ {failed,{error,{suite0_failed,bad_return_value}}}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,2}}},
+ {?eh,tc_auto_skip,{skip_fail_SUITE,end_per_suite,
+ {failed,{error,{suite0_failed,bad_return_value}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_fail_SUITE,end_per_suite,
+ {tc_auto_skip,
+ {failed,{error,{suite0_failed,bad_return_value}}}},
+ []]}},
+
+ %% skip_group_SUITE
+ {?eh,tc_start,{skip_group_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ '_',
+ []]}},
+ {?eh,tc_done,{skip_group_SUITE,init_per_suite,ok}},
+
+ %% test_group_1 - auto_skip due to require failed
+ [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_1,[]}}},
+ {?eh,tc_done,
+ {skip_group_SUITE,{init_per_group,test_group_1,[]},
+ {auto_skipped,{require_failed,{not_available,whatever}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {init_per_group,test_group_1},
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_1},
+ {require_failed,{not_available,whatever}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {test_case,test_group_1},
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,3}}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_1},
+ {require_failed,{not_available,whatever}}}}],
+ %% The following appears to be outside of the group, but
+ %% that's only an implementation detail in
+ %% ct_test_support.erl - it does not know about events from
+ %% test suite specific hooks and regards the group ended with
+ %% the above tc_auto_skip-event for end_per_group.
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {end_per_group,test_group_1},
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+
+ %% test_group_2 - auto_skip due to failed return from group/1
+ [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_2,[]}}},
+ {?eh,tc_done,
+ {skip_group_SUITE,{init_per_group,test_group_2,[]},
+ {auto_skipped,{group0_failed,bad_return_value}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {init_per_group,test_group_2},
+ {tc_auto_skip,{group0_failed,bad_return_value}},
+ []]}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_2},
+ {group0_failed,bad_return_value}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {test_case,test_group_2},
+ {tc_auto_skip,{group0_failed,bad_return_value}},
+ []]}},
+ {?eh,test_stats,{0,0,{2,4}}},
+ {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_2},
+ {group0_failed,bad_return_value}}}],
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {end_per_group,test_group_2},
+ {tc_auto_skip,{group0_failed,bad_return_value}},
+ []]}},
+ %% test_group_3 - user_skip in init_per_group/2
+ [{?eh,tc_start,
+ {skip_group_SUITE,{init_per_group,test_group_3,[]}}},
+ {?eh,cth,{empty_cth,pre_init_per_group,
+ [skip_group_SUITE,test_group_3,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_group,
+ [skip_group_SUITE,test_group_3,'$proplist',
+ {skip,"Skipped in init_per_group/2"},
+ []]}},
+ {?eh,tc_done,{skip_group_SUITE,
+ {init_per_group,test_group_3,[]},
+ {skipped,"Skipped in init_per_group/2"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {init_per_group,test_group_3},
+ {tc_user_skip,"Skipped in init_per_group/2"},
+ []]}},
+ {?eh,tc_user_skip,{skip_group_SUITE,
+ {test_case,test_group_3},
+ "Skipped in init_per_group/2"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {test_case,test_group_3},
+ {tc_user_skip,"Skipped in init_per_group/2"},
+ []]}},
+ {?eh,test_stats,{0,0,{3,4}}},
+ {?eh,tc_user_skip,{skip_group_SUITE,
+ {end_per_group,test_group_3},
+ "Skipped in init_per_group/2"}}],
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_group_SUITE,
+ {end_per_group,test_group_3},
+ {tc_user_skip,"Skipped in init_per_group/2"},
+ []]}},
+
+ {?eh,tc_start,{skip_group_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [skip_group_SUITE,
+ '$proplist',
+ ok,[]]}},
+ {?eh,tc_done,{skip_group_SUITE,end_per_suite,ok}},
+
+
+ %% skip_case_SUITE has 4 test cases which are all skipped in
+ %% different ways
+ {?eh,tc_start,{skip_case_SUITE,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ '_',
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,init_per_suite,ok}},
+
+ %% Skip in spec -> only on_tc_skip shall be called
+ {?eh,tc_user_skip,{skip_case_SUITE,skip_in_spec,"Skipped in spec"}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,skip_in_spec,
+ {tc_user_skip,"Skipped in spec"},
+ []]}},
+ {?eh,test_stats,{0,0,{4,4}}},
+
+ %% Skip in init_per_testcase -> pre/post_end_per_testcase
+ %% shall not be called
+ {?eh,tc_start,{skip_case_SUITE,skip_in_init}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,skip_in_init,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,skip_in_init,
+ '$proplist',
+ {skip,"Skipped in init_per_testcase/2"},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,skip_in_init,
+ {skipped,"Skipped in init_per_testcase/2"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,skip_in_init,
+ {tc_user_skip,"Skipped in init_per_testcase/2"},
+ []]}},
+ {?eh,test_stats,{0,0,{5,4}}},
+
+ %% Fail in init_per_testcase -> pre/post_end_per_testcase
+ %% shall not be called
+ {?eh,tc_start,{skip_case_SUITE,fail_in_init}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,fail_in_init,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,fail_in_init,
+ '$proplist',
+ {skip,{failed,'_'}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,fail_in_init,
+ {auto_skipped,{failed,'_'}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,fail_in_init,
+ {tc_auto_skip,{failed,'_'}},
+ []]}},
+ {?eh,test_stats,{0,0,{5,5}}},
+
+ %% Exit in init_per_testcase -> pre/post_end_per_testcase
+ %% shall not be called
+ {?eh,tc_start,{skip_case_SUITE,exit_in_init}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,exit_in_init,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,exit_in_init,
+ '$proplist',
+ {skip,{failed,'_'}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,exit_in_init,
+ {auto_skipped,{failed,'_'}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,exit_in_init,
+ {tc_auto_skip,{failed,'_'}},
+ []]}},
+ {?eh,test_stats,{0,0,{5,6}}},
+
+ %% Fail in end_per_testcase -> all hooks shall be called and
+ %% test shall succeed.
+ {?eh,tc_start,{skip_case_SUITE,fail_in_end}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ ok,
+ []]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [skip_case_SUITE,fail_in_end,
+ '$proplist',
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',
+ {test_case_failed,"Failed in end_per_testcase/2"}}}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,fail_in_end,
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',
+ {test_case_failed,"Failed in end_per_testcase/2"}}}}}},
+ {?eh,test_stats,{1,0,{5,6}}},
+
+ %% Exit in end_per_testcase -> all hooks shall be called and
+ %% test shall succeed.
+ {?eh,tc_start,{skip_case_SUITE,exit_in_end}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ ok,
+ []]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [skip_case_SUITE,exit_in_end,
+ '$proplist',
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',"Exit in end_per_testcase/2"}}},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,exit_in_end,
+ {failed,
+ {skip_case_SUITE,end_per_testcase,
+ {'EXIT',"Exit in end_per_testcase/2"}}}}},
+ {?eh,test_stats,{2,0,{5,6}}},
+
+ %% Skip in testcase function -> all callbacks shall be called
+ {?eh,tc_start,{skip_case_SUITE,skip_in_case}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ ok,[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [skip_case_SUITE,skip_in_case,
+ '$proplist',
+ {skip,"Skipped in test case function"},
+ []]}},
+ {?eh,tc_done,{skip_case_SUITE,skip_in_case,
+ {skipped,"Skipped in test case function"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,skip_in_case,
+ {tc_user_skip,"Skipped in test case function"},
+ []]}},
+ {?eh,test_stats,{2,0,{6,6}}},
+
+ %% Auto skip due to failed 'require' -> only the on_tc_skip
+ %% callback shall be called
+ {?eh,tc_start,{skip_case_SUITE,req_auto_skip}},
+ {?eh,tc_done,{skip_case_SUITE,req_auto_skip,
+ {auto_skipped,{require_failed,{not_available,whatever}}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,req_auto_skip,
+ {tc_auto_skip,{require_failed,{not_available,whatever}}},
+ []]}},
+ {?eh,test_stats,{2,0,{6,7}}},
+
+ %% Auto skip due to failed testcase/0 function -> only the
+ %% on_tc_skip callback shall be called
+ {?eh,tc_start,{skip_case_SUITE,fail_auto_skip}},
+ {?eh,tc_done,{skip_case_SUITE,fail_auto_skip,
+ {auto_skipped,{testcase0_failed,bad_return_value}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [skip_case_SUITE,fail_auto_skip,
+ {tc_auto_skip,{testcase0_failed,bad_return_value}},
+ []]}},
+ {?eh,test_stats,{2,0,{6,8}}},
+
+ {?eh,tc_start,{skip_case_SUITE,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ []]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [skip_case_SUITE,
+ '$proplist',
+ ok,[]]}},
+ {?eh,tc_done,{skip_case_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
+test_events(failed_sequence) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events =
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_framework,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,[seq_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [seq_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,init_per_suite,ok}},
+ {?eh,tc_start,{seq_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [seq_SUITE,test_case_1,'$proplist',
+ {error,failed_on_purpose},[]]}},
+ {?eh,tc_done,{seq_SUITE,test_case_1,{failed,{error,failed_on_purpose}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,
+ [seq_SUITE,test_case_1,failed_on_purpose,[]]}},
+ {?eh,test_stats,{0,1,{0,0}}},
+ {?eh,tc_start,{seq_SUITE,test_case_2}},
+ {?eh,tc_done,{seq_SUITE,test_case_2,
+ {auto_skipped,{sequence_failed,seq1,test_case_1}}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [seq_SUITE,test_case_2,
+ {tc_auto_skip,{sequence_failed,seq1,test_case_1}},
+ []]}},
+ {?eh,test_stats,{0,1,{0,1}}},
+ {?eh,tc_start,{ct_framework,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,[seq_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,[seq_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
+test_events(repeat_force_stop) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events=
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,2}},
+ {?eh,tc_start,{ct_framework,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,[repeat_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [repeat_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,init_per_suite,ok}},
+ {?eh,tc_start,{repeat_SUITE,test_case_1}},
+ {?eh,cth,{empty_cth,pre_init_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,cth,{empty_cth,pre_end_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_testcase,
+ [repeat_SUITE,test_case_1,'$proplist',ok,[]]}},
+ {?eh,tc_done,{repeat_SUITE,test_case_1,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,{repeat_SUITE,test_case_2}},
+ {?eh,tc_done,{repeat_SUITE,test_case_2,
+ {auto_skipped,
+ "Repeated test stopped by force_stop option"}}},
+ {?eh,cth,{empty_cth,on_tc_skip,
+ [repeat_SUITE,test_case_2,
+ {tc_auto_skip,"Repeated test stopped by force_stop option"},
+ []]}},
+ {?eh,test_stats,{1,0,{0,1}}},
+ {?eh,tc_start,{ct_framework,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,[repeat_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [repeat_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
+test_events(config_clash) ->
+ %% skip_cth.erl will send a 'cth_error' event if a hook is
+ %% erroneously called. Therefore, all Events are changed to
+ %% {negative,{?eh,cth_error,'_'},Event}
+ %% at the end of this function.
+ Events =
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
+ {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{ct_framework,init_per_suite}},
+ {?eh,cth,{empty_cth,pre_init_per_suite,
+ [config_clash_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_init_per_suite,
+ [config_clash_SUITE,'$proplist','$proplist',[]]}},
+ {?eh,tc_done,{ct_framework,init_per_suite,ok}},
+ {?eh,tc_start,{config_clash_SUITE,test_case_1}},
+ {?eh,tc_done,{config_clash_SUITE,test_case_1,
+ {failed,{error,{config_name_already_in_use,[aa]}}}}},
+ {?eh,cth,{empty_cth,on_tc_fail,
+ [config_clash_SUITE,test_case_1,
+ {config_name_already_in_use,[aa]},
+ []]}},
+ {?eh,test_stats,{0,1,{0,0}}},
+ {?eh,tc_start,{ct_framework,end_per_suite}},
+ {?eh,cth,{empty_cth,pre_end_per_suite,
+ [config_clash_SUITE,'$proplist',[]]}},
+ {?eh,cth,{empty_cth,post_end_per_suite,
+ [config_clash_SUITE,'$proplist',ok,[]]}},
+ {?eh,tc_done,{ct_framework,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{empty_cth,terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ],
+ %% Make sure no 'cth_error' events are received!
+ [{negative,{?eh,cth_error,'_'},E} || E <- Events];
+
test_events(ok) ->
ok.
-
%% test events help functions
contains(List) ->
fun(Proplist) when is_list(Proplist) ->
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl
new file mode 100644
index 0000000000..5b50548694
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl
@@ -0,0 +1,62 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(all_hook_callbacks_SUITE).
+
+-suite_defaults([{timetrap, {minutes, 10}}]).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include("ct.hrl").
+
+%% Test server callback functions
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(Config) ->
+ Config.
+
+end_per_group(_Config) ->
+ ok.
+
+init_per_testcase(skip_case, Config) ->
+ {skip,"Skipped in init_per_testcase/2"};
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+all() ->
+ [{group,test_group},test_case,skip_case].
+
+groups() ->
+ [{test_group,[test_case]}].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
+
+skip_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl
new file mode 100644
index 0000000000..f74c757cc1
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl
@@ -0,0 +1,43 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(config_clash_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [{require,aa,yy},{default_config,yy,"this is a default value"}].
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case_1].
+
+%% Test cases starts here.
+test_case_1() ->
+ [{require,aa,xx}].
+test_case_1(_Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl
new file mode 100644
index 0000000000..7cdaf2024b
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl
@@ -0,0 +1,51 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ct_no_end_config_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+%%% This suite is used to verify that all pre/post_end_per_* callbacks
+%%% are called with correct SuiteName even if no end_per_* config
+%%% function exist in the suite, and that the non-exported config
+%%% functions fail with 'undef'.
+
+init_per_suite(Config) ->
+ Config.
+
+init_per_group(_Group,Config) ->
+ Config.
+
+init_per_testcase(_TC,Config) ->
+ Config.
+
+all() ->
+ [test_case_1, {group,test_group}].
+
+groups() ->
+ [{test_group,[],[test_case_2]}].
+
+test_case_1(Config) ->
+ ok.
+
+test_case_2(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl
new file mode 100644
index 0000000000..43c062d66f
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl
@@ -0,0 +1,54 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ct_no_init_config_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+%%% This suite is used to verify that all
+%%% pre/post_init_per_group/testcase callbacks are called with correct
+%%% SuiteName even if no init_per_group/testcase function exist in the
+%%% suite, and that the non-exported config functions fail with 'undef'.
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ Config.
+
+end_per_group(_Group,Config) ->
+ Config.
+
+end_per_testcase(_TC,Config) ->
+ Config.
+
+all() ->
+ [test_case_1, {group,test_group}].
+
+groups() ->
+ [{test_group,[],[test_case_2]}].
+
+test_case_1(Config) ->
+ ok.
+
+test_case_2(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl
new file mode 100644
index 0000000000..85dfe8ca4b
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ct_no_init_suite_config_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+%%% This suite is used to verify that pre/post_init_per_suite
+%%% callbacks are called with correct SuiteName even if no
+%%% init_per_suite function exist in the suite, and that the
+%%% non-exported config function fails with 'undef'.
+
+end_per_suite(Config) ->
+ Config.
+
+all() ->
+ [test_case].
+
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl
index c00eb5cf93..37742f0d20 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl
@@ -44,18 +44,18 @@
-export([pre_end_per_suite/3]).
-export([post_end_per_suite/4]).
--export([pre_init_per_group/3]).
--export([post_init_per_group/4]).
--export([pre_end_per_group/3]).
--export([post_end_per_group/4]).
+-export([pre_init_per_group/4]).
+-export([post_init_per_group/5]).
+-export([pre_end_per_group/4]).
+-export([post_end_per_group/5]).
--export([pre_init_per_testcase/3]).
--export([post_init_per_testcase/4]).
--export([pre_end_per_testcase/3]).
--export([post_end_per_testcase/4]).
+-export([pre_init_per_testcase/4]).
+-export([post_init_per_testcase/5]).
+-export([pre_end_per_testcase/4]).
+-export([post_end_per_testcase/5]).
--export([on_tc_fail/3]).
--export([on_tc_skip/3]).
+-export([on_tc_fail/4]).
+-export([on_tc_skip/4]).
-export([terminate/1]).
@@ -154,150 +154,160 @@ post_end_per_suite(Suite,Config,Return,State) ->
%% @doc Called before each init_per_group.
%% You can change the config in this function.
--spec pre_init_per_group(Group :: atom(),
- Config :: config(),
- State :: #state{}) ->
+-spec pre_init_per_group(Suite :: atom(),
+ Group :: atom(),
+ Config :: config(),
+ State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(Suite,Group,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_init_per_group,
- [Group,Config,State]}}),
- ct:log("~w:pre_init_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,State]}}),
+ ct:log("~w:pre_init_per_group(~w,~w) called", [?MODULE,Suite,Group]),
{Config, State}.
%% @doc Called after each init_per_group.
%% You can change the return value in this function.
--spec post_init_per_group(Group :: atom(),
+-spec post_init_per_group(Suite :: atom(),
+ Group :: atom(),
Config :: config(),
Return :: config() | skip_or_fail(),
State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-post_init_per_group(Group,Config,Return,State) ->
+post_init_per_group(Suite,Group,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_init_per_group,
- [Group,Config,Return,State]}}),
- ct:log("~w:post_init_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,Return,State]}}),
+ ct:log("~w:post_init_per_group(~w,~w) called", [?MODULE,Suite,Group]),
{Return, State}.
%% @doc Called after each end_per_group. The config/state can be changed here,
%% though it will only affect the *end_per_group functions.
--spec pre_end_per_group(Group :: atom(),
+-spec pre_end_per_group(Suite :: atom(),
+ Group :: atom(),
Config :: config() | skip_or_fail(),
State :: #state{}) ->
{ok | skip_or_fail(), NewState :: #state{}}.
-pre_end_per_group(Group,Config,State) ->
+pre_end_per_group(Suite,Group,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_end_per_group,
- [Group,Config,State]}}),
- ct:log("~w:pre_end_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,State]}}),
+ ct:log("~w:pre_end_per_group(~w~w) called", [?MODULE,Suite,Group]),
{Config, State}.
%% @doc Called after each end_per_group. Note that the config cannot be
%% changed here, only the status of the group.
--spec post_end_per_group(Group :: atom(),
+-spec post_end_per_group(Suite :: atom(),
+ Group :: atom(),
Config :: config(),
Return :: term(),
State :: #state{}) ->
{ok | skip_or_fail(), NewState :: #state{}}.
-post_end_per_group(Group,Config,Return,State) ->
+post_end_per_group(Suite,Group,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_end_per_group,
- [Group,Config,Return,State]}}),
- ct:log("~w:post_end_per_group(~w) called", [?MODULE,Group]),
+ [Suite,Group,Config,Return,State]}}),
+ ct:log("~w:post_end_per_group(~w,~w) called", [?MODULE,Suite,Group]),
{Return, State}.
%% @doc Called before init_per_testcase/2 for each test case.
%% You can change the config in this function.
--spec pre_init_per_testcase(TC :: atom(),
- Config :: config(),
- State :: #state{}) ->
+-spec pre_init_per_testcase(Suite :: atom(),
+ TC :: atom(),
+ Config :: config(),
+ State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-pre_init_per_testcase(TC,Config,State) ->
+pre_init_per_testcase(Suite,TC,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_init_per_testcase,
- [TC,Config,State]}}),
- ct:log("~w:pre_init_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,State]}}),
+ ct:log("~w:pre_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Config, State}.
%% @doc Called after init_per_testcase/2, and before the test case.
--spec post_init_per_testcase(TC :: atom(),
+-spec post_init_per_testcase(Suite :: atom(),
+ TC :: atom(),
Config :: config(),
Return :: config() | skip_or_fail(),
State :: #state{}) ->
{config() | skip_or_fail(), NewState :: #state{}}.
-post_init_per_testcase(TC,Config,Return,State) ->
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_init_per_testcase,
- [TC,Config,Return,State]}}),
- ct:log("~w:post_init_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,Return,State]}}),
+ ct:log("~w:post_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Return, State}.
%% @doc Called before end_per_testacse/2. No skip or fail allowed here,
%% only config additions.
--spec pre_end_per_testcase(TC :: atom(),
- Config :: config(),
- State :: #state{}) ->
+-spec pre_end_per_testcase(Suite :: atom(),
+ TC :: atom(),
+ Config :: config(),
+ State :: #state{}) ->
{config(), NewState :: #state{}}.
-pre_end_per_testcase(TC,Config,State) ->
+pre_end_per_testcase(Suite,TC,Config,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, pre_end_per_testcase,
- [TC,Config,State]}}),
- ct:log("~w:pre_end_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,State]}}),
+ ct:log("~w:pre_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Config, State}.
%% @doc Called after end_per_testcase/2 for each test case. Note that
%% the config cannot be changed here, only the status of the test case.
--spec post_end_per_testcase(TC :: atom(),
+-spec post_end_per_testcase(Suite :: atom(),
+ TC :: atom(),
Config :: config(),
Return :: term(),
State :: #state{}) ->
{ok | skip_or_fail(), NewState :: #state{}}.
-post_end_per_testcase(TC,Config,Return,State) ->
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, post_end_per_testcase,
- [TC,Config,Return,State]}}),
- ct:log("~w:post_end_per_testcase(~w) called", [?MODULE,TC]),
+ [Suite,TC,Config,Return,State]}}),
+ ct:log("~w:post_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]),
{Return, State}.
%% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group,
%% post_end_per_group and post_end_per_tc if the suite, group or test case failed.
%% This function should be used for extra cleanup which might be needed.
%% It is not possible to modify the config or the status of the test run.
--spec on_tc_fail(TC :: init_per_suite | end_per_suite |
+-spec on_tc_fail(Suite :: atom(),
+ TC :: init_per_suite | end_per_suite |
init_per_group | end_per_group | atom() |
{Function :: atom(), GroupName :: atom()},
Reason :: term(), State :: #state{}) -> NewState :: #state{}.
-on_tc_fail(TC, Reason, State) ->
+on_tc_fail(Suite, TC, Reason, State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, on_tc_fail,
- [TC,Reason,State]}}),
- ct:log("~w:on_tc_fail(~w) called", [?MODULE,TC]),
+ [Suite,TC,Reason,State]}}),
+ ct:log("~w:on_tc_fail(~w,~w) called", [?MODULE,Suite,TC]),
State.
%% @doc Called when a test case is skipped by either user action
%% or due to an init function failing. Test case can be
%% end_per_suite, init_per_group, end_per_group and the actual test cases.
--spec on_tc_skip(TC :: end_per_suite |
+-spec on_tc_skip(Suite :: atom(),
+ TC :: end_per_suite |
init_per_group | end_per_group | atom() |
{Function :: atom(), GroupName :: atom()},
{tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), Reason :: term()}}} |
{tc_user_skip, {skipped, Reason :: term()}},
State :: #state{}) -> NewState :: #state{}.
-on_tc_skip(TC, Reason, State) ->
+on_tc_skip(Suite, TC, Reason, State) ->
gen_event:notify(
?CT_EVMGR_REF, #event{ name = cth, node = node(),
data = {?MODULE, on_tc_skip,
- [TC,Reason,State]}}),
- ct:log("~w:on_tc_skip(~w) called", [?MODULE,TC]),
+ [Suite,TC,Reason,State]}}),
+ ct:log("~w:on_tc_skip(~w,~w) called", [?MODULE,Suite,TC]),
State.
%% @doc Called when the scope of the CTH is done, this depends on
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl
index 559b22bc9f..141b933697 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl
@@ -45,29 +45,29 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl
index 51202443bf..07d7c84ed5 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl
@@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl
new file mode 100644
index 0000000000..59a3d5cbf9
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl
@@ -0,0 +1,81 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-module(fallback_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+
+%% CT Hooks
+-compile(export_all).
+
+id(Opts) ->
+ empty_cth:id(Opts).
+
+init(Id, Opts) ->
+ empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Group,Config,State) ->
+ empty_cth:pre_init_per_group(fallback_nosuite,Group,Config,State).
+
+post_init_per_group(Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(fallback_nosuite,Group,Config,Return,State).
+
+pre_end_per_group(Group,Config,State) ->
+ empty_cth:pre_end_per_group(fallback_nosuite,Group,Config,State).
+
+post_end_per_group(Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(fallback_nosuite,Group,Config,Return,State).
+
+pre_init_per_testcase(TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(fallback_nosuite,TC,Config,State).
+
+post_init_per_testcase(TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(fallback_nosuite,TC,Config,Return,State).
+
+pre_end_per_testcase(TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(fallback_nosuite,TC,Config,State).
+
+post_end_per_testcase(TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(fallback_nosuite,TC,Config,Return,State).
+
+on_tc_fail(TC, Reason, State) ->
+ empty_cth:on_tc_fail(fallback_nosuite,TC,Reason,State).
+
+on_tc_skip(TC, Reason, State) ->
+ empty_cth:on_tc_skip(fallback_nosuite,TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl
index b49cbe7fb4..679f076f3a 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl
@@ -29,13 +29,13 @@
%% CT Hooks
-export([init/2]).
-export([terminate/1]).
--export([on_tc_skip/3]).
+-export([on_tc_skip/4]).
init(Id, Opts) ->
empty_cth:init(Id, Opts).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite, TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl
index a687743641..95bb76b4c1 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl
@@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl
index 4d9c60f1ca..3562d39967 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl
@@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl
new file mode 100644
index 0000000000..fded4c02ab
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl
@@ -0,0 +1,42 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(repeat_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case_1, test_case_2].
+
+%% Test cases starts here.
+test_case_1(_Config) ->
+ timer:sleep(10000),
+ ok.
+
+test_case_2(_Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl
index 494f398fc1..b9d9d4cec1 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl
@@ -48,35 +48,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl
new file mode 100644
index 0000000000..6d1302fd35
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl
@@ -0,0 +1,45 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(seq_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [{sequence,seq1}].
+
+sequences() ->
+ [{seq1,[test_case_1,test_case_2]}].
+
+%% Test cases starts here.
+test_case_1(_Config) ->
+ exit(failed_on_purpose).
+
+test_case_2(_Config) ->
+ ct:fail("This test shall never be run since test_case_1 fails "
+ "and they are run in sequence").
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec
new file mode 100644
index 0000000000..a271c5e8b2
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec
@@ -0,0 +1,8 @@
+{suites,".",[all_hook_callbacks_SUITE,
+ skip_init_SUITE,
+ skip_req_SUITE,
+ skip_fail_SUITE,
+ skip_group_SUITE,
+ skip_case_SUITE]}.
+{skip_suites,".",all_hook_callbacks_SUITE,"Skipped in spec"}.
+{skip_cases,".",skip_case_SUITE,skip_in_spec,"Skipped in spec"}.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl
new file mode 100644
index 0000000000..dad80ae914
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(skip_case_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(skip_in_init,Config) ->
+ {skip,"Skipped in init_per_testcase/2"};
+init_per_testcase(fail_in_init,Config) ->
+ ct:fail("Failed in init_per_testcase/2");
+init_per_testcase(exit_in_init,Config) ->
+ exit(self(),"Exit in init_per_testcase/2");
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(fail_in_end,_) ->
+ ct:fail("Failed in end_per_testcase/2");
+end_per_testcase(exit_in_end,_) ->
+ exit(self(),"Exit in end_per_testcase/2");
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [skip_in_spec,
+ skip_in_init,
+ fail_in_init,
+ exit_in_init,
+ fail_in_end,
+ exit_in_end,
+ skip_in_case,
+ req_auto_skip,
+ fail_auto_skip
+ ].
+
+%% Test cases starts here.
+skip_in_spec(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall be skipped in the test spec.").
+
+skip_in_init(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall be skipped in init_per_testcase/2.").
+
+fail_in_init(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall fail in init_per_testcase/2.").
+
+exit_in_init(Config) ->
+ ct:fail("This test shall never be run. "
+ "It shall exit in init_per_testcase/2.").
+
+fail_in_end(Config) ->
+ ok.
+
+exit_in_end(Config) ->
+ ok.
+
+skip_in_case(Config) ->
+ {skip,"Skipped in test case function"}.
+
+req_auto_skip() ->
+ [{require,whatever}].
+req_auto_skip(Config) ->
+ ct:fail("This test shall never be run due to "
+ "failed require").
+
+fail_auto_skip() ->
+ faulty_return_value.
+fail_auto_skip(Config) ->
+ ct:fail("This test shall never be run due to "
+ "faulty return from info function").
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl
new file mode 100644
index 0000000000..16f015fe7a
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl
@@ -0,0 +1,182 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-module(skip_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+%% Send a cth_error event if a callback is called with unexpected arguments
+-define(fail(Info),
+ gen_event:notify(
+ ?CT_EVMGR_REF,
+ #event{ name = cth_error,
+ node = node(),
+ data = {illegal_hook_callback,{?MODULE,?FUNCTION_NAME,Info}}})).
+
+%% CT Hooks
+-compile(export_all).
+
+id(Opts) ->
+ empty_cth:id(Opts).
+
+init(Id, Opts) ->
+ empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+ Suite==skip_init_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==skip_case_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ Suite==skip_init_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==skip_case_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ Suite==skip_case_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ Suite==skip_case_SUITE
+ orelse Suite==skip_group_SUITE
+ orelse Suite==seq_SUITE
+ orelse Suite==repeat_SUITE
+ orelse Suite==config_clash_SUITE
+ orelse ?fail(Suite),
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Suite,Group,Config,State) ->
+ (Suite==skip_group_SUITE andalso Group==test_group_3)
+ orelse ?fail({Suite,Group}),
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
+
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ (Suite==skip_group_SUITE andalso Group==test_group_3)
+ orelse ?fail({Suite,Group}),
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
+
+pre_end_per_group(Suite,Group,Config,State) ->
+ ?fail({Suite,Group}),
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
+
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ ?fail({Suite,Group}),
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
+
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_init
+ orelse TC==fail_in_init
+ orelse TC==exit_in_init
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end
+ orelse TC==skip_in_case))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
+
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_init
+ orelse TC==fail_in_init
+ orelse TC==exit_in_init
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end
+ orelse TC==skip_in_case))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
+
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_case
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
+
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ (Suite==skip_case_SUITE andalso (TC==skip_in_case
+ orelse TC==fail_in_end
+ orelse TC==exit_in_end))
+ orelse (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
+
+on_tc_fail(Suite,TC,Reason,State) ->
+ (Suite==seq_SUITE andalso TC==test_case_1)
+ orelse (Suite==config_clash_SUITE andalso TC==test_case_1)
+ orelse ?fail({Suite,TC}),
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
+
+on_tc_skip(all_hook_callbacks_SUITE=Suite,all=TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(Suite,TC,Reason,State)
+ when (Suite==skip_init_SUITE
+ orelse Suite==skip_req_SUITE
+ orelse Suite==skip_fail_SUITE)
+ andalso
+ (TC==init_per_suite
+ orelse TC==test_case
+ orelse TC==end_per_suite) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(skip_group_SUITE=Suite,TC={C,G},Reason,State)
+ when (C==init_per_group orelse C==test_case orelse C==end_per_group) andalso
+ (G==test_group_1 orelse G==test_group_2 orelse G==test_group_3) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(skip_case_SUITE=Suite,TC,Reason,State)
+ when TC==skip_in_spec;
+ TC==skip_in_init;
+ TC==fail_in_init;
+ TC==exit_in_init;
+ TC==skip_in_case;
+ TC==req_auto_skip;
+ TC==fail_auto_skip ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(Suite,TC,Reason,State)
+ when (Suite==seq_SUITE andalso TC==test_case_2)
+ orelse (Suite==repeat_SUITE andalso TC==test_case_2) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State);
+on_tc_skip(Suite,TC,Reason,State) ->
+ ?fail({Suite,TC}),
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl
new file mode 100644
index 0000000000..9f5dfee6b9
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(skip_fail_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ faulty_return_value.
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl
new file mode 100644
index 0000000000..d3b848bfbd
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl
@@ -0,0 +1,64 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(skip_group_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+group(test_group_1) ->
+ [{require,whatever}];
+group(test_group_2) ->
+ faulty_return_value;
+group(_) ->
+ [].
+
+init_per_group(test_group_3,Config) ->
+ {skip,"Skipped in init_per_group/2"};
+init_per_group(_,Config) ->
+ ct:fail("This shall never be run due to auto_skip from group/1").
+
+end_per_group(_,_) ->
+ ct:fail("This shall never be run").
+
+all() ->
+ [{group,test_group_1},
+ {group,test_group_2},
+ {group,test_group_3}].
+
+groups() ->
+ [{test_group_1,[test_case]},
+ {test_group_2,[test_case]},
+ {test_group_3,[test_case]}].
+
+%% Test cases starts here.
+test_case(_Config) ->
+ ct:fail("This test case shall never be run due to skip on group level").
+
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl
new file mode 100644
index 0000000000..70305421ac
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(skip_init_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [].
+
+init_per_suite(Config) ->
+ {skip,"Skipped in init_per_suite/1"}.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl
index d5b347e723..48a2d70e22 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl
@@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl
index 36abac0bf8..d638954d3c 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl
@@ -46,36 +46,36 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State),
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State),
{{skip, "Test skip"}, State}.
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl
new file mode 100644
index 0000000000..e1d261d59a
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl
@@ -0,0 +1,79 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-module(skip_pre_init_tc_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+
+%% CT Hooks
+-compile(export_all).
+
+init(Id, Opts) ->
+ empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
+
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
+
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
+
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
+
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State),
+ {{skip, "Skipped in pre_init_per_testcase"}, State}.
+
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
+
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
+
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
+
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
+
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl
index fa510b2d54..d7b07ee33c 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl
@@ -46,35 +46,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl
new file mode 100644
index 0000000000..bc69dd5ea4
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(skip_req_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [{require,whatever}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [test_case].
+
+%% Test cases starts here.
+test_case(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl
index 7ec0d458b6..c6e0419c50 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl
@@ -48,44 +48,44 @@ post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State),
{Return, [post_end_per_suite|State]}.
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State),
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State),
{Config, [pre_init_per_group|State]}.
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State),
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State),
{Return, [post_init_per_group|State]}.
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State),
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State),
{Config, [pre_end_per_group|State]}.
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State),
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State),
{Return, [post_end_per_group|State]}.
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State),
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State),
{Config, [pre_init_per_testcase|State]}.
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State),
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State),
{Return, [post_init_per_testcase|State]}.
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State),
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State),
{Config, [pre_end_per_testcase|State]}.
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State),
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State),
{Return, [post_end_per_testcase|State]}.
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State),
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State),
[on_tc_fail|State].
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State),
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State),
[on_tc_skip|State].
terminate(State) ->
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl
index 2b9e726819..10a7047899 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl
@@ -44,35 +44,35 @@ pre_end_per_suite(Suite,Config,State) ->
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl
index d48981f667..f933c7702e 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl
@@ -50,43 +50,43 @@ post_end_per_suite(Suite,Config,Return,State) ->
NewConfig = [{post_end_per_suite,?now}|Config],
{NewConfig,NewConfig}.
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State),
+pre_init_per_group(Suite, Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State),
{[{pre_init_per_group,?now}|Config],State}.
-post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State),
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State),
{[{post_init_per_group,?now}|Return],State}.
-pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State),
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State),
{[{pre_end_per_group,?now}|Config],State}.
-post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State),
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State),
{[{post_end_per_group,?now}|Config],State}.
-pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State),
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State),
{[{pre_init_per_testcase,?now}|Config],State}.
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State),
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State),
{[{post_init_per_testcase,?now}|Config],State}.
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State),
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State),
{[{pre_end_per_testcase,?now}|Config],State}.
-post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State),
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State),
{[{post_end_per_testcase,?now}|Config],State}.
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl
index 71d84781e0..b29256a77e 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl
@@ -60,37 +60,37 @@ post_end_per_suite(Suite,Config,Return,State) ->
ct_no_config_SUITE = ct:get_config(suite_cfg),
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(Suite,Group,Config,State) ->
true = ?val(post_init_per_suite, Config),
ct_no_config_SUITE = ct:get_config(suite_cfg),
test_group = ct:get_config(group_cfg),
- empty_cth:pre_init_per_group(Group,
+ empty_cth:pre_init_per_group(Suite,Group,
[{pre_init_per_group,true} | Config],
State).
-post_init_per_group(Group,Config,Return,State) ->
+post_init_per_group(Suite,Group,Config,Return,State) ->
true = ?val(pre_init_per_group, Return),
test_group = ct:get_config(group_cfg),
- empty_cth:post_init_per_group(Group,
+ empty_cth:post_init_per_group(Suite,Group,
Config,
[{post_init_per_group,true} | Return],
State).
-pre_end_per_group(Group,Config,State) ->
+pre_end_per_group(Suite,Group,Config,State) ->
true = ?val(post_init_per_group, Config),
ct_no_config_SUITE = ct:get_config(suite_cfg),
test_group = ct:get_config(group_cfg),
- empty_cth:pre_end_per_group(Group,
+ empty_cth:pre_end_per_group(Suite,Group,
[{pre_end_per_group,true} | Config],
State).
-post_end_per_group(Group,Config,Return,State) ->
+post_end_per_group(Suite,Group,Config,Return,State) ->
true = ?val(pre_end_per_group, Config),
ct_no_config_SUITE = ct:get_config(suite_cfg),
test_group = ct:get_config(group_cfg),
- empty_cth:post_end_per_group(Group,Config,Return,State).
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
+pre_init_per_testcase(Suite,TC,Config,State) ->
true = ?val(post_init_per_suite, Config),
case ?val(name, ?val(tc_group_properties, Config)) of
undefined ->
@@ -102,19 +102,19 @@ pre_init_per_testcase(TC,Config,State) ->
ct_no_config_SUITE = ct:get_config(suite_cfg),
CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"),
TC = ct:get_config(CfgKey),
- empty_cth:pre_init_per_testcase(TC,
+ empty_cth:pre_init_per_testcase(Suite,TC,
[{pre_init_per_testcase,true} | Config],
State).
%%! TODO: Verify Config also in post_init and pre_end!
-post_init_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
- empty_cth:pre_end_per_testcase(TC,Config,State).
+pre_end_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
true = ?val(post_init_per_suite, Config),
true = ?val(pre_init_per_testcase, Config),
case ?val(name, ?val(tc_group_properties, Config)) of
@@ -127,13 +127,13 @@ post_end_per_testcase(TC,Config,Return,State) ->
ct_no_config_SUITE = ct:get_config(suite_cfg),
CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"),
TC = ct:get_config(CfgKey),
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl
index 9abd2e5e83..42e086b96e 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl
@@ -62,43 +62,43 @@ post_end_per_suite(Suite,Config,Return,State) ->
check_dirs(State,Config),
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
+pre_init_per_group(Suite,Group,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_init_per_group(Group,Config,State).
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
-post_init_per_group(Group,Config,Return,State) ->
+post_init_per_group(Suite,Group,Config,Return,State) ->
check_dirs(State,Return),
- empty_cth:post_init_per_group(Group,Config,Return,State).
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
-pre_end_per_group(Group,Config,State) ->
+pre_end_per_group(Suite,Group,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_end_per_group(Group,Config,State).
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
-post_end_per_group(Group,Config,Return,State) ->
+post_end_per_group(Suite,Group,Config,Return,State) ->
check_dirs(State,Config),
- empty_cth:post_end_per_group(Group,Config,Return,State).
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
-pre_init_per_testcase(TC,Config,State) ->
+pre_init_per_testcase(Suite,TC,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_init_per_testcase(TC,Config,State).
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
-post_init_per_testcase(TC,Config,Return,State) ->
+post_init_per_testcase(Suite,TC,Config,Return,State) ->
check_dirs(State,Config),
- empty_cth:post_init_per_testcase(TC,Config,Return,State).
+ empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State).
-pre_end_per_testcase(TC,Config,State) ->
+pre_end_per_testcase(Suite,TC,Config,State) ->
check_dirs(State,Config),
- empty_cth:pre_end_per_testcase(TC,Config,State).
+ empty_cth:pre_end_per_testcase(Suite,TC,Config,State).
-post_end_per_testcase(TC,Config,Return,State) ->
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
check_dirs(State,Config),
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State).
-on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
-on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE.erl
index f8b6a379f6..76611a2db3 100644
--- a/lib/common_test/test/ct_repeat_testrun_SUITE.erl
+++ b/lib/common_test/test/ct_repeat_testrun_SUITE.erl
@@ -363,14 +363,17 @@ skip_first_tc1(Suite) ->
{?eh,tc_start,{Suite,tc1}},
{?eh,tc_done,{Suite,tc1,ok}},
{?eh,test_stats,{'_',0,{0,0}}},
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,1}}},
+ {?eh,tc_start,{Suite,{init_per_group,g,[]}}},
{?eh,tc_done,{Suite,{init_per_group,g,[]},?skipped}},
{?eh,tc_auto_skip,{Suite,{tc1,g},?skip_reason}},
{?eh,test_stats,{'_',0,{0,2}}},
{?eh,tc_auto_skip,{Suite,{tc2,g},?skip_reason}},
{?eh,test_stats,{'_',0,{0,3}}},
{?eh,tc_auto_skip,{Suite,{end_per_group,g},?skip_reason}},
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,4}}},
{?eh,tc_start,{Suite,end_per_suite}},
@@ -390,10 +393,12 @@ skip_tc1_in_group(Suite) ->
{?eh,tc_start,{Suite,tc1}},
{?eh,tc_done,{Suite,tc1,ok}},
{?eh,test_stats,{'_',0,{0,0}}},
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,1}}},
{?eh,tc_start,{Suite,{end_per_group,g,[]}}},
{?eh,tc_done,{Suite,{end_per_group,g,[]},ok}}],
+ {?eh,tc_start,{Suite,tc2}},
{?eh,tc_done,{Suite,tc2,?skipped}},
{?eh,test_stats,{'_',0,{0,2}}},
{?eh,tc_start,{Suite,end_per_suite}},
diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl
index 42ec685c16..884217afc2 100644
--- a/lib/common_test/test/ct_surefire_SUITE.erl
+++ b/lib/common_test/test/ct_surefire_SUITE.erl
@@ -73,7 +73,9 @@ all() ->
relative_path,
url,
logdir,
- fail_pre_init_per_suite
+ fail_pre_init_per_suite,
+ skip_case_in_spec,
+ skip_suite_in_spec
].
%%--------------------------------------------------------------------
@@ -119,6 +121,18 @@ fail_pre_init_per_suite(Config) when is_list(Config) ->
run(fail_pre_init_per_suite,[fail_pre_init_per_suite,
{cth_surefire,[{path,Path}]}],Path,Config,[],Suites).
+skip_case_in_spec(Config) ->
+ DataDir = ?config(data_dir,Config),
+ Spec = filename:join(DataDir,"skip_one_case.spec"),
+ Path = "skip_case_in_spec.xml",
+ run_spec(skip_case_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec).
+
+skip_suite_in_spec(Config) ->
+ DataDir = ?config(data_dir,Config),
+ Spec = filename:join(DataDir,"skip_one_suite.spec"),
+ Path = "skip_suite_in_spec.xml",
+ run_spec(skip_suite_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec).
+
%%%-----------------------------------------------------------------
%%% HELP FUNCTIONS
%%%-----------------------------------------------------------------
@@ -129,8 +143,15 @@ run(Case,CTHs,Report,Config,ExtraOpts) ->
Suite = filename:join(DataDir, "surefire_SUITE"),
run(Case,CTHs,Report,Config,ExtraOpts,Suite).
run(Case,CTHs,Report,Config,ExtraOpts,Suite) ->
- {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts],
- Config),
+ Test = [{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts],
+ do_run(Case, Report, Test, Config).
+
+run_spec(Case,CTHs,Report,Config,Spec) ->
+ Test = [{spec,Spec},{ct_hooks,CTHs},{label,Case}],
+ do_run(Case, Report, Test, Config).
+
+do_run(Case, Report, Test, Config) ->
+ {Opts,ERPid} = setup(Test, Config),
ok = execute(Case, Opts, ERPid, Config),
LogDir =
case lists:keyfind(logdir,1,Opts) of
@@ -201,7 +222,10 @@ test_suite_events(pass_SUITE) ->
{?eh,test_stats,{1,0,{0,0}}},
{?eh,tc_start,{ct_framework,end_per_suite}},
{?eh,tc_done,{ct_framework,end_per_suite,ok}}];
-test_suite_events(_) ->
+test_suite_events(skip_all_surefire_SUITE) ->
+ [{?eh,tc_user_skip,{skip_all_surefire_SUITE,all,"skipped in spec"}},
+ {?eh,test_stats,{0,0,{1,0}}}];
+test_suite_events(Test) ->
[{?eh,tc_start,{surefire_SUITE,init_per_suite}},
{?eh,tc_done,{surefire_SUITE,init_per_suite,ok}},
{?eh,tc_start,{surefire_SUITE,tc_ok}},
@@ -210,46 +234,55 @@ test_suite_events(_) ->
{?eh,tc_start,{surefire_SUITE,tc_fail}},
{?eh,tc_done,{surefire_SUITE,tc_fail,
{failed,{error,{test_case_failed,"this test should fail"}}}}},
- {?eh,test_stats,{1,1,{0,0}}},
- {?eh,tc_start,{surefire_SUITE,tc_skip}},
- {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}},
- {?eh,test_stats,{1,1,{1,0}}},
- {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
- {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
- {auto_skipped,{require_failed,'_'}}}},
- {?eh,test_stats,{1,1,{1,1}}},
- [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}},
- {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}},
- {?eh,tc_start,{surefire_SUITE,tc_ok}},
- {?eh,tc_done,{surefire_SUITE,tc_ok,ok}},
- {?eh,test_stats,{2,1,{1,1}}},
- {?eh,tc_start,{surefire_SUITE,tc_fail}},
- {?eh,tc_done,{surefire_SUITE,tc_fail,
- {failed,{error,{test_case_failed,"this test should fail"}}}}},
- {?eh,test_stats,{2,2,{1,1}}},
- {?eh,tc_start,{surefire_SUITE,tc_skip}},
- {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}},
- {?eh,test_stats,{2,2,{2,1}}},
- {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
- {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
- {auto_skipped,{require_failed,'_'}}}},
- {?eh,test_stats,{2,2,{2,2}}},
- {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}},
- {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}],
- [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}},
- {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]},
- {failed,{error,all_cases_should_be_skipped}}}},
- {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail},
- {failed,
- {surefire_SUITE,init_per_group,
- {'EXIT',all_cases_should_be_skipped}}}}},
- {?eh,test_stats,{2,2,{2,3}}},
- {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail},
- {failed,
- {surefire_SUITE,init_per_group,
- {'EXIT',all_cases_should_be_skipped}}}}}],
- {?eh,tc_start,{surefire_SUITE,end_per_suite}},
- {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}].
+ {?eh,test_stats,{1,1,{0,0}}}] ++
+ tc_skip_events(Test,undefined) ++
+ [{?eh,test_stats,{1,1,{1,0}}},
+ {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
+ {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
+ {auto_skipped,{require_failed,'_'}}}},
+ {?eh,test_stats,{1,1,{1,1}}},
+ [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}},
+ {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}},
+ {?eh,tc_start,{surefire_SUITE,tc_ok}},
+ {?eh,tc_done,{surefire_SUITE,tc_ok,ok}},
+ {?eh,test_stats,{2,1,{1,1}}},
+ {?eh,tc_start,{surefire_SUITE,tc_fail}},
+ {?eh,tc_done,{surefire_SUITE,tc_fail,
+ {failed,{error,{test_case_failed,"this test should fail"}}}}},
+ {?eh,test_stats,{2,2,{1,1}}}] ++
+ tc_skip_events(Test,g) ++
+ [{?eh,test_stats,{2,2,{2,1}}},
+ {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}},
+ {?eh,tc_done,{surefire_SUITE,tc_autoskip_require,
+ {auto_skipped,{require_failed,'_'}}}},
+ {?eh,test_stats,{2,2,{2,2}}},
+ {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}},
+ {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}],
+ [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}},
+ {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]},
+ {failed,{error,all_cases_should_be_skipped}}}},
+ {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail},
+ {failed,
+ {surefire_SUITE,init_per_group,
+ {'EXIT',all_cases_should_be_skipped}}}}},
+ {?eh,test_stats,{2,2,{2,3}}},
+ {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail},
+ {failed,
+ {surefire_SUITE,init_per_group,
+ {'EXIT',all_cases_should_be_skipped}}}}}],
+ {?eh,tc_start,{surefire_SUITE,end_per_suite}},
+ {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}].
+
+tc_skip_events(skip_case_in_spec,Group) ->
+ [{?eh,tc_user_skip,{surefire_SUITE,tc_skip_name(Group),"skipped in spec"}}];
+tc_skip_events(_Test,_Group) ->
+ [{?eh,tc_start,{surefire_SUITE,tc_skip}},
+ {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}].
+
+tc_skip_name(undefined) ->
+ tc_skip;
+tc_skip_name(Group) ->
+ {tc_skip,Group}.
test_events(fail_pre_init_per_suite) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
@@ -257,6 +290,10 @@ test_events(fail_pre_init_per_suite) ->
test_suite_events(pass_SUITE) ++
test_suite_events(fail_SUITE, {1,0,{0,1}}) ++
[{?eh,stop_logging,[]}];
+test_events(skip_suite_in_spec) ->
+ [{?eh,start_logging,'_'},{?eh,start_info,{1,1,0}}] ++
+ test_suite_events(skip_all_surefire_SUITE) ++
+ [{?eh,stop_logging,[]}];
test_events(Test) ->
[{?eh,start_logging,'_'}, {?eh,start_info,{1,1,9}}] ++
test_suite_events(Test) ++
@@ -364,6 +401,8 @@ failed_or_skipped([]) ->
events_to_result(E) ->
events_to_result(E, []).
+events_to_result([{?eh,tc_user_skip,{_Suite,all,_}}|E], Result) ->
+ events_to_result(E, [[[s]]|Result]);
events_to_result([{?eh,tc_auto_skip,{_Suite,init_per_suite,_}}|E], Result) ->
{Suite,Rest} = events_to_result1(E),
events_to_result(Rest, [[[s]|Suite]|Result]);
@@ -382,7 +421,7 @@ events_to_result1([{?eh,tc_done,{_Suite, end_per_suite,R}}|E]) ->
events_to_result1([{?eh,tc_done,{_Suite,_Case,R}}|E]) ->
{Suite,Rest} = events_to_result1(E),
{[result(R)|Suite],Rest};
-events_to_result1([{?eh,tc_auto_skip,_}|E]) ->
+events_to_result1([{?eh,Skip,_}|E]) when Skip==tc_auto_skip; Skip==tc_user_skip ->
{Suite,Rest} = events_to_result1(E),
{[[s]|Suite],Rest};
events_to_result1([_|E]) ->
diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec
new file mode 100644
index 0000000000..42df8a7d1a
--- /dev/null
+++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec
@@ -0,0 +1,2 @@
+{suites,".",surefire_SUITE}.
+{skip_cases,".",surefire_SUITE,tc_skip,"skipped in spec"}.
diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec
new file mode 100644
index 0000000000..57966328ab
--- /dev/null
+++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec
@@ -0,0 +1,2 @@
+{suites,".",[skip_all_surefire_SUITE]}.
+{skip_suites,".",skip_all_surefire_SUITE,"skipped in spec"}.
diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl
index 228d900545..ea8a1a5662 100644
--- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl
+++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl
@@ -161,6 +161,7 @@ test_events(ts_if_1) ->
{?eh,tc_start,{ts_if_1_SUITE,tc4}},
{?eh,tc_done,{ts_if_1_SUITE,tc4,{failed,{error,failed_on_purpose}}}},
{?eh,test_stats,{1,2,{0,1}}},
+ {?eh,tc_start,{ts_if_1_SUITE,tc5}},
{?eh,tc_done,{ts_if_1_SUITE,tc5,{auto_skipped,{sequence_failed,seq1,tc4}}}},
{?eh,test_stats,{1,2,{0,2}}},
diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl
index e926abd885..05a452b99d 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -765,23 +765,23 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
{Done,RemEvs2,length(RemEvs2)}
end;
%% end_per_group auto- or user skipped
- (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize})
+ (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize})
when AutoOrUserSkip == tc_auto_skip;
AutoOrUserSkip == tc_user_skip ->
RemEvs1 =
lists:dropwhile(
fun({EH,#event{name=tc_auto_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G ->
case match_data(R, Reason) of
match -> false;
_ -> true
end;
({EH,#event{name=tc_user_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G ->
case match_data(R, Reason) of
match -> false;
_ -> true
@@ -1008,20 +1008,20 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
{Done,RemEvs2,length(RemEvs2)}
end;
%% end_per_group auto-or user skipped
- (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize})
+ (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize})
when AutoOrUserSkip == tc_auto_skip;
AutoOrUserSkip == tc_user_skip ->
RemEvs1 =
lists:dropwhile(
fun({EH,#event{name=tc_auto_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M, Reason == R ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R ->
false;
({EH,#event{name=tc_user_skip,
node=EvNode,
- data={Mod,end_per_group,Reason}}}) when
- EH == TEH, EvNode == Node, Mod == M, Reason == R ->
+ data={Mod,{end_per_group,EvGroupName},Reason}}}) when
+ EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R ->
false;
({EH,#event{name=stop_logging,
node=EvNode,data=_}}) when
@@ -1264,10 +1264,10 @@ log_events1([E={_EH,tc_done,{_M,{end_per_group,_GrName,Props},_R}} | Evs], Dev,
io:format(Dev, "~s~p]},~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ")
end;
-log_events1([E={_EH,tc_auto_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) ->
+log_events1([E={_EH,tc_auto_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) ->
io:format(Dev, "~s~p],~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ");
-log_events1([E={_EH,tc_user_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) ->
+log_events1([E={_EH,tc_user_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) ->
io:format(Dev, "~s~p],~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ");
log_events1([E], Dev, Ind) ->
diff --git a/lib/common_test/test/ct_testspec_2_SUITE.erl b/lib/common_test/test/ct_testspec_2_SUITE.erl
index 1a941df185..1bab80942a 100644
--- a/lib/common_test/test/ct_testspec_2_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_2_SUITE.erl
@@ -220,7 +220,24 @@ basic_compatible_no_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,Run,Skip}]}] = Tests,
+ [{Alias1V,x_SUITE,all},
+ {Alias1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {Alias1V,z_SUITE,all},
+ {Alias2V,x_SUITE,all},
+ {Alias2V,y_SUITE,all}] = lists:sort(Run),
+ [{Alias1V,z_SUITE,"skipped"},
+ {Alias2V,x_SUITE,{g1,all},"skipped"},
+ {Alias2V,x_SUITE,{g2,all},"skipped"},
+ {Alias2V,y_SUITE,tc1,"skipped"},
+ {Alias2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip),
+
+ ok.
+
%%%-----------------------------------------------------------------
%%%
@@ -346,7 +363,25 @@ basic_compatible_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -439,7 +474,28 @@ no_merging(_Config) ->
[{y_SUITE,[{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[tc1,tc2]},
+ {TO1V,y_SUITE,[{g1,all},{g2,all}]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,x_SUITE,[{skipped,g1,all},{skipped,g2,all}]},
+ {TO2V,y_SUITE,all},
+ {TO2V,y_SUITE,[{skipped,tc1},{skipped,tc2}]}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -510,7 +566,25 @@ multiple_specs(_Config) ->
{y_SUITE,[all,{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,FileResult,FileResult).
+ verify_result(Verify,FileResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([[SpecFile1,SpecFile2]]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile1,SpecFile2],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index 3ce37b98e9..611cdc71ae 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -669,7 +669,7 @@ module.beam: module.erl \
<fsummary>Compiles a list of forms.</fsummary>
<desc>
<p>Is the same as
- <c>forms(File, [verbose,report_errors,report_warnings])</c>.
+ <c>forms(Forms, [verbose,report_errors,report_warnings])</c>.
</p>
</desc>
</func>
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 434360d294..e37ca31704 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -173,17 +173,25 @@ env_default_opts() ->
do_compile(Input, Opts0) ->
Opts = expand_opts(Opts0),
- {Pid,Ref} =
- spawn_monitor(fun() ->
- exit(try
- internal(Input, Opts)
- catch
- error:Reason ->
- {error,Reason}
- end)
- end),
- receive
- {'DOWN',Ref,process,Pid,Rep} -> Rep
+ IntFun = fun() -> try
+ internal(Input, Opts)
+ catch
+ error:Reason ->
+ {error,Reason}
+ end
+ end,
+ %% Dialyzer has already spawned workers.
+ case lists:member(dialyzer, Opts) of
+ true ->
+ IntFun();
+ false ->
+ {Pid,Ref} =
+ spawn_monitor(fun() ->
+ exit(IntFun())
+ end),
+ receive
+ {'DOWN',Ref,process,Pid,Rep} -> Rep
+ end
end.
expand_opts(Opts0) ->
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index 3cb49433ce..adb96fb87d 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(lc_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
basic/1,deeply_nested/1,no_generator/1,
@@ -32,11 +32,11 @@ suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,1}}].
-all() ->
+all() ->
test_lib:recompile(?MODULE),
[{group,p}].
-groups() ->
+groups() ->
[{p,test_lib:parallel(),
[basic,
deeply_nested,
@@ -214,6 +214,7 @@ shadow(Config) when is_list(Config) ->
ok.
effect(Config) when is_list(Config) ->
+ ct:timetrap({minutes,10}),
[{42,{a,b,c}}] =
do_effect(fun(F, L) ->
[F({V1,V2}) ||
@@ -240,7 +241,7 @@ do_effect(Lc, L) ->
lists:reverse(erase(?MODULE)).
id(I) -> I.
-
+
fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok;
fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}})
when length(Args) =:= Arity ->
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index c100fc8ee2..ffa51bcfae 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -61,7 +61,6 @@
#include <openssl/evp.h>
#include <openssl/hmac.h>
-
/* Helper macro to construct a OPENSSL_VERSION_NUMBER.
* See openssl/opensslv.h
*/
@@ -326,7 +325,7 @@ static ErlNifFunc nif_funcs[] = {
{"rsa_private_crypt", 4, rsa_private_crypt},
{"dh_generate_parameters_nif", 2, dh_generate_parameters_nif},
{"dh_check", 1, dh_check},
- {"dh_generate_key_nif", 3, dh_generate_key_nif},
+ {"dh_generate_key_nif", 4, dh_generate_key_nif},
{"dh_compute_key_nif", 3, dh_compute_key_nif},
{"srp_value_B_nif", 5, srp_value_B_nif},
{"srp_user_secret_nif", 7, srp_user_secret_nif},
@@ -2727,12 +2726,13 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
}
static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (PrivKey, DHParams=[P,G], Mpint) */
+{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */
DH* dh_params;
int pub_len, prv_len;
unsigned char *pub_ptr, *prv_ptr;
ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail;
int mpint; /* 0 or 4 */
+ unsigned long len = 0;
dh_params = DH_new();
@@ -2743,11 +2743,21 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_
|| !enif_get_list_cell(env, tail, &head, &tail)
|| !get_bn_from_bin(env, head, &dh_params->g)
|| !enif_is_empty_list(env, tail)
- || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)) {
+ || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)
+ || !enif_get_ulong(env, argv[3], &len) ) {
DH_free(dh_params);
return enif_make_badarg(env);
}
+ if (len) {
+ if (len < BN_num_bits(dh_params->p))
+ dh_params->length = len;
+ else {
+ DH_free(dh_params);
+ return enif_make_badarg(env);
+ }
+ }
+
if (DH_generate_key(dh_params)) {
pub_len = BN_num_bytes(dh_params->pub_key);
prv_len = BN_num_bytes(dh_params->priv_key);
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index eda0f7af51..b6a1371154 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -100,7 +100,7 @@
<code>dh_private() = key_value() </code>
- <code>dh_params() = [key_value()] = [P, G] </code>
+ <code>dh_params() = [key_value()] = [P, G] | [P, G, PrivateKeyBitLength]</code>
<code>ecdh_public() = key_value() </code>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index da8626e38a..deeb763145 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -277,10 +277,11 @@ hmac_final_n(Context, HashLen) ->
des3_cbc | des3_cbf | des3_cfb | des_ede3 |
blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 |
aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 |
- aes_cbc |
+ aes_cbc |
rc2_cbc,
- Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
- (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}.
+ Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
+ (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()};
+ (aes_gcm, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), TagLength::1..16}) -> {binary(), binary()}.
block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc;
Type =:= des_cfb;
@@ -546,9 +547,15 @@ exor(Bin1, Bin2) ->
generate_key(Type, Params) ->
generate_key(Type, Params, undefined).
-generate_key(dh, DHParameters, PrivateKey) ->
+generate_key(dh, DHParameters0, PrivateKey) ->
+ {DHParameters, Len} =
+ case DHParameters0 of
+ [P,G,L] -> {[P,G], L};
+ [P,G] -> {[P,G], 0}
+ end,
dh_generate_key_nif(ensure_int_as_bin(PrivateKey),
- map_ensure_int_as_bin(DHParameters), 0);
+ map_ensure_int_as_bin(DHParameters),
+ 0, Len);
generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg)
when is_binary(Verifier), is_binary(Generator), is_binary(Prime), is_atom(Version) ->
@@ -1200,11 +1207,11 @@ dh_check([_Prime,_Gen]) -> ?nif_stub.
{binary(),binary()}.
dh_generate_key(DHParameters) ->
- dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4).
+ dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4, 0).
dh_generate_key(PrivateKey, DHParameters) ->
- dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4).
+ dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4, 0).
-dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint) -> ?nif_stub.
+dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint, _Length) -> ?nif_stub.
%% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()]
%% MyPrivKey, OthersPublicKey = mpint()
diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src
index 5b28f7ae86..f517c51ec1 100644
--- a/lib/dialyzer/src/dialyzer.app.src
+++ b/lib/dialyzer/src/dialyzer.app.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -48,5 +48,5 @@
{applications, [compiler, hipe, kernel, stdlib, wx]},
{env, []},
{runtime_dependencies, ["wx-1.2","syntax_tools-2.0","stdlib-3.0",
- "kernel-5.0","hipe-3.15.1","erts-8.0",
+ "kernel-5.0","hipe-3.15.4","erts-8.0",
"compiler-7.0"]}]}.
diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index 08e55a78bd..4e18058993 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -101,9 +101,9 @@ loop(#server_state{parent = Parent} = State,
{AnalPid, cserver, CServer, Plt} ->
send_codeserver_plt(Parent, CServer, Plt),
loop(State, Analysis, ExtCalls);
- {AnalPid, done, Plt, DocPlt} ->
+ {AnalPid, done, MiniPlt, DocPlt} ->
send_ext_calls(Parent, ExtCalls),
- send_analysis_done(Parent, Plt, DocPlt);
+ send_analysis_done(Parent, MiniPlt, DocPlt);
{AnalPid, ext_calls, NewExtCalls} ->
loop(State, Analysis, NewExtCalls);
{AnalPid, ext_types, ExtTypes} ->
@@ -121,6 +121,7 @@ loop(#server_state{parent = Parent} = State,
%% The Analysis
%%--------------------------------------------------------------------
+%% Calls to erlang:garbage_collect() help to reduce the heap size.
analysis_start(Parent, Analysis, LegalWarnings) ->
CServer = dialyzer_codeserver:new(),
Plt = Analysis#analysis.plt,
@@ -157,12 +158,9 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0),
TmpCServer2 =
dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
+ erlang:garbage_collect(),
?timing(State#analysis_state.timing_server, "remote",
- begin
- TmpCServer3 =
- dialyzer_utils:process_record_remote_types(TmpCServer2),
- dialyzer_contracts:process_contract_remote_types(TmpCServer3)
- end)
+ contracts_and_records(TmpCServer2))
catch
throw:{error, _ErrorMsg} = Error -> exit(Error)
end,
@@ -171,48 +169,75 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
NewPlt1 = dialyzer_plt:insert_exported_types(NewPlt0, ExpTypes),
State0 = State#analysis_state{plt = NewPlt1},
dump_callgraph(Callgraph, State0, Analysis),
- State1 = State0#analysis_state{codeserver = NewCServer},
%% Remove all old versions of the files being analyzed
AllNodes = dialyzer_callgraph:all_nodes(Callgraph),
- Plt1 = dialyzer_plt:delete_list(NewPlt1, AllNodes),
+ Plt1_a = dialyzer_plt:delete_list(NewPlt1, AllNodes),
+ Plt1 = dialyzer_plt:insert_callbacks(Plt1_a, NewCServer),
+ State1 = State0#analysis_state{codeserver = NewCServer, plt = Plt1},
Exports = dialyzer_codeserver:get_exports(NewCServer),
+ NonExports = sets:subtract(sets:from_list(AllNodes), Exports),
+ NonExportsList = sets:to_list(NonExports),
NewCallgraph =
case Analysis#analysis.race_detection of
true -> dialyzer_callgraph:put_race_detection(true, Callgraph);
false -> Callgraph
end,
- State2 = analyze_callgraph(NewCallgraph, State1#analysis_state{plt = Plt1}),
+ State2 = analyze_callgraph(NewCallgraph, State1),
+ #analysis_state{plt = MiniPlt2, doc_plt = DocPlt} = State2,
dialyzer_callgraph:dispose_race_server(NewCallgraph),
rcv_and_send_ext_types(Parent),
- NonExports = sets:subtract(sets:from_list(AllNodes), Exports),
- NonExportsList = sets:to_list(NonExports),
- Plt2 = dialyzer_plt:delete_list(State2#analysis_state.plt, NonExportsList),
- send_codeserver_plt(Parent, CServer, State2#analysis_state.plt),
- send_analysis_done(Parent, Plt2, State2#analysis_state.doc_plt).
+ %% Since the PLT is never used, a dummy is sent:
+ DummyPlt = dialyzer_plt:new(),
+ send_codeserver_plt(Parent, CServer, DummyPlt),
+ MiniPlt3 = dialyzer_plt:delete_list(MiniPlt2, NonExportsList),
+ send_analysis_done(Parent, MiniPlt3, DocPlt).
+
+contracts_and_records(CodeServer) ->
+ Fun = contrs_and_recs(CodeServer),
+ {Pid, Ref} = erlang:spawn_monitor(Fun),
+ dialyzer_codeserver:give_away(CodeServer, Pid),
+ Pid ! {self(), go},
+ receive {'DOWN', Ref, process, Pid, Return} ->
+ Return
+ end.
+
+-spec contrs_and_recs(dialyzer_codeserver:codeserver()) ->
+ fun(() -> no_return()).
+
+contrs_and_recs(TmpCServer2) ->
+ fun() ->
+ Parent = receive {Pid, go} -> Pid end,
+ {TmpCServer3, RecordDict} =
+ dialyzer_utils:process_record_remote_types(TmpCServer2),
+ TmpServer4 =
+ dialyzer_contracts:process_contract_remote_types(TmpCServer3,
+ RecordDict),
+ dialyzer_codeserver:give_away(TmpServer4, Parent),
+ exit(TmpServer4)
+ end.
analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver,
doc_plt = DocPlt,
+ plt = Plt,
timing_server = TimingServer,
parent = Parent,
solvers = Solvers} = State) ->
- Plt = dialyzer_plt:insert_callbacks(State#analysis_state.plt, Codeserver),
- {NewPlt, NewDocPlt} =
- case State#analysis_state.analysis_type of
- plt_build ->
- NewPlt0 =
- dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver,
- TimingServer, Solvers, Parent),
- {NewPlt0, DocPlt};
- succ_typings ->
- {Warnings, NewPlt0, NewDocPlt0} =
- dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver,
- TimingServer, Solvers, Parent),
- Warnings1 = filter_warnings(Warnings, Codeserver),
- send_warnings(State#analysis_state.parent, Warnings1),
- {NewPlt0, NewDocPlt0}
- end,
- dialyzer_callgraph:delete(Callgraph),
- State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt}.
+ case State#analysis_state.analysis_type of
+ plt_build ->
+ NewMiniPlt =
+ dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver,
+ TimingServer, Solvers, Parent),
+ dialyzer_callgraph:delete(Callgraph),
+ State#analysis_state{plt = NewMiniPlt, doc_plt = DocPlt};
+ succ_typings ->
+ {Warnings, NewMiniPlt, NewDocPlt} =
+ dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver,
+ TimingServer, Solvers, Parent),
+ dialyzer_callgraph:delete(Callgraph),
+ Warnings1 = filter_warnings(Warnings, Codeserver),
+ send_warnings(State#analysis_state.parent, Warnings1),
+ State#analysis_state{plt = NewMiniPlt, doc_plt = NewDocPlt}
+ end.
%%--------------------------------------------------------------------
%% Build the callgraph and fill the codeserver.
@@ -569,8 +594,9 @@ is_ok_fun({_Filename, _Line, {_M, _F, _A} = MFA}, Codeserver) ->
is_ok_tag(Tag, {_F, _L, MorMFA}, Codeserver) ->
not dialyzer_utils:is_suppressed_tag(MorMFA, Tag, Codeserver).
-send_analysis_done(Parent, Plt, DocPlt) ->
- Parent ! {self(), done, Plt, DocPlt},
+send_analysis_done(Parent, MiniPlt, DocPlt) ->
+ ok = dialyzer_plt:give_away(MiniPlt, Parent),
+ Parent ! {self(), done, MiniPlt, DocPlt},
ok.
send_ext_calls(_Parent, none) ->
@@ -583,7 +609,7 @@ send_ext_types(Parent, ExtTypes) ->
Parent ! {self(), ext_types, ExtTypes},
ok.
-send_codeserver_plt(Parent, CServer, Plt ) ->
+send_codeserver_plt(Parent, CServer, Plt) ->
Parent ! {self(), cserver, CServer, Plt},
ok.
@@ -602,14 +628,14 @@ format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc)
format_bad_calls([{FromMFA, {M, F, A} = To}|Left], CodeServer, Acc) ->
{_Var, FunCode} = dialyzer_codeserver:lookup_mfa_code(FromMFA, CodeServer),
Msg = {call_to_missing, [M, F, A]},
- {File, Line} = find_call_file_and_line(FunCode, To),
+ {File, Line} = find_call_file_and_line(FromMFA, FunCode, To, CodeServer),
WarningInfo = {File, Line, FromMFA},
NewAcc = [{?WARN_CALLGRAPH, WarningInfo, Msg}|Acc],
format_bad_calls(Left, CodeServer, NewAcc);
format_bad_calls([], _CodeServer, Acc) ->
Acc.
-find_call_file_and_line(Tree, MFA) ->
+find_call_file_and_line({Module, _, _}, Tree, MFA, CodeServer) ->
Fun =
fun(SubTree, Acc) ->
case cerl:is_c_call(SubTree) of
@@ -622,7 +648,7 @@ find_call_file_and_line(Tree, MFA) ->
case {cerl:concrete(M), cerl:concrete(F), A} of
MFA ->
Ann = cerl:get_ann(SubTree),
- [{get_file(Ann), get_line(Ann)}|Acc];
+ [{get_file(CodeServer, Module, Ann), get_line(Ann)}|Acc];
{erlang, make_fun, 3} ->
[CA1, CA2, CA3] = cerl:call_args(SubTree),
case
@@ -638,7 +664,8 @@ find_call_file_and_line(Tree, MFA) ->
of
MFA ->
Ann = cerl:get_ann(SubTree),
- [{get_file(Ann), get_line(Ann)}|Acc];
+ [{get_file(CodeServer, Module, Ann),
+ get_line(Ann)}|Acc];
_ ->
Acc
end;
@@ -658,8 +685,10 @@ get_line([Line|_]) when is_integer(Line) -> Line;
get_line([_|Tail]) -> get_line(Tail);
get_line([]) -> -1.
-get_file([{file, File}|_]) -> File;
-get_file([_|Tail]) -> get_file(Tail).
+get_file(Codeserver, Module, [{file, FakeFile}|_]) ->
+ dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile);
+get_file(Codeserver, Module, [_|Tail]) ->
+ get_file(Codeserver, Module, Tail).
-spec dump_callgraph(dialyzer_callgraph:callgraph(), #analysis_state{}, #analysis{}) ->
'ok'.
diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl
index 5623929a43..524ae047e2 100644
--- a/lib/dialyzer/src/dialyzer_behaviours.erl
+++ b/lib/dialyzer/src/dialyzer_behaviours.erl
@@ -62,9 +62,9 @@ check_callbacks(Module, Attrs, Records, Plt, Codeserver) ->
_ ->
MFA = {Module,module_info,0},
{_Var,Code} = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
- File = get_file(cerl:get_ann(Code)),
+ File = get_file(Codeserver, Module, cerl:get_ann(Code)),
State = #state{plt = Plt, filename = File, behlines = BehLines,
- codeserver = Codeserver, records = Records},
+ codeserver = Codeserver, records = Records},
Warnings = get_warnings(Module, Behaviours, State),
[add_tag_warning_info(Module, W, State) || W <- Warnings]
end.
@@ -213,12 +213,15 @@ add_tag_warning_info(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) ->
dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity},
State#state.codeserver),
Anns = cerl:get_ann(FunCode),
- WarningInfo = {get_file(Anns), get_line(Anns), {Module, Fun, Arity}},
+ File = get_file(State#state.codeserver, Module, Anns),
+ WarningInfo = {File, get_line(Anns), {Module, Fun, Arity}},
{?WARN_BEHAVIOUR, WarningInfo, Warn}.
get_line([Line|_]) when is_integer(Line) -> Line;
get_line([_|Tail]) -> get_line(Tail);
get_line([]) -> -1.
-get_file([{file, File}|_]) -> File;
-get_file([_|Tail]) -> get_file(Tail).
+get_file(Codeserver, Module, [{file, FakeFile}|_]) ->
+ dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile);
+get_file(Codeserver, Module, [_|Tail]) ->
+ get_file(Codeserver, Module, Tail).
diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index 50abb22009..5e02e7a2cc 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -119,7 +119,11 @@
-opaque callgraph() :: #callgraph{}.
--type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}.
+-type active_digraph() :: {'d', digraph:graph()}
+ | {'e',
+ Out :: ets:tid(),
+ In :: ets:tid(),
+ Map :: ets:tid()}.
%%----------------------------------------------------------------------
@@ -248,24 +252,30 @@ find_non_local_calls([], Set) ->
-spec get_depends_on(scc() | module(), callgraph()) -> [scc()].
-get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In}}) ->
- case ets_lookup_dict(SCC, Out) of
- {ok, Value} -> Value;
- error -> []
- end;
+get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In, Maps}}) ->
+ lookup_scc(SCC, Out, Maps);
get_depends_on(SCC, #callgraph{active_digraph = {'d', DG}}) ->
digraph:out_neighbours(DG, SCC).
-spec get_required_by(scc() | module(), callgraph()) -> [scc()].
-get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In}}) ->
- case ets_lookup_dict(SCC, In) of
- {ok, Value} -> Value;
- error -> []
- end;
+get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) ->
+ lookup_scc(SCC, In, Maps);
get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) ->
digraph:in_neighbours(DG, SCC).
+lookup_scc(SCC, Table, Maps) ->
+ case ets_lookup_dict({'scc', SCC}, Maps) of
+ {ok, SCCInt} ->
+ case ets_lookup_dict(SCCInt, Table) of
+ {ok, Ints} ->
+ [ets:lookup_element(Maps, Int, 2) || Int <- Ints];
+ error ->
+ []
+ end;
+ error -> []
+ end.
+
%%----------------------------------------------------------------------
%% Handling of modules & SCCs
%%----------------------------------------------------------------------
@@ -582,9 +592,10 @@ digraph_delete(DG) ->
active_digraph_delete({'d', DG}) ->
digraph:delete(DG);
-active_digraph_delete({'e', Out, In}) ->
+active_digraph_delete({'e', Out, In, Maps}) ->
ets:delete(Out),
- ets:delete(In).
+ ets:delete(In),
+ ets:delete(Maps).
digraph_edges(DG) ->
digraph:edges(DG).
@@ -758,37 +769,28 @@ to_ps(#callgraph{} = CG, File, Args) ->
ok.
condensation(G) ->
- SCs = digraph_utils:strong_components(G),
- V2I = ets:new(condensation_v2i, []),
- I2C = ets:new(condensation_i2c, []),
- I2I = ets:new(condensation_i2i, [bag]),
- CFun =
- fun(SC, N) ->
- lists:foreach(fun(V) -> true = ets:insert(V2I, {V,N}) end, SC),
- true = ets:insert(I2C, {N, SC}),
- N + 1
- end,
- lists:foldl(CFun, 1, SCs),
- Fun1 =
- fun({V1, V2}) ->
- I1 = ets:lookup_element(V2I, V1, 2),
- I2 = ets:lookup_element(V2I, V2, 2),
- I1 =:= I2 orelse ets:insert(I2I, {I1, I2})
- end,
- lists:foreach(Fun1, digraph:edges(G)),
- Fun3 =
- fun({I1, I2}, {Out, In}) ->
- SC1 = ets:lookup_element(I2C, I1, 2),
- SC2 = ets:lookup_element(I2C, I2, 2),
- {dict:append(SC1, SC2, Out), dict:append(SC2, SC1, In)}
- end,
- {OutDict, InDict} = ets:foldl(Fun3, {dict:new(), dict:new()}, I2I),
- [OutETS, InETS] =
+ SCCs = digraph_utils:strong_components(G),
+ %% Assign unique numbers to SCCs:
+ Ints = lists:seq(1, length(SCCs)),
+ IntToSCC = lists:zip(Ints, SCCs),
+ IntScc = sofs:relation(IntToSCC, [{int, scc}]),
+ %% Subsitute strong components for vertices in edges using the
+ %% unique numbers:
+ C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]),
+ I2V = sofs:relative_product(IntScc, C2V), % [{v, int}]
+ Es = sofs:relation(digraph:edges(G), [{v, v}]),
+ R1 = sofs:relative_product(I2V, Es),
+ R2 = sofs:relative_product(I2V, sofs:converse(R1)),
+ %% Create in- and out-neighbours:
+ In = sofs:relation_to_family(sofs:strict_relation(R2)),
+ R3 = sofs:converse(R2),
+ Out = sofs:relation_to_family(sofs:strict_relation(R3)),
+ [OutETS, InETS, MapsETS] =
[ets:new(Name,[{read_concurrency, true}]) ||
- Name <- [callgraph_deps_out, callgraph_deps_in]],
- ets:insert(OutETS, dict:to_list(OutDict)),
- ets:insert(InETS, dict:to_list(InDict)),
- ets:delete(V2I),
- ets:delete(I2C),
- ets:delete(I2I),
- {{'e', OutETS, InETS}, SCs}.
+ Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]],
+ ets:insert(OutETS, sofs:to_external(Out)),
+ ets:insert(InETS, sofs:to_external(In)),
+ %% Create mappings from SCCs to unique integers, and the inverse:
+ ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)),
+ ets:insert(MapsETS, IntToSCC),
+ {{'e', OutETS, InETS, MapsETS}, SCCs}.
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index fc56693ea3..e8c1613a33 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -637,8 +637,8 @@ cl_loop(State, LogCache) ->
{BackendPid, warnings, Warnings} ->
NewState = store_warnings(State, Warnings),
cl_loop(NewState, LogCache);
- {BackendPid, done, NewPlt, _NewDocPlt} ->
- return_value(State, NewPlt);
+ {BackendPid, done, NewMiniPlt, _NewDocPlt} ->
+ return_value(State, NewMiniPlt);
{BackendPid, ext_calls, ExtCalls} ->
cl_loop(State#cl_state{external_calls = ExtCalls}, LogCache);
{BackendPid, ext_types, ExtTypes} ->
@@ -654,6 +654,7 @@ cl_loop(State, LogCache) ->
cl_error(State, Msg);
_Other ->
%% io:format("Received ~p\n", [_Other]),
+ %% Note: {BackendPid, cserver, CodeServer, Plt} is ignored.
cl_loop(State, LogCache)
end.
@@ -699,10 +700,13 @@ return_value(State = #cl_state{erlang_mode = ErlangMode,
output_plt = OutputPlt,
plt_info = PltInfo,
stored_warnings = StoredWarnings},
- Plt) ->
+ MiniPlt) ->
case OutputPlt =:= none of
- true -> ok;
- false -> dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo)
+ true ->
+ dialyzer_plt:delete(MiniPlt);
+ false ->
+ Plt = dialyzer_plt:restore_full_plt(MiniPlt),
+ dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo)
end,
UnknownWarnings = unknown_warnings(State),
RetValue =
diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl
index 03cd9671af..a5bb4e209c 100644
--- a/lib/dialyzer/src/dialyzer_codeserver.erl
+++ b/lib/dialyzer/src/dialyzer_codeserver.erl
@@ -29,7 +29,9 @@
-module(dialyzer_codeserver).
-export([delete/1,
- finalize_contracts/3,
+ store_temp_contracts/4,
+ give_away/2,
+ finalize_contracts/1,
finalize_exported_types/2,
finalize_records/2,
get_contracts/1,
@@ -38,7 +40,9 @@
get_exports/1,
get_records/1,
get_next_core_label/1,
- get_temp_contracts/1,
+ get_temp_contracts/2,
+ contracts_modules/1,
+ store_contracts/4,
get_temp_exported_types/1,
get_temp_records/1,
insert/3,
@@ -48,6 +52,7 @@
is_exported/2,
lookup_mod_code/2,
lookup_mfa_code/2,
+ lookup_mfa_var_label/2,
lookup_mod_records/2,
lookup_mod_contracts/2,
lookup_mfa_contract/2,
@@ -56,21 +61,22 @@
set_next_core_label/2,
set_temp_records/2,
store_temp_records/3,
- store_temp_contracts/4]).
+ translate_fake_file/3]).
--export_type([codeserver/0, fun_meta_info/0]).
+-export_type([codeserver/0, fun_meta_info/0, contracts/0]).
-include("dialyzer.hrl").
%%--------------------------------------------------------------------
-type dict_ets() :: ets:tid().
+-type map_ets() :: ets:tid().
-type set_ets() :: ets:tid().
-type types() :: erl_types:type_table().
--type mod_records() :: dict:dict(module(), types()).
+-type mod_records() :: erl_types:mod_records().
--type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()).
+-type contracts() :: #{mfa() => dialyzer_contracts:file_contract()}.
-type mod_contracts() :: dict:dict(module(), contracts()).
%% A property-list of data compiled from -compile and -dialyzer attributes.
@@ -81,16 +87,16 @@
-record(codeserver, {next_core_label = 0 :: label(),
code :: dict_ets(),
- exported_types :: set_ets() | 'undefined', % set(mfa())
- records :: dict_ets() | 'undefined',
- contracts :: dict_ets() | 'undefined',
- callbacks :: dict_ets() | 'undefined',
+ exported_types :: set_ets(), % set(mfa())
+ records :: map_ets(),
+ contracts :: map_ets(),
+ callbacks :: map_ets(),
fun_meta_info :: dict_ets(), % {mfa(), meta_info()}
exports :: 'clean' | set_ets(), % set(mfa())
temp_exported_types :: 'clean' | set_ets(), % set(mfa())
- temp_records :: 'clean' | dict_ets(),
- temp_contracts :: 'clean' | dict_ets(),
- temp_callbacks :: 'clean' | dict_ets()
+ temp_records :: 'clean' | map_ets(),
+ temp_contracts :: 'clean' | map_ets(),
+ temp_callbacks :: 'clean' | map_ets()
}).
-opaque codeserver() :: #codeserver{}.
@@ -104,7 +110,7 @@ ets_dict_find(Key, Table) ->
_:_ -> error
end.
-ets_dict_store(Key, Element, Table) ->
+ets_map_store(Key, Element, Table) ->
true = ets:insert(Table, {Key, Element}),
Table.
@@ -128,9 +134,6 @@ ets_set_to_set(Table) ->
Fold = fun({E}, Set) -> sets:add_element(E, Set) end,
ets:foldl(Fold, sets:new(), Table).
-ets_read_concurrent_table(Name) ->
- ets:new(Name, [{read_concurrency, true}]).
-
%%--------------------------------------------------------------------
-spec new() -> codeserver().
@@ -138,6 +141,13 @@ ets_read_concurrent_table(Name) ->
new() ->
CodeOptions = [compressed, public, {read_concurrency, true}],
Code = ets:new(dialyzer_codeserver_code, CodeOptions),
+ ReadOptions = [compressed, {read_concurrency, true}],
+ [Contracts, Callbacks, Records, ExportedTypes] =
+ [ets:new(Name, ReadOptions) ||
+ Name <- [dialyzer_codeserver_contracts,
+ dialyzer_codeserver_callbacks,
+ dialyzer_codeserver_records,
+ dialyzer_codeserver_exported_types]],
TempOptions = [public, {write_concurrency, true}],
[Exports, FunMetaInfo, TempExportedTypes, TempRecords, TempContracts,
TempCallbacks] =
@@ -150,6 +160,10 @@ new() ->
#codeserver{code = Code,
exports = Exports,
fun_meta_info = FunMetaInfo,
+ exported_types = ExportedTypes,
+ records = Records,
+ contracts = Contracts,
+ callbacks = Callbacks,
temp_exported_types = TempExportedTypes,
temp_records = TempRecords,
temp_contracts = TempContracts,
@@ -170,13 +184,15 @@ insert(Mod, ModCode, CS) ->
Exports = cerl:module_exports(ModCode),
Attrs = cerl:module_attrs(ModCode),
Defs = cerl:module_defs(ModCode),
+ {Files, SmallDefs} = compress_file_anno(Defs),
As = cerl:get_ann(ModCode),
Funs =
[{{Mod, cerl:fname_id(Var), cerl:fname_arity(Var)},
- Val} || Val = {Var, _Fun} <- Defs],
- Keys = [Key || {Key, _Value} <- Funs],
+ Val, {Var, cerl_trees:get_label(Fun)}} || Val = {Var, Fun} <- SmallDefs],
+ Keys = [Key || {Key, _Value, _Label} <- Funs],
ModEntry = {Mod, {Name, Exports, Attrs, Keys, As}},
- true = ets:insert(CS#codeserver.code, [ModEntry|Funs]),
+ ModFileEntry = {{mod, Mod}, Files},
+ true = ets:insert(CS#codeserver.code, [ModEntry, ModFileEntry|Funs]),
CS.
-spec get_temp_exported_types(codeserver()) -> sets:set(mfa()).
@@ -220,12 +236,12 @@ get_exports(#codeserver{exports = Exports}) ->
-spec finalize_exported_types(sets:set(mfa()), codeserver()) -> codeserver().
-finalize_exported_types(Set, CS) ->
- ExportedTypes = ets_read_concurrent_table(dialyzer_codeserver_exported_types),
+finalize_exported_types(Set,
+ #codeserver{exported_types = ExportedTypes,
+ temp_exported_types = TempETypes} = CS) ->
true = ets_set_insert_set(Set, ExportedTypes),
- TempExpTypes = CS#codeserver.temp_exported_types,
- true = ets:delete(TempExpTypes),
- CS#codeserver{exported_types = ExportedTypes, temp_exported_types = clean}.
+ true = ets:delete(TempETypes),
+ CS#codeserver{temp_exported_types = clean}.
-spec lookup_mod_code(atom(), codeserver()) -> cerl:c_module().
@@ -237,6 +253,11 @@ lookup_mod_code(Mod, CS) when is_atom(Mod) ->
lookup_mfa_code({_M, _F, _A} = MFA, CS) ->
table__lookup(CS#codeserver.code, MFA).
+-spec lookup_mfa_var_label(mfa(), codeserver()) -> {cerl:c_var(), label()}.
+
+lookup_mfa_var_label({_M, _F, _A} = MFA, CS) ->
+ ets:lookup_element(CS#codeserver.code, MFA, 3).
+
-spec get_next_core_label(codeserver()) -> label().
get_next_core_label(#codeserver{next_core_label = NCL}) ->
@@ -251,8 +272,8 @@ set_next_core_label(NCL, CS) ->
lookup_mod_records(Mod, #codeserver{records = RecDict}) when is_atom(Mod) ->
case ets_dict_find(Mod, RecDict) of
- error -> dict:new();
- {ok, Dict} -> Dict
+ error -> maps:new();
+ {ok, Map} -> Map
end.
-spec get_records(codeserver()) -> mod_records().
@@ -262,11 +283,11 @@ get_records(#codeserver{records = RecDict}) ->
-spec store_temp_records(module(), types(), codeserver()) -> codeserver().
-store_temp_records(Mod, Dict, #codeserver{temp_records = TempRecDict} = CS)
+store_temp_records(Mod, Map, #codeserver{temp_records = TempRecDict} = CS)
when is_atom(Mod) ->
- case dict:size(Dict) =:= 0 of
+ case maps:size(Map) =:= 0 of
true -> CS;
- false -> CS#codeserver{temp_records = ets_dict_store(Mod, Dict, TempRecDict)}
+ false -> CS#codeserver{temp_records = ets_map_store(Mod, Map, TempRecDict)}
end.
-spec get_temp_records(codeserver()) -> mod_records().
@@ -284,20 +305,20 @@ set_temp_records(Dict, CS) ->
-spec finalize_records(mod_records(), codeserver()) -> codeserver().
-finalize_records(Dict, CS) ->
- true = ets:delete(CS#codeserver.temp_records),
- Records = ets_read_concurrent_table(dialyzer_codeserver_records),
+finalize_records(Dict, #codeserver{temp_records = TmpRecords,
+ records = Records} = CS) ->
+ true = ets:delete(TmpRecords),
true = ets_dict_store_dict(Dict, Records),
- CS#codeserver{records = Records, temp_records = clean}.
+ CS#codeserver{temp_records = clean}.
-spec lookup_mod_contracts(atom(), codeserver()) -> contracts().
lookup_mod_contracts(Mod, #codeserver{contracts = ContDict})
when is_atom(Mod) ->
case ets_dict_find(Mod, ContDict) of
- error -> dict:new();
+ error -> maps:new();
{ok, Keys} ->
- dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys])
+ maps:from_list([get_file_contract(Key, ContDict)|| Key <- Keys])
end.
get_file_contract(Key, ContDict) ->
@@ -330,48 +351,69 @@ get_callbacks(#codeserver{callbacks = CallbDict}) ->
-spec store_temp_contracts(module(), contracts(), contracts(), codeserver()) ->
codeserver().
-store_temp_contracts(Mod, SpecDict, CallbackDict,
+store_temp_contracts(Mod, SpecMap, CallbackMap,
#codeserver{temp_contracts = Cn,
temp_callbacks = Cb} = CS)
when is_atom(Mod) ->
- CS1 =
- case dict:size(SpecDict) =:= 0 of
- true -> CS;
- false ->
- CS#codeserver{temp_contracts = ets_dict_store(Mod, SpecDict, Cn)}
- end,
- case dict:size(CallbackDict) =:= 0 of
- true -> CS1;
- false ->
- CS1#codeserver{temp_callbacks = ets_dict_store(Mod, CallbackDict, Cb)}
- end.
-
--spec get_temp_contracts(codeserver()) -> {mod_contracts(), mod_contracts()}.
+ CS1 = CS#codeserver{temp_contracts = ets_map_store(Mod, SpecMap, Cn)},
+ CS1#codeserver{temp_callbacks = ets_map_store(Mod, CallbackMap, Cb)}.
-get_temp_contracts(#codeserver{temp_contracts = TempContDict,
- temp_callbacks = TempCallDict}) ->
- {ets_dict_to_dict(TempContDict), ets_dict_to_dict(TempCallDict)}.
+-spec contracts_modules(codeserver()) -> [module()].
--spec finalize_contracts(mod_contracts(), mod_contracts(), codeserver()) ->
- codeserver().
+contracts_modules(#codeserver{temp_contracts = TempContTable}) ->
+ ets:select(TempContTable, [{{'$1', '$2'}, [], ['$1']}]).
-finalize_contracts(SpecDict, CallbackDict, CS) ->
- Contracts = ets_read_concurrent_table(dialyzer_codeserver_contracts),
- Callbacks = ets_read_concurrent_table(dialyzer_codeserver_callbacks),
- Contracts = dict:fold(fun decompose_spec_dict/3, Contracts, SpecDict),
- Callbacks = dict:fold(fun decompose_cb_dict/3, Callbacks, CallbackDict),
- CS#codeserver{contracts = Contracts, callbacks = Callbacks,
- temp_contracts = clean, temp_callbacks = clean}.
+-spec store_contracts(module(), contracts(), contracts(), codeserver()) ->
+ codeserver().
-decompose_spec_dict(Mod, Dict, Table) ->
- Keys = dict:fetch_keys(Dict),
- true = ets:insert(Table, dict:to_list(Dict)),
- true = ets:insert(Table, {Mod, Keys}),
- Table.
+store_contracts(Mod, SpecMap, CallbackMap, CS) ->
+ #codeserver{contracts = SpecDict, callbacks = CallbackDict} = CS,
+ Keys = maps:keys(SpecMap),
+ true = ets:insert(SpecDict, maps:to_list(SpecMap)),
+ true = ets:insert(SpecDict, {Mod, Keys}),
+ true = ets:insert(CallbackDict, maps:to_list(CallbackMap)),
+ CS.
-decompose_cb_dict(_Mod, Dict, Table) ->
- true = ets:insert(Table, dict:to_list(Dict)),
- Table.
+-spec get_temp_contracts(module(), codeserver()) ->
+ {contracts(), contracts()}.
+
+get_temp_contracts(Mod, #codeserver{temp_contracts = TempContDict,
+ temp_callbacks = TempCallDict}) ->
+ [{Mod, Contracts}] = ets:lookup(TempContDict, Mod),
+ true = ets:delete(TempContDict, Mod),
+ [{Mod, Callbacks}] = ets:lookup(TempCallDict, Mod),
+ true = ets:delete(TempCallDict, Mod),
+ {Contracts, Callbacks}.
+
+-spec give_away(codeserver(), pid()) -> 'ok'.
+
+give_away(#codeserver{temp_records = TempRecords,
+ temp_contracts = TempContracts,
+ temp_callbacks = TempCallbacks,
+ records = Records,
+ contracts = Contracts,
+ callbacks = Callbacks}, Pid) ->
+ _ = [true = ets:give_away(Table, Pid, any) ||
+ Table <- [TempRecords, TempContracts, TempCallbacks,
+ Records, Contracts, Callbacks],
+ Table =/= clean],
+ ok.
+
+-spec finalize_contracts(codeserver()) -> codeserver().
+
+finalize_contracts(#codeserver{temp_contracts = TempContDict,
+ temp_callbacks = TempCallDict} = CS) ->
+ true = ets:delete(TempContDict),
+ true = ets:delete(TempCallDict),
+ CS#codeserver{temp_contracts = clean, temp_callbacks = clean}.
+
+-spec translate_fake_file(codeserver(), module(), file:filename()) ->
+ file:filename().
+
+translate_fake_file(#codeserver{code = Code}, Module, FakeFile) ->
+ Files = ets:lookup_element(Code, {mod, Module}, 2),
+ {FakeFile, File} = lists:keyfind(FakeFile, 1, Files),
+ File.
table__lookup(TablePid, M) when is_atom(M) ->
{Name, Exports, Attrs, Keys, As} = ets:lookup_element(TablePid, M, 2),
@@ -379,3 +421,25 @@ table__lookup(TablePid, M) when is_atom(M) ->
cerl:ann_c_module(As, Name, Exports, Attrs, Defs);
table__lookup(TablePid, MFA) ->
ets:lookup_element(TablePid, MFA, 2).
+
+compress_file_anno(Term) ->
+ {Files, SmallTerm} = compress_file_anno(Term, []),
+ {[{FakeFile, File} || {File, {file, FakeFile}} <- Files], SmallTerm}.
+
+compress_file_anno({file, F}, Fs) when is_list(F) ->
+ case lists:keyfind(F, 1, Fs) of
+ false ->
+ I = integer_to_list(length(Fs)),
+ FileI = {file, I},
+ NFs = [{F, FileI}|Fs],
+ {NFs, FileI};
+ {F, FileI} -> {Fs, FileI}
+ end;
+compress_file_anno(T, Fs) when is_tuple(T) ->
+ {NFs, NL} = compress_file_anno(tuple_to_list(T), Fs),
+ {NFs, list_to_tuple(NL)};
+compress_file_anno([E|L], Fs) ->
+ {Fs1, NE} = compress_file_anno(E, Fs),
+ {NFs, NL} = compress_file_anno(L, Fs1),
+ {NFs, [NE|NL]};
+compress_file_anno(T, Fs) -> {Fs, T}.
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 73b04b305b..f3fba68e84 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -31,7 +31,7 @@
get_contract_return/2,
%% get_contract_signature/1,
is_overloaded/1,
- process_contract_remote_types/1,
+ process_contract_remote_types/2,
store_tmp_contract/5]).
-export_type([file_contract/0, plt_contracts/0]).
@@ -146,14 +146,13 @@ sequence([], _Delimiter) -> "";
sequence([H], _Delimiter) -> H;
sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter).
--spec process_contract_remote_types(dialyzer_codeserver:codeserver()) ->
- dialyzer_codeserver:codeserver().
+-spec process_contract_remote_types(dialyzer_codeserver:codeserver(),
+ erl_types:mod_records()) ->
+ dialyzer_codeserver:codeserver().
-process_contract_remote_types(CodeServer) ->
- {TmpContractDict, TmpCallbackDict} =
- dialyzer_codeserver:get_temp_contracts(CodeServer),
+process_contract_remote_types(CodeServer, RecordDict) ->
+ Mods = dialyzer_codeserver:contracts_modules(CodeServer),
ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer),
- RecordDict = dialyzer_codeserver:get_records(CodeServer),
ContractFun =
fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) ->
#tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract,
@@ -165,20 +164,21 @@ process_contract_remote_types(CodeServer) ->
{{MFA, {File, Contract, Xtra}}, C2}
end,
ModuleFun =
- fun({ModuleName, ContractDict}, C3) ->
- {NewContractList, C4} =
- lists:mapfoldl(ContractFun, C3, dict:to_list(ContractDict)),
- {{ModuleName, dict:from_list(NewContractList)}, C4}
+ fun(ModuleName) ->
+ Cache = erl_types:cache__new(),
+ {ContractMap, CallbackMap} =
+ dialyzer_codeserver:get_temp_contracts(ModuleName, CodeServer),
+ {NewContractList, Cache1} =
+ lists:mapfoldl(ContractFun, Cache, maps:to_list(ContractMap)),
+ {NewCallbackList, _NewCache} =
+ lists:mapfoldl(ContractFun, Cache1, maps:to_list(CallbackMap)),
+ dialyzer_codeserver:store_contracts(ModuleName,
+ maps:from_list(NewContractList),
+ maps:from_list(NewCallbackList),
+ CodeServer)
end,
- Cache = erl_types:cache__new(),
- {NewContractList, C5} =
- lists:mapfoldl(ModuleFun, Cache, dict:to_list(TmpContractDict)),
- {NewCallbackList, _C6} =
- lists:mapfoldl(ModuleFun, C5, dict:to_list(TmpCallbackDict)),
- NewContractDict = dict:from_list(NewContractList),
- NewCallbackDict = dict:from_list(NewCallbackList),
- dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict,
- CodeServer).
+ lists:foreach(ModuleFun, Mods),
+ dialyzer_codeserver:finalize_contracts(CodeServer).
-type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]).
@@ -397,7 +397,7 @@ solve_constraints(Contract, Call, Constraints) ->
%% ?debug("Inf: ~s\n", [erl_types:t_to_string(Inf)]),
%% erl_types:t_assign_variables_to_subtype(Contract, Inf).
--type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()).
+-type contracts() :: dialyzer_codeserver:contracts().
%% Checks the contracts for functions that are not implemented
-spec contracts_without_fun(contracts(), [_], dialyzer_callgraph:callgraph()) ->
@@ -407,12 +407,12 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) ->
AllFuns1 = [{dialyzer_callgraph:lookup_name(Label, Callgraph), Arity}
|| {Label, Arity} <- AllFuns0],
AllFuns2 = [{M, F, A} || {{ok, {M, F, _}}, A} <- AllFuns1],
- AllContractMFAs = dict:fetch_keys(Contracts),
+ AllContractMFAs = maps:keys(Contracts),
ErrorContractMFAs = AllContractMFAs -- AllFuns2,
[warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs].
warn_spec_missing_fun({M, F, A} = MFA, Contracts) ->
- {{File, Line}, _Contract, _Xtra} = dict:fetch(MFA, Contracts),
+ {{File, Line}, _Contract, _Xtra} = maps:get(MFA, Contracts),
WarningInfo = {File, Line, MFA},
{?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}.
@@ -445,11 +445,11 @@ insert_constraints([], Map) -> Map.
-spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) ->
contracts().
-store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) ->
+store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecMap, RecordsDict) ->
%% io:format("contract from form: ~p\n", [TypeSpec]),
TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine),
%% io:format("contract: ~p\n", [TmpContract]),
- dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict).
+ maps:put(MFA, {FileLine, TmpContract, Xtra}, SpecMap).
contract_from_form(Forms, MFA, RecDict, FileLine) ->
{CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []),
@@ -677,7 +677,7 @@ get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) ->
get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) ->
Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer),
- Contracts2 = dict:to_list(Contracts1),
+ Contracts2 = maps:to_list(Contracts1),
Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer),
NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, FindOpaques, Acc),
get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, FindOpaques, NewAcc);
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 639ed426df..83ce875280 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -529,7 +529,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
case is_race_analysis_enabled(State) of
true ->
Ann = cerl:get_ann(Tree),
- File = get_file(Ann),
+ File = get_file(Ann, State),
Line = abs(get_line(Ann)),
dialyzer_races:store_race_call(Fun, ArgTypes, Args,
{File, Line}, State);
@@ -1351,8 +1351,6 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) ->
{Msg, Force} =
case t_is_none(ArgType0) of
true ->
- PatString = format_patterns(Pats),
- PatTypes = [PatString, format_type(OrigArgType, State1)],
%% See if this is covered by an earlier clause or if it
%% simply cannot match
OrigArgTypes =
@@ -1360,14 +1358,24 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) ->
true -> Any = t_any(), [Any || _ <- Pats];
false -> t_to_tlist(OrigArgType)
end,
+ PatString = format_patterns(Pats),
+ ArgTypeString = format_type(OrigArgType, State1),
+ BindResOrig =
+ bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1),
Tag =
- case bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1) of
+ case BindResOrig of
{error, bind, _, _, _} -> pattern_match;
{error, record, _, _, _} -> record_match;
{error, opaque, _, _, _} -> opaque_match;
{_, _} -> pattern_match_cov
end,
- {{Tag, PatTypes}, false};
+ PatTypes = case BindResOrig of
+ {error, opaque, _, _, OpaqueType} ->
+ [PatString, ArgTypeString,
+ format_type(OpaqueType, State1)];
+ _ -> [PatString, ArgTypeString]
+ end,
+ {{Tag, PatTypes}, false};
false ->
%% Try to find out if this is a default clause in a list
%% comprehension and supress this. A real Hack(tm)
@@ -3090,7 +3098,7 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State,
Ann = cerl:get_ann(Tree),
case Force of
true ->
- WarningInfo = {get_file(Ann),
+ WarningInfo = {get_file(Ann, State),
abs(get_line(Ann)),
State#state.curr_fun},
Warn = {Tag, WarningInfo, Msg},
@@ -3100,7 +3108,9 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State,
case is_compiler_generated(Ann) of
true -> State;
false ->
- WarningInfo = {get_file(Ann), get_line(Ann), State#state.curr_fun},
+ WarningInfo = {get_file(Ann, State),
+ get_line(Ann),
+ State#state.curr_fun},
Warn = {Tag, WarningInfo, Msg},
case Tag of
?WARN_CONTRACT_RANGE -> ok;
@@ -3499,6 +3509,12 @@ state__put_races(Races, State) ->
state__records_only(#state{records = Records}) ->
#state{records = Records}.
+-spec state__translate_file(file:filename(), state()) -> file:filename().
+
+state__translate_file(FakeFile, State) ->
+ #state{codeserver = CodeServer, module = Module} = State,
+ dialyzer_codeserver:translate_fake_file(CodeServer, Module, FakeFile).
+
%%% ===========================================================================
%%%
%%% Races
@@ -3570,9 +3586,11 @@ get_line([Line|_]) when is_integer(Line) -> Line;
get_line([_|Tail]) -> get_line(Tail);
get_line([]) -> -1.
-get_file([]) -> [];
-get_file([{file, File}|_]) -> File;
-get_file([_|Tail]) -> get_file(Tail).
+get_file([], _State) -> [];
+get_file([{file, FakeFile}|_], State) ->
+ state__translate_file(FakeFile, State);
+get_file([_|Tail], State) ->
+ get_file(Tail, State).
is_compiler_generated(Ann) ->
lists:member(compiler_generated, Ann) orelse (get_line(Ann) < 1).
diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl
index 4caf64d007..1701aff2f2 100644
--- a/lib/dialyzer/src/dialyzer_gui_wx.erl
+++ b/lib/dialyzer/src/dialyzer_gui_wx.erl
@@ -505,8 +505,9 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt,
end,
ExplanationPid = spawn_link(Fun),
gui_loop(State#gui_state{expl_pid = ExplanationPid});
- {BackendPid, done, _NewPlt, NewDocPlt} ->
+ {BackendPid, done, NewMiniPlt, NewDocPlt} ->
message(State, "Analysis done"),
+ dialyzer_plt:delete(NewMiniPlt),
config_gui_stop(State),
gui_loop(State#gui_state{doc_plt = NewDocPlt});
{'EXIT', BackendPid, {error, Reason}} ->
diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl
index cf2f0e919e..5ababa43dc 100644
--- a/lib/dialyzer/src/dialyzer_plt.erl
+++ b/lib/dialyzer/src/dialyzer_plt.erl
@@ -58,7 +58,9 @@
get_specs/4,
to_file/4,
get_mini_plt/1,
- restore_full_plt/2
+ restore_full_plt/1,
+ delete/1,
+ give_away/2
]).
%% Debug utilities
@@ -82,14 +84,16 @@
%%----------------------------------------------------------------------
-record(plt, {info = table_new() :: dict:dict(),
- types = table_new() :: dict:dict(),
+ types = table_new() :: erl_types:mod_records(),
contracts = table_new() :: dict:dict(),
callbacks = table_new() :: dict:dict(),
exported_types = sets:new() :: sets:set()}).
-record(mini_plt, {info :: ets:tid(),
+ types :: ets:tid(),
contracts :: ets:tid(),
- callbacks :: ets:tid()
+ callbacks :: ets:tid(),
+ exported_types :: ets:tid()
}).
-opaque plt() :: #plt{} | #mini_plt{}.
@@ -130,6 +134,10 @@ delete_module(#plt{info = Info, types = Types,
-spec delete_list(plt(), [mfa() | integer()]) -> plt().
+delete_list(#mini_plt{info = Info,
+ contracts = Contracts}=Plt, List) ->
+ Plt#mini_plt{info = ets_table_delete_list(Info, List),
+ contracts = ets_table_delete_list(Contracts, List)};
delete_list(#plt{info = Info, types = Types,
contracts = Contracts,
callbacks = Callbacks,
@@ -183,7 +191,7 @@ lookup(Plt, Label) when is_integer(Label) ->
lookup_1(#mini_plt{info = Info}, MFAorLabel) ->
ets_table_lookup(Info, MFAorLabel).
--spec insert_types(plt(), dict:dict()) -> plt().
+-spec insert_types(plt(), erl_types:mod_records()) -> plt().
insert_types(PLT, Rec) ->
PLT#plt{types = Rec}.
@@ -193,7 +201,7 @@ insert_types(PLT, Rec) ->
insert_exported_types(PLT, Set) ->
PLT#plt{exported_types = Set}.
--spec get_types(plt()) -> dict:dict().
+-spec get_types(plt()) -> erl_types:mod_records().
get_types(#plt{types = Types}) ->
Types.
@@ -226,12 +234,8 @@ contains_mfa(#plt{info = Info, contracts = Contracts}, MFA) ->
get_default_plt() ->
case os:getenv("DIALYZER_PLT") of
false ->
- case os:getenv("HOME") of
- false ->
- plt_error("The HOME environment variable needs to be set " ++
- "so that Dialyzer knows where to find the default PLT");
- HomeDir -> filename:join(HomeDir, ".dialyzer_plt")
- end;
+ {ok,[[HomeDir]]} = init:get_argument(home),
+ filename:join(HomeDir, ".dialyzer_plt");
UserSpecPlt -> UserSpecPlt
end.
@@ -253,8 +257,10 @@ from_file(FileName, ReturnInfo) ->
Msg = io_lib:format("Old PLT file ~s\n", [FileName]),
plt_error(Msg);
ok ->
+ Types = [{Mod, maps:from_list(dict:to_list(Types))} ||
+ {Mod, Types} <- dict:to_list(Rec#file_plt.types)],
Plt = #plt{info = Rec#file_plt.info,
- types = Rec#file_plt.types,
+ types = dict:from_list(Types),
contracts = Rec#file_plt.contracts,
callbacks = Rec#file_plt.callbacks,
exported_types = Rec#file_plt.exported_types},
@@ -371,12 +377,14 @@ to_file(FileName,
end,
OldModDeps, ModDeps),
ImplMd5 = compute_implementation_md5(),
+ FileTypes = dict:from_list([{Mod, dict:from_list(maps:to_list(MTypes))} ||
+ {Mod, MTypes} <- dict:to_list(Types)]),
Record = #file_plt{version = ?VSN,
file_md5_list = MD5,
info = Info,
contracts = Contracts,
callbacks = Callbacks,
- types = Types,
+ types = FileTypes,
exported_types = ExpTypes,
mod_deps = NewModDeps,
implementation_md5 = ImplMd5},
@@ -510,32 +518,100 @@ init_md5_list_1(Md5List, [], Acc) ->
-spec get_mini_plt(plt()) -> plt().
-get_mini_plt(#plt{info = Info, contracts = Contracts, callbacks = Callbacks}) ->
- [ETSInfo, ETSContracts, ETSCallbacks] =
- [ets:new(Name, [public]) || Name <- [plt_info, plt_contracts, plt_callbacks]],
+get_mini_plt(#plt{info = Info,
+ types = Types,
+ contracts = Contracts,
+ callbacks = Callbacks,
+ exported_types = ExpTypes}) ->
+ [ETSInfo, ETSTypes, ETSContracts, ETSCallbacks, ETSExpTypes] =
+ [ets:new(Name, [public]) ||
+ Name <- [plt_info, plt_types, plt_contracts, plt_callbacks,
+ plt_exported_types]],
CallbackList = dict:to_list(Callbacks),
CallbacksByModule =
[{M, [Cb || {{M1,_,_},_} = Cb <- CallbackList, M1 =:= M]} ||
M <- lists:usort([M || {{M,_,_},_} <- CallbackList])],
- [true, true] =
+ [true, true, true] =
[ets:insert(ETS, dict:to_list(Data)) ||
- {ETS, Data} <- [{ETSInfo, Info}, {ETSContracts, Contracts}]],
+ {ETS, Data} <- [{ETSInfo, Info},
+ {ETSTypes, Types},
+ {ETSContracts, Contracts}]],
true = ets:insert(ETSCallbacks, CallbacksByModule),
- #mini_plt{info = ETSInfo, contracts = ETSContracts, callbacks = ETSCallbacks};
+ true = ets:insert(ETSExpTypes, [{ET} || ET <- sets:to_list(ExpTypes)]),
+ #mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes};
get_mini_plt(undefined) ->
undefined.
--spec restore_full_plt(plt(), plt()) -> plt().
-
-restore_full_plt(#mini_plt{info = ETSInfo, contracts = ETSContracts}, Plt) ->
- Info = dict:from_list(ets:tab2list(ETSInfo)),
- Contracts = dict:from_list(ets:tab2list(ETSContracts)),
- ets:delete(ETSContracts),
- ets:delete(ETSInfo),
- Plt#plt{info = Info, contracts = Contracts};
-restore_full_plt(undefined, undefined) ->
+-spec restore_full_plt(plt()) -> plt().
+
+restore_full_plt(#mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes} = MiniPlt) ->
+ Info = dict:from_list(tab2list(ETSInfo)),
+ Contracts = dict:from_list(tab2list(ETSContracts)),
+ Types = dict:from_list(tab2list(ETSTypes)),
+ Callbacks =
+ dict:from_list([Cb || {_M, Cbs} <- tab2list(ETSCallbacks), Cb <- Cbs]),
+ ExpTypes = sets:from_list([E || {E} <- tab2list(ETSExpTypes)]),
+ ok = delete(MiniPlt),
+ #plt{info = Info,
+ types = Types,
+ contracts = Contracts,
+ callbacks = Callbacks,
+ exported_types = ExpTypes};
+restore_full_plt(undefined) ->
undefined.
+-spec delete(plt()) -> 'ok'.
+
+delete(#mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes}) ->
+ true = ets:delete(ETSContracts),
+ true = ets:delete(ETSTypes),
+ true = ets:delete(ETSInfo),
+ true = ets:delete(ETSCallbacks),
+ true = ets:delete(ETSExpTypes),
+ ok.
+
+-spec give_away(plt(), pid()) -> 'ok'.
+
+give_away(#mini_plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes},
+ Pid) ->
+ true = ets:give_away(ETSContracts, Pid, any),
+ true = ets:give_away(ETSTypes, Pid, any),
+ true = ets:give_away(ETSInfo, Pid, any),
+ true = ets:give_away(ETSCallbacks, Pid, any),
+ true = ets:give_away(ETSExpTypes, Pid, any),
+ ok.
+
+%% Somewhat slower than ets:tab2list(), but uses less memory.
+tab2list(T) ->
+ tab2list(ets:first(T), T, []).
+
+tab2list('$end_of_table', T, A) ->
+ case ets:first(T) of % no safe_fixtable()...
+ '$end_of_table' -> A;
+ Key -> tab2list(Key, T, A)
+ end;
+tab2list(Key, T, A) ->
+ Vs = ets:lookup(T, Key),
+ Key1 = ets:next(T, Key),
+ ets:delete(T, Key),
+ tab2list(Key1, T, Vs ++ A).
+
%%---------------------------------------------------------------------------
%% Edoc
@@ -607,6 +683,12 @@ table_delete_module1(Plt, Mod) ->
table_delete_module2(Plt, Mod) ->
dict:filter(fun(M, _Val) -> M =/= Mod end, Plt).
+ets_table_delete_list(Tab, [H|T]) ->
+ ets:delete(Tab, H),
+ ets_table_delete_list(Tab, T);
+ets_table_delete_list(Tab, []) ->
+ Tab.
+
table_delete_list(Plt, [H|T]) ->
table_delete_list(dict:erase(H, Plt), T);
table_delete_list(Plt, []) ->
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index 987da3aecf..0e44a5223f 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -96,7 +96,7 @@ analyze_callgraph(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent) ->
NewState =
init_state_and_get_success_typings(Callgraph, Plt, Codeserver,
TimingServer, Solvers, Parent),
- dialyzer_plt:restore_full_plt(NewState#st.plt, Plt).
+ NewState#st.plt.
%%--------------------------------------------------------------------
@@ -111,6 +111,7 @@ init_state_and_get_success_typings(Callgraph, Plt, Codeserver,
get_refined_success_typings(SCCs, #st{callgraph = Callgraph,
timing_server = TimingServer} = State) ->
+ erlang:garbage_collect(),
case find_succ_typings(SCCs, State) of
{fixpoint, State1} -> State1;
{not_fixpoint, NotFixpoint1, State1} ->
@@ -155,8 +156,8 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver,
?timing(TimingServer, "warning",
get_warnings_from_modules(Mods, InitState, MiniDocPlt)),
{postprocess_warnings(CWarns ++ ModWarns, Codeserver),
- dialyzer_plt:restore_full_plt(MiniPlt, Plt),
- dialyzer_plt:restore_full_plt(MiniDocPlt, DocPlt)}.
+ MiniPlt,
+ dialyzer_plt:restore_full_plt(MiniDocPlt)}.
get_warnings_from_modules(Mods, State, DocPlt) ->
#st{callgraph = Callgraph, codeserver = Codeserver,
@@ -174,10 +175,10 @@ collect_warnings(M, {Codeserver, Callgraph, Plt, DocPlt}) ->
%% Check if there are contracts for functions that do not exist
Warnings1 =
dialyzer_contracts:contracts_without_fun(Contracts, AllFuns, Callgraph),
+ Attrs = cerl:module_attrs(ModCode),
{Warnings2, FunTypes} =
dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Codeserver,
Records),
- Attrs = cerl:module_attrs(ModCode),
Warnings3 =
dialyzer_behaviours:check_callbacks(M, Attrs, Records, Plt, Codeserver),
DocPlt = insert_into_doc_plt(FunTypes, Callgraph, DocPlt),
@@ -262,7 +263,7 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) ->
NewFunTypes =
dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records),
Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer),
- Contracts = orddict:from_list(dict:to_list(Contracts1)),
+ Contracts = orddict:from_list(maps:to_list(Contracts1)),
FindOpaques = find_opaques_fun(Records),
DecoratedFunTypes =
decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques),
@@ -348,21 +349,25 @@ find_succ_typings(SCCs, #st{codeserver = Codeserver, callgraph = Callgraph,
-spec find_succ_types_for_scc(scc(), typesig_init_data()) -> [mfa_or_funlbl()].
-find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) ->
- SCC_Info = [{MFA,
- dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
- dialyzer_codeserver:lookup_mod_records(M, Codeserver)}
- || {M, _, _} = MFA <- SCC],
+find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) ->
+ SCC = [MFA || {_, _, _} = MFA <- SCC0],
Contracts1 = [{MFA, dialyzer_codeserver:lookup_mfa_contract(MFA, Codeserver)}
- || {_, _, _} = MFA <- SCC],
+ || MFA <- SCC],
Contracts2 = [{MFA, Contract} || {MFA, {ok, Contract}} <- Contracts1],
Contracts3 = orddict:from_list(Contracts2),
Label = dialyzer_codeserver:get_next_core_label(Codeserver),
- AllFuns = collect_fun_info([Fun || {_MFA, {_Var, Fun}, _Rec} <- SCC_Info]),
+ AllFuns = lists:append(
+ [begin
+ {_Var, Fun} =
+ dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
+ collect_fun_info([Fun])
+ end || MFA <- SCC]),
+ erlang:garbage_collect(),
PropTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt),
%% Assume that the PLT contains the current propagated types
- FunTypes = dialyzer_typesig:analyze_scc(SCC_Info, Label, Callgraph,
- Plt, PropTypes, Solvers),
+ FunTypes = dialyzer_typesig:analyze_scc(SCC, Label, Callgraph,
+ Codeserver, Plt, PropTypes,
+ Solvers),
AllFunSet = sets:from_list([X || {X, _} <- AllFuns]),
FilteredFunTypes =
dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes),
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index 1787b66192..4d650592e2 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,7 +29,7 @@
-module(dialyzer_typesig).
--export([analyze_scc/6]).
+-export([analyze_scc/7]).
-export([get_safe_underapprox/2]).
%%-import(helper, %% 'helper' could be any module doing sanity checks...
@@ -101,10 +101,9 @@
-type types() :: erl_types:type_table().
--type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, types()}].
-type typesig_funmap() :: #{type_var() => type_var()}.
--type prop_types() :: dict:dict(label(), types()).
+-type prop_types() :: dict:dict(label(), erl_types:erl_type()).
-record(state, {callgraph :: dialyzer_callgraph:callgraph()
| 'undefined',
@@ -121,7 +120,7 @@
plt :: dialyzer_plt:plt()
| 'undefined',
prop_types = dict:new() :: prop_types(),
- records = dict:new() :: types(),
+ records = maps:new() :: types(),
scc = [] :: ordsets:ordset(type_var()),
mfas :: [mfa()],
solvers = [] :: [solver()]
@@ -160,11 +159,10 @@
%%-----------------------------------------------------------------------------
%% Analysis of strongly connected components.
%%
-%% analyze_scc(SCC, NextLabel, CallGraph, PLT, PropTypes, Solvers) -> FunTypes
+%% analyze_scc(SCC, NextLabel, CallGraph, CodeServer,
+%% PLT, PropTypes, Solvers) -> FunTypes
%%
-%% SCC - [{MFA, Def, Records}]
-%% where Def = {Var, Fun} as in the Core Erlang module definitions.
-%% Records = dict(RecName, {Arity, [{FieldName, FieldType}]})
+%% SCC - [{MFA}]
%% NextLabel - An integer that is higher than any label in the code.
%% CallGraph - A callgraph as produced by dialyzer_callgraph.erl
%% Note: The callgraph must have been built with all the
@@ -176,28 +174,27 @@
%% Solvers - User specified solvers.
%%-----------------------------------------------------------------------------
--spec analyze_scc(typesig_scc(), label(),
+-spec analyze_scc([mfa()], label(),
dialyzer_callgraph:callgraph(),
+ dialyzer_codeserver:codeserver(),
dialyzer_plt:plt(), prop_types(), [solver()]) -> prop_types().
-analyze_scc(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers0) ->
+analyze_scc(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers0) ->
Solvers = solvers(Solvers0),
- assert_format_of_scc(SCC),
- State1 = new_state(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers),
- DefSet = add_def_list([Var || {_MFA, {Var, _Fun}, _Rec} <- SCC], sets:new()),
- State2 = traverse_scc(SCC, DefSet, State1),
+ State1 = new_state(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes,
+ Solvers),
+ DefSet = add_def_list(maps:values(State1#state.name_map), sets:new()),
+ ModRecs = [{M, dialyzer_codeserver:lookup_mod_records(M, CServer)} ||
+ M <- lists:usort([M || {M, _, _} <- SCC])],
+ State2 = traverse_scc(SCC, CServer, DefSet, ModRecs, State1),
State3 = state__finalize(State2),
+ erlang:garbage_collect(),
Funs = state__scc(State3),
pp_constrs_scc(Funs, State3),
constraints_to_dot_scc(Funs, State3),
T = solve(Funs, State3),
dict:from_list(maps:to_list(T)).
-assert_format_of_scc([{_MFA, {_Var, _Fun}, _Records}|Left]) ->
- assert_format_of_scc(Left);
-assert_format_of_scc([]) ->
- ok.
-
solvers([]) -> [v2];
solvers(Solvers) -> Solvers.
@@ -207,12 +204,15 @@ solvers(Solvers) -> Solvers.
%%
%% ============================================================================
-traverse_scc([{_MFA, Def, Rec}|Left], DefSet, AccState) ->
+traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, ModRecs, AccState) ->
+ Def = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
+ {M, Rec} = lists:keyfind(M, 1, ModRecs),
TmpState1 = state__set_rec_dict(AccState, Rec),
DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)),
- {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1),
- traverse_scc(Left, DefSet, NewAccState);
-traverse_scc([], _DefSet, AccState) ->
+ TmpState2 = state__new_constraint_context(TmpState1),
+ {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState2),
+ traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState);
+traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) ->
AccState.
traverse(Tree, DefinedVars, State) ->
@@ -2106,6 +2106,12 @@ v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval,
end;
v2_solve_disj([], [], _I, _Map, V2State, UL, MapL, Eval, Uneval, Failed) ->
{ok, V2State, lists:reverse(Eval), UL, MapL, lists:reverse(Uneval), Failed};
+v2_solve_disj([every_i], Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed) ->
+ NewIs = case Cs of
+ [] -> [];
+ _ -> [I, every_i]
+ end,
+ v2_solve_disj(NewIs, Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed);
v2_solve_disj(Is, [C|Cs], I, Map, V2State, UL, MapL, Eval, Uneval0, Failed) ->
Uneval = [{I,C#constraint_list.id} ||
not is_failed_list(C, V2State)] ++ Uneval0,
@@ -2177,7 +2183,7 @@ v2_solve_conj([I|Is], [Cs|Tail], I, Map0, Conj, IsFlat, V2State0,
M = lists:keydelete(I, 1, vars_per_child(U, Masks)),
{V2State2, NewF0} = save_updated_vars_list(AllCs, M, V2State1),
{NewF, F} = lists:splitwith(fun(J) -> J < I end, NewF0),
- Is1 = lists:umerge(Is, F),
+ Is1 = umerge_mask(Is, F),
NewFs = [NewF|NewFs0],
v2_solve_conj(Is1, Tail, I+1, Map, Conj, IsFlat, V2State2,
[U|UL], NewFs, VarsUp, LastMap, LastFlags)
@@ -2199,6 +2205,14 @@ v2_solve_conj([], _Cs, _I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
v2_solve_conj(NewFlags, Cs, 1, Map, Conj, IsFlat, V2State,
[], [], [U|VarsUp], Map, NewFlags)
end;
+v2_solve_conj([every_i], Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
+ LastMap, LastFlags) ->
+ NewIs = case Cs of
+ [] -> [];
+ _ -> [I, every_i]
+ end,
+ v2_solve_conj(NewIs, Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
+ LastMap, LastFlags);
v2_solve_conj(Is, [_|Tail], I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
LastMap, LastFlags) ->
v2_solve_conj(Is, Tail, I+1, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp,
@@ -2215,7 +2229,12 @@ report_detected_loop(_) ->
add_mask_to_flags(Flags, [Im|M], I, L) when I > Im ->
add_mask_to_flags(Flags, M, I, [Im|L]);
add_mask_to_flags(Flags, [_|M], _I, L) ->
- {lists:umerge(M, Flags), lists:reverse(L)}.
+ {umerge_mask(Flags, M), lists:reverse(L)}.
+
+umerge_mask([every_i]=Is, _F) ->
+ Is;
+umerge_mask(Is, F) ->
+ lists:umerge(Is, F).
get_mask(V, Masks) ->
case maps:find(V, Masks) of
@@ -2229,7 +2248,7 @@ get_flags(#v2_state{constr_data = ConData}=V2State0, C) ->
error ->
?debug("get_flags Id=~w Flags=all ~w\n", [Id, length(Cs)]),
V2State = V2State0#v2_state{constr_data = maps:put(Id, {[],[]}, ConData)},
- {V2State, lists:seq(1, length(Cs))};
+ {V2State, [every_i]};
{ok, failed} ->
{V2State0, failed_list};
{ok, {Part,U}} when U =/= [] ->
@@ -2702,11 +2721,14 @@ pp_map(_S, _Map) ->
%%
%% ============================================================================
-new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) ->
- List = [{MFA, Var} || {MFA, {Var, _Fun}, _Rec} <- SCC0],
+new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers) ->
+ List_SCC =
+ [begin
+ {Var, Label} = dialyzer_codeserver:lookup_mfa_var_label(MFA, CServer),
+ {{MFA, Var}, t_var(Label)}
+ end || MFA <- MFAs],
+ {List, SCC} = lists:unzip(List_SCC),
NameMap = maps:from_list(List),
- MFAs = [MFA || {MFA, _Var} <- List],
- SCC = [mk_var(Fun) || {_MFA, {_Var, Fun}, _Rec} <- SCC0],
SelfRec =
case SCC of
[OneF] ->
@@ -2906,8 +2928,9 @@ state__get_rec_var(Fun, #state{fun_map = Map}) ->
maps:find(Fun, Map).
state__finalize(State) ->
- State1 = enumerate_constraints(State),
- order_fun_constraints(State1).
+ State1 = state__new_constraint_context(State),
+ State2 = enumerate_constraints(State1),
+ order_fun_constraints(State2).
%% ============================================================================
%%
@@ -2987,7 +3010,7 @@ find_constraint_deps([Type|Tail], Acc) ->
NewAcc = [[t_var_name(D) || D <- t_collect_vars(Type)]|Acc],
find_constraint_deps(Tail, NewAcc);
find_constraint_deps([], Acc) ->
- lists:flatten(Acc).
+ lists:append(Acc).
mk_constraint_1(Lhs, eq, Rhs, Deps) when Lhs < Rhs ->
#constraint{lhs = Lhs, op = eq, rhs = Rhs, deps = Deps};
@@ -3095,8 +3118,8 @@ expand_to_conjunctions(#constraint_list{type = disj, list = List}) ->
List1 = [C || C <- List, is_simple_constraint(C)],
%% Just an assert.
[] = [C || #constraint{} = C <- List1],
- Expanded = lists:flatten([expand_to_conjunctions(C)
- || #constraint_list{} = C <- List]),
+ Expanded = lists:append([expand_to_conjunctions(C)
+ || #constraint_list{} = C <- List]),
ReturnList = Expanded ++ List1,
if length(ReturnList) > ?DISJ_NORM_FORM_LIMIT -> throw(too_many_disj);
true -> ReturnList
@@ -3121,8 +3144,10 @@ calculate_deps(List) ->
calculate_deps([H|Tail], Acc) ->
Deps = get_deps(H),
calculate_deps(Tail, [Deps|Acc]);
+calculate_deps([], []) -> [];
+calculate_deps([], [L]) -> L;
calculate_deps([], Acc) ->
- ordsets:from_list(lists:flatten(Acc)).
+ lists:umerge(Acc).
mk_conj_constraint_list(List) ->
mk_constraint_list(conj, List).
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 1f2d3e3aaa..e71a953279 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -202,7 +202,7 @@ get_core_from_abstract_code(AbstrCode, Opts) ->
get_record_and_type_info(AbstractCode) ->
Module = get_module(AbstractCode),
- get_record_and_type_info(AbstractCode, Module, dict:new()).
+ get_record_and_type_info(AbstractCode, Module, maps:new()).
-spec get_record_and_type_info(abstract_code(), module(), type_table()) ->
{'ok', type_table()} | {'error', string()}.
@@ -215,7 +215,7 @@ get_record_and_type_info([{attribute, A, record, {Name, Fields0}}|Left],
{ok, Fields} = get_record_fields(Fields0, RecDict),
Arity = length(Fields),
FN = {File, erl_anno:line(A)},
- NewRecDict = dict:store({record, Name}, {FN, [{Arity,Fields}]}, RecDict),
+ NewRecDict = maps:put({record, Name}, {FN, [{Arity,Fields}]}, RecDict),
get_record_and_type_info(Left, Module, NewRecDict, File);
get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}}
|Left], Module, RecDict, File) ->
@@ -223,7 +223,7 @@ get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}}
{ok, Fields} = get_record_fields(Fields0, RecDict),
Arity = length(Fields),
FN = {File, erl_anno:line(A)},
- NewRecDict = dict:store({record, Name}, {FN, [{Arity, Fields}]}, RecDict),
+ NewRecDict = maps:put({record, Name}, {FN, [{Arity, Fields}]}, RecDict),
get_record_and_type_info(Left, Module, NewRecDict, File);
get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm}}|Left],
Module, RecDict, File)
@@ -263,9 +263,9 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN,
false ->
try erl_types:t_var_names(ArgForms) of
ArgNames ->
- dict:store({TypeOrOpaque, Name, Arity},
- {{Module, FN, TypeForm, ArgNames},
- erl_types:t_any()}, RecDict)
+ maps:put({TypeOrOpaque, Name, Arity},
+ {{Module, FN, TypeForm, ArgNames},
+ erl_types:t_any()}, RecDict)
catch
_:_ ->
throw({error, flat_format("Type declaration for ~w does not "
@@ -296,19 +296,18 @@ get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) ->
get_record_fields([], _RecDict, Acc) ->
lists:reverse(Acc).
--spec process_record_remote_types(codeserver()) -> codeserver().
+-spec process_record_remote_types(codeserver()) ->
+ {codeserver(), mod_records()}.
%% The field types are cached. Used during analysis when handling records.
process_record_remote_types(CServer) ->
TempRecords = dialyzer_codeserver:get_temp_records(CServer),
ExpTypes = dialyzer_codeserver:get_exported_types(CServer),
- Cache = erl_types:cache__new(),
- {TempRecords1, Cache1} =
- process_opaque_types0(TempRecords, ExpTypes, Cache),
+ TempRecords1 = process_opaque_types0(TempRecords, ExpTypes),
%% A cache (not the field type cache) is used for speeding things up a bit.
VarTable = erl_types:var_table__new(),
ModuleFun =
- fun({Module, Record}, C0) ->
+ fun({Module, Record}) ->
RecordFun =
fun({Key, Value}, C2) ->
case Key of
@@ -334,24 +333,27 @@ process_record_remote_types(CServer) ->
_Other -> {{Key, Value}, C2}
end
end,
- {RecordList, C1} =
- lists:mapfoldl(RecordFun, C0, dict:to_list(Record)),
- {{Module, dict:from_list(RecordList)}, C1}
+ Cache = erl_types:cache__new(),
+ {RecordList, _NewCache} =
+ lists:mapfoldl(RecordFun, Cache, maps:to_list(Record)),
+ {Module, maps:from_list(RecordList)}
end,
- {NewRecordsList, C1} =
- lists:mapfoldl(ModuleFun, Cache1, dict:to_list(TempRecords1)),
+ NewRecordsList = lists:map(ModuleFun, dict:to_list(TempRecords1)),
NewRecords = dict:from_list(NewRecordsList),
- _C8 = check_record_fields(NewRecords, ExpTypes, C1),
- dialyzer_codeserver:finalize_records(NewRecords, CServer).
+ check_record_fields(NewRecords, ExpTypes),
+ {dialyzer_codeserver:finalize_records(NewRecords, CServer), NewRecords}.
%% erl_types:t_from_form() substitutes the declaration of opaque types
%% for the expanded type in some cases. To make sure the initial type,
%% any(), is not used, the expansion is done twice.
%% XXX: Recursive opaque types are not handled well.
-process_opaque_types0(TempRecords0, TempExpTypes, Cache) ->
- {TempRecords1, NewCache} =
+process_opaque_types0(TempRecords0, TempExpTypes) ->
+ Cache = erl_types:cache__new(),
+ {TempRecords1, Cache1} =
process_opaque_types(TempRecords0, TempExpTypes, Cache),
- process_opaque_types(TempRecords1, TempExpTypes, NewCache).
+ {TempRecords, _NewCache} =
+ process_opaque_types(TempRecords1, TempExpTypes, Cache1),
+ TempRecords.
process_opaque_types(TempRecords, TempExpTypes, Cache) ->
VarTable = erl_types:var_table__new(),
@@ -371,8 +373,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) ->
end
end,
{RecordList, C1} =
- lists:mapfoldl(RecordFun, C0, dict:to_list(Record)),
- {{Module, dict:from_list(RecordList)}, C1}
+ lists:mapfoldl(RecordFun, C0, maps:to_list(Record)),
+ {{Module, maps:from_list(RecordList)}, C1}
%% dict:map(RecordFun, Record)
end,
{TempRecordList, NewCache} =
@@ -380,7 +382,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) ->
{dict:from_list(TempRecordList), NewCache}.
%% dict:map(ModuleFun, TempRecords).
-check_record_fields(Records, TempExpTypes, Cache) ->
+check_record_fields(Records, TempExpTypes) ->
+ Cache = erl_types:cache__new(),
VarTable = erl_types:var_table__new(),
CheckFun =
fun({Module, Element}, C0) ->
@@ -410,9 +413,10 @@ check_record_fields(Records, TempExpTypes, Cache) ->
msg_with_position(Fun, FileLine)
end
end,
- lists:foldl(ElemFun, C0, dict:to_list(Element))
+ lists:foldl(ElemFun, C0, maps:to_list(Element))
end,
- lists:foldl(CheckFun, Cache, dict:to_list(Records)).
+ _NewCache = lists:foldl(CheckFun, Cache, dict:to_list(Records)),
+ ok.
msg_with_position(Fun, FileLine) ->
try Fun()
@@ -435,17 +439,17 @@ merge_records(NewRecords, OldRecords) ->
%%
%% ============================================================================
--type spec_dict() :: dict:dict().
--type callback_dict() :: dict:dict().
+-type spec_map() :: dialyzer_codeserver:contracts().
+-type callback_map() :: dialyzer_codeserver:contracts().
-spec get_spec_info(module(), abstract_code(), type_table()) ->
- {'ok', spec_dict(), callback_dict()} | {'error', string()}.
+ {'ok', spec_map(), callback_map()} | {'error', string()}.
-get_spec_info(ModName, AbstractCode, RecordsDict) ->
+get_spec_info(ModName, AbstractCode, RecordsMap) ->
OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName),
OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0),
- get_spec_info(AbstractCode, dict:new(), dict:new(),
- RecordsDict, ModName, OptionalCallbacks, "nofile").
+ get_spec_info(AbstractCode, maps:new(), maps:new(),
+ RecordsMap, ModName, OptionalCallbacks, "nofile").
get_optional_callbacks(Abs, ModName) ->
[{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)].
@@ -463,7 +467,7 @@ get_optional_callbacks(Abs) ->
%% are erl_types:erl_type()
get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left],
- SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File)
+ SpecMap, CallbackMap, RecordsMap, ModName, OptCb, File)
when ((Contract =:= 'spec') or (Contract =:= 'callback')),
is_list(TypeSpec) ->
Ln = erl_anno:line(Anno),
@@ -472,24 +476,24 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left],
{F, A} -> {ModName, F, A}
end,
Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)],
- ActiveDict =
+ ActiveMap =
case Contract of
- spec -> SpecDict;
- callback -> CallbackDict
+ spec -> SpecMap;
+ callback -> CallbackMap
end,
- try dict:find(MFA, ActiveDict) of
+ try maps:find(MFA, ActiveMap) of
error ->
SpecData = {TypeSpec, Xtra},
- NewActiveDict =
+ NewActiveMap =
dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData,
- ActiveDict, RecordsDict),
- {NewSpecDict, NewCallbackDict} =
+ ActiveMap, RecordsMap),
+ {NewSpecMap, NewCallbackMap} =
case Contract of
- spec -> {NewActiveDict, CallbackDict};
- callback -> {SpecDict, NewActiveDict}
+ spec -> {NewActiveMap, CallbackMap};
+ callback -> {SpecMap, NewActiveMap}
end,
- get_spec_info(Left, NewSpecDict, NewCallbackDict,
- RecordsDict, ModName, OptCb, File);
+ get_spec_info(Left, NewSpecMap, NewCallbackMap,
+ RecordsMap, ModName, OptCb, File);
{ok, {{OtherFile, L}, _D}} ->
{Mod, Fun, Arity} = MFA,
Msg = flat_format(" Contract/callback for function ~w:~w/~w "
@@ -502,16 +506,16 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left],
[Ln, Error])}
end;
get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left],
- SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) ->
- get_spec_info(Left, SpecDict, CallbackDict,
- RecordsDict, ModName, OptCb, IncludeFile);
-get_spec_info([_Other|Left], SpecDict, CallbackDict,
- RecordsDict, ModName, OptCb, File) ->
- get_spec_info(Left, SpecDict, CallbackDict,
- RecordsDict, ModName, OptCb, File);
-get_spec_info([], SpecDict, CallbackDict,
- _RecordsDict, _ModName, _OptCb, _File) ->
- {ok, SpecDict, CallbackDict}.
+ SpecMap, CallbackMap, RecordsMap, ModName, OptCb, _File) ->
+ get_spec_info(Left, SpecMap, CallbackMap,
+ RecordsMap, ModName, OptCb, IncludeFile);
+get_spec_info([_Other|Left], SpecMap, CallbackMap,
+ RecordsMap, ModName, OptCb, File) ->
+ get_spec_info(Left, SpecMap, CallbackMap,
+ RecordsMap, ModName, OptCb, File);
+get_spec_info([], SpecMap, CallbackMap,
+ _RecordsMap, _ModName, _OptCb, _File) ->
+ {ok, SpecMap, CallbackMap}.
-spec get_fun_meta_info(module(), abstract_code(), [dial_warn_tag()]) ->
dialyzer_codeserver:fun_meta_info() | {'error', string()}.
@@ -707,7 +711,7 @@ format_errors([]) ->
-spec format_sig(erl_types:erl_type()) -> string().
format_sig(Type) ->
- format_sig(Type, dict:new()).
+ format_sig(Type, maps:new()).
-spec format_sig(erl_types:erl_type(), type_table()) -> string().
@@ -959,9 +963,7 @@ label(Tree) ->
-spec parallelism() -> integer().
parallelism() ->
- CPUs = erlang:system_info(logical_processors_available),
- Schedulers = erlang:system_info(schedulers),
- min(CPUs, Schedulers).
+ erlang:system_info(schedulers_online).
-spec family([{K,V}]) -> [{K,[V]}].
diff --git a/lib/dialyzer/test/abstract_SUITE.erl b/lib/dialyzer/test/abstract_SUITE.erl
index 269db3e836..0e84dfab24 100644
--- a/lib/dialyzer/test/abstract_SUITE.erl
+++ b/lib/dialyzer/test/abstract_SUITE.erl
@@ -7,7 +7,7 @@
-include_lib("common_test/include/ct.hrl").
-include("dialyzer_test_constants.hrl").
--export([suite/0, all/0, init_per_suite/0, init_per_suite/1]).
+-export([suite/0, all/0, init_per_suite/0, init_per_suite/1, end_per_suite/1]).
-export([generated_case/1]).
suite() ->
@@ -24,6 +24,10 @@ init_per_suite(Config) ->
ok -> [{dialyzer_options, []}|Config]
end.
+end_per_suite(_Config) ->
+ %% This function is required since init_per_suite/1 exists.
+ ok.
+
generated_case(Config) when is_list(Config) ->
%% Equivalent to:
%%
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
index cb6a88786e..365b4798c5 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
@@ -1,2 +1,2 @@
{dialyzer_options, []}.
-{time_limit, 2}.
+{time_limit, 5}.
diff --git a/lib/dialyzer/test/map_SUITE_data/dialyzer_options b/lib/dialyzer/test/map_SUITE_data/dialyzer_options
index 50991c9bc5..02425c33f2 100644
--- a/lib/dialyzer/test/map_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/map_SUITE_data/dialyzer_options
@@ -1 +1,2 @@
{dialyzer_options, []}.
+{time_limit, 30}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
index 06ed52043a..cb301ff6a1 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
@@ -1,2 +1,2 @@
{dialyzer_options, [{warnings, [no_unused, no_return]}]}.
-{time_limit, 20}.
+{time_limit, 40}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/weird b/lib/dialyzer/test/opaque_SUITE_data/results/weird
new file mode 100644
index 0000000000..d7f57cd152
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/weird
@@ -0,0 +1,6 @@
+
+weird_warning1.erl:15: Matching of pattern {'a', Dict} tagged with a record name violates the declared type of #b{q::queue:queue(_)}
+weird_warning2.erl:13: Matching of pattern <{'b', Queue}, Key, Value> tagged with a record name violates the declared type of <#a{d::dict:dict(_,_)},'my_key','my_value'>
+weird_warning3.erl:14: The call weird_warning3:add_element(#a{d::queue:queue(_)},'my_key','my_value') does not have a term of type #a{d::dict:dict(_,_)} | #b{q::queue:queue(_)} (with opaque subterms) as 1st argument
+weird_warning3.erl:16: The attempt to match a term of type #a{d::queue:queue(_)} against the pattern {'a', Dict} breaks the opacity of queue:queue(_)
+weird_warning3.erl:18: Matching of pattern {'b', Queue} tagged with a record name violates the declared type of #a{d::queue:queue(_)}
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl
new file mode 100644
index 0000000000..094138e72b
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl
@@ -0,0 +1,18 @@
+-module(weird_warning1).
+-export([public_func/0]).
+
+-record(a, {
+ d = dict:new() :: dict:dict()
+ }).
+
+-record(b, {
+ q = queue:new() :: queue:queue()
+ }).
+
+public_func() ->
+ add_element(#b{}, my_key, my_value).
+
+add_element(#a{d = Dict}, Key, Value) ->
+ dict:store(Key, Value, Dict);
+add_element(#b{q = Queue}, Key, Value) ->
+ queue:in({Key, Value}, Queue).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl
new file mode 100644
index 0000000000..4e4512157b
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl
@@ -0,0 +1,14 @@
+-module(weird_warning2).
+-export([public_func/0]).
+
+-record(a, {d = dict:new() :: dict:dict()}).
+
+-record(b, {q = queue:new() :: queue:queue()}).
+
+public_func() ->
+ add_element(#a{}, my_key, my_value).
+
+add_element(#a{d = Dict}, Key, Value) ->
+ dict:store(Key, Value, Dict);
+add_element(#b{q = Queue}, Key, Value) ->
+ queue:in({Key, Value}, Queue).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl
new file mode 100644
index 0000000000..b70ca645cb
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl
@@ -0,0 +1,19 @@
+-module(weird_warning3).
+-export([public_func/0]).
+
+-record(a, {
+ d = dict:new() :: dict:dict()
+ }).
+
+-record(b, {
+ q = queue:new() :: queue:queue()
+ }).
+
+public_func() ->
+ %% Notice that t_to_string() will create "#a{d::queue:queue(_)}".
+ add_element({a, queue:new()}, my_key, my_value).
+
+add_element(#a{d = Dict}, Key, Value) ->
+ dict:store(Key, Value, Dict);
+add_element(#b{q = Queue}, Key, Value) ->
+ queue:in({Key, Value}, Queue).
diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl
index 460d4e2240..fbfa979e1b 100644
--- a/lib/dialyzer/test/plt_SUITE.erl
+++ b/lib/dialyzer/test/plt_SUITE.erl
@@ -26,6 +26,8 @@ build_plt(Config) ->
end.
beam_tests(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Plt = filename:join(PrivDir, "beam_tests.plt"),
Prog = <<"
-module(no_auto_import).
@@ -42,10 +44,12 @@ beam_tests(Config) when is_list(Config) ->
">>,
Opts = [no_auto_import],
{ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts),
- [] = run_dialyzer(plt_build, [BeamFile], []),
+ [] = run_dialyzer(plt_build, [BeamFile], [{output_plt, Plt}]),
ok.
run_plt_check(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Plt = filename:join(PrivDir, "run_plt_check.plt"),
Mod1 = <<"
-module(run_plt_check1).
">>,
@@ -56,7 +60,7 @@ run_plt_check(Config) when is_list(Config) ->
{ok, BeamFile1} = compile(Config, Mod1, run_plt_check1, []),
{ok, BeamFile2} = compile(Config, Mod2A, run_plt_check2, []),
- [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], []),
+ [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], [{output_plt, Plt}]),
Mod2B = <<"
-module(run_plt_check2).
@@ -70,11 +74,13 @@ run_plt_check(Config) when is_list(Config) ->
% callgraph warning as run_plt_check2:call/1 makes a call to unexported
% function run_plt_check1:call/1.
- [_] = run_dialyzer(plt_check, [], []),
+ [_] = run_dialyzer(plt_check, [], [{init_plt, Plt}]),
ok.
run_succ_typings(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Plt = filename:join(PrivDir, "run_succ_typings.plt"),
Mod1A = <<"
-module(run_succ_typings1).
@@ -84,7 +90,7 @@ run_succ_typings(Config) when is_list(Config) ->
">>,
{ok, BeamFile1} = compile(Config, Mod1A, run_succ_typings1, []),
- [] = run_dialyzer(plt_build, [BeamFile1], []),
+ [] = run_dialyzer(plt_build, [BeamFile1], [{output_plt, Plt}]),
Mod1B = <<"
-module(run_succ_typings1).
@@ -107,9 +113,11 @@ run_succ_typings(Config) when is_list(Config) ->
{ok, BeamFile2} = compile(Config, Mod2, run_succ_typings2, []),
% contract types warning as run_succ_typings2:call/0 makes a call to
% run_succ_typings1:call/0, which returns a (not b) in the PLT.
- [_] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, false}]),
+ [_] = run_dialyzer(succ_typings, [BeamFile2],
+ [{check_plt, false}, {init_plt, Plt}]),
% warning not returned as run_succ_typings1 is updated in the PLT.
- [] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, true}]),
+ [] = run_dialyzer(succ_typings, [BeamFile2],
+ [{check_plt, true}, {init_plt, Plt}]),
ok.
@@ -252,12 +260,9 @@ remove_plt(Config) ->
ok.
bad_dialyzer_attr(Config) ->
- PrivDir = ?config(priv_dir, Config),
-
Prog1 = <<"-module(dial).
-dialyzer({no_return, [undef/0]}).">>,
{ok, Beam1} = compile(Config, Prog1, dial, []),
- Plt = filename:join(PrivDir, "bad_attr.plt"),
{dialyzer_error,
"Analysis failed with error:\n"
"Could not scan the following file(s):\n"
diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars
new file mode 100644
index 0000000000..2c1f8f8d17
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/chars
@@ -0,0 +1,4 @@
+
+chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok'
+chars.erl:32: Function t1/0 has no local return
+chars.erl:32: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok'
diff --git a/lib/dialyzer/test/small_SUITE_data/src/anno.erl b/lib/dialyzer/test/small_SUITE_data/src/anno.erl
new file mode 100644
index 0000000000..70f1d42141
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/anno.erl
@@ -0,0 +1,18 @@
+-module(anno).
+
+%% OTP-14131
+
+-export([t1/0, t2/0, t3/0]).
+
+t1() ->
+ A = erl_parse:anno_from_term({attribute, 1, module, my_test}),
+ compile:forms([A], []).
+
+t2() ->
+ A = erl_parse:new_anno({attribute, 1, module, my_test}),
+ compile:forms([A], []).
+
+t3() ->
+ A = erl_parse:new_anno({attribute, 1, module, my_test}),
+ T = erl_parse:anno_to_term(A),
+ {attribute, 1, module, my_test} = T.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl
new file mode 100644
index 0000000000..1e9c8ab6b9
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl
@@ -0,0 +1,32 @@
+-module(chars).
+
+%% ERL-313
+
+-export([t/0]).
+-export([t1/0]).
+
+-record(r, {f :: $A .. $Z}).
+
+-type cs() :: $A..$Z | $a .. $z | $/.
+
+-spec t() -> $0-$0..$9-$0| $?.
+
+t() ->
+ c(#r{f = $z - 3}),
+ c($z - 3),
+ c($B).
+
+-spec c(cs()) -> $3-$0..$9-$0.
+
+c($A + 1) -> 2;
+c(C) ->
+ case C of
+ $z - 3 -> 3;
+ #r{f = $z - 3} -> 7
+ end.
+
+%% Display contract with character in warning:
+-spec f(#{a := $1, b => $2, c => $3}) -> ok. % invalid type spec
+f(_) -> ok.
+
+t1() -> f(#{b => $2}). % breaks the contract
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 996e75a8d3..0df36efa16 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -454,6 +454,9 @@ transition({timeout, _}, _) ->
%% Outgoing message.
transition({send, Msg}, S) ->
outgoing(Msg, S);
+transition({send, Msg, Route}, S) ->
+ put_route(Route),
+ outgoing(Msg, S);
%% Request for graceful shutdown at remove_transport, stop_service of
%% application shutdown.
@@ -483,8 +486,10 @@ transition({'DOWN', _, process, TPid, _},
= S) ->
start_next(S);
-%% Transport has died after connection timeout.
-transition({'DOWN', _, process, _, _}, _) ->
+%% Transport has died after connection timeout, or handler process has
+%% died.
+transition({'DOWN', _, process, Pid, _}, _) ->
+ erase_route(Pid),
ok;
%% State query.
@@ -494,6 +499,40 @@ transition({state, Pid}, #state{state = S, transport = TPid}) ->
%% Crash on anything unexpected.
+%% put_route/1
+%%
+%% Map identifiers in an outgoing request to be able to lookup the
+%% handler process when the answer is received.
+
+put_route({Pid, Ref, Seqs}) ->
+ MRef = monitor(process, Pid),
+ put(Pid, Seqs),
+ put(Seqs, {Pid, Ref, MRef}).
+
+%% get_route/1
+
+get_route(#diameter_packet{header = #diameter_header{is_request = false}}
+ = Pkt) ->
+ Seqs = diameter_codec:sequence_numbers(Pkt),
+ case erase(Seqs) of
+ {Pid, Ref, MRef} ->
+ demonitor(MRef),
+ erase(Pid),
+ {Pid, Ref, self()};
+ undefined ->
+ false
+ end;
+
+get_route(_) ->
+ false.
+
+%% erase_route/1
+
+erase_route(Pid) ->
+ erase(erase(Pid)).
+
+%% capx/1
+
capx(recv_CER) ->
'CER';
capx({'Wait-CEA', _, _}) ->
@@ -576,8 +615,7 @@ incoming({Msg, NPid}, S) ->
T
catch
{?MODULE, Name, Pkt} ->
- S#state.parent ! {recv, self(), Name, {Pkt, NPid}},
- rcv(Name, Pkt, S)
+ incoming(Name, Pkt, NPid, S)
end;
incoming(Msg, S) ->
@@ -585,10 +623,15 @@ incoming(Msg, S) ->
recv(Msg, S)
catch
{?MODULE, Name, Pkt} ->
- S#state.parent ! {recv, self(), Name, Pkt},
- rcv(Name, Pkt, S)
+ incoming(Name, Pkt, false, S)
end.
+%% incoming/4
+
+incoming(Name, Pkt, NPid, #state{parent = Pid} = S) ->
+ Pid ! {recv, self(), get_route(Pkt), Name, Pkt, NPid},
+ rcv(Name, Pkt, S).
+
%% recv/2
recv(#diameter_packet{header = #diameter_header{} = Hdr}
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index ccf68f4d93..e4f77e3a24 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1858,13 +1858,6 @@ eq(Any, Id, PeerId) ->
%% OctetString() can be specified as an iolist() so test for string
%% rather then term equality.
-%% transports/1
-
-transports(#state{watchdogT = WatchdogT}) ->
- ets:select(WatchdogT, [{#watchdog{peer = '$1', _ = '_'},
- [{'is_pid', '$1'}],
- ['$1']}]).
-
%% ---------------------------------------------------------------------------
%% # service_info/2
%% ---------------------------------------------------------------------------
@@ -1887,7 +1880,6 @@ transports(#state{watchdogT = WatchdogT}) ->
-define(ALL_INFO, [capabilities,
applications,
transport,
- pending,
options]).
%% The rest.
@@ -1981,7 +1973,6 @@ complete_info(Item, #state{service = Svc} = S) ->
applications -> info_apps(S);
transport -> info_transport(S);
options -> info_options(S);
- pending -> info_pending(S);
keys -> ?ALL_INFO ++ ?CAP_INFO ++ ?OTHER_INFO;
all -> service_info(?ALL_INFO, S);
statistics -> info_stats(S);
@@ -2189,13 +2180,6 @@ info_apps(#state{service = #diameter_service{applications = Apps}}) ->
mk_app(#diameter_app{} = A) ->
lists:zip(record_info(fields, diameter_app), tl(tuple_to_list(A))).
-%% info_pending/1
-%%
-%% One entry for each outgoing request whose answer is outstanding.
-
-info_pending(#state{} = S) ->
- diameter_traffic:pending(transports(S)).
-
%% info_info/1
%%
%% Extract process_info from connections info.
diff --git a/lib/diameter/src/base/diameter_sup.erl b/lib/diameter/src/base/diameter_sup.erl
index 482289cb9a..01c51f0856 100644
--- a/lib/diameter/src/base/diameter_sup.erl
+++ b/lib/diameter/src/base/diameter_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -42,7 +42,7 @@
-define(TABLES, [{diameter_sequence, [set]},
{diameter_service, [set, {keypos, 3}]},
- {diameter_request, [bag]},
+ {diameter_request, [set]},
{diameter_config, [bag, {keypos, 2}]}]).
%% start_link/0
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index d93a3e71e3..bc1ccf4feb 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,7 @@
-export([send_request/4]).
%% towards diameter_watchdog
--export([receive_message/4]).
+-export([receive_message/6]).
%% towards diameter_peer_fsm and diameter_watchdog
-export([incr/4,
@@ -40,11 +40,11 @@
%% towards diameter_service
-export([make_recvdata/1,
peer_up/1,
- peer_down/1,
- pending/1]).
+ peer_down/1]).
-%% towards ?MODULE
--export([send/1]). %% send from remote node
+%% internal
+-export([send/1, %% send from remote node
+ init/1]). %% monitor process start
-include_lib("diameter/include/diameter.hrl").
-include("diameter_internal.hrl").
@@ -57,14 +57,12 @@
-define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests
-define(DEFAULT_SPAWN_OPTS, []).
-%% Table containing outgoing requests for which a reply has yet to be
-%% received.
+%% Table containing outgoing entries that live and die with
+%% peer_up/down. The name is historic, since the table used to contain
+%% information about outgoing requests for which an answer has yet to
+%% be received.
-define(REQUEST_TABLE, diameter_request).
-%% Workaround for dialyzer's lack of understanding of match specs.
--type match(T)
- :: T | '_' | '$1' | '$2' | '$3' | '$4'.
-
%% Record diameter:call/4 options are parsed into.
-record(options,
{filter = none :: diameter:peer_filter(),
@@ -72,7 +70,7 @@
timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF,
detach = false :: boolean()}).
-%% Term passed back to receive_message/4 with every incoming message.
+%% Term passed back to receive_message/6 with every incoming message.
-record(recvdata,
{peerT :: ets:tid(),
service_name :: diameter:service_name(),
@@ -87,12 +85,12 @@
%% Record stored in diameter_request for each outgoing request.
-record(request,
- {ref :: match(reference()), %% used to receive answer
- caller :: match(pid()), %% calling process
- handler :: match(pid()), %% request process
- transport :: match(pid()), %% peer process
- caps :: match(#diameter_caps{}), %% of connection
- packet :: match(#diameter_packet{})}). %% of request
+ {ref :: reference(), %% used to receive answer
+ caller :: pid() | undefined, %% calling process
+ handler :: pid(), %% request process
+ transport :: pid() | undefined, %% peer process
+ caps :: #diameter_caps{} | undefined, %% of connection
+ packet :: #diameter_packet{} | undefined}). %% of request
%% ---------------------------------------------------------------------------
%% # make_recvdata/1
@@ -113,26 +111,27 @@ make_recvdata([SvcName, PeerT, Apps, SvcOpts | _]) ->
%% peer_up/1
%% ---------------------------------------------------------------------------
-%% Insert an element that is used to detect whether or not there has
-%% been a failover when inserting an outgoing request.
+%% Start a process that dies with peer_down/1, on which request
+%% processes can monitor. There is no other process that dies with
+%% peer_down since failover doesn't imply the loss of transport in the
+%% case of a watchdog transition into state SUSPECT.
peer_up(TPid) ->
- ets:insert(?REQUEST_TABLE, {TPid}).
+ proc_lib:start(?MODULE, init, [TPid]).
+
+init(TPid) ->
+ ets:insert(?REQUEST_TABLE, {TPid, self()}),
+ proc_lib:init_ack(self()),
+ proc_lib:hibernate(erlang, exit, [{shutdown, TPid}]).
%% ---------------------------------------------------------------------------
%% peer_down/1
%% ---------------------------------------------------------------------------
peer_down(TPid) ->
- ets:delete_object(?REQUEST_TABLE, {TPid}),
- lists:foreach(fun failover/1, ets:lookup(?REQUEST_TABLE, TPid)).
-%% Note that a request process can store its request after failover
-%% notifications are sent here: insert_request/2 sends the notification
-%% in that case.
-
-%% failover/1
-
-failover({_TPid, {Pid, TRef}}) ->
- Pid ! {failover, TRef}.
+ [{_, Pid}] = ets:lookup(?REQUEST_TABLE, TPid),
+ ets:delete(?REQUEST_TABLE, TPid),
+ Pid ! ok, %% make it die
+ Pid.
%% ---------------------------------------------------------------------------
%% incr/4
@@ -207,54 +206,25 @@ incr_rc(Dir, Pkt, TPid, Dict0) ->
incr_rc(Dir, Pkt, TPid, {Dict0, Dict0, Dict0}).
%% ---------------------------------------------------------------------------
-%% pending/1
-%% ---------------------------------------------------------------------------
-
-pending(TPids) ->
- MatchSpec = [{{'$1',
- #request{caller = '$2',
- handler = '$3',
- transport = '$4',
- _ = '_'},
- '_'},
- [?ORCOND([{'==', T, '$4'} || T <- TPids])],
- [{{'$1', [{{caller, '$2'}},
- {{handler, '$3'}},
- {{transport, '$4'}}]}}]}],
-
- try
- ets:select(?REQUEST_TABLE, MatchSpec)
- catch
- error: badarg -> [] %% service has gone down
- end.
-
-%% ---------------------------------------------------------------------------
-%% # receive_message/4
+%% # receive_message/6
%%
%% Handle an incoming Diameter message.
%% ---------------------------------------------------------------------------
-%% Handle an incoming Diameter message in the watchdog process. This
-%% used to come through the service process but this avoids that
-%% becoming a bottleneck.
+%% Handle an incoming Diameter message in the watchdog process.
-receive_message(TPid, {Pkt, NPid}, Dict0, RecvData) ->
- NPid ! {diameter, incoming(TPid, Pkt, Dict0, RecvData)};
+receive_message(TPid, Route, Pkt, false, Dict0, RecvData) ->
+ incoming(TPid, Route, Pkt, Dict0, RecvData);
-receive_message(TPid, Pkt, Dict0, RecvData) ->
- incoming(TPid, Pkt, Dict0, RecvData).
+receive_message(TPid, Route, Pkt, NPid, Dict0, RecvData) ->
+ NPid ! {diameter, incoming(TPid, Route, Pkt, Dict0, RecvData)}.
%% incoming/4
-incoming(TPid, Pkt, Dict0, RecvData)
+incoming(TPid, Route, Pkt, Dict0, RecvData)
when is_pid(TPid) ->
#diameter_packet{header = #diameter_header{is_request = R}} = Pkt,
- recv(R,
- (not R) andalso lookup_request(Pkt, TPid),
- TPid,
- Pkt,
- Dict0,
- RecvData).
+ recv(R, Route, TPid, Pkt, Dict0, RecvData).
%% recv/6
@@ -269,8 +239,8 @@ recv(true, false, TPid, Pkt, Dict0, T) ->
end;
%% ... answer to known request ...
-recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) ->
- Pid ! {answer, Ref, Req, Dict0, Pkt},
+recv(false, {Pid, Ref, TPid}, _, Pkt, Dict0, _) ->
+ Pid ! {answer, Ref, TPid, Dict0, Pkt},
{answer, Pid};
%% Note that failover could have happened prior to this message being
@@ -1503,32 +1473,39 @@ send_R(Pkt0,
packet = Pkt0},
incr(send, Pkt, TPid, AppDict),
- TRef = send_request(TPid, Pkt, Req, SvcName, Timeout),
+ {TRef, MRef} = zend_requezt(TPid, Pkt, Req, SvcName, Timeout),
Pid ! Ref, %% tell caller a send has been attempted
handle_answer(SvcName,
App,
- recv_A(Timeout, SvcName, App, Opts, {TRef, Req})).
+ recv_A(Timeout, SvcName, App, Opts, {TRef, MRef, Req})).
%% recv_A/5
-recv_A(Timeout, SvcName, App, Opts, {TRef, #request{ref = Ref} = Req}) ->
+recv_A(Timeout, SvcName, App, Opts, {TRef, MRef, #request{ref = Ref} = Req}) ->
%% Matching on TRef below ensures we ignore messages that pertain
%% to a previous transport prior to failover. The answer message
- %% includes the #request{} since it's not necessarily Req; that
- %% is, from the last peer to which we've transmitted.
+ %% includes the pid of the transport on which it was received,
+ %% which may not be the last peer to which we've transmitted.
receive
- {answer = A, Ref, Rq, Dict0, Pkt} -> %% Answer from peer
- {A, Rq, Dict0, Pkt};
+ {answer = A, Ref, TPid, Dict0, Pkt} -> %% Answer from peer
+ {A, #request{} = erase(TPid), Dict0, Pkt};
{timeout = Reason, TRef, _} -> %% No timely reply
{error, Req, Reason};
- {failover, TRef} -> %% Service says peer has gone down
- retransmit(pick_peer(SvcName, App, Req, Opts),
- Req,
- Opts,
- SvcName,
- Timeout)
+ {'DOWN', MRef, process, _, _} when false /= MRef -> %% local peer_down
+ failover(SvcName, App, Req, Opts, Timeout);
+ {failover, TRef} -> %% local or remote peer_down
+ failover(SvcName, App, Req, Opts, Timeout)
end.
+%% failover/5
+
+failover(SvcName, App, Req, Opts, Timeout) ->
+ retransmit(pick_peer(SvcName, App, Req, Opts),
+ Req,
+ Opts,
+ SvcName,
+ Timeout).
+
%% handle_answer/3
handle_answer(SvcName, App, {error, Req, Reason}) ->
@@ -1705,44 +1682,63 @@ encode(DictT, TPid, #diameter_packet{bin = undefined} = Pkt) ->
encode(_, _, #diameter_packet{} = Pkt) ->
Pkt.
+%% zend_requezt/5
+%%
+%% Strip potentially large record fields that aren't used by the
+%% processes the records can be send to, possibly on a remote node.
+
+zend_requezt(TPid, Pkt, Req, SvcName, Timeout) ->
+ put(TPid, Req),
+ send_request(TPid, z(Pkt), Req, SvcName, Timeout).
+
%% send_request/5
send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, _SvcName, Timeout)
when node() == node(TPid) ->
Seqs = diameter_codec:sequence_numbers(Bin),
TRef = erlang:start_timer(Timeout, self(), TPid),
- Entry = {Seqs, #request{handler = Pid} = Req, TRef},
-
- %% Ensure that request table is cleaned even if the process is
- %% killed.
- spawn(fun() -> diameter_lib:wait([Pid]), delete_request(Entry) end),
-
- insert_request(Entry),
- send(TPid, Pkt),
- TRef;
+ send(TPid, Pkt, _Route = {self(), Req#request.ref, Seqs}),
+ {TRef, _MRef = peer_monitor(TPid, TRef)};
%% Send using a remote transport: spawn a process on the remote node
%% to relay the answer.
send_request(TPid, #diameter_packet{} = Pkt, Req, SvcName, Timeout) ->
TRef = erlang:start_timer(Timeout, self(), TPid),
- T = {TPid, Pkt, Req, SvcName, Timeout, TRef},
+ T = {TPid, Pkt, z(Req), SvcName, Timeout, TRef},
spawn(node(TPid), ?MODULE, send, [T]),
- TRef.
+ {TRef, false}.
+
+%% z/1
+%%
+%% Avoid sending potentially large terms unnecessarily. The records
+%% themselves are retained since they're sent between nodes in send/1
+%% and changing what's sent causes upgrade issues.
+
+z(#request{ref = Ref, handler = Pid}) ->
+ #request{ref = Ref,
+ handler = Pid};
+
+z(#diameter_packet{header = H, bin = Bin, transport_data = T}) ->
+ #diameter_packet{header = H,
+ bin = Bin,
+ transport_data = T}.
%% send/1
send({TPid, Pkt, #request{handler = Pid} = Req0, SvcName, Timeout, TRef}) ->
Req = Req0#request{handler = self()},
- recv(TPid, Pid, TRef, send_request(TPid, Pkt, Req, SvcName, Timeout)).
+ recv(TPid, Pid, TRef, zend_requezt(TPid, Pkt, Req, SvcName, Timeout)).
%% recv/4
%%
%% Relay an answer from a remote node.
-recv(TPid, Pid, TRef, LocalTRef) ->
+recv(TPid, Pid, TRef, {LocalTRef, MRef}) ->
receive
{answer, _, _, _, _} = A ->
Pid ! A;
+ {'DOWN', MRef, process, _, _} ->
+ Pid ! {failover, TRef};
{failover = T, LocalTRef} ->
Pid ! {T, TRef};
T ->
@@ -1751,14 +1747,13 @@ recv(TPid, Pid, TRef, LocalTRef) ->
%% send/2
-send(Pid, Pkt) -> %% Strip potentially large message terms.
- #diameter_packet{header = H,
- bin = Bin,
- transport_data = T}
- = Pkt,
- Pid ! {send, #diameter_packet{header = H,
- bin = Bin,
- transport_data = T}}.
+send(Pid, Pkt) ->
+ Pid ! {send, Pkt}.
+
+%% send/3
+
+send(Pid, Pkt, Route) ->
+ Pid ! {send, Pkt, Route}.
%% retransmit/4
@@ -1768,8 +1763,8 @@ retransmit({TPid, Caps, App}
= Req,
SvcName,
Timeout) ->
- have_request(Pkt0, TPid) %% Don't failover to a peer we've
- andalso ?THROW(timeout), %% already sent to.
+ undefined == get(TPid) %% Don't failover to a peer we've
+ orelse ?THROW(timeout), %% already sent to.
Pkt = make_retransmit_packet(Pkt0),
@@ -1822,56 +1817,20 @@ resend_request(Pkt0,
?LOG(retransmission, Pkt#diameter_packet.header),
incr(TPid, {msg_id(Pkt, AppDict), send, retransmission}),
- TRef = send_request(TPid, Pkt, Req, SvcName, Tmo),
- {TRef, Req}.
-
-%% insert_request/1
-
-insert_request({_Seqs, #request{transport = TPid}, TRef} = T) ->
- ets:insert(?REQUEST_TABLE, [T, {TPid, {self(), TRef}}]),
- is_peer_up(TPid)
- orelse (self() ! {failover, TRef}). %% failover/1 may have missed
-
-%% is_peer_up/1
-%%
-%% Is the entry written by peer_up/1 and deleted by peer_down/1 still
-%% in the request table?
+ {TRef, MRef} = zend_requezt(TPid, Pkt, Req, SvcName, Tmo),
+ {TRef, MRef, Req}.
-is_peer_up(TPid) ->
- Spec = [{{TPid}, [], ['$_']}],
- '$end_of_table' /= ets:select(?REQUEST_TABLE, Spec, 1).
+%% peer_monitor/2
-%% lookup_request/2
-%%
-%% Note the match on both the key and transport pid. The latter is
-%% necessary since the same Hop-by-Hop and End-to-End identifiers are
-%% reused in the case of retransmission.
-
-lookup_request(Msg, TPid) ->
- Seqs = diameter_codec:sequence_numbers(Msg),
- Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, '_'},
- [],
- ['$_']}],
- case ets:select(?REQUEST_TABLE, Spec) of
- [{_, Req, _}] ->
- Req;
- [] ->
+peer_monitor(TPid, TRef) ->
+ case ets:lookup(?REQUEST_TABLE, TPid) of %% at peer_up/1
+ [{_, MPid}] ->
+ monitor(process, MPid);
+ [] -> %% transport has gone down
+ self() ! {failover, TRef},
false
end.
-%% delete_request/1
-
-delete_request({_Seqs, #request{handler = Pid, transport = TPid}, TRef} = T) ->
- Spec = [{R, [], [true]} || R <- [T, {TPid, {Pid, TRef}}]],
- ets:select_delete(?REQUEST_TABLE, Spec).
-
-%% have_request/2
-
-have_request(Pkt, TPid) ->
- Seqs = diameter_codec:sequence_numbers(Pkt),
- Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'},
- '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1).
-
%% get_destination/2
get_destination(Dict, Msg) ->
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index 2ba60a65fb..f28b8f2910 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -283,7 +283,7 @@ event(Msg,
?LOG(transition, {From, To}).
data(Msg, TPid, reopen, okay) ->
- {recv, TPid, 'DWA', _Pkt} = Msg, %% assert
+ {recv, TPid, false, 'DWA', _Pkt, _NPid} = Msg, %% assert
{TPid, T} = eraser(open),
[T];
@@ -447,12 +447,14 @@ transition({'DOWN', _, process, TPid, _Reason} = D,
end;
%% Incoming message.
-transition({recv, TPid, Name, PktT}, #watchdog{transport = TPid} = S) ->
+transition({recv, TPid, Route, Name, Pkt, NPid},
+ #watchdog{transport = TPid}
+ = S) ->
try
- incoming(Name, PktT, S)
+ incoming(Name, Pkt, NPid, S)
catch
#watchdog{dictionary = Dict0, receive_data = T} = NS ->
- diameter_traffic:receive_message(TPid, PktT, Dict0, T),
+ diameter_traffic:receive_message(TPid, Route, Pkt, NPid, Dict0, T),
NS
end;
@@ -582,15 +584,17 @@ send_watchdog(#watchdog{pending = false,
%% Don't count encode errors since we don't expect any on DWR/DWA.
-%% incoming/3
+%% incoming/4
-incoming(Name, {Pkt, NPid}, S) ->
- NS = recv(Name, Pkt, S),
- NPid ! {diameter, discard},
- NS;
+incoming(Name, Pkt, false, S) ->
+ recv(Name, Pkt, S);
-incoming(Name, Pkt, S) ->
- recv(Name, Pkt, S).
+incoming(Name, Pkt, NPid, S) ->
+ try
+ recv(Name, Pkt, S)
+ after
+ NPid ! {diameter, discard}
+ end.
%% recv/3
diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile
index 21a0da926f..81fa8f187a 100644
--- a/lib/eldap/test/Makefile
+++ b/lib/eldap/test/Makefile
@@ -42,7 +42,7 @@ TARGET_FILES= \
SPEC_FILES = eldap.spec
-# COVER_FILE = eldap.cover
+COVER_FILE = eldap.cover
# ----------------------------------------------------
diff --git a/lib/eldap/test/eldap.cover b/lib/eldap/test/eldap.cover
new file mode 100644
index 0000000000..8c15956e72
--- /dev/null
+++ b/lib/eldap/test/eldap.cover
@@ -0,0 +1,3 @@
+{incl_app,eldap,details}.
+
+{excl_mods, eldap, ['ELDAPv3']}.
diff --git a/lib/erl_interface/doc/src/erl_call.xml b/lib/erl_interface/doc/src/erl_call.xml
index f1e52b1889..426f6b88ca 100644
--- a/lib/erl_interface/doc/src/erl_call.xml
+++ b/lib/erl_interface/doc/src/erl_call.xml
@@ -193,7 +193,7 @@ erl_call -s -a 'erlang halt' -n madonna
<p>To apply with many arguments:</p>
<code type="none"><![CDATA[
-erl_call -s -a 'lists map [{math,sqrt},[1,4,9,16,25]]' -n madonna
+erl_call -s -a 'lists seq [1,10]' -n madonna
]]></code>
<p>To evaluate some expressions
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 226a5d0f61..a5a3e8c136 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -236,7 +236,8 @@
-export([t_is_identifier/1]).
-endif.
--export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]).
+-export_type([erl_type/0, opaques/0, type_table/0, mod_records/0,
+ var_table/0, cache/0]).
%%-define(DEBUG, true).
@@ -379,8 +380,9 @@
-type type_value() :: {{module(), {file:name(), erl_anno:line()},
erl_parse:abstract_type(), ArgNames :: [atom()]},
erl_type()}.
--type type_table() :: dict:dict(record_key() | type_key(),
- record_value() | type_value()).
+-type type_table() :: #{record_key() | type_key() =>
+ record_value() | type_value()}.
+-type mod_records() :: dict:dict(module(), type_table()).
-opaque var_table() :: #{atom() => erl_type()}.
@@ -524,7 +526,8 @@ list_contains_opaque(List, Opaques) ->
lists:any(fun(E) -> t_contains_opaque(E, Opaques) end, List).
%% t_find_opaque_mismatch/2 of two types should only be used if their
-%% t_inf is t_none() due to some opaque type violation.
+%% t_inf is t_none() due to some opaque type violation. However,
+%% 'error' is returned if a structure mismatch is found.
%%
%% The first argument of the function is the pattern and its second
%% argument the type we are matching against the pattern.
@@ -533,22 +536,30 @@ list_contains_opaque(List, Opaques) ->
'error' | {'ok', erl_type(), erl_type()}.
t_find_opaque_mismatch(T1, T2, Opaques) ->
- t_find_opaque_mismatch(T1, T2, T2, Opaques).
+ catch t_find_opaque_mismatch(T1, T2, T2, Opaques).
t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error;
-t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> error;
+t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error);
t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) ->
t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques);
t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) ->
case is_opaque_type(T2, Opaques) of
- false -> {ok, TopType, T2};
+ false ->
+ case t_is_opaque(T1) andalso compatible_opaque_types(T1, T2) =/= [] of
+ true -> error;
+ false -> {ok, TopType, T2}
+ end;
true ->
t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques)
end;
t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) ->
%% The generated message is somewhat misleading:
case is_opaque_type(T1, Opaques) of
- false -> {ok, TopType, T1};
+ false ->
+ case t_is_opaque(T2) andalso compatible_opaque_types(T1, T2) =/= [] of
+ true -> error;
+ false -> {ok, TopType, T1}
+ end;
true ->
t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques)
end;
@@ -564,7 +575,11 @@ t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2,
t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques);
t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) ->
t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques);
-t_find_opaque_mismatch(_T1, _T2, _TopType, _Opaques) -> error.
+t_find_opaque_mismatch(T1, T2, _TopType, Opaques) ->
+ case t_is_none(t_inf(T1, T2, Opaques)) of
+ false -> error;
+ true -> throw(error)
+ end.
t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) ->
List = lists:zipwith(fun(T1, T2) ->
@@ -573,10 +588,11 @@ t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) ->
t_find_opaque_mismatch_list(List).
t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) ->
- List = [t_find_opaque_mismatch(T1, T2, T2, Opaques) || T1 <- L1, T2 <- L2],
+ List = [catch t_find_opaque_mismatch(T1, T2, T2, Opaques) ||
+ T1 <- L1, T2 <- L2],
t_find_opaque_mismatch_list(List).
-t_find_opaque_mismatch_list([]) -> error;
+t_find_opaque_mismatch_list([]) -> throw(error);
t_find_opaque_mismatch_list([H|T]) ->
case H of
{ok, _T1, _T2} -> H;
@@ -749,16 +765,16 @@ decorate_tuples_in_sets([], _L, _Opaques, Acc) ->
-spec t_opaque_from_records(type_table()) -> [erl_type()].
-t_opaque_from_records(RecDict) ->
- OpaqueRecDict =
- dict:filter(fun(Key, _Value) ->
+t_opaque_from_records(RecMap) ->
+ OpaqueRecMap =
+ maps:filter(fun(Key, _Value) ->
case Key of
{opaque, _Name, _Arity} -> true;
_ -> false
end
- end, RecDict),
- OpaqueTypeDict =
- dict:map(fun({opaque, Name, _Arity},
+ end, RecMap),
+ OpaqueTypeMap =
+ maps:map(fun({opaque, Name, _Arity},
{{Module, _FileLine, _Form, ArgNames}, _Type}) ->
%% Args = args_to_types(ArgNames),
%% List = lists:zip(ArgNames, Args),
@@ -767,8 +783,8 @@ t_opaque_from_records(RecDict) ->
Rep = t_any(), % not used for anything right now
Args = [t_any() || _ <- ArgNames],
t_opaque(Module, Name, Args, Rep)
- end, OpaqueRecDict),
- [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)].
+ end, OpaqueRecMap),
+ [OpaqueType || {_Key, OpaqueType} <- maps:to_list(OpaqueTypeMap)].
%% Decompose opaque instances of type arg2 to structured types, in arg1
%% XXX: Same as t_unopaque
@@ -802,10 +818,6 @@ list_struct_from_opaque(Types, Opaques) ->
[t_struct_from_opaque(Type, Opaques) || Type <- Types].
%%-----------------------------------------------------------------------------
-
--type mod_records() :: dict:dict(module(), type_table()).
-
-%%-----------------------------------------------------------------------------
%% Unit type. Signals non termination.
%%
@@ -2245,16 +2257,21 @@ t_has_var_list([]) -> false.
-spec t_collect_vars(erl_type()) -> [erl_type()].
t_collect_vars(T) ->
- t_collect_vars(T, []).
+ Vs = t_collect_vars(T, maps:new()),
+ [V || {V, _} <- maps:to_list(Vs)].
--spec t_collect_vars(erl_type(), [erl_type()]) -> [erl_type()].
+-type ctab() :: #{erl_type() => 'any'}.
+
+-spec t_collect_vars(erl_type(), ctab()) -> ctab().
t_collect_vars(?var(_) = Var, Acc) ->
- ordsets:add_element(Var, Acc);
+ maps:put(Var, any, Acc);
t_collect_vars(?function(Domain, Range), Acc) ->
- ordsets:union(t_collect_vars(Domain, Acc), t_collect_vars(Range, []));
+ Acc1 = t_collect_vars(Domain, Acc),
+ t_collect_vars(Range, Acc1);
t_collect_vars(?list(Contents, Termination, _), Acc) ->
- ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, []));
+ Acc1 = t_collect_vars(Contents, Acc),
+ t_collect_vars(Termination, Acc1);
t_collect_vars(?product(Types), Acc) ->
t_collect_vars_list(Types, Acc);
t_collect_vars(?tuple(?any, ?any, ?any), Acc) ->
@@ -3052,6 +3069,9 @@ inf_opaque_types(IsOpaque1, T1, IsOpaque2, T2, Opaques) ->
end
end.
+compatible_opaque_types(?opaque(Es1), ?opaque(Es2)) ->
+ [{O1, O2} || O1 <- Es1, O2 <- Es2, is_compat_opaque_names(O1, O2)].
+
is_compat_opaque_names(Opaque1, Opaque2) ->
#opaque{mod = Mod1, name = Name1, args = Args1} = Opaque1,
#opaque{mod = Mod2, name = Name2, args = Args2} = Opaque2,
@@ -3067,88 +3087,91 @@ is_compat_args([A1|Args1], [A2|Args2]) ->
is_compat_args([], []) -> true;
is_compat_args(_, _) -> false.
-is_compat_arg(A1, A2) ->
- is_specialization(A1, A2) orelse is_specialization(A2, A1).
-
--spec is_specialization(erl_type(), erl_type()) -> boolean().
-
-%% Returns true if the first argument is a specialization of the
-%% second argument in the sense that every type is a specialization of
-%% any(). For example, {_,_} is a specialization of any(), but not of
-%% tuple(). Does not handle variables, but any() and unions (sort of).
-
-is_specialization(T, T) -> true;
-is_specialization(_, ?any) -> true;
-is_specialization(?any, _) -> false;
-is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) ->
- (is_specialization(Domain1, Domain2) andalso
- is_specialization(Range1, Range2));
-is_specialization(?list(Contents1, Termination1, Size1),
- ?list(Contents2, Termination2, Size2)) ->
+-spec is_compat_arg(erl_type(), erl_type()) -> boolean().
+
+%% The intention is that 'true' is to be returned iff one of the
+%% arguments is a specialization of the other argument in the sense
+%% that every type is a specialization of any(). For example, {_,_} is
+%% a specialization of any(), but not of tuple(). Does not handle
+%% variables, but any() and unions (sort of). However, the
+%% implementation is more relaxed as any() is compatible to anything.
+
+is_compat_arg(T, T) -> true;
+is_compat_arg(_, ?any) -> true;
+is_compat_arg(?any, _) -> true;
+is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) ->
+ (is_compat_arg(Domain1, Domain2) andalso
+ is_compat_arg(Range1, Range2));
+is_compat_arg(?list(Contents1, Termination1, Size1),
+ ?list(Contents2, Termination2, Size2)) ->
(Size1 =:= Size2 andalso
- is_specialization(Contents1, Contents2) andalso
- is_specialization(Termination1, Termination2));
-is_specialization(?product(Types1), ?product(Types2)) ->
- specialization_list(Types1, Types2);
-is_specialization(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false;
-is_specialization(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false;
-is_specialization(?tuple(Elements1, Arity, _),
- ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
- specialization_list(Elements1, Elements2);
-is_specialization(?tuple_set([{Arity, List}]),
- ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
- specialization_list(sup_tuple_elements(List), Elements2);
-is_specialization(?tuple(Elements1, Arity, _),
- ?tuple_set([{Arity, List}])) when Arity =/= ?any ->
- specialization_list(Elements1, sup_tuple_elements(List));
-is_specialization(?tuple_set(List1), ?tuple_set(List2)) ->
+ is_compat_arg(Contents1, Contents2) andalso
+ is_compat_arg(Termination1, Termination2));
+is_compat_arg(?product(Types1), ?product(Types2)) ->
+ is_compat_list(Types1, Types2);
+is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) ->
+ (is_compat_list(Pairs1, Pairs2) andalso
+ is_compat_arg(DefK1, DefK2) andalso
+ is_compat_arg(DefV1, DefV2));
+is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false;
+is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false;
+is_compat_arg(?tuple(Elements1, Arity, _),
+ ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
+ is_compat_list(Elements1, Elements2);
+is_compat_arg(?tuple_set([{Arity, List}]),
+ ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
+ is_compat_list(sup_tuple_elements(List), Elements2);
+is_compat_arg(?tuple(Elements1, Arity, _),
+ ?tuple_set([{Arity, List}])) when Arity =/= ?any ->
+ is_compat_list(Elements1, sup_tuple_elements(List));
+is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) ->
try
- specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1],
- [sup_tuple_elements(T) || {_Arity, T} <- List2])
+ is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1],
+ [sup_tuple_elements(T) || {_Arity, T} <- List2])
catch _:_ -> false
end;
-is_specialization(?opaque(_) = T1, T2) ->
- is_specialization(t_opaque_structure(T1), T2);
-is_specialization(T1, ?opaque(_) = T2) ->
- is_specialization(T1, t_opaque_structure(T2));
-is_specialization(?union(List1)=T1, ?union(List2)=T2) ->
- case specialization_union2(T1, T2) of
- {yes, Type1, Type2} -> is_specialization(Type1, Type2);
- no -> specialization_list(List1, List2)
+is_compat_arg(?opaque(_) = T1, T2) ->
+ is_compat_arg(t_opaque_structure(T1), T2);
+is_compat_arg(T1, ?opaque(_) = T2) ->
+ is_compat_arg(T1, t_opaque_structure(T2));
+is_compat_arg(?union(List1)=T1, ?union(List2)=T2) ->
+ case is_compat_union2(T1, T2) of
+ {yes, Type1, Type2} -> is_compat_arg(Type1, Type2);
+ no -> is_compat_list(List1, List2)
end;
-is_specialization(?union(List), T2) ->
+is_compat_arg(?union(List), T2) ->
case unify_union(List) of
- {yes, Type} -> is_specialization(Type, T2);
+ {yes, Type} -> is_compat_arg(Type, T2);
no -> false
end;
-is_specialization(T1, ?union(List)) ->
+is_compat_arg(T1, ?union(List)) ->
case unify_union(List) of
- {yes, Type} -> is_specialization(T1, Type);
+ {yes, Type} -> is_compat_arg(T1, Type);
no -> false
end;
-is_specialization(?var(_), _) -> exit(error);
-is_specialization(_, ?var(_)) -> exit(error);
-is_specialization(?none, _) -> false;
-is_specialization(_, ?none) -> false;
-is_specialization(?unit, _) -> false;
-is_specialization(_, ?unit) -> false;
-is_specialization(#c{}, #c{}) -> false.
+is_compat_arg(?var(_), _) -> exit(error);
+is_compat_arg(_, ?var(_)) -> exit(error);
+is_compat_arg(?none, _) -> false;
+is_compat_arg(_, ?none) -> false;
+is_compat_arg(?unit, _) -> false;
+is_compat_arg(_, ?unit) -> false;
+is_compat_arg(#c{}, #c{}) -> false.
-specialization_list_list(LL1, LL2) ->
- length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2).
+is_compat_list_list(LL1, LL2) ->
+ length(LL1) =:= length(LL2) andalso is_compat_list_list1(LL1, LL2).
-specialization_list_list1([], []) -> true;
-specialization_list_list1([L1|LL1], [L2|LL2]) ->
- specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2).
+is_compat_list_list1([], []) -> true;
+is_compat_list_list1([L1|LL1], [L2|LL2]) ->
+ is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2).
-specialization_list(L1, L2) ->
- length(L1) =:= length(L2) andalso specialization_list1(L1, L2).
+is_compat_list(L1, L2) ->
+ length(L1) =:= length(L2) andalso is_compat_list1(L1, L2).
-specialization_list1([], []) -> true;
-specialization_list1([T1|L1], [T2|L2]) ->
- is_specialization(T1, T2) andalso specialization_list1(L1, L2).
+is_compat_list1([], []) -> true;
+is_compat_list1([T1|L1], [T2|L2]) ->
+ is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2).
-specialization_union2(?union(List1)=T1, ?union(List2)=T2) ->
+is_compat_union2(?union(List1)=T1, ?union(List2)=T2) ->
case {unify_union(List1), unify_union(List2)} of
{{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2};
{{yes, Type1}, no} -> {yes, Type1, T2};
@@ -4181,7 +4204,7 @@ t_map(Fun, T) ->
-spec t_to_string(erl_type()) -> string().
t_to_string(T) ->
- t_to_string(T, dict:new()).
+ t_to_string(T, maps:new()).
-spec t_to_string(erl_type(), type_table()) -> string().
@@ -4542,6 +4565,8 @@ from_form({atom, _L, Atom}, _S, _D, L, C) ->
{t_atom(Atom), L, C};
from_form({integer, _L, Int}, _S, _D, L, C) ->
{t_integer(Int), L, C};
+from_form({char, _L, Char}, _S, _D, L, C) ->
+ {t_integer(Char), L, C};
from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
@@ -5056,6 +5081,7 @@ check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]},
list_check_record_fields(Args, S, C);
check_record_fields({atom, _L, _}, _S, C) -> C;
check_record_fields({integer, _L, _}, _S, C) -> C;
+check_record_fields({char, _L, _}, _S, C) -> C;
check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C;
check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C;
check_record_fields({type, _L, tuple, any}, _S, C) -> C;
@@ -5157,6 +5183,7 @@ t_form_to_string({var, _L, Name}) -> atom_to_list(Name);
t_form_to_string({atom, _L, Atom}) ->
io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... '
t_form_to_string({integer, _L, Int}) -> integer_to_list(Int);
+t_form_to_string({char, _L, Char}) -> integer_to_list(Char);
t_form_to_string({op, _L, _Op, _Arg} = Op) ->
case erl_eval:partial_eval(Op) of
{integer, _, _} = Int -> t_form_to_string(Int);
@@ -5239,7 +5266,7 @@ t_form_to_string({type, _L, union, Args}) ->
t_form_to_string({type, _L, Name, []} = T) ->
try
M = mod,
- D0 = dict:new(),
+ D0 = maps:new(),
MR = dict:from_list([{M, D0}]),
Site = {type, {M,Name,0}},
V = var_table__new(),
@@ -5303,8 +5330,8 @@ is_erl_type(_) -> false.
-spec lookup_record(atom(), type_table()) ->
'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
-lookup_record(Tag, RecDict) when is_atom(Tag) ->
- case dict:find({record, Tag}, RecDict) of
+lookup_record(Tag, Table) when is_atom(Tag) ->
+ case maps:find({record, Tag}, Table) of
{ok, {_FileLine, [{_Arity, Fields}]}} ->
{ok, Fields};
{ok, {_FileLine, List}} when is_list(List) ->
@@ -5318,18 +5345,18 @@ lookup_record(Tag, RecDict) when is_atom(Tag) ->
-spec lookup_record(atom(), arity(), type_table()) ->
'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
-lookup_record(Tag, Arity, RecDict) when is_atom(Tag) ->
- case dict:find({record, Tag}, RecDict) of
+lookup_record(Tag, Arity, Table) when is_atom(Tag) ->
+ case maps:find({record, Tag}, Table) of
{ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields};
{ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict);
error -> error
end.
-spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'.
-lookup_type(Name, Arity, RecDict) ->
- case dict:find({type, Name, Arity}, RecDict) of
+lookup_type(Name, Arity, Table) ->
+ case maps:find({type, Name, Arity}, Table) of
error ->
- case dict:find({opaque, Name, Arity}, RecDict) of
+ case maps:find({opaque, Name, Arity}, Table) of
error -> error;
{ok, Found} -> {opaque, Found}
end;
@@ -5339,8 +5366,8 @@ lookup_type(Name, Arity, RecDict) ->
-spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) ->
boolean().
-type_is_defined(TypeOrOpaque, Name, Arity, RecDict) ->
- dict:is_key({TypeOrOpaque, Name, Arity}, RecDict).
+type_is_defined(TypeOrOpaque, Name, Arity, Table) ->
+ maps:is_key({TypeOrOpaque, Name, Arity}, Table).
cannot_have_opaque(Type, TypeName, TypeNames) ->
t_is_none(Type) orelse is_recursive(TypeName, TypeNames).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl
new file mode 100644
index 0000000000..807c4b0d0d
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl
@@ -0,0 +1,217 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% File : basic_num_bif.erl
+%%% Description : Taken from the compiler test suite
+%%%-------------------------------------------------------------------
+-module(basic_num_bif).
+
+-export([test/0]).
+
+%% Tests optimization of the BIFs:
+%% abs/1
+%% float/1
+%% float_to_list/1
+%% integer_to_list/1
+%% list_to_float/1
+%% list_to_integer/1
+%% round/1
+%% trunc/1
+
+test() ->
+ Funs = [fun t_abs/0, fun t_float/0,
+ fun t_float_to_list/0, fun t_integer_to_list/0,
+ fun t_list_to_float_safe/0, fun t_list_to_float_risky/0,
+ fun t_list_to_integer/0, fun t_round/0, fun t_trunc/0],
+ lists:foreach(fun (F) -> ok = F() end, Funs).
+
+t_abs() ->
+ %% Floats.
+ 5.5 = abs(5.5),
+ 0.0 = abs(0.0),
+ 100.0 = abs(-100.0),
+ %% Integers.
+ 5 = abs(5),
+ 0 = abs(0),
+ 100 = abs(-100),
+ %% The largest smallnum. OTP-3190.
+ X = (1 bsl 27) - 1,
+ X = abs(X),
+ X = abs(X-1)+1,
+ X = abs(X+1)-1,
+ X = abs(-X),
+ X = abs(-X-1)-1,
+ X = abs(-X+1)+1,
+ %% Bignums.
+ BigNum = 13984792374983749,
+ BigNum = abs(BigNum),
+ BigNum = abs(-BigNum),
+ ok.
+
+t_float() ->
+ 0.0 = float(0),
+ 2.5 = float(2.5),
+ 0.0 = float(0.0),
+ -100.55 = float(-100.55),
+ 42.0 = float(42),
+ -100.0 = float(-100),
+ %% Bignums.
+ 4294967305.0 = float(4294967305),
+ -4294967305.0 = float(-4294967305),
+ %% Extremely big bignums.
+ Big = list_to_integer(lists:duplicate(2000, $1)),
+ {'EXIT', {badarg, _}} = (catch float(Big)),
+ ok.
+
+%% Tests float_to_list/1.
+
+t_float_to_list() ->
+ test_ftl("0.0e+0", 0.0),
+ test_ftl("2.5e+1", 25.0),
+ test_ftl("2.5e+0", 2.5),
+ test_ftl("2.5e-1", 0.25),
+ test_ftl("-3.5e+17", -350.0e15),
+ ok.
+
+test_ftl(Expect, Float) ->
+ %% No on the next line -- we want the line number from t_float_to_list.
+ Expect = remove_zeros(lists:reverse(float_to_list(Float)), []).
+
+%% Removes any non-significant zeros in a floating point number.
+%% Example: 2.500000e+01 -> 2.5e+1
+
+remove_zeros([$+, $e|Rest], [$0, X|Result]) ->
+ remove_zeros([$+, $e|Rest], [X|Result]);
+remove_zeros([$-, $e|Rest], [$0, X|Result]) ->
+ remove_zeros([$-, $e|Rest], [X|Result]);
+remove_zeros([$0, $.|Rest], [$e|Result]) ->
+ remove_zeros(Rest, [$., $0, $e|Result]);
+remove_zeros([$0|Rest], [$e|Result]) ->
+ remove_zeros(Rest, [$e|Result]);
+remove_zeros([Char|Rest], Result) ->
+ remove_zeros(Rest, [Char|Result]);
+remove_zeros([], Result) ->
+ Result.
+
+%% Tests integer_to_list/1.
+
+t_integer_to_list() ->
+ "0" = integer_to_list(0),
+ "42" = integer_to_list(42),
+ "-42" = integer_to_list(-42),
+ "-42" = integer_to_list(-42),
+ "32768" = integer_to_list(32768),
+ "268435455" = integer_to_list(268435455),
+ "-268435455" = integer_to_list(-268435455),
+ "123456932798748738738" = integer_to_list(123456932798748738738),
+ Big_List = lists:duplicate(2000, $1),
+ Big = list_to_integer(Big_List),
+ Big_List = integer_to_list(Big),
+ ok.
+
+%% Tests list_to_float/1.
+
+t_list_to_float_safe() ->
+ 0.0 = list_to_float("0.0"),
+ 0.0 = list_to_float("-0.0"),
+ 0.5 = list_to_float("0.5"),
+ -0.5 = list_to_float("-0.5"),
+ 100.0 = list_to_float("1.0e2"),
+ 127.5 = list_to_float("127.5"),
+ -199.5 = list_to_float("-199.5"),
+ ok.
+
+%% This might crash the emulator...
+%% (Known to crash the Unix version of Erlang 4.4.1)
+
+t_list_to_float_risky() ->
+ Many_Ones = lists:duplicate(25000, $1),
+ _ = list_to_float("2."++Many_Ones),
+ {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)),
+ ok.
+
+%% Tests list_to_integer/1.
+
+t_list_to_integer() ->
+ 0 = list_to_integer("0"),
+ 0 = list_to_integer("00"),
+ 0 = list_to_integer("-0"),
+ 1 = list_to_integer("1"),
+ -1 = list_to_integer("-1"),
+ 42 = list_to_integer("42"),
+ -12 = list_to_integer("-12"),
+ 32768 = list_to_integer("32768"),
+ 268435455 = list_to_integer("268435455"),
+ -268435455 = list_to_integer("-268435455"),
+ %% Bignums.
+ 123456932798748738738 = list_to_integer("123456932798748738738"),
+ _ = list_to_integer(lists:duplicate(2000, $1)),
+ ok.
+
+%% Tests round/1.
+
+t_round() ->
+ 0 = round(0.0),
+ 0 = round(0.4),
+ 1 = round(0.5),
+ 0 = round(-0.4),
+ -1 = round(-0.5),
+ 255 = round(255.3),
+ 256 = round(255.6),
+ -1033 = round(-1033.3),
+ -1034 = round(-1033.6),
+ %% OTP-3722:
+ X = (1 bsl 27) - 1,
+ MX = -X,
+ MXm1 = -X-1,
+ MXp1 = -X+1,
+ F = X + 0.0,
+ X = round(F),
+ X = round(F+1)-1,
+ X = round(F-1)+1,
+ MX = round(-F),
+ MXm1 = round(-F-1),
+ MXp1 = round(-F+1),
+ X = round(F+0.1),
+ X = round(F+1+0.1)-1,
+ X = round(F-1+0.1)+1,
+ MX = round(-F+0.1),
+ MXm1 = round(-F-1+0.1),
+ MXp1 = round(-F+1+0.1),
+ X = round(F-0.1),
+ X = round(F+1-0.1)-1,
+ X = round(F-1-0.1)+1,
+ MX = round(-F-0.1),
+ MXm1 = round(-F-1-0.1),
+ MXp1 = round(-F+1-0.1),
+ 0.5 = abs(round(F+0.5)-(F+0.5)),
+ 0.5 = abs(round(F-0.5)-(F-0.5)),
+ 0.5 = abs(round(-F-0.5)-(-F-0.5)),
+ 0.5 = abs(round(-F+0.5)-(-F+0.5)),
+ %% Bignums.
+ 4294967296 = round(4294967296.1),
+ 4294967297 = round(4294967296.9),
+ -4294967296 = -round(4294967296.1),
+ -4294967297 = -round(4294967296.9),
+ ok.
+
+t_trunc() ->
+ 0 = trunc(0.0),
+ 5 = trunc(5.3333),
+ -10 = trunc(-10.978987),
+ %% The largest smallnum, converted to float (OTP-3722):
+ X = (1 bsl 27) - 1,
+ F = X + 0.0,
+ %% io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n",
+ %% [X, X, binary_to_list(term_to_binary(X)),
+ %% F, F, binary_to_list(term_to_binary(F)),
+ %% trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]),
+ X = trunc(F),
+ X = trunc(F+1)-1,
+ X = trunc(F-1)+1,
+ X = -trunc(-F),
+ X = -trunc(-F-1)-1,
+ X = -trunc(-F+1)+1,
+ %% Bignums.
+ 4294967305 = trunc(4294967305.7),
+ -4294967305 = trunc(-4294967305.7),
+ ok.
diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl
index a5b3924aa8..b9adb660f2 100644
--- a/lib/hipe/test/hipe_SUITE.erl
+++ b/lib/hipe/test/hipe_SUITE.erl
@@ -16,7 +16,11 @@
%%
-module(hipe_SUITE).
--compile([export_all]).
+-export([all/0, groups/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ app/0, app/1, appup/0, appup/1]).
+
-include_lib("common_test/include/ct.hrl").
all() ->
diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl
index 61952e81d7..86083fa02b 100644
--- a/lib/hipe/test/opt_verify_SUITE.erl
+++ b/lib/hipe/test/opt_verify_SUITE.erl
@@ -1,6 +1,9 @@
-module(opt_verify_SUITE).
--compile([export_all]).
+-export([all/0, groups/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ call_elim/0, call_elim/1]).
all() ->
[call_elim].
@@ -23,23 +26,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-call_elim_test_file(Config, FileName, Option) ->
- PrivDir = test_server:lookup_config(priv_dir, Config),
- TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")),
- {ok, TestCase} = compile:file(FileName),
- {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]),
- {ok, Icode} = file:read_file(TempOut),
- ok = file:delete(TempOut),
- Icode.
-
-substring_count(Icode, Substring) ->
- substring_count(Icode, Substring, 0).
-substring_count(Icode, Substring, N) ->
- case string:str(Icode, Substring) of
- 0 -> N;
- I -> substring_count(lists:nthtail(I, Icode), Substring, N+1)
- end.
-
call_elim() ->
[{doc, "Test that the call elimination optimization pass is ok"}].
call_elim(Config) ->
@@ -60,3 +46,20 @@ call_elim(Config) ->
Icode6 = call_elim_test_file(Config, F3, no_icode_call_elim),
3 = substring_count(binary:bin_to_list(Icode6), "is_key"),
ok.
+
+call_elim_test_file(Config, FileName, Option) ->
+ PrivDir = test_server:lookup_config(priv_dir, Config),
+ TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")),
+ {ok, TestCase} = compile:file(FileName),
+ {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]),
+ {ok, Icode} = file:read_file(TempOut),
+ ok = file:delete(TempOut),
+ Icode.
+
+substring_count(Icode, Substring) ->
+ substring_count(Icode, Substring, 0).
+substring_count(Icode, Substring, N) ->
+ case string:str(Icode, Substring) of
+ 0 -> N;
+ I -> substring_count(lists:nthtail(I, Icode), Substring, N+1)
+ end.
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index 705afec022..4217b3c4fb 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -83,7 +83,7 @@
<title>HTTP DATA TYPES</title>
<p>Type definitions related to HTTP:</p>
- <p><c>method() = head | get | put | post | trace | options | delete</c></p>
+ <p><c>method() = head | get | put | post | trace | options | delete | patch</c></p>
<taglist>
<tag><c>request()</c></tag>
<item><p>= <c>{url(), headers()}</c></p>
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index 398fc7e5b6..5c3b5a2d3c 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,22 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 6.3.4</title>
+ <section><title>Inets 6.3.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Correct misstakes in ftp client introduced in inets-6.3.4</p>
+ <p>
+ Own Id: OTP-14203 Aux Id: OTP-13982 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 6.3.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl
index 911f5b71a7..23d6483291 100644
--- a/lib/inets/src/ftp/ftp.erl
+++ b/lib/inets/src/ftp/ftp.erl
@@ -1477,10 +1477,7 @@ handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when T
handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
caller = {recv_file, Fd}} = State)
when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
- case file_close(Fd) of
- ok -> ok;
- {error,einval} -> ok
- end,
+ file_close(Fd),
progress_report({transfer_size, 0}, State),
activate_ctrl_connection(State),
{noreply, State#state{dsock = undefined, data = <<>>}};
@@ -2066,10 +2063,7 @@ handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) ->
end;
handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) ->
- case file_close(Fd) of
- ok -> ok;
- {error, einval} -> ok
- end,
+ file_close(Fd),
close_data_connection(State),
ctrl_result_response(Status, State#state{dsock = undefined},
{error, epath});
@@ -2345,7 +2339,7 @@ accept_data_connection(#state{mode = passive} = State) ->
send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) ->
verbose(lists:flatten(Message),Verbose,send),
?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]),
- ok = send_message(Socket, Message).
+ _ = send_message(Socket, Message).
send_data_message(_S=#state{dsock = Socket}, Message) ->
?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]),
@@ -2366,37 +2360,44 @@ send_message({tcp, Socket}, Message) ->
send_message({ssl, Socket}, Message) ->
ssl:send(Socket, Message).
-activate_ctrl_connection(#state{csock = Socket, ctrl_data = {<<>>, _, _}}) ->
- ok = activate_connection(Socket);
-activate_ctrl_connection(#state{csock = Socket}) ->
- ok = activate_connection(Socket),
+activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) ->
+ activate_connection(CSock);
+activate_ctrl_connection(#state{csock = CSock}) ->
+ activate_connection(CSock),
%% We have already received at least part of the next control message,
%% that has been saved in ctrl_data, process this first.
- self() ! {socket_type(Socket), unwrap_socket(Socket), <<>>},
+ self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>},
ok.
+activate_data_connection(#state{dsock = DSock} = State) ->
+ activate_connection(DSock),
+ State.
+
+activate_connection(Socket) ->
+ ignore_return_value(
+ case socket_type(Socket) of
+ tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]);
+ ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}])
+ end).
+
+
+ignore_return_value(_) -> ok.
+
unwrap_socket({tcp,Socket}) -> Socket;
unwrap_socket({ssl,Socket}) -> Socket.
socket_type({tcp,_Socket}) -> tcp;
socket_type({ssl,_Socket}) -> ssl.
-activate_data_connection(#state{dsock = Socket} = State) ->
- ok = activate_connection(Socket),
- State.
-
-activate_connection({tcp, Socket}) -> inet:setopts(Socket, [{active, once}]);
-activate_connection({ssl, Socket}) -> ssl:setopts(Socket, [{active, once}]).
-
close_ctrl_connection(#state{csock = undefined}) -> ok;
close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket).
close_data_connection(#state{dsock = undefined}) -> ok;
close_data_connection(#state{dsock = Socket}) -> close_connection(Socket).
-close_connection({lsock,Socket}) -> gen_tcp:close(Socket);
-close_connection({tcp, Socket}) -> gen_tcp:close(Socket);
-close_connection({ssl, Socket}) -> ssl:close(Socket).
+close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
+close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
+close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ).
%% ------------ FILE HANDLING ----------------------------------------
send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) ->
@@ -2408,7 +2409,7 @@ send_file(State, Fd) ->
progress_report({binary, Bin}, State),
send_file(State, Fd);
{ok, _, _} ->
- ok = file_close(Fd),
+ file_close(Fd),
close_data_connection(State),
progress_report({transfer_size, 0}, State),
activate_ctrl_connection(State),
@@ -2423,7 +2424,7 @@ file_open(File, Option) ->
file:open(File, [raw, binary, Option]).
file_close(Fd) ->
- file:close(Fd).
+ ignore_return_value( file:close(Fd) ).
file_read(Fd) ->
case file:read(Fd, ?FILE_BUFSIZE) of
diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl
index 91d87289a2..bd5f6df39e 100644
--- a/lib/inets/src/http_client/httpc.erl
+++ b/lib/inets/src/http_client/httpc.erl
@@ -147,6 +147,26 @@ request(Method, Request, HttpOptions, Options) ->
request(Method, Request, HttpOptions, Options, default_profile()).
request(Method,
+ {Url, Headers, ContentType, TupleBody},
+ HTTPOptions, Options, Profile)
+ when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete))
+ andalso (is_atom(Profile) orelse is_pid(Profile)) andalso
+ is_list(ContentType) andalso is_tuple(TupleBody)->
+ case check_body_gen(TupleBody) of
+ ok ->
+ do_request(Method, {Url, Headers, ContentType, TupleBody}, HTTPOptions, Options, Profile);
+ Error ->
+ Error
+ end;
+request(Method,
+ {Url, Headers, ContentType, Body},
+ HTTPOptions, Options, Profile)
+ when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete))
+ andalso (is_atom(Profile) orelse is_pid(Profile)) andalso
+ is_list(ContentType) andalso (is_list(Body) orelse is_binary(Body)) ->
+ do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile);
+
+request(Method,
{Url, Headers},
HTTPOptions, Options, Profile)
when (Method =:= options) orelse
@@ -155,12 +175,6 @@ request(Method,
(Method =:= delete) orelse
(Method =:= trace) andalso
(is_atom(Profile) orelse is_pid(Profile)) ->
- ?hcrt("request", [{method, Method},
- {url, Url},
- {headers, Headers},
- {http_options, HTTPOptions},
- {options, Options},
- {profile, Profile}]),
case uri_parse(Url, Options) of
{error, Reason} ->
{error, Reason};
@@ -172,21 +186,9 @@ request(Method,
handle_request(Method, Url, ParsedUrl, Headers, [], [],
HTTPOptions, Options, Profile)
end
- end;
-
-request(Method,
- {Url, Headers, ContentType, Body},
- HTTPOptions, Options, Profile)
- when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse
- (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) ->
- ?hcrt("request", [{method, Method},
- {url, Url},
- {headers, Headers},
- {content_type, ContentType},
- {body, Body},
- {http_options, HTTPOptions},
- {options, Options},
- {profile, Profile}]),
+ end.
+
+do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) ->
case uri_parse(Url, Options) of
{error, Reason} ->
{error, Reason};
@@ -196,7 +198,6 @@ request(Method,
HTTPOptions, Options, Profile)
end.
-
%%--------------------------------------------------------------------------
%% cancel_request(RequestId) -> ok
%% cancel_request(RequestId, Profile) -> ok
@@ -209,7 +210,6 @@ cancel_request(RequestId) ->
cancel_request(RequestId, Profile)
when is_atom(Profile) orelse is_pid(Profile) ->
- ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]),
httpc_manager:cancel_request(RequestId, profile_name(Profile)).
@@ -232,7 +232,6 @@ cancel_request(RequestId, Profile)
set_options(Options) ->
set_options(Options, default_profile()).
set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) ->
- ?hcrt("set options", [{options, Options}, {profile, Profile}]),
case validate_options(Options) of
{ok, Opts} ->
httpc_manager:set_options(Opts, profile_name(Profile));
@@ -272,7 +271,6 @@ get_options(all = _Options, Profile) ->
get_options(Options, Profile)
when (is_list(Options) andalso
(is_atom(Profile) orelse is_pid(Profile))) ->
- ?hcrt("get options", [{options, Options}, {profile, Profile}]),
case Options -- get_options() of
[] ->
try
@@ -314,9 +312,6 @@ store_cookies(SetCookieHeaders, Url) ->
store_cookies(SetCookieHeaders, Url, Profile)
when is_atom(Profile) orelse is_pid(Profile) ->
- ?hcrt("store cookies", [{set_cookie_headers, SetCookieHeaders},
- {url, Url},
- {profile, Profile}]),
try
begin
%% Since the Address part is not actually used
@@ -353,9 +348,6 @@ cookie_header(Url, Opts) when is_list(Opts) ->
cookie_header(Url, Opts, Profile)
when (is_list(Opts) andalso (is_atom(Profile) orelse is_pid(Profile))) ->
- ?hcrt("cookie header", [{url, Url},
- {opts, Opts},
- {profile, Profile}]),
try
begin
httpc_manager:which_cookies(Url, Opts, profile_name(Profile))
@@ -398,7 +390,6 @@ which_sessions() ->
which_sessions(default_profile()).
which_sessions(Profile) ->
- ?hcrt("which sessions", [{profile, Profile}]),
try
begin
httpc_manager:which_sessions(profile_name(Profile))
@@ -419,7 +410,6 @@ info() ->
info(default_profile()).
info(Profile) ->
- ?hcrt("info", [{profile, Profile}]),
try
begin
httpc_manager:info(profile_name(Profile))
@@ -440,7 +430,6 @@ reset_cookies() ->
reset_cookies(default_profile()).
reset_cookies(Profile) ->
- ?hcrt("reset cookies", [{profile, Profile}]),
try
begin
httpc_manager:reset_cookies(profile_name(Profile))
@@ -458,7 +447,6 @@ reset_cookies(Profile) ->
%% same behavior as active once for sockets.
%%-------------------------------------------------------------------------
stream_next(Pid) ->
- ?hcrt("stream next", [{handler, Pid}]),
httpc_handler:stream_next(Pid).
@@ -466,7 +454,6 @@ stream_next(Pid) ->
%%% Behaviour callbacks
%%%========================================================================
start_standalone(PropList) ->
- ?hcrt("start standalone", [{proplist, PropList}]),
case proplists:get_value(profile, PropList) of
undefined ->
{error, no_profile};
@@ -477,14 +464,11 @@ start_standalone(PropList) ->
end.
start_service(Config) ->
- ?hcrt("start service", [{config, Config}]),
httpc_profile_sup:start_child(Config).
stop_service(Profile) when is_atom(Profile) ->
- ?hcrt("stop service", [{profile, Profile}]),
httpc_profile_sup:stop_child(Profile);
stop_service(Pid) when is_pid(Pid) ->
- ?hcrt("stop service", [{pid, Pid}]),
case service_info(Pid) of
{ok, [{profile, Profile}]} ->
stop_service(Profile);
@@ -510,7 +494,6 @@ service_info(Pid) ->
%%%========================================================================
%%% Internal functions
%%%========================================================================
-
handle_request(Method, Url,
{Scheme, UserInfo, Host, Port, Path, Query},
Headers0, ContentType, Body0,
@@ -521,9 +504,6 @@ handle_request(Method, Url,
try
begin
- ?hcrt("begin processing", [{started, Started},
- {new_headers, NewHeaders0}]),
-
{NewHeaders, Body} =
case Body0 of
{chunkify, ProcessBody, Acc}
@@ -575,16 +555,13 @@ handle_request(Method, Url,
{ok, RequestId} ->
handle_answer(RequestId, Sync, Options);
{error, Reason} ->
- ?hcrd("request failed", [{reason, Reason}]),
{error, Reason}
end
end
catch
error:{noproc, _} ->
- ?hcrv("noproc", [{profile, Profile}]),
{error, {not_started, Profile}};
throw:Error ->
- ?hcrv("throw", [{error, Error}]),
Error
end.
@@ -620,15 +597,10 @@ handle_answer(RequestId, false, _) ->
handle_answer(RequestId, true, Options) ->
receive
{http, {RequestId, saved_to_file}} ->
- ?hcrt("received saved-to-file", [{request_id, RequestId}]),
{ok, saved_to_file};
{http, {RequestId, {_,_,_} = Result}} ->
- ?hcrt("received answer", [{request_id, RequestId},
- {result, Result}]),
return_answer(Options, Result);
{http, {RequestId, {error, Reason}}} ->
- ?hcrt("received error", [{request_id, RequestId},
- {reason, Reason}]),
{error, Reason}
end.
@@ -1257,18 +1229,14 @@ child_name(Pid, [{Name, Pid} | _]) ->
child_name(Pid, [_ | Children]) ->
child_name(Pid, Children).
-%% d(F) ->
-%% d(F, []).
-
-%% d(F, A) ->
-%% d(get(dbg), F, A).
-
-%% d(true, F, A) ->
-%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]);
-%% d(_, _, _) ->
-%% ok.
-
host_address(Host, false) ->
Host;
host_address(Host, true) ->
string:strip(string:strip(Host, right, $]), left, $[).
+
+check_body_gen({Fun, _}) when is_function(Fun) ->
+ ok;
+check_body_gen({chunkify, Fun, _}) when is_function(Fun) ->
+ ok;
+check_body_gen(Gen) ->
+ {error, {bad_body_generator, Gen}}.
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 2e7df8e424..c99200777b 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -32,7 +32,6 @@
%% Internal Application API
-export([
start_link/4,
- %% connect_and_send/2,
send/2,
cancel/2,
stream_next/1,
@@ -165,14 +164,12 @@ info(Pid) ->
%%--------------------------------------------------------------------
%% Request should not be streamed
stream(BodyPart, #request{stream = none} = Request, _) ->
- ?hcrt("stream - none", []),
{false, BodyPart, Request};
%% Stream to caller
stream(BodyPart, #request{stream = Self} = Request, Code)
when ?IS_STREAMED(Code) andalso
((Self =:= self) orelse (Self =:= {self, once})) ->
- ?hcrt("stream - self", [{stream, Self}, {code, Code}]),
httpc_response:send(Request#request.from,
{Request#request.id, stream, BodyPart}),
{true, <<>>, Request};
@@ -182,10 +179,8 @@ stream(BodyPart, #request{stream = Self} = Request, Code)
%% We keep this for backward compatibillity...
stream(BodyPart, #request{stream = Filename} = Request, Code)
when ?IS_STREAMED(Code) andalso is_list(Filename) ->
- ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]),
case file:open(Filename, [write, raw, append, delayed_write]) of
{ok, Fd} ->
- ?hcrt("stream - file open ok", [{fd, Fd}]),
stream(BodyPart, Request#request{stream = Fd}, 200);
{error, Reason} ->
exit({stream_to_file_failed, Reason})
@@ -194,7 +189,6 @@ stream(BodyPart, #request{stream = Filename} = Request, Code)
%% Stream to file
stream(BodyPart, #request{stream = Fd} = Request, Code)
when ?IS_STREAMED(Code) ->
- ?hcrt("stream to file", [{stream, Fd}, {code, Code}]),
case file:write(Fd, BodyPart) of
ok ->
{true, <<>>, Request};
@@ -203,7 +197,6 @@ stream(BodyPart, #request{stream = Fd} = Request, Code)
end;
stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed
- ?hcrt("stream - ignore", [{request, Request}]),
{false, BodyPart, Request}.
@@ -257,22 +250,148 @@ init([Parent, Request, Options, ProfileName]) ->
%% {stop, Reason, State} (terminate/2 is called)
%% Description: Handling call messages
%%--------------------------------------------------------------------
-handle_call(#request{address = Addr} = Request, _,
+handle_call(Request, From, State) ->
+ try do_handle_call(Request, From, State) of
+ Result ->
+ Result
+ catch
+ _:Reason ->
+ {stop, {shutdown, Reason} , State}
+ end.
+
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast(Msg, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(Msg, State) ->
+ try do_handle_cast(Msg, State) of
+ Result ->
+ Result
+ catch
+ _:Reason ->
+ {stop, {shutdown, Reason} , State}
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info(Info, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info(Info, State) ->
+ try do_handle_info(Info, State) of
+ Result ->
+ Result
+ catch
+ _:Reason ->
+ {stop, {shutdown, Reason} , State}
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: terminate(Reason, State) -> _ (ignored by gen_server)
+%% Description: Shutdown the httpc_handler
+%%--------------------------------------------------------------------
+
+%% Init error there is no socket to be closed.
+terminate(normal,
+ #state{request = Request,
+ session = {send_failed, _} = Reason} = State) ->
+ maybe_send_answer(Request,
+ httpc_response:error(Request, Reason),
+ State),
+ ok;
+
+terminate(normal,
+ #state{request = Request,
+ session = {connect_failed, _} = Reason} = State) ->
+ maybe_send_answer(Request,
+ httpc_response:error(Request, Reason),
+ State),
+ ok;
+
+terminate(normal, #state{session = undefined}) ->
+ ok;
+
+%% Init error sending, no session information has been setup but
+%% there is a socket that needs closing.
+terminate(normal,
+ #state{session = #session{id = undefined} = Session}) ->
+ close_socket(Session);
+
+%% Socket closed remotely
+terminate(normal,
+ #state{session = #session{socket = {remote_close, Socket},
+ socket_type = SocketType,
+ id = Id},
+ profile_name = ProfileName,
+ request = Request,
+ timers = Timers,
+ pipeline = Pipeline,
+ keep_alive = KeepAlive} = State) ->
+ %% Clobber session
+ (catch httpc_manager:delete_session(Id, ProfileName)),
+
+ maybe_retry_queue(Pipeline, State),
+ maybe_retry_queue(KeepAlive, State),
+
+ %% Cancel timers
+ cancel_timers(Timers),
+
+ %% Maybe deliver answers to requests
+ deliver_answer(Request),
+
+ %% And, just in case, close our side (**really** overkill)
+ http_transport:close(SocketType, Socket);
+
+terminate(_Reason, #state{session = #session{id = Id,
+ socket = Socket,
+ socket_type = SocketType},
+ request = undefined,
+ profile_name = ProfileName,
+ timers = Timers,
+ pipeline = Pipeline,
+ keep_alive = KeepAlive} = State) ->
+
+ %% Clobber session
+ (catch httpc_manager:delete_session(Id, ProfileName)),
+
+ maybe_retry_queue(Pipeline, State),
+ maybe_retry_queue(KeepAlive, State),
+
+ cancel_timer(Timers#timers.queue_timer, timeout_queue),
+ http_transport:close(SocketType, Socket);
+
+terminate(_Reason, #state{request = undefined}) ->
+ ok;
+
+terminate(Reason, #state{request = Request} = State) ->
+ NewState = maybe_send_answer(Request,
+ httpc_response:error(Request, Reason),
+ State),
+ terminate(Reason, NewState#state{request = undefined}).
+
+%%--------------------------------------------------------------------
+%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState}
+%% Purpose: Convert process state when code is changed
+%%--------------------------------------------------------------------
+
+code_change(_, State, _) ->
+ {ok, State}.
+
+%%%--------------------------------------------------------------------
+%%% Internal functions
+%%%--------------------------------------------------------------------
+do_handle_call(#request{address = Addr} = Request, _,
#state{status = Status,
session = #session{type = pipeline} = Session,
timers = Timers,
options = #options{proxy = Proxy} = _Options,
profile_name = ProfileName} = State0)
when Status =/= undefined ->
-
- ?hcrv("new request on a pipeline session",
- [{request, Request},
- {profile, ProfileName},
- {status, Status},
- {timers, Timers}]),
-
Address = handle_proxy(Addr, Proxy),
-
case httpc_request:send(Address, Session, Request) of
ok ->
@@ -287,9 +406,8 @@ handle_call(#request{address = Addr} = Request, _,
case State0#state.request of
#request{} = OldRequest -> %% Old request not yet finished
- ?hcrd("old request still not finished", []),
%% Make sure to use the new value of timers in state
- NewTimers = State1#state.timers,
+ NewTimers = State1#state.timers,
NewPipeline = queue:in(Request, State1#state.pipeline),
NewSession =
Session#session{queue_length =
@@ -297,7 +415,6 @@ handle_call(#request{address = Addr} = Request, _,
queue:len(NewPipeline) + 1,
client_close = ClientClose},
insert_session(NewSession, ProfileName),
- ?hcrd("session updated", []),
{reply, ok, State1#state{
request = OldRequest,
pipeline = NewPipeline,
@@ -306,7 +423,6 @@ handle_call(#request{address = Addr} = Request, _,
undefined ->
%% Note: tcp-message receiving has already been
%% activated by handle_pipeline/2.
- ?hcrd("no current request", []),
cancel_timer(Timers#timers.queue_timer,
timeout_queue),
NewSession =
@@ -314,18 +430,16 @@ handle_call(#request{address = Addr} = Request, _,
client_close = ClientClose},
httpc_manager:insert_session(NewSession, ProfileName),
NewTimers = Timers#timers{queue_timer = undefined},
- ?hcrd("session created", []),
State = init_wait_for_response_state(Request, State1#state{session = NewSession,
timers = NewTimers}),
{reply, ok, State}
end;
{error, Reason} ->
- ?hcri("failed sending request", [{reason, Reason}]),
NewPipeline = queue:in(Request, State0#state.pipeline),
- {stop, shutdown, {pipeline_failed, Reason}, State0#state{pipeline = NewPipeline}}
+ {stop, {shutdown, {pipeline_failed, Reason}}, State0#state{pipeline = NewPipeline}}
end;
-handle_call(#request{address = Addr} = Request, _,
+do_handle_call(#request{address = Addr} = Request, _,
#state{status = Status,
session = #session{type = keep_alive} = Session,
timers = Timers,
@@ -333,17 +447,11 @@ handle_call(#request{address = Addr} = Request, _,
profile_name = ProfileName} = State0)
when Status =/= undefined ->
- ?hcrv("new request on a keep-alive session",
- [{request, Request},
- {profile, ProfileName},
- {status, Status}]),
-
ClientClose = httpc_request:is_client_closing(Request#request.headers),
case State0#state.request of
#request{} -> %% Old request not yet finished
%% Make sure to use the new value of timers in state
- ?hcrd("old request still not finished", []),
NewKeepAlive = queue:in(Request, State0#state.keep_alive),
NewSession =
Session#session{queue_length =
@@ -351,13 +459,11 @@ handle_call(#request{address = Addr} = Request, _,
queue:len(NewKeepAlive) + 1,
client_close = ClientClose},
insert_session(NewSession, ProfileName),
- ?hcrd("session updated", []),
{reply, ok, State0#state{keep_alive = NewKeepAlive,
session = NewSession}};
undefined ->
%% Note: tcp-message receiving has already been
%% activated by handle_pipeline/2.
- ?hcrd("no current request", []),
cancel_timer(Timers#timers.queue_timer,
timeout_queue),
NewTimers = Timers#timers{queue_timer = undefined},
@@ -365,8 +471,6 @@ handle_call(#request{address = Addr} = Request, _,
Address = handle_proxy(Addr, Proxy),
case httpc_request:send(Address, Session, Request) of
ok ->
- ?hcrd("request sent", []),
-
%% Activate the request time out for the new request
State2 =
activate_request_timeout(State1#state{request = Request}),
@@ -377,22 +481,13 @@ handle_call(#request{address = Addr} = Request, _,
State = init_wait_for_response_state(Request, State2#state{session = NewSession}),
{reply, ok, State};
{error, Reason} ->
- ?hcri("failed sending request", [{reason, Reason}]),
- {stop, shutdown, {keepalive_failed, Reason}, State1}
+ {stop, {shutdown, {keepalive_failed, Reason}}, State1}
end
end;
-
-handle_call(info, _, State) ->
+do_handle_call(info, _, State) ->
Info = handler_info(State),
{reply, Info, State}.
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State} (terminate/2 is called)
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-
%% When the request in process has been canceled the handler process is
%% stopped and the pipelined requests will be reissued or remaining
%% requests will be sent on a new connection. This is is
@@ -405,145 +500,102 @@ handle_call(info, _, State) ->
%% handle_keep_alive_queue/2 on the other hand will just skip the
%% request as if it was never issued as in this case the request will
%% not have been sent.
-handle_cast({cancel, RequestId},
+do_handle_cast({cancel, RequestId},
#state{request = #request{id = RequestId} = Request,
- profile_name = ProfileName,
canceled = Canceled} = State) ->
- ?hcrv("cancel current request", [{request_id, RequestId},
- {profile, ProfileName},
- {canceled, Canceled}]),
{stop, normal,
State#state{canceled = [RequestId | Canceled],
request = Request#request{from = answer_sent}}};
-handle_cast({cancel, RequestId},
- #state{profile_name = ProfileName,
- request = #request{id = CurrId},
- canceled = Canceled} = State) ->
- ?hcrv("cancel", [{request_id, RequestId},
- {curr_req_id, CurrId},
- {profile, ProfileName},
- {canceled, Canceled}]),
+do_handle_cast({cancel, RequestId},
+ #state{request = #request{},
+ canceled = Canceled} = State) ->
{noreply, State#state{canceled = [RequestId | Canceled]}};
-handle_cast({cancel, RequestId},
- #state{profile_name = ProfileName,
- request = undefined,
- canceled = Canceled} = State) ->
- ?hcrv("cancel", [{request_id, RequestId},
- {curr_req_id, undefined},
- {profile, ProfileName},
- {canceled, Canceled}]),
+do_handle_cast({cancel, _},
+ #state{request = undefined} = State) ->
{noreply, State};
-
-handle_cast(stream_next, #state{session = Session} = State) ->
+do_handle_cast(stream_next, #state{session = Session} = State) ->
activate_once(Session),
%% Inactivate the #state.once here because we don't want
%% next_body_chunk/1 to activate the socket twice.
{noreply, State#state{once = inactive}}.
-
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State} (terminate/2 is called)
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
-handle_info({Proto, _Socket, Data},
+do_handle_info({Proto, _Socket, Data},
#state{mfa = {Module, Function, Args},
- request = #request{method = Method,
- stream = Stream} = Request,
+ request = #request{method = Method} = Request,
session = Session,
status_line = StatusLine} = State)
when (Proto =:= tcp) orelse
(Proto =:= ssl) orelse
(Proto =:= httpc_handler) ->
- ?hcri("received data", [{proto, Proto},
- {module, Module},
- {function, Function},
- {method, Method},
- {stream, Stream},
- {session, Session},
- {status_line, StatusLine}]),
-
- FinalResult =
- try Module:Function([Data | Args]) of
- {ok, Result} ->
- ?hcrd("data processed - ok", []),
- handle_http_msg(Result, State);
- {_, whole_body, _} when Method =:= head ->
- ?hcrd("data processed - whole body", []),
- handle_response(State#state{body = <<>>});
- {Module, whole_body, [Body, Length]} ->
- ?hcrd("data processed - whole body", [{length, Length}]),
- {_, Code, _} = StatusLine,
- {Streamed, NewBody, NewRequest} = stream(Body, Request, Code),
- %% When we stream we will not keep the already
- %% streamed data, that would be a waste of memory.
- NewLength =
- case Streamed of
- false ->
- Length;
- true ->
- Length - size(Body)
- end,
-
- NewState = next_body_chunk(State, Code),
- NewMFA = {Module, whole_body, [NewBody, NewLength]},
- {noreply, NewState#state{mfa = NewMFA,
- request = NewRequest}};
- {Module, decode_size,
- [TotalChunk, HexList,
+ try Module:Function([Data | Args]) of
+ {ok, Result} ->
+ handle_http_msg(Result, State);
+ {_, whole_body, _} when Method =:= head ->
+ handle_response(State#state{body = <<>>});
+ {Module, whole_body, [Body, Length]} ->
+ {_, Code, _} = StatusLine,
+ {Streamed, NewBody, NewRequest} = stream(Body, Request, Code),
+ %% When we stream we will not keep the already
+ %% streamed data, that would be a waste of memory.
+ NewLength =
+ case Streamed of
+ false ->
+ Length;
+ true ->
+ Length - size(Body)
+ end,
+
+ NewState = next_body_chunk(State, Code),
+ NewMFA = {Module, whole_body, [NewBody, NewLength]},
+ {noreply, NewState#state{mfa = NewMFA,
+ request = NewRequest}};
+ {Module, decode_size,
+ [TotalChunk, HexList, AccHeaderSize,
{MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
- when BodySoFar =/= <<>> ->
- ?hcrd("data processed - decode_size", []),
- %% The response body is chunk-encoded. Steal decoded
- %% chunks as much as possible to stream.
- {_, Code, _} = StatusLine,
- {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code),
- NewState = next_body_chunk(State, Code),
- NewMFA = {Module, decode_size,
- [TotalChunk, HexList,
+ when BodySoFar =/= <<>> ->
+ %% The response body is chunk-encoded. Steal decoded
+ %% chunks as much as possible to stream.
+ {_, Code, _} = StatusLine,
+ {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code),
+ NewState = next_body_chunk(State, Code),
+ NewMFA = {Module, decode_size,
+ [TotalChunk, HexList, AccHeaderSize,
{MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
+ {noreply, NewState#state{mfa = NewMFA,
+ request = NewRequest}};
+ {Module, decode_data,
+ [ChunkSize, TotalChunk,
+ {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
+ when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> ->
+ %% The response body is chunk-encoded. Steal decoded
+ %% chunks as much as possible to stream.
+ ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)),
+ <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk,
+ StolenBody = <<BodySoFar/binary, StolenChunk/binary>>,
+ NewChunkSize = ChunkSize - ChunkSizeToSteal,
+ {_, Code, _} = StatusLine,
+
+ {_, NewBody, NewRequest} = stream(StolenBody, Request, Code),
+ NewState = next_body_chunk(State, Code),
+ NewMFA = {Module, decode_data,
+ [NewChunkSize, NewTotalChunk,
+ {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
{noreply, NewState#state{mfa = NewMFA,
request = NewRequest}};
- {Module, decode_data,
- [ChunkSize, TotalChunk,
- {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]}
- when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> ->
- ?hcrd("data processed - decode_data", []),
- %% The response body is chunk-encoded. Steal decoded
- %% chunks as much as possible to stream.
- ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)),
- <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk,
- StolenBody = <<BodySoFar/binary, StolenChunk/binary>>,
- NewChunkSize = ChunkSize - ChunkSizeToSteal,
- {_, Code, _} = StatusLine,
-
- {_, NewBody, NewRequest} = stream(StolenBody, Request, Code),
- NewState = next_body_chunk(State, Code),
- NewMFA = {Module, decode_data,
- [NewChunkSize, NewTotalChunk,
- {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]},
- {noreply, NewState#state{mfa = NewMFA,
- request = NewRequest}};
- NewMFA ->
- ?hcrd("data processed - new mfa", []),
- activate_once(Session),
- {noreply, State#state{mfa = NewMFA}}
- catch
- _:_Reason ->
- ?hcrd("data processing exit", [{exit, _Reason}]),
- ClientReason = {could_not_parse_as_http, Data},
- ClientErrMsg = httpc_response:error(Request, ClientReason),
- NewState = answer_request(Request, ClientErrMsg, State),
- {stop, normal, NewState}
- end,
- ?hcri("data processed", [{final_result, FinalResult}]),
- FinalResult;
-
+ NewMFA ->
+ activate_once(Session),
+ {noreply, State#state{mfa = NewMFA}}
+ catch
+ _:Reason ->
+ ClientReason = {could_not_parse_as_http, Data},
+ ClientErrMsg = httpc_response:error(Request, ClientReason),
+ NewState = answer_request(Request, ClientErrMsg, State),
+ {stop, {shutdown, Reason}, NewState}
+ end;
-handle_info({Proto, Socket, Data},
+do_handle_info({Proto, Socket, Data},
#state{mfa = MFA,
request = Request,
session = Session,
@@ -568,200 +620,107 @@ handle_info({Proto, Socket, Data},
{noreply, State};
-
%% The Server may close the connection to indicate that the
%% whole body is now sent instead of sending an length
%% indicator.
-handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
+do_handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
handle_response(State#state{body = hd(Args)});
-handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
+do_handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) ->
handle_response(State#state{body = hd(Args)});
%%% Server closes idle pipeline
-handle_info({tcp_closed, _}, State = #state{request = undefined}) ->
+do_handle_info({tcp_closed, _}, State = #state{request = undefined}) ->
{stop, normal, State};
-handle_info({ssl_closed, _}, State = #state{request = undefined}) ->
+do_handle_info({ssl_closed, _}, State = #state{request = undefined}) ->
{stop, normal, State};
%%% Error cases
-handle_info({tcp_closed, _}, #state{session = Session0} = State) ->
+do_handle_info({tcp_closed, _}, #state{session = Session0} = State) ->
Socket = Session0#session.socket,
Session = Session0#session{socket = {remote_close, Socket}},
%% {stop, session_remotly_closed, State};
{stop, normal, State#state{session = Session}};
-handle_info({ssl_closed, _}, #state{session = Session0} = State) ->
+do_handle_info({ssl_closed, _}, #state{session = Session0} = State) ->
Socket = Session0#session.socket,
Session = Session0#session{socket = {remote_close, Socket}},
%% {stop, session_remotly_closed, State};
{stop, normal, State#state{session = Session}};
-handle_info({tcp_error, _, _} = Reason, State) ->
+do_handle_info({tcp_error, _, _} = Reason, State) ->
{stop, Reason, State};
-handle_info({ssl_error, _, _} = Reason, State) ->
+do_handle_info({ssl_error, _, _} = Reason, State) ->
{stop, Reason, State};
%% Timeouts
%% Internally, to a request handling process, a request timeout is
%% seen as a canceled request.
-handle_info({timeout, RequestId},
+do_handle_info({timeout, RequestId},
#state{request = #request{id = RequestId} = Request,
canceled = Canceled,
profile_name = ProfileName} = State) ->
- ?hcri("timeout of current request", [{id, RequestId}]),
httpc_response:send(Request#request.from,
httpc_response:error(Request, timeout)),
httpc_manager:request_done(RequestId, ProfileName),
- ?hcrv("response (timeout) sent - now terminate", []),
{stop, normal,
State#state{request = Request#request{from = answer_sent},
canceled = [RequestId | Canceled]}};
-handle_info({timeout, RequestId},
+do_handle_info({timeout, RequestId},
#state{canceled = Canceled,
profile_name = ProfileName} = State) ->
- ?hcri("timeout", [{id, RequestId}]),
Filter =
fun(#request{id = Id, from = From} = Request) when Id =:= RequestId ->
- ?hcrv("found request", [{id, Id}, {from, From}]),
%% Notify the owner
httpc_response:send(From,
httpc_response:error(Request, timeout)),
httpc_manager:request_done(RequestId, ProfileName),
- ?hcrv("response (timeout) sent", []),
[Request#request{from = answer_sent}];
(_) ->
true
end,
case State#state.status of
pipeline ->
- ?hcrd("pipeline", []),
Pipeline = queue:filter(Filter, State#state.pipeline),
{noreply, State#state{canceled = [RequestId | Canceled],
pipeline = Pipeline}};
keep_alive ->
- ?hcrd("keep_alive", []),
KeepAlive = queue:filter(Filter, State#state.keep_alive),
{noreply, State#state{canceled = [RequestId | Canceled],
keep_alive = KeepAlive}}
end;
-handle_info(timeout_queue, State = #state{request = undefined}) ->
+do_handle_info(timeout_queue, State = #state{request = undefined}) ->
{stop, normal, State};
%% Timing was such as the queue_timeout was not canceled!
-handle_info(timeout_queue, #state{timers = Timers} = State) ->
+do_handle_info(timeout_queue, #state{timers = Timers} = State) ->
{noreply, State#state{timers =
Timers#timers{queue_timer = undefined}}};
%% Setting up the connection to the server somehow failed.
-handle_info({init_error, Tag, ClientErrMsg},
+do_handle_info({init_error, Reason, ClientErrMsg},
State = #state{request = Request}) ->
- ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]),
NewState = answer_request(Request, ClientErrMsg, State),
- {stop, normal, NewState};
-
+ {stop, {shutdown, Reason}, NewState};
%%% httpc_manager process dies.
-handle_info({'EXIT', _, _}, State = #state{request = undefined}) ->
+do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) ->
{stop, normal, State};
%%Try to finish the current request anyway,
%% there is a fairly high probability that it can be done successfully.
%% Then close the connection, hopefully a new manager is started that
%% can retry requests in the pipeline.
-handle_info({'EXIT', _, _}, State) ->
+do_handle_info({'EXIT', _, _}, State) ->
{noreply, State#state{status = close}}.
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> _ (ignored by gen_server)
-%% Description: Shutdown the httpc_handler
-%%--------------------------------------------------------------------
-
-%% Init error there is no socket to be closed.
-terminate(normal,
- #state{request = Request,
- session = {send_failed, AReason} = Reason} = State) ->
- ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]),
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
-terminate(normal,
- #state{request = Request,
- session = {connect_failed, AReason} = Reason} = State) ->
- ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]),
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
-terminate(normal, #state{session = undefined}) ->
- ok;
-
-%% Init error sending, no session information has been setup but
-%% there is a socket that needs closing.
-terminate(normal,
- #state{session = #session{id = undefined} = Session}) ->
- close_socket(Session);
-
-%% Socket closed remotely
-terminate(normal,
- #state{session = #session{socket = {remote_close, Socket},
- socket_type = SocketType,
- id = Id},
- profile_name = ProfileName,
- request = Request,
- timers = Timers,
- pipeline = Pipeline,
- keep_alive = KeepAlive} = State) ->
- ?hcrt("terminate(normal) - remote close",
- [{id, Id}, {profile, ProfileName}]),
-
- %% Clobber session
- (catch httpc_manager:delete_session(Id, ProfileName)),
-
- maybe_retry_queue(Pipeline, State),
- maybe_retry_queue(KeepAlive, State),
-
- %% Cancel timers
- cancel_timers(Timers),
-
- %% Maybe deliver answers to requests
- deliver_answer(Request),
-
- %% And, just in case, close our side (**really** overkill)
- http_transport:close(SocketType, Socket);
-
-terminate(Reason, #state{session = #session{id = Id,
- socket = Socket,
- socket_type = SocketType},
- request = undefined,
- profile_name = ProfileName,
- timers = Timers,
- pipeline = Pipeline,
- keep_alive = KeepAlive} = State) ->
- ?hcrt("terminate",
- [{id, Id}, {profile, ProfileName}, {reason, Reason}]),
-
- %% Clobber session
- (catch httpc_manager:delete_session(Id, ProfileName)),
-
- maybe_retry_queue(Pipeline, State),
- maybe_retry_queue(KeepAlive, State),
-
- cancel_timer(Timers#timers.queue_timer, timeout_queue),
- http_transport:close(SocketType, Socket);
+call(Msg, Pid) ->
+ call(Msg, Pid, infinity).
-terminate(Reason, #state{request = undefined}) ->
- ?hcrt("terminate", [{reason, Reason}]),
- ok;
+call(Msg, Pid, Timeout) ->
+ gen_server:call(Pid, Msg, Timeout).
-terminate(Reason, #state{request = Request} = State) ->
- ?hcrd("terminate", [{reason, Reason}, {request, Request}]),
- NewState = maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- terminate(Reason, NewState#state{request = undefined}).
+cast(Msg, Pid) ->
+ gen_server:cast(Pid, Msg).
maybe_retry_queue(Q, State) ->
case queue:is_empty(Q) of
@@ -776,45 +735,13 @@ maybe_send_answer(#request{from = answer_sent}, _Reason, State) ->
maybe_send_answer(Request, Answer, State) ->
answer_request(Request, Answer, State).
-deliver_answer(#request{id = Id, from = From} = Request)
+deliver_answer(#request{from = From} = Request)
when is_pid(From) ->
Response = httpc_response:error(Request, socket_closed_remotely),
- ?hcrd("deliver answer", [{id, Id}, {from, From}, {response, Response}]),
httpc_response:send(From, Response);
-deliver_answer(Request) ->
- ?hcrd("skip deliver answer", [{request, Request}]),
+deliver_answer(_Request) ->
ok.
-
-%%--------------------------------------------------------------------
-%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState}
-%% Purpose: Convert process state when code is changed
-%%--------------------------------------------------------------------
-
-code_change(_, State, _) ->
- {ok, State}.
-
-
-%% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts,
-%% Auth, Relaxed}) ->
-%% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts,
-%% Auth, Relaxed}.
-
-%% old_http_options({http_options, _, TimeOut, AutoRedirect,
-%% SslOpts, Auth, Relaxed}) ->
-%% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}.
-
-%% new_queue(Queue, Fun) ->
-%% List = queue:to_list(Queue),
-%% NewList =
-%% lists:map(fun(Request) ->
-%% Settings =
-%% Fun(Request#request.settings),
-%% Request#request{settings = Settings}
-%% end, List),
-%% queue:from_list(NewList).
-
-
%%%--------------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
@@ -872,26 +799,21 @@ connect(SocketType, ToAddress,
connect_and_send_first_request(Address, Request, #state{options = Options} = State) ->
SocketType = socket_type(Request),
ConnTimeout = (Request#request.settings)#http_options.connect_timeout,
- ?hcri("connect",
- [{address, Address}, {request, Request}, {options, Options}]),
case connect(SocketType, Address, Options, ConnTimeout) of
{ok, Socket} ->
ClientClose =
- httpc_request:is_client_closing(
- Request#request.headers),
+ httpc_request:is_client_closing(
+ Request#request.headers),
SessionType = httpc_manager:session_type(Options),
SocketType = socket_type(Request),
Session = #session{id = {Request#request.address, self()},
scheme = Request#request.scheme,
socket = Socket,
- socket_type = SocketType,
- client_close = ClientClose,
- type = SessionType},
- ?hcri("connected - now send first request", [{socket, Socket}]),
-
+ socket_type = SocketType,
+ client_close = ClientClose,
+ type = SessionType},
case httpc_request:send(Address, Session, Request) of
ok ->
- ?hcri("first request sent", []),
TmpState = State#state{request = Request,
session = Session,
mfa = init_mfa(Request, State),
@@ -949,12 +871,6 @@ handler_info(#state{request = Request,
options = _Options,
timers = _Timers} = _State) ->
- ?hcrt("handler info", [{request, Request},
- {session, Session},
- {pipeline, Pipeline},
- {keep_alive, KeepAlive},
- {status, Status}]),
-
%% Info about the current request
RequestInfo =
case Request of
@@ -965,8 +881,6 @@ handler_info(#state{request = Request,
[{id, Id}, {started, ReqStarted}]
end,
- ?hcrt("handler info", [{request_info, RequestInfo}]),
-
%% Info about the current session/socket
SessionType = Session#session.type,
QueueLen = case SessionType of
@@ -979,22 +893,12 @@ handler_info(#state{request = Request,
Socket = Session#session.socket,
SocketType = Session#session.socket_type,
- ?hcrt("handler info", [{session_type, SessionType},
- {queue_length, QueueLen},
- {scheme, Scheme},
- {socket, Socket}]),
-
SocketOpts = http_transport:getopts(SocketType, Socket),
SocketStats = http_transport:getstat(SocketType, Socket),
Remote = http_transport:peername(SocketType, Socket),
Local = http_transport:sockname(SocketType, Socket),
- ?hcrt("handler info", [{remote, Remote},
- {local, Local},
- {socket_opts, SocketOpts},
- {socket_stats, SocketStats}]),
-
SocketInfo = [{remote, Remote},
{local, Local},
{socket_opts, SocketOpts},
@@ -1014,7 +918,6 @@ handler_info(#state{request = Request,
handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body},
State = #state{request = Request}) ->
- ?hcrt("handle_http_msg", [{headers, Headers}]),
case Headers#http_response_h.'content-type' of
"multipart/byteranges" ++ _Param ->
exit({not_yet_implemented, multypart_byteranges});
@@ -1028,15 +931,12 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body},
end;
handle_http_msg({ChunkedHeaders, Body},
#state{status_line = {_, Code, _}, headers = Headers} = State) ->
- ?hcrt("handle_http_msg",
- [{chunked_headers, ChunkedHeaders}, {headers, Headers}]),
NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders),
{_, NewBody, NewRequest} = stream(Body, State#state.request, Code),
handle_response(State#state{headers = NewHeaders,
body = NewBody,
request = NewRequest});
handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) ->
- ?hcrt("handle_http_msg", [{code, Code}]),
{_, NewBody, NewRequest} = stream(Body, State#state.request, Code),
handle_response(State#state{body = NewBody, request = NewRequest}).
@@ -1051,41 +951,28 @@ handle_http_body(_, #state{status = {ssl_tunnel, Request},
{stop, normal, NewState};
handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) ->
- ?hcrt("handle_http_body - 304", []),
handle_response(State#state{body = <<>>});
handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) ->
- ?hcrt("handle_http_body - 204", []),
handle_response(State#state{body = <<>>});
handle_http_body(<<>>, #state{request = #request{method = head}} = State) ->
- ?hcrt("handle_http_body - head", []),
handle_response(State#state{body = <<>>});
handle_http_body(Body, #state{headers = Headers,
max_body_size = MaxBodySize,
status_line = {_,Code, _},
request = Request} = State) ->
- ?hcrt("handle_http_body",
- [{max_body_size, MaxBodySize}, {headers, Headers}, {code, Code}]),
TransferEnc = Headers#http_response_h.'transfer-encoding',
case case_insensitive_header(TransferEnc) of
"chunked" ->
- ?hcrt("handle_http_body - chunked", []),
try http_chunk:decode(Body, State#state.max_body_size,
State#state.max_header_size) of
{Module, Function, Args} ->
- ?hcrt("handle_http_body - new mfa",
- [{module, Module},
- {function, Function},
- {args, Args}]),
NewState = next_body_chunk(State, Code),
{noreply, NewState#state{mfa =
{Module, Function, Args}}};
{ok, {ChunkedHeaders, NewBody}} ->
- ?hcrt("handle_http_body - new body",
- [{chunked_headers, ChunkedHeaders},
- {new_body, NewBody}]),
NewHeaders = http_chunk:handle_headers(Headers,
ChunkedHeaders),
case Body of
@@ -1107,7 +994,6 @@ handle_http_body(Body, #state{headers = Headers,
{stop, normal, NewState}
end;
Enc when Enc =:= "identity"; Enc =:= undefined ->
- ?hcrt("handle_http_body - identity", []),
Length =
list_to_integer(Headers#http_response_h.'content-length'),
case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of
@@ -1131,7 +1017,6 @@ handle_http_body(Body, #state{headers = Headers,
{stop, normal, NewState}
end;
Encoding when is_list(Encoding) ->
- ?hcrt("handle_http_body - other", [{encoding, Encoding}]),
NewState = answer_request(Request,
httpc_response:error(Request,
unknown_encoding),
@@ -1152,18 +1037,10 @@ handle_response(#state{request = Request,
options = Options,
profile_name = ProfileName} = State)
when Status =/= new ->
-
- ?hcrd("handle response", [{profile, ProfileName},
- {status, Status},
- {request, Request},
- {session, Session},
- {status_line, StatusLine}]),
-
handle_cookies(Headers, Request, Options, ProfileName),
case httpc_response:result({StatusLine, Headers, Body}, Request) of
%% 100-continue
continue ->
- ?hcrd("handle response - continue", []),
%% Send request body
{_, RequestBody} = Request#request.content,
send_raw(Session, RequestBody),
@@ -1180,7 +1057,6 @@ handle_response(#state{request = Request,
%% Ignore unexpected 100-continue response and receive the
%% actual response that the server will send right away.
{ignore, Data} ->
- ?hcrd("handle response - ignore", [{data, Data}]),
Relaxed = (Request#request.settings)#http_options.relaxed,
MFA = {httpc_response, parse,
[State#state.max_header_size, Relaxed]},
@@ -1194,23 +1070,17 @@ handle_response(#state{request = Request,
%% obsolete and the manager will create a new request
%% with the same id as the current.
{redirect, NewRequest, Data} ->
- ?hcrt("handle response - redirect",
- [{new_request, NewRequest}, {data, Data}]),
ok = httpc_manager:redirect_request(NewRequest, ProfileName),
handle_queue(State#state{request = undefined}, Data);
{retry, TimeNewRequest, Data} ->
- ?hcrt("handle response - retry",
- [{time_new_request, TimeNewRequest}, {data, Data}]),
ok = httpc_manager:retry_request(TimeNewRequest, ProfileName),
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);
{stop, Msg} ->
- ?hcrd("handle response - stop", [{msg, Msg}]),
end_stream(StatusLine, Request),
NewState = maybe_send_answer(Request, Msg, State),
{stop, normal, NewState}
@@ -1245,28 +1115,19 @@ handle_pipeline(#state{status = pipeline,
profile_name = ProfileName,
options = #options{pipeline_timeout = TimeOut}} = State,
Data) ->
-
- ?hcrd("handle pipeline", [{profile, ProfileName},
- {session, Session},
- {timeout, TimeOut}]),
-
case queue:out(State#state.pipeline) of
{empty, _} ->
- ?hcrd("pipeline queue empty", []),
handle_empty_queue(Session, ProfileName, TimeOut, State);
{{value, NextRequest}, Pipeline} ->
- ?hcrd("pipeline queue non-empty", []),
case lists:member(NextRequest#request.id,
State#state.canceled) of
true ->
- ?hcrv("next request had been cancelled", []),
%% See comment for handle_cast({cancel, RequestId})
{stop, normal,
State#state{request =
NextRequest#request{from = answer_sent},
pipeline = Pipeline}};
false ->
- ?hcrv("next request", [{request, NextRequest}]),
NewSession =
Session#session{queue_length =
%% Queue + current
@@ -1283,25 +1144,16 @@ handle_keep_alive_queue(#state{status = keep_alive,
options = #options{keep_alive_timeout = TimeOut,
proxy = Proxy}} = State,
Data) ->
-
- ?hcrd("handle keep_alive", [{profile, ProfileName},
- {session, Session},
- {timeout, TimeOut}]),
-
case queue:out(State#state.keep_alive) of
{empty, _} ->
- ?hcrd("keep_alive queue empty", []),
handle_empty_queue(Session, ProfileName, TimeOut, State);
{{value, NextRequest}, KeepAlive} ->
- ?hcrd("keep_alive queue non-empty", []),
case lists:member(NextRequest#request.id,
State#state.canceled) of
true ->
- ?hcrv("next request has already been canceled", []),
handle_keep_alive_queue(
State#state{keep_alive = KeepAlive}, Data);
false ->
- ?hcrv("next request", [{request, NextRequest}]),
#request{address = Addr} = NextRequest,
Address = handle_proxy(Addr, Proxy),
case httpc_request:send(Address, Session, NextRequest) of
@@ -1314,7 +1166,6 @@ handle_keep_alive_queue(#state{status = keep_alive,
end
end
end.
-
handle_empty_queue(Session, ProfileName, TimeOut, State) ->
%% The server may choose too terminate an idle pipline| keep_alive session
%% in this case we want to receive the close message
@@ -1350,7 +1201,6 @@ init_wait_for_response_state(Request, State) ->
status_line = undefined,
headers = undefined,
body = undefined}.
-
gather_data(<<>>, Session, State) ->
activate_once(Session),
{noreply, State};
@@ -1381,10 +1231,6 @@ activate_request_timeout(
State;
_ ->
ReqId = Request#request.id,
- ?hcrt("activate request timer",
- [{request_id, ReqId},
- {time_consumed, t() - Request#request.started},
- {timeout, Timeout}]),
Msg = {timeout, ReqId},
Ref = erlang:send_after(Timeout, self(), Msg),
Request2 = Request#request{timer = Ref},
@@ -1427,10 +1273,6 @@ try_to_enable_pipeline_or_keep_alive(
status_line = {Version, _, _},
headers = Headers,
profile_name = ProfileName} = State) ->
- ?hcrd("try to enable pipeline or keep-alive",
- [{version, Version},
- {headers, Headers},
- {session, Session}]),
case is_keep_alive_enabled_server(Version, Headers) andalso
is_keep_alive_connection(Headers, Session) of
true ->
@@ -1455,7 +1297,6 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg,
#state{session = Session,
timers = Timers,
profile_name = ProfileName} = State) ->
- ?hcrt("answer request", [{request, Request}, {msg, Msg}]),
httpc_response:send(From, Msg),
RequestTimers = Timers#timers.request_timers,
TimerRef =
@@ -1602,42 +1443,32 @@ socket_type(#request{scheme = http}) ->
ip_comm;
socket_type(#request{scheme = https, settings = Settings}) ->
Settings#http_options.ssl.
-%% socket_type(http) ->
-%% ip_comm;
-%% socket_type(https) ->
-%% {ssl1, []}. %% Dummy value ok for ex setopts that does not use this value
start_stream({_Version, _Code, _ReasonPhrase}, _Headers,
#request{stream = none} = Request) ->
- ?hcrt("start stream - none", []),
{ok, Request};
start_stream({_Version, Code, _ReasonPhrase}, Headers,
#request{stream = self} = Request)
when ?IS_STREAMED(Code) ->
- ?hcrt("start stream - self", [{code, Code}]),
Msg = httpc_response:stream_start(Headers, Request, ignore),
httpc_response:send(Request#request.from, Msg),
{ok, Request};
start_stream({_Version, Code, _ReasonPhrase}, Headers,
#request{stream = {self, once}} = Request)
when ?IS_STREAMED(Code) ->
- ?hcrt("start stream - self:once", [{code, Code}]),
Msg = httpc_response:stream_start(Headers, Request, self()),
httpc_response:send(Request#request.from, Msg),
{ok, Request};
start_stream({_Version, Code, _ReasonPhrase}, _Headers,
#request{stream = Filename} = Request)
when ?IS_STREAMED(Code) andalso is_list(Filename) ->
- ?hcrt("start stream", [{code, Code}, {filename, Filename}]),
case file:open(Filename, [write, raw, append, delayed_write]) of
{ok, Fd} ->
- ?hcri("start stream - file open ok", [{fd, Fd}]),
{ok, Request#request{stream = Fd}};
{error, Reason} ->
exit({stream_to_file_failed, Reason})
end;
start_stream(_StatusLine, _Headers, Request) ->
- ?hcrt("start stream - no op", []),
{ok, Request}.
stream_remaining_body(<<>>, _, _) ->
@@ -1648,16 +1479,12 @@ stream_remaining_body(Body, Request, {_, Code, _}) ->
%% Note the end stream message is handled by httpc_response and will
%% be sent by answer_request
end_stream(_, #request{stream = none}) ->
- ?hcrt("end stream - none", []),
ok;
end_stream(_, #request{stream = self}) ->
- ?hcrt("end stream - self", []),
ok;
end_stream(_, #request{stream = {self, once}}) ->
- ?hcrt("end stream - self:once", []),
ok;
end_stream({_,200,_}, #request{stream = Fd}) ->
- ?hcrt("end stream - 200", [{stream, Fd}]),
case file:close(Fd) of
ok ->
ok;
@@ -1665,15 +1492,13 @@ end_stream({_,200,_}, #request{stream = Fd}) ->
file:close(Fd)
end;
end_stream({_,206,_}, #request{stream = Fd}) ->
- ?hcrt("end stream - 206", [{stream, Fd}]),
case file:close(Fd) of
ok ->
ok;
{error, enospc} -> % Could be due to delayed_write
file:close(Fd)
end;
-end_stream(SL, R) ->
- ?hcrt("end stream", [{status_line, SL}, {request, R}]),
+end_stream(_, _) ->
ok.
@@ -1702,11 +1527,8 @@ handle_verbose(trace) ->
handle_verbose(_) ->
ok.
-
-
send_raw(#session{socket = Socket, socket_type = SocketType},
{ProcessBody, Acc}) when is_function(ProcessBody, 1) ->
- ?hcrt("send raw", [{acc, Acc}]),
send_raw(SocketType, Socket, ProcessBody, Acc);
send_raw(#session{socket = Socket, socket_type = SocketType}, Body) ->
http_transport:send(SocketType, Socket, Body).
@@ -1717,7 +1539,6 @@ send_raw(SocketType, Socket, ProcessBody, Acc) ->
ok;
{ok, Data, NewAcc} ->
DataBin = iolist_to_binary(Data),
- ?hcrd("send", [{data, DataBin}]),
case http_transport:send(SocketType, Socket, DataBin) of
ok ->
send_raw(SocketType, Socket, ProcessBody, NewAcc);
@@ -1883,16 +1704,3 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
end.
-%% ---------------------------------------------------------------------
-
-call(Msg, Pid) ->
- call(Msg, Pid, infinity).
-
-call(Msg, Pid, Timeout) ->
- gen_server:call(Pid, Msg, Timeout).
-
-cast(Msg, Pid) ->
- gen_server:cast(Pid, Msg).
-
-t() ->
- http_util:timestamp().
diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl
index d8bdac24e3..0fd5faa466 100644
--- a/lib/inets/src/http_client/httpc_response.erl
+++ b/lib/inets/src/http_client/httpc_response.erl
@@ -363,7 +363,7 @@ redirect(Response = {StatusLine, Headers, Body}, Request) ->
%% Automatic redirection
{ok, {Scheme, _, Host, Port, Path, Query}} ->
NewHeaders =
- (Request#request.headers)#http_request_h{host = Host},
+ (Request#request.headers)#http_request_h{host = Host++":"++integer_to_list(Port)},
NewRequest =
Request#request{redircount =
Request#request.redircount+1,
diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl
index 7e20a9ba67..82273c8c74 100644
--- a/lib/inets/src/http_server/httpd_request_handler.erl
+++ b/lib/inets/src/http_server/httpd_request_handler.erl
@@ -241,9 +241,9 @@ handle_info({tcp_closed, _}, State) ->
handle_info({ssl_closed, _}, State) ->
{stop, normal, State};
handle_info({tcp_error, _, _} = Reason, State) ->
- {stop, Reason, State};
+ {stop, {shutdown, Reason}, State};
handle_info({ssl_error, _, _} = Reason, State) ->
- {stop, Reason, State};
+ {stop, {shutdown, Reason}, State};
%% Timeouts
handle_info(timeout, #state{mfa = {_, parse, _}} = State) ->
diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src
index 3a31daeb20..d28d4cd766 100644
--- a/lib/inets/src/inets_app/inets.appup.src
+++ b/lib/inets/src/inets_app/inets.appup.src
@@ -18,10 +18,14 @@
%% %CopyrightEnd%
{"%VSN%",
[
+ {<<"6.2.4">>, [{load_module, httpd_request_handler,
+ soft_purge, soft_purge, []}]},
{<<"6\\..*">>,[{restart_application, inets}]},
{<<"5\\..*">>,[{restart_application, inets}]}
],
[
+ {<<"6.2.4">>, [{load_module, httpd_request_handler,
+ soft_purge, soft_purge, []}]},
{<<"6\\..*">>,[{restart_application, inets}]},
{<<"5\\..*">>,[{restart_application, inets}]}
]
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index a64ae2b87c..8aea38037d 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -88,7 +88,8 @@ real_requests()->
stream_through_mfa,
streaming_error,
inet_opts,
- invalid_headers
+ invalid_headers,
+ invalid_body
].
only_simulated() ->
@@ -125,7 +126,9 @@ only_simulated() ->
redirect_see_other,
redirect_temporary_redirect,
port_in_host_header,
- relaxed
+ redirect_port_in_host_header,
+ relaxed,
+ multipart_chunks
].
misc() ->
@@ -1000,10 +1003,25 @@ invalid_headers(Config) ->
Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]},
{error, _} = httpc:request(get, Request, [], []).
+%%-------------------------------------------------------------------------
+
+invalid_body(Config) ->
+ URL = url(group_name(Config), "/dummy.html", Config),
+ try
+ httpc:request(post, {URL, [], <<"text/plain">>, "foobar"},
+ [], []),
+ ct:fail(accepted_invalid_input)
+ catch
+ error:function_clause ->
+ ok
+ end.
+
+%%-------------------------------------------------------------------------
remote_socket_close(Config) when is_list(Config) ->
URL = url(group_name(Config), "/just_close.html", Config),
{error, socket_closed_remotely} = httpc:request(URL).
+
%%-------------------------------------------------------------------------
remote_socket_close_async(Config) when is_list(Config) ->
@@ -1102,7 +1120,20 @@ port_in_host_header(Config) when is_list(Config) ->
Request = {url(group_name(Config), "/ensure_host_header_with_port.html", Config), []},
{ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []),
inets_test_lib:check_body(Body).
+%%-------------------------------------------------------------------------
+redirect_port_in_host_header(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/redirect_ensure_host_header_with_port.html", Config), []},
+ {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []),
+ inets_test_lib:check_body(Body).
+
+%%-------------------------------------------------------------------------
+multipart_chunks(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/multipart_chunks.html", Config), []},
+ {ok, Ref} = httpc:request(get, Request, [], [{sync, false}, {stream, self}]),
+ ok = receive_stream_n(Ref, 10),
+ httpc:cancel_request(Ref).
+
%%-------------------------------------------------------------------------
timeout_memory_leak() ->
[{doc, "Check OTP-8739"}].
@@ -1398,7 +1429,7 @@ dummy_server(Caller, SocketType, Inet, Extra) ->
end.
dummy_server_init(Caller, ip_comm, Inet, _) ->
- BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}],
+ BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {keepalive, true}, {active, false}],
{ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]),
{ok, Port} = inet:port(ListenSocket),
Caller ! {port, Port},
@@ -1680,6 +1711,12 @@ handle_uri(_,"/ensure_host_header_with_port.html",_,Headers,_,_) ->
"HTTP/1.1 500 Internal Server Error\r\n" ++
"Content-Length:" ++ Len ++ "\r\n\r\n" ++ B
end;
+handle_uri(_,"/redirect_ensure_host_header_with_port.html",Port,_,Socket,_) ->
+ NewUri = url_start(Socket) ++
+ integer_to_list(Port) ++ "/ensure_host_header_with_port.html",
+ "HTTP/1.1 302 Found \r\n" ++
+ "Location:" ++ NewUri ++ "\r\n" ++
+ "Content-Length:0\r\n\r\n";
handle_uri(_,"/300.html",Port,_,Socket,_) ->
NewUri = url_start(Socket) ++
@@ -1968,6 +2005,16 @@ handle_uri(_,"/missing_CR.html",_,_,_,_) ->
"Content-Length:32\r\n\n" ++
"<HTML><BODY>foobar</BODY></HTML>";
+handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) ->
+ Head = "HTTP/1.1 200 ok\r\n" ++
+ "Transfer-Encoding:chunked\r\n" ++
+ "Date: " ++ httpd_util:rfc1123_date() ++ "\r\n"
+ "Connection: Keep-Alive\r\n" ++
+ "Content-Type: multipart/x-mixed-replace; boundary=chunk_boundary\r\n" ++
+ "\r\n",
+ send(Socket, Head),
+ send_multipart_chunks(Socket),
+ http_chunk:encode_last();
handle_uri("HEAD",_,_,_,_,_) ->
"HTTP/1.1 200 ok\r\n" ++
"Content-Length:0\r\n\r\n";
@@ -2264,3 +2311,21 @@ otp_8739_dummy_server_main(_Parent, ListenSocket) ->
Error ->
exit(Error)
end.
+
+send_multipart_chunks(Socket) ->
+ send(Socket, http_chunk:encode("--chunk_boundary\r\n")),
+ send(Socket, http_chunk:encode("Content-Type: text/plain\r\nContent-Length: 4\r\n\r\n")),
+ send(Socket, http_chunk:encode("test\r\n")),
+ ct:sleep(500),
+ send_multipart_chunks(Socket).
+
+receive_stream_n(_, 0) ->
+ ok;
+receive_stream_n(Ref, N) ->
+ receive
+ {http, {Ref, stream_start, _}} ->
+ receive_stream_n(Ref, N);
+ {http, {Ref,stream, Data}} ->
+ ct:pal("Data: ~p", [Data]),
+ receive_stream_n(Ref, N-1)
+ end.
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index eef5abd610..9591ab22ed 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 6.3.4
+INETS_VSN = 6.3.5
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml
index 59a046bf4d..5b5b71e521 100644
--- a/lib/kernel/doc/src/heart.xml
+++ b/lib/kernel/doc/src/heart.xml
@@ -37,10 +37,7 @@
the <c>heart</c> port program is to check that the Erlang runtime system
it is supervising is still running. If the port program has not
received any heartbeats within <c>HEART_BEAT_TIMEOUT</c> seconds
- (defaults to 60 seconds), the system can be rebooted. Also, if
- the system is equipped with a hardware watchdog timer and is
- running Solaris, the watchdog can be used to supervise the entire
- system.</p>
+ (defaults to 60 seconds), the system can be rebooted.</p>
<p>An Erlang runtime system to be monitored by a heart program
is to be started with command-line flag <c>-heart</c> (see
also <seealso marker="erts:erl"><c>erl(1)</c></seealso>).
@@ -51,17 +48,13 @@
or a terminated Erlang runtime system, environment variable
<c>HEART_COMMAND</c> must be set before the system is started.
If this variable is not set, a warning text is printed but
- the system does not reboot. However, if the hardware watchdog is
- used, it still triggers a reboot <c>HEART_BEAT_BOOT_DELAY</c>
- seconds later (defaults to 60 seconds).</p>
+ the system does not reboot.</p>
<p>To reboot on Windows, <c>HEART_COMMAND</c> can be
set to <c>heart -shutdown</c> (included in the Erlang delivery)
or to any other suitable program that can activate a reboot.</p>
- <p>The hardware watchdog is not started under Solaris if
- environment variable <c>HW_WD_DISABLE</c> is set.</p>
- <p>The environment variables <c>HEART_BEAT_TIMEOUT</c> and
- <c>HEART_BEAT_BOOT_DELAY</c> can be used to configure the heart
- time-outs; they can be set in the operating system shell before Erlang
+ <p>The environment variable <c>HEART_BEAT_TIMEOUT</c>
+ can be used to configure the heart
+ time-outs; it can be set in the operating system shell before Erlang
is started or be specified at the command line:</p>
<pre>
% <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre>
diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl
index 3523f680a3..3ee8e2c6e6 100644
--- a/lib/kernel/src/error_logger.erl
+++ b/lib/kernel/src/error_logger.erl
@@ -360,8 +360,12 @@ init(Max) when is_integer(Max) ->
%% go back.
init({go_back, _PostState}) ->
{ok, {?buffer_size, 0, []}};
-init(_) -> %% Start and just relay to other
- {ok, []}. %% node if node(GLeader) =/= node().
+init(_) ->
+ %% The error logger process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ process_flag(message_queue_data, off_heap),
+ {ok, []}.
-spec handle_event(term(), state()) -> {'ok', state()}.
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
index 58b601e456..6d94f7770f 100644
--- a/lib/kernel/src/file.erl
+++ b/lib/kernel/src/file.erl
@@ -1413,7 +1413,7 @@ path_open_first([Path|Rest], Name, Mode, LastError) ->
case open(FileName, Mode) of
{ok, Fd} ->
{ok, Fd, FileName};
- {error, enoent} ->
+ {error, Reason} when Reason =:= enoent; Reason =:= enotdir ->
path_open_first(Rest, Name, Mode, LastError);
Error ->
Error
diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl
index eea78aabdf..8fa48d56fb 100644
--- a/lib/kernel/src/heart.erl
+++ b/lib/kernel/src/heart.erl
@@ -198,16 +198,11 @@ start_portprogram() ->
end.
get_heart_timeouts() ->
- HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of
- false -> "";
- H when is_list(H) ->
- "-ht " ++ H
- end,
- HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of
- false -> "";
- W when is_list(W) ->
- " -wt " ++ W
- end.
+ case os:getenv("HEART_BEAT_TIMEOUT") of
+ false -> "";
+ H when is_list(H) ->
+ "-ht " ++ H
+ end.
check_start_heart() ->
case init:get_argument(heart) of
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index f8519d3a5e..03d4324992 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -289,12 +289,11 @@ get_data(Port, MonRef, Eot, Sofar) ->
more ->
get_data(Port, MonRef, Eot, [Sofar,Bytes]);
Last ->
- Port ! {self(), close},
- flush_until_closed(Port),
- flush_exit(Port),
+ catch port_close(Port),
+ flush_until_down(Port, MonRef),
iolist_to_binary([Sofar, Last])
end;
- {'DOWN', MonRef, _, _ , _} ->
+ {'DOWN', MonRef, _, _, _} ->
flush_exit(Port),
iolist_to_binary(Sofar)
end.
@@ -308,18 +307,25 @@ eot(Bs, Eot) ->
binary:part(Bs,{0, Pos})
end.
-flush_until_closed(Port) ->
+%% When port_close returns we know that all the
+%% messages sent have been sent and that the
+%% DOWN message is after them all.
+flush_until_down(Port, MonRef) ->
receive
{Port, {data, _Bytes}} ->
- flush_until_closed(Port);
- {Port, closed} ->
- true
+ flush_until_down(Port, MonRef);
+ {'DOWN', MonRef, _, _, _} ->
+ flush_exit(Port)
end.
+%% The exit signal is always delivered before
+%% the down signal, so we can be sure that if there
+%% was an exit message sent, it will be in the
+%% mailbox now.
flush_exit(Port) ->
receive
{'EXIT', Port, _} ->
ok
- after 1 -> % force context switch
+ after 0 ->
ok
end.
diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl
index 21bff02214..bd6ea26678 100644
--- a/lib/kernel/src/rpc.erl
+++ b/lib/kernel/src/rpc.erl
@@ -67,17 +67,27 @@
%%------------------------------------------------------------------------
+
+%% The rex server may receive a huge amount of
+%% messages. Make sure that they are stored off heap to
+%% avoid exessive GCs.
+
+-define(SPAWN_OPTS, [{spawn_opt,[{message_queue_data,off_heap}]}]).
+
%% Remote execution and broadcasting facility
-spec start() -> {'ok', pid()} | 'ignore' | {'error', term()}.
start() ->
- gen_server:start({local,?NAME}, ?MODULE, [], []).
+ gen_server:start({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS).
-spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}.
start_link() ->
- gen_server:start_link({local,?NAME}, ?MODULE, [], []).
+ %% The rex server process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ gen_server:start_link({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS).
-spec stop() -> term().
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index c5167efa56..5777b397b8 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -588,20 +588,28 @@ sticky_compiler(Files, PrivDir) ->
[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
+ case code:is_sticky(Mod) of
+ true ->
+ %% 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;
+ false ->
+ %% For some reason the module is not sticky
+ %% could be that the .erlang file has
+ %% unstuck it?
+ {Mod, is_not_sticky}
end.
%% Test that the -pa and -pz options work as expected.
diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl
index b6e7551741..bb01c2384d 100644
--- a/lib/kernel/test/error_logger_SUITE.erl
+++ b/lib/kernel/test/error_logger_SUITE.erl
@@ -30,6 +30,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
+ off_heap/1,
error_report/1, info_report/1, error/1, info/1,
emulator/1, tty/1, logfile/1, add/1, delete/1]).
@@ -45,7 +46,7 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [error_report, info_report, error, info, emulator, tty,
+ [off_heap, error_report, info_report, error, info, emulator, tty,
logfile, add, delete].
groups() ->
@@ -66,6 +67,16 @@ end_per_group(_GroupName, Config) ->
%%-----------------------------------------------------------------
+off_heap(_Config) ->
+ %% The error_logger process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ MQD = message_queue_data,
+ {MQD,off_heap} = process_info(whereis(error_logger), MQD),
+ ok.
+
+%%-----------------------------------------------------------------
+
error_report(Config) when is_list(Config) ->
error_logger:add_report_handler(?MODULE, self()),
Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}],
diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl
index 1c72ddc87f..d76c4097d8 100644
--- a/lib/kernel/test/rpc_SUITE.erl
+++ b/lib/kernel/test/rpc_SUITE.erl
@@ -21,7 +21,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
--export([call/1, block_call/1, multicall/1, multicall_timeout/1,
+-export([off_heap/1,
+ call/1, block_call/1, multicall/1, multicall_timeout/1,
multicall_dies/1, multicall_node_dies/1,
called_dies/1, called_node_dies/1,
called_throws/1, call_benchmark/1, async_call/1]).
@@ -35,7 +36,7 @@ suite() ->
{timetrap,{minutes,2}}].
all() ->
- [call, block_call, multicall, multicall_timeout,
+ [off_heap, call, block_call, multicall, multicall_timeout,
multicall_dies, multicall_node_dies, called_dies,
called_node_dies, called_throws, call_benchmark,
async_call].
@@ -55,6 +56,13 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+off_heap(_Config) ->
+ %% The rex server process may receive a huge amount of
+ %% messages. Make sure that they are stored off heap to
+ %% avoid exessive GCs.
+ MQD = message_queue_data,
+ {MQD,off_heap} = process_info(whereis(rex), MQD),
+ ok.
%% Test different rpc calls.
diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml
index 51c98d0d3e..9f59759cb6 100644
--- a/lib/mnesia/doc/src/notes.xml
+++ b/lib/mnesia/doc/src/notes.xml
@@ -39,7 +39,23 @@
thus constitutes one section in this document. The title of each
section is the version number of Mnesia.</p>
- <section><title>Mnesia 4.14.2</title>
+ <section><title>Mnesia 4.14.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed crash in checkpoint handling when table was deleted
+ during backup.</p>
+ <p>
+ Own Id: OTP-14167</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Mnesia 4.14.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl
index 9eb939e8d3..fc626940b4 100644
--- a/lib/mnesia/src/mnesia_checkpoint.erl
+++ b/lib/mnesia/src/mnesia_checkpoint.erl
@@ -909,7 +909,7 @@ retainer_loop(Cp = #checkpoint_args{name=Name}) ->
retainer_loop(Cp2);
{From, {iter_end, Iter}} ->
- retainer_fixtable(Iter#iter.oid_tab, false),
+ ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)),
Iters = Cp#checkpoint_args.iterators -- [Iter],
reply(From, Name, ok),
retainer_loop(Cp#checkpoint_args{iterators = Iters});
@@ -971,7 +971,8 @@ do_stop(Cp) ->
unset({checkpoint, Name}),
lists:foreach(fun deactivate_tab/1, Cp#checkpoint_args.retainers),
Iters = Cp#checkpoint_args.iterators,
- lists:foreach(fun(I) -> retainer_fixtable(I#iter.oid_tab, false) end, Iters).
+ [?SAFE(retainer_fixtable(Tab, false)) || #iter{main_tab=Tab} <- Iters],
+ ok.
deactivate_tab(R) ->
Name = R#retainer.cp_name,
@@ -1151,7 +1152,7 @@ do_change_copy(Cp, Tab, FromType, ToType) ->
Cp#checkpoint_args{retainers = Rs, nodes = writers(Rs)}.
check_iter(From, Iter) when Iter#iter.pid == From ->
- retainer_fixtable(Iter#iter.oid_tab, false),
+ ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)),
false;
check_iter(_From, _Iter) ->
true.
diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl
index 7320d381ea..6f7531245f 100644
--- a/lib/mnesia/src/mnesia_event.erl
+++ b/lib/mnesia/src/mnesia_event.erl
@@ -114,7 +114,8 @@ handle_table_event({Oper, Record, TransId}, State) ->
handle_system_event({mnesia_checkpoint_activated, _Checkpoint}, State) ->
{ok, State};
-handle_system_event({mnesia_checkpoint_deactivated, _Checkpoint}, State) ->
+handle_system_event({mnesia_checkpoint_deactivated, Checkpoint}, State) ->
+ report_error("Checkpoint '~p' has been deactivated, last table copy deleted.\n",[Checkpoint]),
{ok, State};
handle_system_event({mnesia_up, Node}, State) ->
diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl
index e745ec9b04..044cf501fd 100644
--- a/lib/mnesia/test/mnesia_evil_backup.erl
+++ b/lib/mnesia/test/mnesia_evil_backup.erl
@@ -723,18 +723,18 @@ bup_records(File, Mod) ->
exit(Reason)
end.
-sops_with_checkpoint(doc) ->
+sops_with_checkpoint(doc) ->
["Test schema operations during a checkpoint"];
sops_with_checkpoint(suite) -> [];
sops_with_checkpoint(Config) when is_list(Config) ->
- Ns = ?acquire_nodes(2, Config),
-
+ Ns = [N1,N2] = ?acquire_nodes(2, Config),
+
?match({ok, cp1, Ns}, mnesia:activate_checkpoint([{name, cp1},{max,mnesia:system_info(tables)}])),
- Tab = tab,
+ Tab = tab,
?match({atomic, ok}, mnesia:create_table(Tab, [{disc_copies,Ns}])),
OldRecs = [{Tab, K, -K} || K <- lists:seq(1, 5)],
[mnesia:dirty_write(R) || R <- OldRecs],
-
+
?match({ok, cp2, Ns}, mnesia:activate_checkpoint([{name, cp2},{max,mnesia:system_info(tables)}])),
File1 = "cp1_delete_me.BUP",
?match(ok, mnesia:dirty_write({Tab,6,-6})),
@@ -742,16 +742,16 @@ sops_with_checkpoint(Config) when is_list(Config) ->
?match(ok, mnesia:dirty_write({Tab,7,-7})),
File2 = "cp2_delete_me.BUP",
?match(ok, mnesia:backup_checkpoint(cp2, File2)),
-
+
?match(ok, mnesia:deactivate_checkpoint(cp1)),
?match(ok, mnesia:backup_checkpoint(cp2, File1)),
?match(ok, mnesia:dirty_write({Tab,8,-8})),
-
+
?match({atomic,ok}, mnesia:delete_table(Tab)),
?match({error,_}, mnesia:backup_checkpoint(cp2, File2)),
?match({'EXIT',_}, mnesia:dirty_write({Tab,9,-9})),
- ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])),
+ ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])),
Test = fun(N) when N > 5 -> ?error("To many records in backup ~p ~n", [N]);
(N) -> case mnesia:dirty_read(Tab,N) of
[{Tab,N,B}] when -B =:= N -> ok;
@@ -759,8 +759,29 @@ sops_with_checkpoint(Config) when is_list(Config) ->
end
end,
[Test(N) || N <- mnesia:dirty_all_keys(Tab)],
- ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])),
-
+ ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])),
+
+ %% Mnesia crashes when deleting a table during backup
+ ?match([], mnesia_test_lib:stop_mnesia([N2])),
+ Tab2 = ram,
+ ?match({atomic, ok}, mnesia:create_table(Tab2, [{ram_copies,[N1]}])),
+ ?match({ok, cp3, _}, mnesia:activate_checkpoint([{name, cp3},
+ {ram_overrides_dump,true},
+ {min,[Tab2]}])),
+ Write = fun Loop (N) ->
+ case N > 0 of
+ true ->
+ mnesia:dirty_write({Tab2, N+100, N+100}),
+ Loop(N-1);
+ false ->
+ ok
+ end
+ end,
+ ok = Write(100000),
+ spawn_link(fun() -> ?match({atomic, ok},mnesia:delete_table(Tab2)) end),
+
+ %% We don't check result here, depends on timing of above call
+ mnesia:backup_checkpoint(cp3, File2),
file:delete(File1), file:delete(File2),
- ?verify_mnesia(Ns, []).
+ ?verify_mnesia([N1], [N2]).
diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk
index 439b21e58c..e272a469bb 100644
--- a/lib/mnesia/vsn.mk
+++ b/lib/mnesia/vsn.mk
@@ -1 +1 @@
-MNESIA_VSN = 4.14.2
+MNESIA_VSN = 4.14.3
diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl
index 0cea1fdcf0..200c728a62 100644
--- a/lib/observer/src/cdv_bin_cb.erl
+++ b/lib/observer/src/cdv_bin_cb.erl
@@ -58,7 +58,7 @@ binary_to_term_fun(Bin) ->
try binary_to_term(Bin) of
Term -> plain_html(io_lib:format("~p",[Term]))
catch error:badarg ->
- Warning = "This binary can not be coverted to an Erlang term",
+ Warning = "This binary can not be converted to an Erlang term",
observer_html_lib:warning(Warning)
end
end.
diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl
index 44f121f359..5782339183 100644
--- a/lib/observer/src/cdv_detail_wx.erl
+++ b/lib/observer/src/cdv_detail_wx.erl
@@ -55,7 +55,7 @@ init([Id, Data, ParentFrame, Callback, Parent]) ->
end,
{stop,normal};
{info,Info} ->
- observer_lib:display_info_dialog(Info),
+ observer_lib:display_info_dialog(ParentFrame,Info),
{stop,normal}
end.
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index 2f9f81104a..13e73f027d 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -928,7 +928,10 @@ general_info(File) ->
WholeLine -> WholeLine
end,
- GI = get_general_info(Fd,#general_info{created=Created}),
+ {Slogan,SysVsn} = get_slogan_and_sysvsn(Fd,[]),
+ GI = get_general_info(Fd,#general_info{created=Created,
+ slogan=Slogan,
+ system_vsn=SysVsn}),
{MemTot,MemMax} =
case lookup_index(?memory) of
@@ -982,12 +985,20 @@ general_info(File) ->
mem_max=MemMax,
instr_info=InstrInfo}.
+get_slogan_and_sysvsn(Fd,Acc) ->
+ case val(Fd,eof) of
+ "Slogan: " ++ SloganPart when Acc==[] ->
+ get_slogan_and_sysvsn(Fd,[SloganPart]);
+ "System version: " ++ SystemVsn ->
+ {lists:append(lists:reverse(Acc)),SystemVsn};
+ eof ->
+ {lists:append(lists:reverse(Acc)),"-1"};
+ SloganPart ->
+ get_slogan_and_sysvsn(Fd,[[$\n|SloganPart]|Acc])
+ end.
+
get_general_info(Fd,GenInfo) ->
case line_head(Fd) of
- "Slogan" ->
- get_general_info(Fd,GenInfo#general_info{slogan=val(Fd)});
- "System version" ->
- get_general_info(Fd,GenInfo#general_info{system_vsn=val(Fd)});
"Compiled" ->
get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)});
"Taints" ->
diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl
index fcb900960b..925f4456bb 100644
--- a/lib/observer/src/etop.erl
+++ b/lib/observer/src/etop.erl
@@ -23,7 +23,7 @@
-export([start/0, start/1, config/2, stop/0, dump/1, help/0]).
%% Internal
-export([update/1]).
--export([loadinfo/1, meminfo/2, getopt/2]).
+-export([loadinfo/2, meminfo/2, getopt/2]).
-include("etop.hrl").
-include("etop_defs.hrl").
@@ -319,18 +319,18 @@ output(graphical) -> exit({deprecated, "Use observer instead"});
output(text) -> etop_txt.
-loadinfo(SysI) ->
+loadinfo(SysI,Prev) ->
#etop_info{n_procs = Procs,
run_queue = RQ,
now = Now,
wall_clock = WC,
runtime = RT} = SysI,
- Cpu = calculate_cpu_utilization(WC,RT),
+ Cpu = calculate_cpu_utilization(WC,RT,Prev#etop_info.runtime),
Clock = io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w",
tuple_to_list(element(2,calendar:now_to_datetime(Now)))),
{Cpu,Procs,RQ,Clock}.
-calculate_cpu_utilization({_,WC},{_,RT}) ->
+calculate_cpu_utilization({_,WC},{_,RT},_) ->
%% Old version of observer_backend, using statistics(wall_clock)
%% and statistics(runtime)
case {WC,RT} of
@@ -341,15 +341,23 @@ calculate_cpu_utilization({_,WC},{_,RT}) ->
_ ->
round(100*RT/WC)
end;
-calculate_cpu_utilization(_,undefined) ->
+calculate_cpu_utilization(_,undefined,_) ->
%% First time collecting - no cpu utilization has been measured
%% since scheduler_wall_time flag is not yet on
0;
-calculate_cpu_utilization(_,RTInfo) ->
+calculate_cpu_utilization(WC,RTInfo,undefined) ->
+ %% Second time collecting - RTInfo shows scheduler_wall_time since
+ %% flag was set to true. Faking previous values by setting
+ %% everything to zero.
+ ZeroRT = [{Id,0,0} || {Id,_,_} <- RTInfo],
+ calculate_cpu_utilization(WC,RTInfo,ZeroRT);
+calculate_cpu_utilization(_,RTInfo,PrevRTInfo) ->
%% New version of observer_backend, using statistics(scheduler_wall_time)
- Sum = lists:foldl(fun({_,A,T},{AAcc,TAcc}) -> {A+AAcc,T+TAcc} end,
+ Sum = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}},{AAcc,TAcc}) ->
+ {(A1 - A0)+AAcc,(T1 - T0)+TAcc}
+ end,
{0,0},
- RTInfo),
+ lists:zip(PrevRTInfo,RTInfo)),
case Sum of
{0,0} ->
0;
diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl
index 3b4c176478..6b8f9df24f 100644
--- a/lib/observer/src/etop_txt.erl
+++ b/lib/observer/src/etop_txt.erl
@@ -22,35 +22,35 @@
%%-compile(export_all).
-export([init/1,stop/1]).
--export([do_update/3]).
+-export([do_update/4]).
-include("etop.hrl").
-include("etop_defs.hrl").
--import(etop,[loadinfo/1,meminfo/2]).
+-import(etop,[loadinfo/2,meminfo/2]).
-define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n").
stop(Pid) -> Pid ! stop.
init(Config) ->
- loop(Config).
+ loop(#etop_info{},Config).
-loop(Config) ->
- Info = do_update(Config),
+loop(Prev,Config) ->
+ Info = do_update(Prev,Config),
receive
stop -> stopped;
- {dump,Fd} -> do_update(Fd,Info,Config), loop(Config);
- {config,_,Config1} -> loop(Config1)
- after Config#opts.intv -> loop(Config)
+ {dump,Fd} -> do_update(Fd,Info,Prev,Config), loop(Info,Config);
+ {config,_,Config1} -> loop(Info,Config1)
+ after Config#opts.intv -> loop(Info,Config)
end.
-do_update(Config) ->
+do_update(Prev,Config) ->
Info = etop:update(Config),
- do_update(standard_io,Info,Config).
+ do_update(standard_io,Info,Prev,Config).
-do_update(Fd,Info,Config) ->
- {Cpu,NProcs,RQ,Clock} = loadinfo(Info),
+do_update(Fd,Info,Prev,Config) ->
+ {Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev),
io:nl(Fd),
writedoubleline(Fd),
case Info#etop_info.memi of
diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl
index 936b2783e2..80a41fdde9 100644
--- a/lib/observer/src/observer_app_wx.erl
+++ b/lib/observer/src/observer_app_wx.erl
@@ -191,8 +191,8 @@ handle_event(#wx{event=#wxMouse{type=Type, x=X0, y=Y0}},
end;
handle_event(#wx{event=#wxCommand{type=command_menu_selected}},
- State = #state{sel=undefined}) ->
- observer_lib:display_info_dialog("Select process first"),
+ State = #state{panel=Panel,sel=undefined}) ->
+ observer_lib:display_info_dialog(Panel,"Select process first"),
{noreply, State};
handle_event(#wx{id=?ID_PROC_INFO, event=#wxCommand{type=command_menu_selected}},
@@ -205,7 +205,7 @@ handle_event(#wx{id=?ID_PROC_MSG, event=#wxCommand{type=command_menu_selected}},
case observer_lib:user_term(Panel, "Enter message", "") of
cancel -> ok;
{ok, Term} -> Pid ! Term;
- {error, Error} -> observer_lib:display_info_dialog(Error)
+ {error, Error} -> observer_lib:display_info_dialog(Panel,Error)
end,
{noreply, State};
@@ -214,7 +214,7 @@ handle_event(#wx{id=?ID_PROC_KILL, event=#wxCommand{type=command_menu_selected}}
case observer_lib:user_term(Panel, "Enter Exit Reason", "kill") of
cancel -> ok;
{ok, Term} -> exit(Pid, Term);
- {error, Error} -> observer_lib:display_info_dialog(Error)
+ {error, Error} -> observer_lib:display_info_dialog(Panel,Error)
end,
{noreply, State};
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 59a2f9f205..47844c1307 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -20,7 +20,7 @@
-module(observer_lib).
-export([get_wx_parent/1,
- display_info_dialog/1, display_yes_no_dialog/1,
+ display_info_dialog/2, display_yes_no_dialog/1,
display_progress_dialog/2, destroy_progress_dialog/0,
wait_for_progress/0, report_progress/1,
user_term/3, user_term_multiline/3,
@@ -105,10 +105,10 @@ setup_timer(Bool, {Timer, Old}) ->
timer:cancel(Timer),
setup_timer(Bool, {false, Old}).
-display_info_dialog(Str) ->
- display_info_dialog("",Str).
-display_info_dialog(Title,Str) ->
- Dlg = wxMessageDialog:new(wx:null(), Str, [{caption,Title}]),
+display_info_dialog(Parent,Str) ->
+ display_info_dialog(Parent,"",Str).
+display_info_dialog(Parent,Title,Str) ->
+ Dlg = wxMessageDialog:new(Parent, Str, [{caption,Title}]),
wxMessageDialog:showModal(Dlg),
wxMessageDialog:destroy(Dlg),
ok.
@@ -461,14 +461,16 @@ create_box(Parent, Data) ->
link_entry(Panel,Value);
_ ->
Value = to_str(Value0),
- case length(Value) > 100 of
- true ->
- Shown = lists:sublist(Value, 80),
+ case string:sub_word(lists:sublist(Value, 80),1,$\n) of
+ Value ->
+ %% Short string, no newlines - show all
+ wxStaticText:new(Panel, ?wxID_ANY, Value);
+ Shown ->
+ %% Long or with newlines,
+ %% use tooltip to show all
TCtrl = wxStaticText:new(Panel, ?wxID_ANY, [Shown,"..."]),
wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)),
- TCtrl;
- false ->
- wxStaticText:new(Panel, ?wxID_ANY, Value)
+ TCtrl
end
end,
wxSizer:add(Line, 10, 0), % space of size 10 horisontally
@@ -722,7 +724,7 @@ progress_loop(Title,PD,Caller) ->
if is_list(Reason) -> Reason;
true -> file:format_error(Reason)
end,
- display_info_dialog("Crashdump Viewer Error",FailMsg),
+ display_info_dialog(PD,"Crashdump Viewer Error",FailMsg),
Caller ! error,
unregister(?progress_handler),
unlink(Caller);
diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl
index 53ba3fa607..c21d2705c0 100644
--- a/lib/observer/src/observer_port_wx.erl
+++ b/lib/observer/src/observer_port_wx.erl
@@ -267,10 +267,19 @@ handle_cast(Event, _State) ->
error({unhandled_cast, Event}).
handle_info({portinfo_open, PortIdStr},
- State = #state{grid=Grid, ports=Ports, open_wins=Opened}) ->
- Port = lists:keyfind(PortIdStr,#port.id_str,Ports),
- NewOpened = display_port_info(Grid, Port, Opened),
- {noreply, State#state{open_wins = NewOpened}};
+ State = #state{node=Node, grid=Grid, opt=Opt, open_wins=Opened}) ->
+ Ports0 = get_ports(Node),
+ Ports = update_grid(Grid, Opt, Ports0),
+ Port = lists:keyfind(PortIdStr, #port.id_str, Ports),
+ NewOpened =
+ case Port of
+ false ->
+ self() ! {error,"No such port: " ++ PortIdStr},
+ Opened;
+ _ ->
+ display_port_info(Grid, Port, Opened)
+ end,
+ {noreply, State#state{ports=Ports, open_wins=NewOpened}};
handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt,
ports=OldPorts}) ->
@@ -296,8 +305,9 @@ handle_info(not_active, State = #state{timer = Timer0}) ->
Timer = observer_lib:stop_timer(Timer0),
{noreply, State#state{timer=Timer}};
-handle_info({error, Error}, State) ->
- handle_error(Error),
+handle_info({error, Error}, #state{panel=Panel} = State) ->
+ Str = io_lib:format("ERROR: ~s~n",[Error]),
+ observer_lib:display_info_dialog(Panel, Str),
{noreply, State};
handle_info(_Event, State) ->
@@ -501,11 +511,6 @@ filter_monitor_info() ->
[Pid || {process, Pid} <- Ms]
end.
-
-handle_error(Foo) ->
- Str = io_lib:format("ERROR: ~s~n",[Foo]),
- observer_lib:display_info_dialog(Str).
-
update_grid(Grid, Opt, Ports) ->
wx:batch(fun() -> update_grid2(Grid, Opt, Ports) end).
update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Ports) ->
diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl
index ee6829b847..f07b9e295a 100644
--- a/lib/observer/src/observer_pro_wx.erl
+++ b/lib/observer/src/observer_pro_wx.erl
@@ -511,7 +511,13 @@ table_holder(#holder{info=Info, attrs=Attrs,
table_holder(S0);
{dump, Fd} ->
EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)},
- etop_txt:do_update(Fd, EtopInfo, #opts{node=Node}),
+ %% The empty #etop_info{} below is a dummy previous info
+ %% value. It is used by etop to calculate the scheduler
+ %% utilization since last update. When dumping to file,
+ %% there is no previous measurement to use, so we just add
+ %% a dummy here, and the value shown will be since the
+ %% tool was started.
+ etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}),
file:close(Fd),
table_holder(S0);
stop ->
diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
index c13b164ff9..21eb9facc5 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -92,7 +92,7 @@ init([Pid, ParentFrame, Parent]) ->
observer_wx:return_to_localnode(ParentFrame, node(Pid)),
{stop, badrpc};
process_undefined ->
- observer_lib:display_info_dialog("No such alive process"),
+ observer_lib:display_info_dialog(ParentFrame,"No such alive process"),
{stop, normal}
end.
diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl
index 968a7620aa..4356cb890c 100644
--- a/lib/observer/src/observer_tv_wx.erl
+++ b/lib/observer/src/observer_tv_wx.erl
@@ -238,8 +238,9 @@ handle_info(not_active, State = #state{timer = Timer0}) ->
Timer = observer_lib:stop_timer(Timer0),
{noreply, State#state{timer=Timer}};
-handle_info({error, Error}, #state{opt=Opt}=State) ->
- handle_error(Error),
+handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) ->
+ Str = io_lib:format("ERROR: ~s~n",[Error]),
+ observer_lib:display_info_dialog(Panel,Str),
case Opt#opt.type of
mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true);
_ -> ok
@@ -365,10 +366,6 @@ list_to_strings([A]) -> integer_to_list(A);
list_to_strings([A|B]) ->
integer_to_list(A) ++ " ," ++ list_to_strings(B).
-handle_error(Foo) ->
- Str = io_lib:format("ERROR: ~s~n",[Foo]),
- observer_lib:display_info_dialog(Str).
-
update_grid(Grid, Opt, Tables) ->
wx:batch(fun() -> update_grid2(Grid, Opt, Tables) end).
update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Tables) ->
diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
index 5732c12006..83de4fa64c 100644
--- a/lib/observer/src/observer_wx.erl
+++ b/lib/observer/src/observer_wx.erl
@@ -467,10 +467,10 @@ handle_info(_Info, State) ->
stop_servers(#state{node=Node, log=LogOn, sys_panel=Sys, pro_panel=Procs, tv_panel=TVs,
trace_panel=Trace, app_panel=Apps, perf_panel=Perfs,
- allc_panel=Alloc} = _State) ->
+ allc_panel=Alloc, port_panel=Ports} = _State) ->
LogOn andalso rpc:block_call(Node, rb, stop, []),
Me = self(),
- Tabs = [Sys, Procs, TVs, Trace, Apps, Perfs, Alloc],
+ Tabs = [Sys, Procs, Ports, TVs, Trace, Apps, Perfs, Alloc],
Stop = fun() ->
try
_ = [wx_object:stop(Panel) || Panel <- Tabs],
@@ -580,9 +580,10 @@ get_active_pid(#state{notebook=Notebook, pro_panel=Pro, sys_panel=Sys,
pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys,
tv_panel=Tv, trace_panel=Trace, app_panel=App,
- perf_panel=Perf, allc_panel=Alloc}) ->
+ perf_panel=Perf, allc_panel=Alloc, port_panel=Port}) ->
case Pid of
Pro -> "Processes";
+ Port -> "Ports";
Sys -> "System";
Tv -> "Table Viewer" ;
Trace -> ?TRACE_STR;
@@ -635,7 +636,8 @@ create_connect_dialog(connect, #state{frame = Frame}) ->
wxWindow:setSizerAndFit(Dialog, VSizer),
wxSizer:setSizeHints(VSizer, Dialog),
- CookiePath = filename:join(os:getenv("HOME"), ".erlang.cookie"),
+ {ok,[[HomeDir]]} = init:get_argument(home),
+ CookiePath = filename:join(HomeDir, ".erlang.cookie"),
DefaultCookie = case filelib:is_file(CookiePath) of
true ->
{ok, Bin} = file:read_file(CookiePath),
diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl
index 4c882ad951..b5fb027878 100644
--- a/lib/observer/test/observer_SUITE.erl
+++ b/lib/observer/test/observer_SUITE.erl
@@ -34,7 +34,8 @@
%% Test cases
-export([app_file/1, appup_file/1,
- basic/1, process_win/1, table_win/1
+ basic/1, process_win/1, table_win/1,
+ port_win_when_tab_not_initiated/1
]).
%% Default timetrap timeout (set in init_per_testcase)
@@ -49,7 +50,8 @@ groups() ->
[{gui, [],
[basic,
process_win,
- table_win
+ table_win,
+ port_win_when_tab_not_initiated
]
}].
@@ -299,6 +301,17 @@ table_win(Config) when is_list(Config) ->
observer:stop(),
ok.
+%% Test PR-1296/OTP-14151
+%% Clicking a link to a port before the port tab has been activated the
+%% first time crashes observer.
+port_win_when_tab_not_initiated(Config) ->
+ {ok,Port} = gen_tcp:listen(0,[]),
+ ok = observer:start(),
+ Notebook = setup_whitebox_testing(),
+ observer ! {open_link,erlang:port_to_list(Port)},
+ timer:sleep(1000),
+ observer:stop(),
+ ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl
index 4729d090f8..0a9a883390 100644
--- a/lib/os_mon/src/memsup.erl
+++ b/lib/os_mon/src/memsup.erl
@@ -701,6 +701,7 @@ get_os_wordsize_with_uname() ->
"sparc64" -> 64;
"amd64" -> 64;
"ppc64" -> 64;
+ "s390x" -> 64;
_ -> 32
end.
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index c503230d70..c97ec361d1 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -757,6 +757,39 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
</func>
<func>
+ <name>pkix_verify_hostname(Cert, ReferenceIDs) -> boolean()</name>
+ <name>pkix_verify_hostname(Cert, ReferenceIDs, Opts) -> boolean()</name>
+ <fsummary>Verifies that a PKIX x.509 certificate <i>presented identifier</i> (e.g hostname) is
+ an expected one.</fsummary>
+ <type>
+ <v>Cert = der_encoded() | #'OTPCertificate'{} </v>
+ <v>ReferenceIDs = [ RefID ]</v>
+ <v>RefID = {IdType,string()}</v>
+ <v>IdType = dns_id | srv_id | uri_id</v>
+ <v>Opts = [ PvhOpt() ]</v>
+ <v>PvhOpt = [MatchOpt | FailCallBackOpt | FqdnExtractOpt]</v>
+ <v>MatchOpt = {fun(RefId | FQDN::string(), PresentedID) -> boolean() | default}</v>
+ <v>PresentedID = {dNSName,string()} | {uniformResourceIdentifier,string()}</v>
+ <v>FailCallBackOpt = {fail_callback, fun(#'OTPCertificate'{}) -> boolean()}</v>
+ <v>FqdnExtractOpt = {fqdn_fun, fun(RefID) -> FQDN::string() | default | undefined}</v>
+ </type>
+ <desc>
+ <p>This function checks that the <i>Presented Identifier</i> (e.g hostname) in a peer certificate
+ conforms with the Expected Identifier that the client wants to connect to.
+ This functions is intended to be added as an extra client check to the peer certificate when performing
+ <seealso marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso>
+ </p>
+ <p>See <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url>
+ for detailed information about hostname verification.
+ The <seealso marker="using_public_key#verify_hostname">User's Manual</seealso>
+ and
+ <seealso marker="using_public_key#verify_hostname_examples">code examples</seealso>
+ describes this function more detailed.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name>sign(Msg, DigestType, Key) -> binary()</name>
<fsummary>Creates a digital signature.</fsummary>
<type>
@@ -824,6 +857,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<func>
<name>ssh_hostkey_fingerprint(HostKey) -> string()</name>
<name>ssh_hostkey_fingerprint(DigestType, HostKey) -> string()</name>
+ <name>ssh_hostkey_fingerprint([DigestType], HostKey) -> [string()]</name>
<fsummary>Calculates a ssh fingerprint for a hostkey.</fsummary>
<type>
<v>Key = public_key()</v>
@@ -847,6 +881,10 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
5> public_key:ssh_hostkey_fingerprint(sha256,Key).
"SHA256:aZGXhabfbf4oxglxltItWeHU7ub3Dc31NcNw2cMJePQ"
+
+ 6> public_key:ssh_hostkey_fingerprint([sha,sha256],Key).
+ ["SHA1:bSLY/C4QXLDL/Iwmhyg0PGW9UbY",
+ "SHA256:aZGXhabfbf4oxglxltItWeHU7ub3Dc31NcNw2cMJePQ"]
</code>
</desc>
</func>
diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml
index e3a1eed4be..417d479da3 100644
--- a/lib/public_key/doc/src/using_public_key.xml
+++ b/lib/public_key/doc/src/using_public_key.xml
@@ -417,6 +417,259 @@ true = public_key:verify(Digest, none, Signature, PublicKey),</code>
</section>
+ <section>
+ <marker id="verify_hostname"></marker>
+ <title>Verifying a certificate hostname</title>
+ <section>
+ <title>Background</title>
+ <p>When a client checks a server certificate there are a number of checks available like
+ checks that the certificate is not revoked, not forged or not out-of-date.
+ </p>
+ <p>There are however attacks that are not detected by those checks. Suppose a bad guy has
+ succeded with a DNS infection. Then the client could belive it is connecting to one host but
+ ends up at another but evil one. Though it is evil, it could have a perfectly legal
+ certificate! The certificate has a valid signature, it is not revoked, the certificate chain
+ is not faked and has a trusted root and so on.
+ </p>
+ <p>To detect that the server is not the intended one, the client must additionaly perform
+ a <i>hostname verification</i>. This procedure is described in
+ <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url>. The idea is that the certificate
+ lists the hostnames it could be fetched from. This is checked by the certificate issuer when
+ the certificate is signed. So if the certificate is issued by a trusted root the client
+ could trust the host names signed in it.
+ </p>
+ <p>There is a default hostname matching procedure defined in
+ <url href="https://tools.ietf.org/html/rfc6125#section-6">RFC 6125, section 6</url>
+ as well as protocol dependent variations defined in
+ <url href="https://tools.ietf.org/html/rfc6125#appendix-B">RFC 6125 appendix B</url>.
+ The default procedure is implemented in
+ <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2,3</seealso>.
+ It is possible for a client to hook in modified rules using the options list.
+ </p>
+ <p>Some terminology is needed: the certificate presents hostname(s) on which it is valid.
+ Those are called <i>Presented IDs</i>. The hostname(s) the client belives it connects to
+ are called <i>Reference IDs</i>. The matching rules aims to verify that there is at least
+ one of the Reference IDs that matches one of the Presented IDs. If not, the verification fails.
+ </p>
+ <p>The IDs contains normal fully qualified domain names like e.g <c>foo.example.com</c>,
+ but IP addresses are not recommended. The rfc describes why this is not recommended as well
+ as security considerations about how to aquire the Reference IDs.
+ </p>
+ <p>Internationalized domain names are not supported.
+ </p>
+ </section>
+ <section>
+ <title>The verification process</title>
+ <p>Traditionally the Presented IDs were found in the <c>Subject</c> certificate field as <c>CN</c>
+ names. This is still quite common. When printing a certificate they show up as:
+ </p>
+ <code>
+ $ openssl x509 -text &lt; cert.pem
+ ...
+ Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org
+ ...
+ </code>
+ <p>The example <c>Subject</c> field has one C, two CN and one O part. It is only the
+ CN (Common Name) that is used by hostname verification. The two other (C and O) is not used
+ here even when they contain a domain name like the O part. The C and O parts are defined
+ elsewhere and meaningful only for other functions.
+ </p>
+ <p>In the example the Presented IDs are <c>example.com</c> as well as hostnames matching
+ <c>*.example.com</c>. For example <c>foo.example.com</c> and <c>bar.example.com</c> both
+ matches but not <c>foo.bar.example.com</c>. The name <c>erlang.org</c> matches neither
+ since it is not a CN.
+ </p>
+ <p>In case where the Presented IDs are fetched from the <c>Subject</c> certificate field, the
+ names may contain wildcard characters. The function handles this as defined in
+ <url href="https://tools.ietf.org/html/rfc6125#section-6.4.3">chapter 6.4.3 in RFC 6125</url>.
+ </p>
+ <p>There may only be one wildcard character and that is in the first label, for example:
+ <c>*.example.com</c>. This matches <c>foo.example.com</c> but neither <c>example.com</c> nor
+ <c>foo.bar.example.com</c>.
+ </p>
+ <p>There may be label characters before or/and after the wildcard. For example:
+ <c>a*d.example.com</c> matches <c>abcd.example.com</c> and <c>ad.example.com</c>,
+ but not <c>ab.cd.example.com</c>.
+ </p>
+ <p>In the previous example there is no indication of which protocols are expected. So a client
+ has no indication of whether it is a web server, an ldap server or maybe a sip server it is
+ connected to.
+ There are fields in the certificate that can indicate this. To be more exact, the rfc
+ introduces the usage of the <c>X509v3 Subject Alternative Name</c> in the <c>X509v3 extensions</c>
+ field:
+ </p>
+ <code>
+ $ openssl x509 -text &lt; cert.pem
+ ...
+ X509v3 extensions:
+ X509v3 Subject Alternative Name:
+ DNS:kb.example.org, URI:https://www.example.org
+ ...
+ </code>
+ <p>Here <c>kb.example.org</c> serves any protocol while <c>www.example.org</c> presents a secure
+ web server.
+ </p>
+
+ <p>The next example has both <c>Subject</c> and <c>Subject Alternate Name</c> present:</p>
+ <code>
+ $ openssl x509 -text &lt; cert.pem
+ ...
+ Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org
+ ...
+ X509v3 extensions:
+ X509v3 Subject Alternative Name:
+ DNS:kb.example.org, URI:https://www.example.org
+ ...
+ </code>
+ <p>The RFC states that if a certificate defines Reference IDs in a <c>Subject Alternate Name</c>
+ field, the <c>Subject</c> field MUST NOT be used for host name checking, even if it contains
+ valid CN names.
+ Therefore only <c>kb.example.org</c> and <c>https://www.example.org</c> matches. The match fails
+ both for <c>example.com</c> and <c>foo.example.com</c> becuase they are in the <c>Subject</c>
+ field which is not checked because the <c>Subject Alternate Name</c> field is present.
+ </p>
+ </section>
+
+ <section>
+ <marker id="verify_hostname_examples"></marker>
+ <title>Function call examples</title>
+ <note>
+ <p>Other applications like ssl/tls or https might have options that are passed
+ down to the <c>public_key:pkix_verify_hostname</c>. You will probably not
+ have to call it directly</p>
+ </note>
+ <p>Suppose our client expects to connect to the web server https://www.example.net. This
+ URI is therefore the Reference IDs of the client.
+ The call will be:
+ </p>
+ <code>
+ public_key:pkix_verify_hostname(CertFromHost,
+ [{uri_id, "https://www.example.net"}
+ ]).
+ </code>
+ <p>The call will return <c>true</c> or <c>false</c> depending on the check. The caller
+ do not need to handle the matching rules in the rfc. The matching will proceed as:
+ </p>
+ <list>
+ <item>If there is a <c>Subject Alternate Name</c> field, the <c>{uri_id,string()}</c> in the
+ function call will be compared to any
+ <c>{uniformResourceIdentifier,string()}</c> in the Certificate field.
+ If the two <c>strings()</c> are equal (case insensitive), there is a match.
+ The same applies for any <c>{dns_id,string()}</c> in the call which is compared
+ with all <c>{dNSName,string()}</c> in the Certificate field.
+ </item>
+ <item>If there is NO <c>Subject Alternate Name</c> field, the <c>Subject</c> field will be
+ checked. All <c>CN</c> names will be compared to all hostnames <i>extracted</i> from
+ <c>{uri_id,string()}</c> and from <c>{dns_id,string()}</c>.
+ </item>
+ </list>
+ </section>
+ <section>
+ <title>Extending the search mechanism</title>
+ <p>The caller can use own extraction and matching rules. This is done with the two options
+ <c>fqdn_fun</c> and <c>match_fun</c>.
+ </p>
+ <section>
+ <title>Hostname extraction</title>
+ <p>The <c>fqdn_fun</c> extracts hostnames (Fully Qualified Domain Names) from uri_id
+ or other ReferenceIDs that are not pre-defined in the public_key function.
+ Suppose you have some URI with a very special protocol-part:
+ <c>myspecial://example.com"</c>. Since this a non-standard URI there will be no hostname
+ extracted for matching CN-names in the <c>Subject</c>.</p>
+ <p>To "teach" the function how to extract, you can give a fun which replaces the default
+ extraction function.
+ The <c>fqdn_fun</c> takes one argument and returns
+ either a <c>string()</c> to be matched to each CN-name or the atom <c>default</c> which will invoke
+ the default fqdn extraction function. The return value <c>undefined</c> removes the current
+ URI from the fqdn extraction.
+ </p>
+ <code>
+ ...
+ Extract = fun({uri_id, "myspecial://"++HostName}) -> HostName;
+ (_Else) -> default
+ end,
+ ...
+ public_key:pkix_verify_hostname(CertFromHost, RefIDs,
+ [{fqdn_fun, Extract}])
+ ...
+ </code>
+ </section>
+ <section>
+ <title>Re-defining the match operations</title>
+ <p>The default matching handles dns_id and uri_id. In an uri_id the value is tested for
+ equality with a value from the <c>Subject Alternate Name</c>. If som other kind of matching
+ is needed, use the <c>match_fun</c> option.
+ </p>
+ <p>The <c>match_fun</c> takes two arguments and returns either <c>true</c>,
+ <c>false</c> or <c>default</c>. The value <c>default</c> will invoke the default
+ match function.
+ </p>
+ <code>
+ ...
+ Match = fun({uri_id,"myspecial://"++A},
+ {uniformResourceIdentifier,"myspecial://"++B}) ->
+ my_match(A,B);
+ (_RefID, _PresentedID) ->
+ default
+ end,
+ ...
+ public_key:pkix_verify_hostname(CertFromHost, RefIDs,
+ [{match_fun, Match}]),
+ ...
+ </code>
+ <p>In case of a match operation between a ReferenceID and a CN value from the <c>Subject</c>
+ field, the first argument to the fun is the extracted hostname from the ReferenceID, and the
+ second argument is the tuple <c>{cn, string()}</c> taken from the <c>Subject</c> field. That
+ makes it possible to have separate matching rules for Presented IDs from the <c>Subject</c>
+ field and from the <c>Subject Alternate Name</c> field.
+ </p>
+ <p>The default matching transformes the ascii values in strings to lowercase before comparing.
+ The <c>match_fun</c> is however called without any transfomation applied to the strings. The
+ reason is to enable the user to do unforseen handling of the strings where the original format
+ is needed.
+ </p>
+ </section>
+ </section>
+ <section>
+ <title>"Pinning" a Certificate</title>
+ <p>The <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url> defines <i>pinning</i>
+ as:</p>
+ <quote>
+ <p>"The act of establishing a cached name association between
+ the application service's certificate and one of the client's
+ reference identifiers, despite the fact that none of the presented
+ identifiers matches the given reference identifier. ..."
+ </p>
+ </quote>
+ <p>The purpose is to have a mechanism for a human to accept an otherwise faulty Certificate.
+ In for example a web browser, you could get a question like </p>
+ <quote>
+ <p>Warning: you wanted to visit the site www.example.com,
+ but the certificate is for shop.example.com. Accept anyway (yes/no)?"
+ </p>
+ </quote>
+ <p>This could be accomplished with the option <c>fail_callback</c> which will
+ be called if the hostname verification fails:
+ </p>
+ <code>
+ -include_lib("public_key/include/public_key.hrl"). % Record def
+ ...
+ Fail = fun(#'OTPCertificate'{}=C) ->
+ case in_my_cache(C) orelse my_accept(C) of
+ true ->
+ enter_my_cache(C),
+ true;
+ false ->
+ false
+ end,
+ ...
+ public_key:pkix_verify_hostname(CertFromHost, RefIDs,
+ [{fail_callback, Fail}]),
+ ...
+ </code>
+ </section>
+ </section>
+
<section>
<title>SSH Files</title>
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 05c09f8996..adc35073d6 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -48,6 +48,7 @@
pkix_issuer_id/2,
pkix_normalize_name/1,
pkix_path_validation/3,
+ pkix_verify_hostname/2, pkix_verify_hostname/3,
ssh_decode/2, ssh_encode/2,
ssh_hostkey_fingerprint/1, ssh_hostkey_fingerprint/2,
ssh_curvename2oid/1, oid2ssh_curvename/1,
@@ -763,6 +764,76 @@ pkix_crls_validate(OtpCert, DPAndCRLs0, Options) ->
pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs,
Options, pubkey_crl:init_revokation_state()).
+%--------------------------------------------------------------------
+-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(),
+ ReferenceIDs :: [{uri_id | dns_id | oid(), string()}]) -> boolean().
+
+-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(),
+ ReferenceIDs :: [{uri_id | dns_id | oid(), string()}],
+ Options :: proplists:proplist()) -> boolean().
+
+%% Description: Validates a hostname to RFC 6125
+%%--------------------------------------------------------------------
+pkix_verify_hostname(Cert, ReferenceIDs) ->
+ pkix_verify_hostname(Cert, ReferenceIDs, []).
+
+pkix_verify_hostname(BinCert, ReferenceIDs, Options) when is_binary(BinCert) ->
+ pkix_verify_hostname(pkix_decode_cert(BinCert,otp), ReferenceIDs, Options);
+
+pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, ReferenceIDs0, Opts) ->
+ MatchFun = proplists:get_value(match_fun, Opts, undefined),
+ FailCB = proplists:get_value(fail_callback, Opts, fun(_Cert) -> false end),
+ FqdnFun = proplists:get_value(fqdn_fun, Opts, fun verify_hostname_extract_fqdn_default/1),
+
+ ReferenceIDs = [{T,to_string(V)} || {T,V} <- ReferenceIDs0],
+ PresentedIDs =
+ try lists:keyfind(?'id-ce-subjectAltName',
+ #'Extension'.extnID,
+ TbsCert#'OTPTBSCertificate'.extensions)
+ of
+ #'Extension'{extnValue = ExtVals} ->
+ [{T,to_string(V)} || {T,V} <- ExtVals];
+ false ->
+ []
+ catch
+ _:_ -> []
+ end,
+ %% PresentedIDs example: [{dNSName,"ewstest.ericsson.com"}, {dNSName,"www.ericsson.com"}]}
+ case PresentedIDs of
+ [] ->
+ %% Fallback to CN-ids [rfc6125, ch6]
+ case TbsCert#'OTPTBSCertificate'.subject of
+ {rdnSequence,RDNseq} ->
+ PresentedCNs =
+ [{cn, to_string(V)}
+ || ATVs <- RDNseq, % RDNseq is list-of-lists
+ #'AttributeTypeAndValue'{type = ?'id-at-commonName',
+ value = {_T,V}} <- ATVs
+ % _T = kind of string (teletexString etc)
+ ],
+ %% Example of PresentedCNs: [{cn,"www.ericsson.se"}]
+ %% match ReferenceIDs to PresentedCNs
+ verify_hostname_match_loop(verify_hostname_fqnds(ReferenceIDs, FqdnFun),
+ PresentedCNs,
+ MatchFun, FailCB, Cert);
+
+ _ ->
+ false
+ end;
+ _ ->
+ %% match ReferenceIDs to PresentedIDs
+ case verify_hostname_match_loop(ReferenceIDs, PresentedIDs,
+ MatchFun, FailCB, Cert) of
+ false ->
+ %% Try to extract DNS-IDs from URIs etc
+ DNS_ReferenceIDs =
+ [{dns_is,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)],
+ verify_hostname_match_loop(DNS_ReferenceIDs, PresentedIDs,
+ MatchFun, FailCB, Cert);
+ true ->
+ true
+ end
+ end.
%%--------------------------------------------------------------------
-spec ssh_decode(binary(), public_key | ssh_file()) -> [{public_key(), Attributes::list()}]
@@ -822,21 +893,31 @@ oid2ssh_curvename(?'secp521r1') -> <<"nistp521">>.
%%--------------------------------------------------------------------
-spec ssh_hostkey_fingerprint(public_key()) -> string().
--spec ssh_hostkey_fingerprint(digest_type(), public_key()) -> string().
+-spec ssh_hostkey_fingerprint( digest_type(), public_key()) -> string()
+ ; ([digest_type()], public_key()) -> [string()]
+ .
ssh_hostkey_fingerprint(Key) ->
- sshfp_string(md5, Key).
+ sshfp_string(md5, public_key:ssh_encode(Key,ssh2_pubkey) ).
-ssh_hostkey_fingerprint(HashAlg, Key) ->
- lists:concat([sshfp_alg_name(HashAlg),
- [$: | sshfp_string(HashAlg, Key)]
- ]).
+ssh_hostkey_fingerprint(HashAlgs, Key) when is_list(HashAlgs) ->
+ EncKey = public_key:ssh_encode(Key, ssh2_pubkey),
+ [sshfp_full_string(HashAlg,EncKey) || HashAlg <- HashAlgs];
+ssh_hostkey_fingerprint(HashAlg, Key) when is_atom(HashAlg) ->
+ EncKey = public_key:ssh_encode(Key, ssh2_pubkey),
+ sshfp_full_string(HashAlg, EncKey).
-sshfp_string(HashAlg, Key) ->
+
+sshfp_string(HashAlg, EncodedKey) ->
%% Other HashAlgs than md5 will be printed with
%% other formats than hextstr by
%% ssh-keygen -E <alg> -lf <file>
- fp_fmt(sshfp_fmt(HashAlg), crypto:hash(HashAlg, public_key:ssh_encode(Key,ssh2_pubkey))).
+ fp_fmt(sshfp_fmt(HashAlg), crypto:hash(HashAlg, EncodedKey)).
+
+sshfp_full_string(HashAlg, EncKey) ->
+ lists:concat([sshfp_alg_name(HashAlg),
+ [$: | sshfp_string(HashAlg, EncKey)]
+ ]).
sshfp_alg_name(sha) -> "SHA1";
sshfp_alg_name(Alg) -> string:to_upper(atom_to_list(Alg)).
@@ -1200,3 +1281,96 @@ ascii_to_lower(String) ->
end)>>
||
<<C>> <= iolist_to_binary(String) >>.
+
+%%%----------------------------------------------------------------
+%%% pkix_verify_hostname help functions
+verify_hostname_extract_fqdn_default({dns_id,S}) ->
+ S;
+verify_hostname_extract_fqdn_default({uri_id,URI}) ->
+ {ok,{https,_,Host,_,_,_}} = http_uri:parse(URI),
+ Host.
+
+
+verify_hostname_fqnds(L, FqdnFun) ->
+ [E || E0 <- L,
+ E <- [try case FqdnFun(E0) of
+ default -> verify_hostname_extract_fqdn_default(E0);
+ undefined -> undefined; % will make the "is_list(E)" test fail
+ Other -> Other
+ end
+ catch _:_-> undefined % will make the "is_list(E)" test fail
+ end],
+ is_list(E),
+ E =/= "",
+ {error,einval} == inet:parse_address(E)
+ ].
+
+
+-define(srvName_OID, {1,3,6,1,4,1,434,2,2,1,37,0}).
+
+verify_hostname_match_default(Ref, Pres) ->
+ verify_hostname_match_default0(to_lower_ascii(Ref), to_lower_ascii(Pres)).
+
+verify_hostname_match_default0(FQDN=[_|_], {cn,FQDN}) ->
+ not lists:member($*, FQDN);
+verify_hostname_match_default0(FQDN=[_|_], {cn,Name=[_|_]}) ->
+ [F1|Fs] = string:tokens(FQDN, "."),
+ [N1|Ns] = string:tokens(Name, "."),
+ match_wild(F1,N1) andalso Fs==Ns;
+verify_hostname_match_default0({dns_id,R}, {dNSName,P}) ->
+ R==P;
+verify_hostname_match_default0({uri_id,R}, {uniformResourceIdentifier,P}) ->
+ R==P;
+verify_hostname_match_default0({srv_id,R}, {T,P}) when T == srvName ;
+ T == ?srvName_OID ->
+ R==P;
+verify_hostname_match_default0(_, _) ->
+ false.
+
+
+match_wild(A, [$*|B]) -> match_wild_suffixes(A, B);
+match_wild([C|A], [ C|B]) -> match_wild(A, B);
+match_wild([], []) -> true;
+match_wild(_, _) -> false.
+
+%% Match the parts after the only wildcard by comparing them from the end
+match_wild_suffixes(A, B) -> match_wild_sfx(lists:reverse(A), lists:reverse(B)).
+
+match_wild_sfx([$*|_], _) -> false; % Bad name (no wildcards alowed)
+match_wild_sfx(_, [$*|_]) -> false; % Bad pattern (no more wildcards alowed)
+match_wild_sfx([A|Ar], [A|Br]) -> match_wild_sfx(Ar, Br);
+match_wild_sfx(Ar, []) -> not lists:member($*, Ar); % Chk for bad name (= wildcards)
+match_wild_sfx(_, _) -> false.
+
+
+verify_hostname_match_loop(Refs0, Pres0, undefined, FailCB, Cert) ->
+ Pres = lists:map(fun to_lower_ascii/1, Pres0),
+ Refs = lists:map(fun to_lower_ascii/1, Refs0),
+ lists:any(
+ fun(R) ->
+ lists:any(fun(P) ->
+ verify_hostname_match_default(R,P) orelse FailCB(Cert)
+ end, Pres)
+ end, Refs);
+verify_hostname_match_loop(Refs, Pres, MatchFun, FailCB, Cert) ->
+ lists:any(
+ fun(R) ->
+ lists:any(fun(P) ->
+ (case MatchFun(R,P) of
+ default -> verify_hostname_match_default(R,P);
+ Bool -> Bool
+ end) orelse FailCB(Cert)
+ end,
+ Pres)
+ end,
+ Refs).
+
+
+to_lower_ascii(S) when is_list(S) -> lists:map(fun to_lower_ascii/1, S);
+to_lower_ascii({T,S}) -> {T, to_lower_ascii(S)};
+to_lower_ascii(C) when $A =< C,C =< $Z -> C + ($a-$A);
+to_lower_ascii(C) -> C.
+
+to_string(S) when is_list(S) -> S;
+to_string(B) when is_binary(B) -> binary_to_list(B).
+
diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl
index cd24819899..68aa152911 100644
--- a/lib/public_key/test/public_key_SUITE.erl
+++ b/lib/public_key/test/public_key_SUITE.erl
@@ -45,13 +45,17 @@ all() ->
{group, sign_verify},
pkix, pkix_countryname, pkix_emailaddress, pkix_path_validation,
pkix_iso_rsa_oid, pkix_iso_dsa_oid, pkix_crl, general_name,
+ pkix_verify_hostname_cn,
+ pkix_verify_hostname_subjAltName,
+ pkix_verify_hostname_options,
short_cert_issuer_hash, short_crl_issuer_hash,
ssh_hostkey_fingerprint_md5_implicit,
ssh_hostkey_fingerprint_md5,
ssh_hostkey_fingerprint_sha,
ssh_hostkey_fingerprint_sha256,
ssh_hostkey_fingerprint_sha384,
- ssh_hostkey_fingerprint_sha512
+ ssh_hostkey_fingerprint_sha512,
+ ssh_hostkey_fingerprint_list
].
groups() ->
@@ -90,20 +94,21 @@ end_per_group(_GroupName, Config) ->
%%-------------------------------------------------------------------
init_per_testcase(TestCase, Config) ->
case TestCase of
- ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase(md5, Config);
- ssh_hostkey_fingerprint_md5 -> init_fingerprint_testcase(md5, Config);
- ssh_hostkey_fingerprint_sha -> init_fingerprint_testcase(sha, Config);
- ssh_hostkey_fingerprint_sha256 -> init_fingerprint_testcase(sha256, Config);
- ssh_hostkey_fingerprint_sha384 -> init_fingerprint_testcase(sha384, Config);
- ssh_hostkey_fingerprint_sha512 -> init_fingerprint_testcase(sha512, Config);
+ ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase([md5], Config);
+ ssh_hostkey_fingerprint_md5 -> init_fingerprint_testcase([md5], Config);
+ ssh_hostkey_fingerprint_sha -> init_fingerprint_testcase([sha], Config);
+ ssh_hostkey_fingerprint_sha256 -> init_fingerprint_testcase([sha256], Config);
+ ssh_hostkey_fingerprint_sha384 -> init_fingerprint_testcase([sha384], Config);
+ ssh_hostkey_fingerprint_sha512 -> init_fingerprint_testcase([sha512], Config);
+ ssh_hostkey_fingerprint_list -> init_fingerprint_testcase([sha,md5], Config);
_ -> init_common_per_testcase(Config)
end.
-init_fingerprint_testcase(Alg, Config) ->
- CryptoSupports = lists:member(Alg, proplists:get_value(hashs, crypto:supports())),
- case CryptoSupports of
- false -> {skip,{Alg,not_supported}};
- true -> init_common_per_testcase(Config)
+init_fingerprint_testcase(Algs, Config) ->
+ Hashs = proplists:get_value(hashs, crypto:supports(), []),
+ case Algs -- Hashs of
+ [] -> init_common_per_testcase(Config);
+ UnsupportedAlgs -> {skip,{UnsupportedAlgs,not_supported}}
end.
init_common_per_testcase(Config0) ->
@@ -597,6 +602,14 @@ ssh_hostkey_fingerprint_sha512(_Config) ->
Expected = public_key:ssh_hostkey_fingerprint(sha512, ssh_hostkey(rsa)).
%%--------------------------------------------------------------------
+%% Since this kind of fingerprint is not available yet on standard
+%% distros, we do like this instead.
+ssh_hostkey_fingerprint_list(_Config) ->
+ Expected = ["SHA1:Soammnaqg06jrm2jivMSnzQGlmk",
+ "MD5:4b:0b:63:de:0f:a7:3a:ab:2c:cc:2d:d1:21:37:1d:3a"],
+ Expected = public_key:ssh_hostkey_fingerprint([sha,md5], ssh_hostkey(rsa)).
+
+%%--------------------------------------------------------------------
encrypt_decrypt() ->
[{doc, "Test public_key:encrypt_private and public_key:decrypt_public"}].
encrypt_decrypt(Config) when is_list(Config) ->
@@ -814,6 +827,114 @@ pkix_path_validation(Config) when is_list(Config) ->
ok.
%%--------------------------------------------------------------------
+%% To generate the PEM file contents:
+%%
+%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -subj '/C=SE/CN=example.com/CN=*.foo.example.com/CN=a*b.bar.example.com/O=erlang.org' > public_key_SUITE_data/pkix_verify_hostname_cn.pem
+%%
+%% Note that the same pem-file is used in pkix_verify_hostname_options/1
+%%
+%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org
+%% extensions = no subjAltName
+
+pkix_verify_hostname_cn(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")),
+ Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp),
+
+ %% Check that 1) only CNs are checked,
+ %% 2) an empty label does not match a wildcard and
+ %% 3) a wildcard does not match more than one label
+ false = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"},
+ {dns_id,"foo.EXAMPLE.com"},
+ {dns_id,"b.a.foo.EXAMPLE.com"}]),
+
+ %% Check that a hostname is extracted from a https-uri and used for checking:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"HTTPS://EXAMPLE.com"}]),
+
+ %% Check wildcard matching one label:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"a.foo.EXAMPLE.com"}]),
+
+ %% Check wildcard with surrounding chars matches one label:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"accb.bar.EXAMPLE.com"}]),
+
+ %% Check that a wildcard with surrounding chars matches an empty string:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://ab.bar.EXAMPLE.com"}]).
+
+%%--------------------------------------------------------------------
+%% To generate the PEM file contents:
+%%
+%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -extensions SAN -config public_key_SUITE_data/verify_hostname.conf 2>/dev/null > public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem
+%%
+%% Subject: C=SE, CN=example.com
+%% Subject Alternative Name: DNS:kb.example.org, URI:http://www.example.org, URI:https://wws.example.org
+
+pkix_verify_hostname_subjAltName(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_subjAltName.pem")),
+ Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp),
+
+ %% Check that neither a uri nor dns hostname matches a CN if subjAltName is present:
+ false = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"},
+ {dns_id,"example.com"}]),
+
+ %% Check that a uri_id matches a URI subjAltName:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://wws.example.org"}]),
+
+ %% Check that a dns_id does not match a URI subjAltName:
+ false = public_key:pkix_verify_hostname(Cert, [{dns_id,"www.example.org"},
+ {dns_id,"wws.example.org"}]),
+
+ %% Check that a dns_id matches a DNS subjAltName:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"kb.example.org"}]).
+
+%%--------------------------------------------------------------------
+%% Uses the pem-file for pkix_verify_hostname_cn
+%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org
+pkix_verify_hostname_options(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")),
+ Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp),
+
+ %% Check that the fail_callback is called and is presented the correct certificate:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"}],
+ [{fail_callback,
+ fun(#'OTPCertificate'{}=C) when C==Cert ->
+ true; % To test the return value matters
+ (#'OTPCertificate'{}=C) ->
+ ct:log("~p:~p: Wrong cert:~n~p~nExpect~n~p",
+ [?MODULE, ?LINE, C, Cert]),
+ ct:fail("Wrong cert, see log");
+ (C) ->
+ ct:log("~p:~p: Bad cert: ~p",[?MODULE,?LINE,C]),
+ ct:fail("Bad cert, see log")
+ end}]),
+
+ %% Check the callback for user-provided match functions:
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"very.wrong.domain"}],
+ [{match_fun,
+ fun("very.wrong.domain", {cn,"example.com"}) ->
+ true;
+ (_, _) ->
+ false
+ end}]),
+ false = public_key:pkix_verify_hostname(Cert, [{dns_id,"not.example.com"}],
+ [{match_fun, fun(_, _) -> default end}]),
+ true = public_key:pkix_verify_hostname(Cert, [{dns_id,"example.com"}],
+ [{match_fun, fun(_, _) -> default end}]),
+
+ %% Check the callback for user-provided fqdn extraction:
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}],
+ [{fqdn_fun,
+ fun({uri_id, "some://very.wrong.domain"}) ->
+ "example.com";
+ (_) ->
+ ""
+ end}]),
+ true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"}],
+ [{fqdn_fun, fun(_) -> default end}]),
+ false = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}]).
+
+%%--------------------------------------------------------------------
pkix_iso_rsa_oid() ->
[{doc, "Test workaround for supporting certs that use ISO oids"
" 1.3.14.3.2.29 instead of PKIX/PKCS oid"}].
diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem
new file mode 100644
index 0000000000..9f7b428f9a
--- /dev/null
+++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem
@@ -0,0 +1,17 @@
+-----BEGIN CERTIFICATE-----
+MIICsjCCAhugAwIBAgIJAMCGx1ezaJFRMA0GCSqGSIb3DQEBCwUAMHIxCzAJBgNV
+BAYTAlNFMRQwEgYDVQQDDAtleGFtcGxlLmNvbTEaMBgGA1UEAwwRKi5mb28uZXhh
+bXBsZS5jb20xHDAaBgNVBAMME2EqYi5iYXIuZXhhbXBsZS5jb20xEzARBgNVBAoM
+CmVybGFuZy5vcmcwHhcNMTYxMjIwMTUwNDUyWhcNMTcwMTE5MTUwNDUyWjByMQsw
+CQYDVQQGEwJTRTEUMBIGA1UEAwwLZXhhbXBsZS5jb20xGjAYBgNVBAMMESouZm9v
+LmV4YW1wbGUuY29tMRwwGgYDVQQDDBNhKmIuYmFyLmV4YW1wbGUuY29tMRMwEQYD
+VQQKDAplcmxhbmcub3JnMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDVGJgZ
+defGucvMXf0RrEm6Hb18IfVUo9IV6swSP/kwAu/608ZIZdzlfp2pxC0e72a4E3WN
+4vrGxAr2wMMQOiyoy4qlAeLX27THJ6Q4Vl82fc6QuOJbScKIydSZ4KoB+luGlBu5
+b6xYh2pBbneKFpsecmK5rsWtTactjD4n1tKjUwIDAQABo1AwTjAdBgNVHQ4EFgQU
+OCtzidUeaDva7qp12T0CQrgfLW4wHwYDVR0jBBgwFoAUOCtzidUeaDva7qp12T0C
+QrgfLW4wDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQsFAAOBgQCAz+ComCMo9Qbu
+PHxG7pv3mQvoxrMFva/Asg4o9mW2mDyrk0DwI4zU8vMHbSRKSBYGm4TATXsQkDQT
+gJw/bxhISnhZZtPC7Yup8kJCkJ6S6EDLYrlzgsRqfeU6jWim3nbfaLyMi9dHFDMk
+HULnyNNW3qxTEKi8Wo2sCMej4l7KFg==
+-----END CERTIFICATE-----
diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem
new file mode 100644
index 0000000000..83e1ad37b3
--- /dev/null
+++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem
@@ -0,0 +1,14 @@
+-----BEGIN CERTIFICATE-----
+MIICEjCCAXugAwIBAgIJANwliLph5EiAMA0GCSqGSIb3DQEBCwUAMCMxCzAJBgNV
+BAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNvbTAeFw0xNjEyMjAxNTEyMjRaFw0x
+NzAxMTkxNTEyMjRaMCMxCzAJBgNVBAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNv
+bTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAydstIN157w8QxkVaOl3wm81j
+fgZ8gqO3BXkECPF6bw5ewLlmePL6Qs4RypsaRe7cKJ9rHFlwhpdcYkxWSWEt2N7Z
+Ry3N4SjuU04ohWbYgy3ijTt7bJg7jOV1Dh56BnI4hwhQj0oNFizNZOeRRfEzdMnS
++uk03t/Qre2NS7KbwnUCAwEAAaNOMEwwSgYDVR0RBEMwQYIOa2IuZXhhbXBsZS5v
+cmeGFmh0dHA6Ly93d3cuZXhhbXBsZS5vcmeGF2h0dHBzOi8vd3dzLmV4YW1wbGUu
+b3JnMA0GCSqGSIb3DQEBCwUAA4GBAKqFqW5gCso422bXriCBJoygokOTTOw1Rzpq
+K8Mm0B8W9rrW9OTkoLEcjekllZcUCZFin2HovHC5HlHZz+mQvBI1M6sN2HVQbSzS
+EgL66U9gwJVnn9/U1hXhJ0LO28aGbyE29DxnewNR741dWN3oFxCdlNaO6eMWaEsO
+gduJ5sDl
+-----END CERTIFICATE-----
diff --git a/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf
new file mode 100644
index 0000000000..a28864dc78
--- /dev/null
+++ b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf
@@ -0,0 +1,16 @@
+[req]
+prompt = no
+distinguished_name = DN
+
+[DN]
+C=SE
+CN=example.com
+
+[SAN]
+subjectAltName = @alt_names
+
+[alt_names]
+DNS = kb.example.org
+URI.1 = http://www.example.org
+URI.2 = https://wws.example.org
+
diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml
index 82a4c79379..7aae5e5c41 100644
--- a/lib/runtime_tools/doc/src/LTTng.xml
+++ b/lib/runtime_tools/doc/src/LTTng.xml
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf8" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE chapter SYSTEM "chapter.dtd">
<chapter>
<header>
diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
index e943fb4a3e..b27bc63d15 100644
--- a/lib/runtime_tools/src/observer_backend.erl
+++ b/lib/runtime_tools/src/observer_backend.erl
@@ -314,13 +314,12 @@ etop_collect(Collector) ->
case SchedulerWallTime of
undefined ->
- spawn(fun() -> flag_holder_proc(Collector) end),
+ erlang:system_flag(scheduler_wall_time,true),
+ spawn(fun() -> flag_holder_proc(Collector) end),
ok;
_ ->
ok
- end,
-
- erlang:system_flag(scheduler_wall_time,true).
+ end.
flag_holder_proc(Collector) ->
Ref = erlang:monitor(process,Collector),
diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml
index fa503fa573..4ca4a08329 100644
--- a/lib/sasl/doc/src/systools.xml
+++ b/lib/sasl/doc/src/systools.xml
@@ -268,7 +268,7 @@
<fsummary>Creates a release package.</fsummary>
<type>
<v>Name = string()</v>
- <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir}</v>
+ <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir} | | no_warn_sasl | warnings_as_errors</v>
<v>&nbsp;Dir = string()</v>
<v>&nbsp;IncDir = src | include | atom()</v>
<v>&nbsp;Var = {VarName,PreFix}</v>
@@ -297,6 +297,10 @@
directory unless <c>Name</c> contains a path. If option
<c>{outdir,Dir}</c> is specified, it is located in <c>Dir</c>
instead.</p>
+ <p>If SASL is not included as an application in
+ the <c>.rel</c> file, a warning is issued because such a
+ release cannot be used in an upgrade. To turn off this
+ warning, add option <c>no_warn_sasl</c>.</p>
<p>By default, the release package contains the directories
<c>lib/App-Vsn/ebin</c> and <c>lib/App-Vsn/priv</c> for each
included application. If more directories are to be included,
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index efe6cc9eb4..3a188e95ee 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -94,7 +94,11 @@ make_script(RelName, Output, Flags) when is_list(RelName),
Warnings = wsasl(Flags, Warnings0),
case systools_lib:werror(Flags, Warnings) of
true ->
- return(ok,Warnings,Flags);
+ Warnings1 = [W || {warning,W}<-Warnings],
+ return({error,?MODULE,
+ {warnings_treated_as_errors,Warnings1}},
+ Warnings,
+ Flags);
false ->
case generate_script(Output,Release,Appls,Flags) of
ok ->
@@ -115,7 +119,6 @@ make_script(RelName, _Output, Flags) when is_list(Flags) ->
make_script(RelName, _Output, Flags) ->
badarg(Flags,[RelName, Flags]).
-
wsasl(Options, Warnings) ->
case lists:member(no_warn_sasl,Options) of
true -> lists:delete({warning,missing_sasl},Warnings);
@@ -148,21 +151,10 @@ get_outdir(Flags) ->
return(ok,Warnings,Flags) ->
case member(silent,Flags) of
true ->
- case systools_lib:werror(Flags, Warnings) of
- true ->
- error;
- false ->
- {ok,?MODULE,Warnings}
- end;
+ {ok,?MODULE,Warnings};
_ ->
- case member(warnings_as_errors,Flags) of
- true ->
- io:format("~ts",[format_warning(Warnings, true)]),
- error;
- false ->
- io:format("~ts",[format_warning(Warnings)]),
- ok
- end
+ io:format("~ts",[format_warning(Warnings)]),
+ ok
end;
return({error,Mod,Error},_,Flags) ->
case member(silent,Flags) of
@@ -300,6 +292,8 @@ add_apply_upgrade(Script,Args) ->
%% {variables,[{Name,AbsString}]}
%% {machine, jam | beam | vee}
%% {var_tar, include | ownfile | omit}
+%% no_warn_sasl
+%% warnings_as_errors
%%
%% The tar file contains:
%% lib/App-Vsn/ebin
@@ -332,13 +326,23 @@ make_tar(RelName, Flags) when is_list(RelName), is_list(Flags) ->
Path = make_set(Path1 ++ code:get_path()),
ModTestP = {member(src_tests, Flags),xref_p(Flags)},
case get_release(RelName, Path, ModTestP, machine(Flags)) of
- {ok, Release, Appls, Warnings} ->
- case catch mk_tar(RelName, Release, Appls, Flags, Path1) of
- ok ->
- return(ok,Warnings,Flags);
- Error ->
- return(Error,Warnings,Flags)
- end;
+ {ok, Release, Appls, Warnings0} ->
+ Warnings = wsasl(Flags, Warnings0),
+ case systools_lib:werror(Flags, Warnings) of
+ true ->
+ Warnings1 = [W || {warning,W}<-Warnings],
+ return({error,?MODULE,
+ {warnings_treated_as_errors,Warnings1}},
+ Warnings,
+ Flags);
+ false ->
+ case catch mk_tar(RelName, Release, Appls, Flags, Path1) of
+ ok ->
+ return(ok,Warnings,Flags);
+ Error ->
+ return(Error,Warnings,Flags)
+ end
+ end;
Error ->
return(Error,[],Flags)
end;
@@ -2109,90 +2113,80 @@ cas([Y | Args], X) ->
%% Check Options for make_tar
check_args_tar(Args) ->
- cat(Args, {undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, []}).
+ cat(Args, []).
-cat([], {_Path,_Sil,_Dirs,_Erts,_Test,_Var,_VarTar,_Mach,_Xref,_XrefApps, X}) ->
+cat([], X) ->
X;
%%% path ---------------------------------------------------------------
-cat([{path, P} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(P) ->
+cat([{path, P} | Args], X) when is_list(P) ->
case check_path(P) of
ok ->
- cat(Args, {P, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X++[{path,P}]})
+ cat(Args, X++[{path,P}])
end;
%%% silent -------------------------------------------------------------
-cat([silent | Args], {Path, _Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, silent, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([silent | Args], X) ->
+ cat(Args, X);
%%% dirs ---------------------------------------------------------------
-cat([{dirs, D} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) ->
+cat([{dirs, D} | Args], X) ->
case check_dirs(D) of
ok ->
- cat(Args, {Path, Sil, D, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X++[{dirs, D}]})
+ cat(Args, X++[{dirs, D}])
end;
%%% erts ---------------------------------------------------------------
-cat([{erts, E} | Args], {Path, Sil, Dirs, _Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(E)->
- cat(Args, {Path, Sil, Dirs, E, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([{erts, E} | Args], X) when is_list(E)->
+ cat(Args, X);
%%% src_tests ----------------------------------------------------
-cat([src_tests | Args], {Path, Sil, Dirs, Erts, _Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, src_tests, Var, VarTar, Mach,
- Xref, XrefApps, X});
+cat([src_tests | Args], X) ->
+ cat(Args, X);
%%% variables ----------------------------------------------------------
-cat([{variables, V} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(V) ->
+cat([{variables, V} | Args], X) when is_list(V) ->
case check_vars(V) of
ok ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, V, VarTar, Mach, Xref, XrefApps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, XrefApps, X++[{variables, V}]})
+ cat(Args, X++[{variables, V}])
end;
%%% var_tar ------------------------------------------------------------
-cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == include ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, include, Mach, Xref, XrefApps, X});
-cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == ownfile ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, ownfile, Mach, Xref, XrefApps, X});
-cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == omit ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, omit, Mach, Xref, XrefApps, X});
+cat([{var_tar, VT} | Args], X) when VT == include;
+ VT == ownfile;
+ VT == omit ->
+ cat(Args, X);
%%% machine ------------------------------------------------------------
-cat([{machine, M} | Args], {Path, Sil, Dirs, Erts, Test,
- Var, VarTar, Mach, Xref, XrefApps, X}) when is_atom(M) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([{machine, M} | Args], X) when is_atom(M) ->
+ cat(Args, X);
%%% exref --------------------------------------------------------------
-cat([exref | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, _Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, exref, XrefApps, X});
+cat([exref | Args], X) ->
+ cat(Args, X);
%%% exref Apps ---------------------------------------------------------
-cat([{exref, Apps} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Apps) ->
+cat([{exref, Apps} | Args], X) when is_list(Apps) ->
case check_apps(Apps) of
ok ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, Apps, X});
+ cat(Args, X);
error ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, XrefApps, X++[{exref, Apps}]})
+ cat(Args, X++[{exref, Apps}])
end;
%%% outdir Dir ---------------------------------------------------------
-cat([{outdir, Dir} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Dir) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach,
- Xref, XrefApps, X});
+cat([{outdir, Dir} | Args], X) when is_list(Dir) ->
+ cat(Args, X);
%%% otp_build (secret, not documented) ---------------------------------
-cat([otp_build | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([otp_build | Args], X) ->
+ cat(Args, X);
+%%% warnings_as_errors ----
+cat([warnings_as_errors | Args], X) ->
+ cat(Args, X);
+%%% no_warn_sasl ----
+cat([no_warn_sasl | Args], X) ->
+ cat(Args, X);
%%% no_module_tests (kept for backwards compatibility, but ignored) ----
-cat([no_module_tests | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X});
+cat([no_module_tests | Args], X) ->
+ cat(Args, X);
%%% ERROR --------------------------------------------------------------
-cat([Y | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) ->
- cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X++[Y]}).
+cat([Y | Args], X) ->
+ cat(Args, X++[Y]).
check_path([]) ->
ok;
@@ -2292,6 +2286,9 @@ format_error({delete,File,Error}) ->
[File,file:format_error(Error)]);
format_error({tar_error,What}) ->
form_tar_err(What);
+format_error({warnings_treated_as_errors,Warnings}) ->
+ io_lib:format("Warnings being treated as errors:~n~ts",
+ [map(fun(W) -> form_warn("",W) end, Warnings)]);
format_error(ListOfErrors) when is_list(ListOfErrors) ->
format_errors(ListOfErrors);
format_error(E) -> io_lib:format("~p~n",[E]).
@@ -2348,24 +2345,15 @@ form_tar_err({add, File, Error}) ->
%% Format warning
format_warning(Warnings) ->
- format_warning(Warnings, false).
-
-format_warning(Warnings, Werror) ->
- Prefix = case Werror of
- true ->
- "";
- false ->
- "*WARNING* "
- end,
- map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings).
-
-form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) ->
+ map(fun({warning,W}) -> form_warn("*WARNING* ", W) end, Warnings).
+
+form_warn(Prefix, {source_not_found,{Mod,App,_}}) ->
io_lib:format("~ts~w: Source code not found: ~w.erl~n",
[Prefix,App,Mod]);
form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) ->
io_lib:format("~ts~w: Parse error: ~p~n",
[Prefix,App,File]);
-form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) ->
+form_warn(Prefix, {obj_out_of_date,{Mod,App,_}}) ->
io_lib:format("~ts~w: Object code (~w) out of date~n",
[Prefix,App,Mod]);
form_warn(Prefix, {exref_undef, Undef}) ->
@@ -2375,8 +2363,8 @@ form_warn(Prefix, {exref_undef, Undef}) ->
end,
map(F, Undef);
form_warn(Prefix, missing_sasl) ->
- io_lib:format("~ts: Missing application sasl. "
+ io_lib:format("~tsMissing application sasl. "
"Can not upgrade with this release~n",
[Prefix]);
form_warn(Prefix, What) ->
- io_lib:format("~ts ~p~n", [Prefix,What]).
+ io_lib:format("~ts~p~n", [Prefix,What]).
diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl
index 28534dc0c8..7e1844b400 100644
--- a/lib/sasl/src/systools_relup.erl
+++ b/lib/sasl/src/systools_relup.erl
@@ -155,36 +155,12 @@ mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) ->
mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) ->
case check_opts(Opts) of
[] ->
- R = (catch do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs,
- add_code_path(Opts), Opts)),
- case {get_opt(silent, Opts), get_opt(noexec, Opts)} of
- {false, false} ->
- case R of
- {ok, _Res, _Mod, Ws} ->
- print_warnings(Ws, Opts),
- case systools_lib:werror(Opts, Ws) of
- true ->
- error;
- false ->
- ok
- end;
- Other ->
- print_error(Other),
- error
- end;
- _ ->
- case R of
- {ok, _Res, _Mod, Ws} ->
- case systools_lib:werror(Opts, Ws) of
- true ->
- error;
- false ->
- R
- end;
- R ->
- R
- end
- end;
+ R = try do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs,
+ add_code_path(Opts), Opts)
+ catch throw:Error ->
+ Error
+ end,
+ done_mk_relup(Opts, R);
BadArg ->
erlang:error({badarg, BadArg})
end.
@@ -224,17 +200,45 @@ do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) ->
{Dn, Ws2} = foreach_baserel_dn(TopRel, TopApps, BaseDnRelDcs,
Path, Opts, Ws1),
Relup = {TopRel#release.vsn, Up, Dn},
- case systools_lib:werror(Opts, Ws2) of
- true ->
- ok;
- false ->
- write_relup_file(Relup, Opts)
- end,
- {ok, Relup, ?MODULE, Ws2};
+
+ {ok, Relup, Ws2};
Other ->
- throw(Other)
+ Other
end.
+done_mk_relup(Opts, {ok,Relup,Ws}) ->
+ WAE = get_opt(warnings_as_errors,Opts),
+ Silent = get_opt(silent,Opts),
+ Noexec = get_opt(noexec,Opts),
+
+ if WAE andalso Ws=/=[] ->
+ return_error(Silent,
+ {error,?MODULE,{warnings_treated_as_errors, Ws}});
+ not Noexec ->
+ case write_relup_file(Relup,Opts) of
+ ok ->
+ return_ok(Silent,Relup,Ws);
+ Error ->
+ return_error(Silent,Error)
+ end;
+ true -> % noexec
+ return_ok(true,Relup,Ws)
+ end;
+done_mk_relup(Opts, Error) ->
+ return_error(get_opt(silent,Opts) orelse get_opt(noexec,Opts), Error).
+
+return_error(true, Error) ->
+ Error;
+return_error(false, Error) ->
+ print_error(Error),
+ error.
+
+return_ok(true,Relup,Ws) ->
+ {ok,Relup,?MODULE,Ws};
+return_ok(false,_Relup,Ws) ->
+ print_warnings(Ws),
+ ok.
+
%%-----------------------------------------------------------------
%% foreach_baserel_up(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret
%% foreach_baserel_dn(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret
@@ -529,33 +533,18 @@ to_list(X) when is_list(X) -> X.
%% Writes a relup file.
%%
write_relup_file(Relup, Opts) ->
- case get_opt(noexec, Opts) of
- true ->
- ok;
- _ ->
- Filename = case get_opt(outdir, Opts) of
- OutDir when is_list(OutDir) ->
- filename:join(filename:absname(OutDir),
- "relup");
- false ->
- "relup";
- Badarg ->
- throw({error, ?MODULE, {badarg, {outdir,Badarg}}})
- end,
-
- case file:open(Filename, [write]) of
- {ok, Fd} ->
- io:format(Fd, "~p.~n", [Relup]),
- case file:close(Fd) of
- ok -> ok;
- {error,Reason} ->
- throw({error, ?MODULE,
- {file_problem, {"relup", {close,Reason}}}})
- end;
- {error, Reason} ->
- throw({error, ?MODULE,
- {file_problem, {"relup", {open, Reason}}}})
- end
+ Filename = filename:join(filename:absname(get_opt(outdir,Opts)),
+ "relup"),
+ case file:open(Filename, [write]) of
+ {ok, Fd} ->
+ io:format(Fd, "~p.~n", [Relup]),
+ case file:close(Fd) of
+ ok -> ok;
+ {error,Reason} ->
+ {error, ?MODULE, {file_problem, {"relup", {close,Reason}}}}
+ end;
+ {error, Reason} ->
+ {error, ?MODULE, {file_problem, {"relup", {open, Reason}}}}
end.
add_code_path(Opts) ->
@@ -593,10 +582,9 @@ default(path) -> false;
default(noexec) -> false;
default(silent) -> false;
default(restart_emulator) -> false;
-default(outdir) -> false.
+default(outdir) -> ".";
+default(warnings_as_errors) -> false.
-print_error({'EXIT', Err}) ->
- print_error(Err);
print_error({error, Mod, Error}) ->
S = apply(Mod, format_error, [Error]),
io:format(S, []);
@@ -614,24 +602,20 @@ format_error({missing_sasl,Release}) ->
io_lib:format("No sasl application in release ~ts, ~ts. "
"Can not be upgraded.",
[Release#release.name, Release#release.vsn]);
+format_error({warnings_treated_as_errors, Warnings}) ->
+ io_lib:format("Warnings being treated as errors:~n~ts",
+ [[format_warning("",W) || W <- Warnings]]);
format_error(Error) ->
- io:format("~p~n", [Error]).
+ io_lib:format("~p~n", [Error]).
-print_warnings(Ws, Opts) when is_list(Ws) ->
- lists:foreach(fun(W) -> print_warning(W, Opts) end, Ws);
-print_warnings(W, Opts) ->
- print_warning(W, Opts).
+print_warnings(Ws) when is_list(Ws) ->
+ lists:foreach(fun(W) -> print_warning(W) end, Ws);
+print_warnings(W) ->
+ print_warning(W).
-print_warning(W, Opts) ->
- Prefix = case lists:member(warnings_as_errors, Opts) of
- true ->
- "";
- false ->
- "*WARNING* "
- end,
- S = format_warning(Prefix, W),
- io:format("~ts", [S]).
+print_warning(W) ->
+ io:format("~ts", [format_warning(W)]).
format_warning(W) ->
format_warning("*WARNING* ", W).
@@ -639,6 +623,8 @@ format_warning(W) ->
format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) ->
io_lib:format("~tsThe ERTS version changed between ~p and ~p~n",
[Prefix, Rel1, Rel2]);
+format_warning(Prefix, pre_R15_emulator_upgrade) ->
+ io_lib:format("~tsUpgrade from an OTP version earlier than R15. New code should be compiled with the old emulator.~n",[Prefix]);
format_warning(Prefix, What) ->
io_lib:format("~ts~p~n",[Prefix, What]).
diff --git a/lib/sasl/test/release_handler_SUITE_data/start b/lib/sasl/test/release_handler_SUITE_data/start
index 87275045b1..eab2b77aed 100755
--- a/lib/sasl/test/release_handler_SUITE_data/start
+++ b/lib/sasl/test/release_handler_SUITE_data/start
@@ -21,8 +21,7 @@ then
fi
HEART_COMMAND=$ROOTDIR/bin/start
-HW_WD_DISABLE=true
-export HW_WD_DISABLE HEART_COMMAND
+export HEART_COMMAND
START_ERL_DATA=${1:-$RELDIR/start_erl.data}
diff --git a/lib/sasl/test/release_handler_SUITE_data/start_client b/lib/sasl/test/release_handler_SUITE_data/start_client
index 5ea94d6f7c..05d744f06e 100755
--- a/lib/sasl/test/release_handler_SUITE_data/start_client
+++ b/lib/sasl/test/release_handler_SUITE_data/start_client
@@ -24,8 +24,7 @@ RELDIR=$CLIENTDIR/releases
# Note that this scripts is modified an copied to $CLIENTDIR/bin/start
# in release_handler_SUITE:copy_client - therefore HEART_COMMAND is as follows:
HEART_COMMAND=$CLIENTDIR/bin/start
-HW_WD_DISABLE=true
-export HW_WD_DISABLE HEART_COMMAND
+export HEART_COMMAND
START_ERL_DATA=${1:-$RELDIR/start_erl.data}
diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index bf95ceb70c..cce73f5bce 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -29,6 +29,8 @@
-module(systools_SUITE).
+-compile(export_all).
+
%%-define(debug, true).
-include_lib("common_test/include/ct.hrl").
@@ -39,31 +41,6 @@
-include_lib("kernel/include/file.hrl").
--export([all/0,suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
--export([script_options/1, normal_script/1, unicode_script/1,
- unicode_script/2, no_mod_vsn_script/1,
- wildcard_script/1, variable_script/1, no_sasl_script/1,
- no_dot_erlang_script/1,
- abnormal_script/1, src_tests_script/1, crazy_script/1,
- included_script/1, included_override_script/1,
- included_fail_script/1, included_bug_script/1, exref_script/1,
- duplicate_modules_script/1,
- otp_3065_circular_dependenies/1, included_and_used_sort_script/1]).
--export([tar_options/1, normal_tar/1, no_mod_vsn_tar/1, system_files_tar/1,
- system_files_tar/2, invalid_system_files_tar/1,
- invalid_system_files_tar/2, variable_tar/1,
- src_tests_tar/1, var_tar/1, exref_tar/1, link_tar/1,
- otp_9507_path_ebin/1]).
--export([normal_relup/1, restart_relup/1, abnormal_relup/1, no_sasl_relup/1,
- no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1,
- regexp_relup/1]).
--export([normal_hybrid/1,hybrid_no_old_sasl/1,hybrid_no_new_sasl/1]).
--export([otp_6226_outdir/1]).
--export([init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2]).
--export([delete_tree/1]).
-
-import(lists, [foldl/3]).
-define(default_timeout, ?t:minutes(20)).
@@ -91,7 +68,8 @@ groups() ->
{tar, [],
[tar_options, normal_tar, no_mod_vsn_tar, system_files_tar,
invalid_system_files_tar, variable_tar,
- src_tests_tar, var_tar, exref_tar, link_tar, otp_9507_path_ebin]},
+ src_tests_tar, var_tar, exref_tar, link_tar, no_sasl_tar,
+ otp_9507_path_ebin]},
{relup, [],
[normal_relup, restart_relup, abnormal_relup, no_sasl_relup,
no_appup_relup, bad_appup_relup, app_start_type_relup, regexp_relup
@@ -238,6 +216,7 @@ normal_script(Config) when is_list(Config) ->
%% Check the same but w. silent flag
{ok, _, []} = systools:make_script(LatestName, [silent]),
+ {ok, _, []} = systools:make_script(LatestName, [silent,warnings_as_errors]),
%% Use the local option
ok = systools:make_script(LatestName, [local]),
@@ -456,9 +435,16 @@ no_sasl_script(Config) when is_list(Config) ->
{ok, _ , [{warning,missing_sasl}]} =
systools:make_script(LatestName,[{path, P},silent]),
+ {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} =
+ systools:make_script(LatestName,[{path, P},silent,warnings_as_errors]),
+
{ok, _ , []} =
systools:make_script(LatestName,[{path, P},silent, no_warn_sasl]),
+ {ok, _ , []} =
+ systools:make_script(LatestName,[{path, P},silent, no_warn_sasl,
+ warnings_as_errors]),
+
ok = file:set_cwd(OldDir),
ok.
@@ -525,7 +511,9 @@ src_tests_script(Config) when is_list(Config) ->
ok = file:delete(BootFile),
false = filelib:is_regular(BootFile),
%% With warnings_as_errors and src_tests option, an error should be issued
- error =
+ {error, systools_make,
+ {warnings_treated_as_errors, [{obj_out_of_date,_},
+ {source_not_found,_}]}} =
systools:make_script(LatestName, [silent, {path, N}, src_tests,
warnings_as_errors]),
error =
@@ -745,7 +733,7 @@ exref_script(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [{path,P}, silent]),
+ {ok, _, []} = systools:make_script(LatestName, [{path,P}, silent]),
%% Complete exref
{ok, _, W1} =
@@ -894,10 +882,10 @@ normal_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
ok = systools:make_tar(LatestName, [{path, P}]),
ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName),
- {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]),
ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName),
ok = file:set_cwd(OldDir),
@@ -918,10 +906,10 @@ no_mod_vsn_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
ok = systools:make_tar(LatestName, [{path, P}]),
ok = check_tar(fname([lib,'db-3.1',ebin,'db.app']), LatestName),
- {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]),
ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName),
ok = file:set_cwd(OldDir),
@@ -945,11 +933,11 @@ system_files_tar(Config) ->
ok = file:write_file("sys.config","[].\n"),
ok = file:write_file("relup","{\"LATEST\",[],[]}.\n"),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
ok = systools:make_tar(LatestName, [{path, P}]),
ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName),
ok = check_tar(fname(["releases","LATEST","relup"]), LatestName),
- {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]),
ok = check_tar(fname(["releases","LATEST","sys.config"]), LatestName),
ok = check_tar(fname(["releases","LATEST","relup"]), LatestName),
@@ -978,7 +966,7 @@ invalid_system_files_tar(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
%% Add dummy relup and sys.config - faulty sys.config
ok = file:write_file("sys.config","[]\n"), %!!! syntax error - missing '.'
@@ -1036,7 +1024,7 @@ variable_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName,
+ {ok, _, []} = systools:make_script(LatestName,
[silent,
{path, P},
{variables,[{"TEST", LibDir}]}]),
@@ -1045,7 +1033,7 @@ variable_tar(Config) when is_list(Config) ->
{variables,[{"TEST", LibDir}]}]),
ok = check_var_tar("TEST", LatestName),
- {ok, _, _} = systools:make_tar(LatestName,
+ {ok, _, []} = systools:make_tar(LatestName,
[{path, P}, silent,
{variables,[{"TEST", LibDir}]}]),
ok = check_var_tar("TEST", LatestName),
@@ -1174,7 +1162,7 @@ var_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName,
+ {ok, _, []} = systools:make_script(LatestName,
[silent,
{path, P},
{variables,[{"TEST", LibDir}]}]),
@@ -1218,7 +1206,7 @@ exref_tar(Config) when is_list(Config) ->
ok = file:set_cwd(LatestDir),
- {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ {ok, _, []} = systools:make_script(LatestName, [silent, {path, P}]),
%% Complete exref
{ok, _, W1} =
@@ -1248,7 +1236,41 @@ exref_tar(Config) when is_list(Config) ->
ok = file:set_cwd(OldDir),
ok.
+%% make_tar: Create tar without sasl appl. Check warning.
+no_sasl_tar(Config) when is_list(Config) ->
+ {ok, OldDir} = file:get_cwd(),
+ {LatestDir, LatestName} = create_script(latest1_no_sasl,Config),
+
+ DataDir = filename:absname(?copydir),
+ LibDir = fname([DataDir, d_normal, lib]),
+ P = [fname([LibDir, '*', ebin]),
+ fname([DataDir, lib, kernel, ebin]),
+ fname([DataDir, lib, stdlib, ebin]),
+ fname([DataDir, lib, sasl, ebin])],
+
+ ok = file:set_cwd(LatestDir),
+
+ {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ ok = systools:make_tar(LatestName, [{path, P}]),
+ {ok, _, [{warning,missing_sasl}]} =
+ systools:make_tar(LatestName, [{path, P}, silent]),
+ {ok, _, []} =
+ systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl]),
+ {ok, _, []} =
+ systools:make_tar(LatestName, [{path, P}, silent, no_warn_sasl,
+ warnings_as_errors]),
+ TarFile = LatestName ++ ".tar.gz",
+ true = filelib:is_regular(TarFile),
+ ok = file:delete(TarFile),
+ {error, systools_make, {warnings_treated_as_errors,[missing_sasl]}} =
+ systools:make_tar(LatestName, [{path, P}, silent, warnings_as_errors]),
+ error =
+ systools:make_tar(LatestName, [{path, P}, warnings_as_errors]),
+ false = filelib:is_regular(TarFile),
+
+ ok = file:set_cwd(OldDir),
+ ok.
%% make_tar: OTP-9507 - make_tar failed when path given as just 'ebin'.
otp_9507_path_ebin(Config) when is_list(Config) ->
@@ -1268,7 +1290,7 @@ otp_9507_path_ebin(Config) when is_list(Config) ->
fname([DataDir, lib, kernel, ebin]),
fname([DataDir, lib, stdlib, ebin]),
fname([DataDir, lib, sasl, ebin])],
- {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]),
+ {ok, _, []} = systools:make_script(RelName, [silent, {path, P1}]),
ok = systools:make_tar(RelName, [{path, P1}]),
Content1 = tar_contents(RelName),
@@ -1309,7 +1331,7 @@ normal_relup(Config) when is_list(Config) ->
ok = systools:make_relup(LatestName, [LatestName1], [LatestName1],
[{path, P}]),
ok = check_relup([{db, "2.1"}], [{db, "1.0"}]),
- {ok, _, _, []} =
+ {ok, Relup, _, []} =
systools:make_relup(LatestName, [LatestName1], [LatestName1],
[{path, P}, silent]),
ok = check_relup([{db, "2.1"}], [{db, "1.0"}]),
@@ -1322,7 +1344,9 @@ normal_relup(Config) when is_list(Config) ->
error =
systools:make_relup(LatestName, [LatestName2], [LatestName1],
[{path, P}, warnings_as_errors]),
- error =
+ {error, systools_relup,
+ {warnings_treated_as_errors,[pre_R15_emulator_upgrade,
+ {erts_vsn_changed, _}]}} =
systools:make_relup(LatestName, [LatestName2], [LatestName1],
[{path, P}, silent, warnings_as_errors]),
@@ -1341,6 +1365,14 @@ normal_relup(Config) when is_list(Config) ->
%% relup file should exist now
true = filelib:is_regular("relup"),
+ %% file should not be written if noexec option is used.
+ %% delete before running tests.
+ ok = file:delete("relup"),
+ {ok,Relup,_,[]} =
+ systools:make_relup(LatestName, [LatestName1], [LatestName1],
+ [{path, P}, noexec]),
+ false = filelib:is_regular("relup"),
+
ok = file:set_cwd(OldDir),
ok.
diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src
index ca61782639..db09ec3dc5 100644
--- a/lib/snmp/src/app/snmp.appup.src
+++ b/lib/snmp/src/app/snmp.appup.src
@@ -8,6 +8,10 @@
%% {update, snmpa_local_db, soft, soft_purge, soft_purge, []}
%% {add_module, snmpm_net_if_mt}
[
+ {<<"5\\.2\\.4">>,
+ [{load_module, snmp, soft_purge, soft_purge, []},
+ {load_module, snmpc_lib, soft_purge, soft_purge, []},
+ {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]},
{<<"5\\..*">>, [{restart_application, snmp}]},
{<<"4\\..*">>, [{restart_application, snmp}]}
],
@@ -17,6 +21,10 @@
%% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}}
[
+ {<<"5\\.2\\.4">>,
+ [{load_module, snmp, soft_purge, soft_purge, []},
+ {load_module, snmpc_lib, soft_purge, soft_purge, []},
+ {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]},
{<<"5\\..*">>, [{restart_application, snmp}]},
{<<"4\\..*">>, [{restart_application, snmp}]}
]
diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl
index df3933ea01..8a736f688b 100644
--- a/lib/snmp/src/app/snmp.erl
+++ b/lib/snmp/src/app/snmp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -573,9 +573,16 @@ print_mod_info(Prefix, {Module, Info}) ->
CompDate =
case key1search(compile_time, Info) of
{value, {Year, Month, Day, Hour, Min, Sec}} ->
- lists:flatten(
- io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w",
- [Year, Month, Day, Hour, Min, Sec]));
+ io_lib:format(
+ "~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w",
+ [Year, Month, Day, Hour, Min, Sec]);
+ _ ->
+ "Not found"
+ end,
+ Digest =
+ case key1search(md5, Info) of
+ {value, MD5} when is_binary(MD5) ->
+ [io_lib:format("~2.16.0b", [Byte]) || <<Byte>> <= MD5];
_ ->
"Not found"
end,
@@ -583,12 +590,14 @@ print_mod_info(Prefix, {Module, Info}) ->
"~s Vsn: ~s~n"
"~s App vsn: ~s~n"
"~s Compiler ver: ~s~n"
- "~s Compile time: ~s~n",
+ "~s Compile time: ~s~n"
+ "~s MD5 digest: ~s~n",
[Prefix, Module,
Prefix, Vsn,
Prefix, AppVsn,
- Prefix, CompVer,
- Prefix, CompDate]),
+ Prefix, CompVer,
+ Prefix, CompDate,
+ Prefix, Digest]),
ok.
key1search(Key, Vals) ->
@@ -617,7 +626,7 @@ versions1() ->
Error ->
Error
end.
-
+
versions2() ->
case ms2() of
{ok, Mods} ->
@@ -625,25 +634,56 @@ versions2() ->
Error ->
Error
end.
-
+
version_info(Mods) ->
SysInfo = sys_info(),
OsInfo = os_info(),
ModInfo = [mod_version_info(Mod) || Mod <- Mods],
[{sys_info, SysInfo}, {os_info, OsInfo}, {mod_info, ModInfo}].
-
+
mod_version_info(Mod) ->
Info = Mod:module_info(),
- {value, {attributes, Attr}} = lists:keysearch(attributes, 1, Info),
- {value, {vsn, [Vsn]}} = lists:keysearch(vsn, 1, Attr),
- {value, {app_vsn, AppVsn}} = lists:keysearch(app_vsn, 1, Attr),
- {value, {compile, Comp}} = lists:keysearch(compile, 1, Info),
- {value, {version, Ver}} = lists:keysearch(version, 1, Comp),
- {value, {time, Time}} = lists:keysearch(time, 1, Comp),
- {Mod, [{vsn, Vsn},
- {app_vsn, AppVsn},
- {compiler_version, Ver},
- {compile_time, Time}]}.
+ {Mod,
+ case key1search(attributes, Info) of
+ {value, Attr} ->
+ case key1search(vsn, Attr) of
+ {value, [Vsn]} ->
+ [{vsn, Vsn}];
+ not_found ->
+ []
+ end ++
+ case key1search(app_vsn, Attr) of
+ {value, AppVsn} ->
+ [{app_vsn, AppVsn}];
+ not_found ->
+ []
+ end;
+ not_found ->
+ []
+ end ++
+ case key1search(compile, Info) of
+ {value, Comp} ->
+ case key1search(version, Comp) of
+ {value, Ver} ->
+ [{compiler_version, Ver}];
+ not_found ->
+ []
+ end ++
+ case key1search(time, Comp) of
+ {value, Ver} ->
+ [{compile_time, Ver}];
+ not_found ->
+ []
+ end;
+ not_found ->
+ []
+ end ++
+ case key1search(md5, Info) of
+ {value, Bin} ->
+ [{md5, Bin}];
+ not_found ->
+ []
+ end}.
sys_info() ->
SysArch = string:strip(erlang:system_info(system_architecture),right,$\n),
diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl
index 51690b6e7e..33ddd78308 100644
--- a/lib/snmp/src/compile/snmpc_lib.erl
+++ b/lib/snmp/src/compile/snmpc_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -99,7 +99,7 @@ make_ASN1type({{type_with_size,Type,{range,Lo,Hi}},Line}) ->
print_error("Undefined type '~w'",[Type],Line),
guess_string_type()
end;
-make_ASN1type({{integer_with_enum,Type,Enums},Line}) ->
+make_ASN1type({{type_with_enum,Type,Enums},Line}) ->
case lookup_vartype(Type) of
{value,ASN1type} -> ASN1type#asn1_type{assocList = [{enums, Enums}]};
false ->
diff --git a/lib/snmp/src/compile/snmpc_mib_gram.yrl b/lib/snmp/src/compile/snmpc_mib_gram.yrl
index 743c3a6550..14a668127e 100644
--- a/lib/snmp/src/compile/snmpc_mib_gram.yrl
+++ b/lib/snmp/src/compile/snmpc_mib_gram.yrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -387,10 +387,12 @@ syntax -> type : {{type, cat('$1')},line_of('$1')}.
syntax -> type size : {{type_with_size, cat('$1'), '$2'},line_of('$1')}.
syntax -> usertype size : {{type_with_size,val('$1'), '$2'},line_of('$1')}.
syntax -> 'INTEGER' '{' namedbits '}' :
- {{integer_with_enum, 'INTEGER', '$3'}, line_of('$1')}.
+ {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}.
syntax -> 'BITS' '{' namedbits '}' :
ensure_ver(2,'$1'),
{{bits, '$3'}, line_of('$1')}.
+syntax -> usertype '{' namedbits '}' :
+ {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}.
syntax -> 'SEQUENCE' 'OF' usertype :
{{sequence_of,val('$3')},line_of('$1')}.
diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl
index 2c8851c2a7..9b3c2bfd2c 100644
--- a/lib/snmp/test/snmp_compiler_test.erl
+++ b/lib/snmp/test/snmp_compiler_test.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -56,7 +56,8 @@
otp_8574/1,
otp_8595/1,
otp_10799/1,
- otp_10808/1
+ otp_10808/1,
+ otp_14145/1
]).
@@ -135,7 +136,8 @@ all() ->
].
groups() ->
- [{tickets, [], [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808]}].
+ [{tickets, [],
+ [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808, otp_14145]}].
init_per_group(_GroupName, Config) ->
Config.
@@ -431,6 +433,30 @@ otp_10808(Config) when is_list(Config) ->
%%======================================================================
+otp_14145(suite) ->
+ [];
+otp_14145(Config) when is_list(Config) ->
+ put(tname, otp10808),
+ p("starting with Config: ~p~n", [Config]),
+
+ Dir = ?config(case_top_dir, Config),
+ MibDir = ?config(mib_dir, Config),
+ MibName = "OTP14145-MIB",
+ MibFile = join(MibDir, MibName++".mib"),
+ ?line {ok, MibBin} =
+ snmpc:compile(MibFile, [{outdir, Dir},
+ {verbosity, trace},
+ {group_check, false},
+ module_compliance]),
+ p("Mib: ~n~p~n", [MibBin]),
+ MIB = read_mib(MibBin),
+ Oid = [1,3,6,1,2,1,67,4],
+ check_mib(MIB#mib.mes, Oid, undefined),
+ ok.
+
+
+%%======================================================================
+
augments_extra_info(suite) ->
[];
augments_extra_info(Config) when is_list(Config) ->
diff --git a/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib
new file mode 100644
index 0000000000..f29c65c4c2
--- /dev/null
+++ b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib
@@ -0,0 +1,44 @@
+OTP14145-MIB DEFINITIONS ::= BEGIN
+
+IMPORTS
+ MODULE-IDENTITY, OBJECT-TYPE,
+ mib-2 FROM SNMPv2-SMI
+ InetAddressType, InetAddress FROM INET-ADDRESS-MIB
+ MODULE-COMPLIANCE, OBJECT-GROUP FROM SNMPv2-CONF;
+
+testMibId MODULE-IDENTITY
+ LAST-UPDATED "200608210000Z" -- 21 August 2006
+ ORGANIZATION "a"
+ CONTACT-INFO "a"
+ DESCRIPTION "a"
+ REVISION "200608210000Z" -- 21 August 2006
+ DESCRIPTION "a"
+ ::= { mib-2 67 }
+
+testObj OBJECT-TYPE
+ SYNTAX InetAddressType
+ -- SYNTAX InetAddress
+ MAX-ACCESS read-only
+ STATUS current
+ DESCRIPTION "a"
+ ::= { testMibId 2 }
+
+testObjId OBJECT IDENTIFIER ::= { testMibId 3 }
+
+testMibCompliance MODULE-COMPLIANCE
+ STATUS current
+ DESCRIPTION "a"
+ MODULE
+ OBJECT testObj
+ SYNTAX InetAddressType { ipv4(1), ipv6(2) }
+ -- SYNTAX InetAddress ( SIZE(4|16) )
+ DESCRIPTION "a"
+ ::= { testMibId 4 }
+
+testObjGroup OBJECT-GROUP
+ OBJECTS { testObj }
+ STATUS current
+ DESCRIPTION "a"
+ ::= { testObjId 1 }
+
+END
diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk
index 28eba0d0d6..30b8ee1124 100644
--- a/lib/snmp/vsn.mk
+++ b/lib/snmp/vsn.mk
@@ -2,7 +2,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
+# Copyright Ericsson AB 1997-2017. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = snmp
-SNMP_VSN = 5.2.4
+SNMP_VSN = 5.2.5
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)"
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 6b49f89449..f6e26f5ee8 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -153,7 +153,7 @@
<item>
<p>IP version to use.</p>
</item>
- <tag><c><![CDATA[{user_dir, string()}]]></c></tag>
+ <tag><marker id="opt_user_dir"></marker><c><![CDATA[{user_dir, string()}]]></c></tag>
<item>
<p>Sets the user directory, that is, the directory containing
<c>ssh</c> configuration files for the user, such as
@@ -175,22 +175,48 @@
supplied with this option.
</p>
</item>
- <tag><c><![CDATA[{silently_accept_hosts, boolean() | accept_fun() | {crypto:digest_type(), accept_fun()} }]]></c>
- <br/>
- <c><![CDATA[accept_fun() :: fun(PeerName::string(), FingerPrint::string()) -> boolean()]]></c>
+ <tag>
+ <c><![CDATA[{silently_accept_hosts, boolean()}]]></c> <br/>
+ <c><![CDATA[{silently_accept_hosts, CallbackFun}]]></c> <br/>
+ <c><![CDATA[{silently_accept_hosts, {HashAlgoSpec, CallbackFun} }]]></c> <br/>
+ <br/>
+ <c><![CDATA[HashAlgoSpec = crypto:digest_type() | [ crypto:digest_type() ] ]]></c><br/>
+ <c><![CDATA[CallbackFun = fun(PeerName, FingerPrint) -> boolean()]]></c><br/>
+ <c><![CDATA[PeerName = string()]]></c><br/>
+ <c><![CDATA[FingerPrint = string() | [ string() ] ]]></c>
</tag>
<item>
- <p>When <c>true</c>, hosts are added to the
- file <c><![CDATA[known_hosts]]></c> without asking the user.
- Defaults to <c>false</c> which will give a user question on stdio of whether to accept or reject a previously
- unseen host.</p>
- <p>If the option value is has an <c>accept_fun()</c>, that fun will called with the arguments
- <c>(PeerName, PeerHostKeyFingerPrint)</c>. The fingerprint is calculated on the Peer's Host Key with
- <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-1">public_key:ssh_hostkey_fingerprint/1</seealso>.
- </p>
- <p>If the <c>crypto:digest_type()</c> is present, the fingerprint is calculated with that digest type by the function
- <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>.
- </p>
+ <p>This option guides the <c>connect</c> function how to act when the connected server presents a Host
+ Key that the client has not seen before. The default is to ask the user with a question on stdio of whether to
+ accept or reject the new Host Key.
+ See also the option <seealso marker="#opt_user_dir"><c>user_dir</c></seealso>
+ for the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded.
+ </p>
+ <p>The option can be given in three different forms as seen above:</p>
+ <list>
+ <item>The value is a <c>boolean()</c>. The value <c>true</c> will make the client accept any unknown
+ Host Key without any user interaction. The value <c>false</c> keeps the default behaviour of asking the
+ the user on stdio.
+ </item>
+ <item>A <c>CallbackFun</c> will be called and the boolean return value <c>true</c> will make the client
+ accept the Host Key. A return value of <c>false</c> will make the client to reject the Host Key and therefore
+ also the connection will be closed. The arguments to the fun are:
+ <list type="bulleted">
+ <item><c>PeerName</c> - a string with the name or address of the remote host.</item>
+ <item><c>FingerPrint</c> - the fingerprint of the Host Key as
+ <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-1">public_key:ssh_hostkey_fingerprint/1</seealso>
+ calculates it.
+ </item>
+ </list>
+ </item>
+ <item>A tuple <c>{HashAlgoSpec, CallbackFun}</c>. The <c>HashAlgoSpec</c> specifies which hash algorithm
+ shall be used to calculate the fingerprint used in the call of the <c>CallbackFun</c>. The <c>HashALgoSpec</c>
+ is either an atom or a list of atoms as the first argument in
+ <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>.
+ If it is a list of hash algorithm names, the <c>FingerPrint</c> argument in the <c>CallbackFun</c> will be
+ a list of fingerprints in the same order as the corresponding name in the <c>HashAlgoSpec</c> list.
+ </item>
+ </list>
</item>
<tag><c><![CDATA[{user_interaction, boolean()}]]></c></tag>
<item>
@@ -200,7 +226,7 @@
supplying a password. Defaults to <c>true</c>.
Even if user interaction is allowed it can be
suppressed by other options, such as <c>silently_accept_hosts</c>
- and <c>password</c>. However, those optins are not always desirable
+ and <c>password</c>. However, those options are not always desirable
to use from a security point of view.</p>
</item>
diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml
index 0861c641c7..864378b640 100644
--- a/lib/ssh/doc/src/using_ssh.xml
+++ b/lib/ssh/doc/src/using_ssh.xml
@@ -305,7 +305,7 @@ ok = erl_tar:close(HandleRead),
<code type="erl" >
-module(ssh_echo_server).
--behaviour(ssh_subsystem).
+-behaviour(ssh_daemon_channel).
-record(state, {
n,
id,
diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src
index 76b7d8cd55..2bb7491b0c 100644
--- a/lib/ssh/src/ssh.app.src
+++ b/lib/ssh/src/ssh.app.src
@@ -48,4 +48,3 @@
"stdlib-3.1"
]}]}.
-
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index 31e343e81b..68d98d3875 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -280,9 +280,11 @@ valid_socket_to_use(Socket, Options) ->
{error, {unsupported,L4}}
end.
-is_tcp_socket(Socket) -> {ok,[]} =/= inet:getopts(Socket, [delay_send]).
-
-
+is_tcp_socket(Socket) ->
+ case inet:getopts(Socket, [delay_send]) of
+ {ok,[_]} -> true;
+ _ -> false
+ end.
daemon_shell_opt(Options) ->
case proplists:get_value(shell, Options) of
@@ -317,6 +319,7 @@ start_daemon(Socket, Options) ->
do_start_daemon(Socket, [{role,server}|SshOptions], SocketOptions)
catch
throw:bad_fd -> {error,bad_fd};
+ throw:bad_socket -> {error,bad_socket};
_C:_E -> {error,{cannot_start_daemon,_C,_E}}
end;
{error,SockError} ->
@@ -333,6 +336,7 @@ start_daemon(Host, Port, Options, Inet) ->
do_start_daemon(Host, Port, [{role,server}|SshOptions] , [Inet|SocketOptions])
catch
throw:bad_fd -> {error,bad_fd};
+ throw:bad_socket -> {error,bad_socket};
_C:_E -> {error,{cannot_start_daemon,_C,_E}}
end
end.
@@ -362,8 +366,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) ->
{error, {already_started, _}} ->
{error, eaddrinuse};
Result = {ok,_} ->
- ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket),
- Result;
+ call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, Result);
Result = {error, _} ->
Result
catch
@@ -376,8 +379,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) ->
{error, {already_started, _}} ->
{error, eaddrinuse};
{ok, _} ->
- ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket),
- {ok, Sup};
+ call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, {ok, Sup});
Other ->
Other
end
@@ -447,6 +449,16 @@ do_start_daemon(Host0, Port0, SshOptions, SocketOptions) ->
end
end.
+call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, DefaultResult) ->
+ try ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket)
+ of
+ {error,Error} -> {error,Error};
+ _ -> DefaultResult
+ catch
+ C:R -> {error,{could_not_start_connection,{C,R}}}
+ end.
+
+
sync_request_control(false) ->
ok;
sync_request_control({LSock,Callback}) ->
@@ -620,11 +632,22 @@ handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) -
handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_function(Value,2) ->
Opt;
handle_ssh_option({silently_accept_hosts, {DigestAlg,Value}} = Opt) when is_function(Value,2) ->
- case lists:member(DigestAlg, [md5, sha, sha224, sha256, sha384, sha512]) of
- true ->
- Opt;
- false ->
- throw({error, {eoptions, Opt}})
+ Algs = if is_atom(DigestAlg) -> [DigestAlg];
+ is_list(DigestAlg) -> DigestAlg;
+ true -> throw({error, {eoptions, Opt}})
+ end,
+ case [A || A <- Algs,
+ not lists:member(A, [md5, sha, sha224, sha256, sha384, sha512])] of
+ [_|_] = UnSup1 ->
+ throw({error, {{eoptions, Opt}, {not_fingerprint_algos,UnSup1}}});
+ [] ->
+ CryptoHashAlgs = proplists:get_value(hashs, crypto:supports(), []),
+ case [A || A <- Algs,
+ not lists:member(A, CryptoHashAlgs)] of
+ [_|_] = UnSup2 ->
+ throw({error, {{eoptions, Opt}, {unsupported_algo,UnSup2}}});
+ [] -> Opt
+ end
end;
handle_ssh_option({user_interaction, Value} = Opt) when is_boolean(Value) ->
Opt;
diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl
index ac35b70209..9b54ecb2dd 100644
--- a/lib/ssh/src/ssh_auth.erl
+++ b/lib/ssh/src/ssh_auth.erl
@@ -406,7 +406,11 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1,
kb_tries_left = KbTriesLeft,
user = User,
userauth_supported_methods = Methods} = Ssh) ->
- SendOneEmpty = proplists:get_value(tstflg, Opts) == one_empty,
+ SendOneEmpty =
+ (proplists:get_value(tstflg,Opts) == one_empty)
+ orelse
+ proplists:get_value(one_empty, proplists:get_value(tstflg,Opts,[]), false),
+
case check_password(User, unicode:characters_to_list(Password), Opts, Ssh) of
{true,Ssh1} when SendOneEmpty==true ->
Msg = #ssh_msg_userauth_info_request{name = "",
diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl
index 8af0ecc5f9..6f8c050486 100644
--- a/lib/ssh/src/ssh_cli.erl
+++ b/lib/ssh/src/ssh_cli.erl
@@ -453,14 +453,20 @@ move_cursor(From, To, #ssh_pty{width=Width, term=Type}) ->
%% %%% make sure that there is data to send
%% %%% before calling ssh_connection:send
write_chars(ConnectionHandler, ChannelId, Chars) ->
- case erlang:iolist_size(Chars) of
- 0 ->
- ok;
- _ ->
- ssh_connection:send(ConnectionHandler, ChannelId,
- ?SSH_EXTENDED_DATA_DEFAULT, Chars)
+ case has_chars(Chars) of
+ false -> ok;
+ true -> ssh_connection:send(ConnectionHandler,
+ ChannelId,
+ ?SSH_EXTENDED_DATA_DEFAULT,
+ Chars)
end.
+has_chars([C|_]) when is_integer(C) -> true;
+has_chars([H|T]) when is_list(H) ; is_binary(H) -> has_chars(H) orelse has_chars(T);
+has_chars(<<_:8,_/binary>>) -> true;
+has_chars(_) -> false.
+
+
%%% tail, works with empty lists
tl1([_|A]) -> A;
tl1(_) -> [].
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 7451c9e6d0..4496c657c3 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -609,13 +609,15 @@ handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) ->
%%%---- diffie-hellman group exchange
handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) ->
- {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
+ {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
send_bytes(GexGroup, D),
+ Ssh = ssh_transport:parallell_gen_key(Ssh1),
{next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) ->
- {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
+ {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
send_bytes(GexGroup, D),
+ Ssh = ssh_transport:parallell_gen_key(Ssh1),
{next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) ->
@@ -1206,7 +1208,7 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock,
catch
_C:_E ->
disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Encountered unexpected input"},
+ description = "Bad packet"},
StateName, D)
end;
@@ -1221,13 +1223,12 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock,
{bad_mac, Ssh1} ->
disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad mac"},
+ description = "Bad packet"},
StateName, D0#data{ssh_params=Ssh1});
- {error, {exceeds_max_size,PacketLen}} ->
+ {error, {exceeds_max_size,_PacketLen}} ->
disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad packet length "
- ++ integer_to_list(PacketLen)},
+ description = "Bad packet"},
StateName, D0)
catch
_C:_E ->
diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl
index dff2bae9f2..0345bbdea7 100644
--- a/lib/ssh/src/ssh_dbg.erl
+++ b/lib/ssh/src/ssh_dbg.erl
@@ -50,50 +50,61 @@ messages(Write, MangleArg) when is_function(Write,2),
is_function(MangleArg,1) ->
catch dbg:start(),
setup_tracer(Write, MangleArg),
- dbg:p(new,c),
+ dbg:p(new,[c,timestamp]),
dbg_ssh_messages().
dbg_ssh_messages() ->
dbg:tp(ssh_message,encode,1, x),
dbg:tp(ssh_message,decode,1, x),
- dbg:tpl(ssh_transport,select_algorithm,3, x).
-
+ dbg:tpl(ssh_transport,select_algorithm,3, x),
+ dbg:tp(ssh_transport,hello_version_msg,1, x),
+ dbg:tp(ssh_transport,handle_hello_version,1, x).
+
%%%----------------------------------------------------------------
stop() ->
dbg:stop().
%%%================================================================
-msg_formater({trace,Pid,call,{ssh_message,encode,[Msg]}}, D) ->
- fmt("~nSEND ~p ~s~n", [Pid,wr_record(shrink_bin(Msg))], D);
-msg_formater({trace,_Pid,return_from,{ssh_message,encode,1},_Res}, D) ->
+msg_formater({trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) ->
+ fmt("~n~s SEND ~p ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D);
+msg_formater({trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) ->
D;
-msg_formater({trace,_Pid,call,{ssh_message,decode,_}}, D) ->
+msg_formater({trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) ->
D;
-msg_formater({trace,Pid,return_from,{ssh_message,decode,1},Msg}, D) ->
- fmt("~n~p RECV ~s~n", [Pid,wr_record(shrink_bin(Msg))], D);
+msg_formater({trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) ->
+ fmt("~n~s ~p RECV ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D);
-msg_formater({trace,_Pid,call,{ssh_transport,select_algorithm,_}}, D) ->
+msg_formater({trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) ->
+ D;
+msg_formater({trace_ts,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg},TS}, D) ->
+ fmt("~n~s ~p ALGORITHMS~n~s~n", [ts(TS),Pid, wr_record(Alg)], D);
+
+msg_formater({trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) ->
D;
-msg_formater({trace,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg}}, D) ->
- fmt("~n~p ALGORITHMS~n~s~n", [Pid, wr_record(Alg)], D);
+msg_formater({trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) ->
+ fmt("~n~s ~p TCP SEND HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D);
+msg_formater({trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) ->
+ fmt("~n~s ~p RECV HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D);
+msg_formater({trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) ->
+ D;
-msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Pid}, D) ->
- fmt("~n~p TCP SEND on ~p~n ~p~n", [Pid,Sock, shrink_bin(Bytes)], D);
+msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) ->
+ fmt("~n~s ~p TCP SEND on ~p~n ~p~n", [ts(TS),Pid,Sock, shrink_bin(Bytes)], D);
-msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Dest}, D) ->
- fmt("~n~p TCP SEND from ~p TO ~p~n ~p~n", [Pid,Sock,Dest, shrink_bin(Bytes)], D);
+msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) ->
+ fmt("~n~s ~p TCP SEND from ~p TO ~p~n ~p~n", [ts(TS),Pid,Sock,Dest, shrink_bin(Bytes)], D);
-msg_formater({trace,Pid,send,ErlangMsg,Dest}, D) ->
- fmt("~n~p ERL MSG SEND TO ~p~n ~p~n", [Pid,Dest, shrink_bin(ErlangMsg)], D);
+msg_formater({trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) ->
+ fmt("~n~s ~p ERL MSG SEND TO ~p~n ~p~n", [ts(TS),Pid,Dest, shrink_bin(ErlangMsg)], D);
-msg_formater({trace,Pid,'receive',{tcp,Sock,Bytes}}, D) ->
- fmt("~n~p TCP RECEIVE on ~p~n ~p~n", [Pid,Sock,shrink_bin(Bytes)], D);
+msg_formater({trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) ->
+ fmt("~n~s ~p TCP RECEIVE on ~p~n ~p~n", [ts(TS),Pid,Sock,shrink_bin(Bytes)], D);
-msg_formater({trace,Pid,'receive',ErlangMsg}, D) ->
- fmt("~n~p ERL MSG RECEIVE~n ~p~n", [Pid,shrink_bin(ErlangMsg)], D);
+msg_formater({trace_ts,Pid,'receive',ErlangMsg,TS}, D) ->
+ fmt("~n~s ~p ERL MSG RECEIVE~n ~p~n", [ts(TS),Pid,shrink_bin(ErlangMsg)], D);
msg_formater(M, D) ->
@@ -106,6 +117,11 @@ msg_formater(M, D) ->
fmt(Fmt, Args, D=#data{writer=Write,acc=Acc}) ->
D#data{acc = Write(io_lib:format(Fmt, Args), Acc)}.
+ts({_,_,Usec}=Now) ->
+ {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now),
+ io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]);
+ts(_) ->
+ "-".
%%%----------------------------------------------------------------
setup_tracer(Write, MangleArg) ->
Handler = fun(Arg, D) ->
@@ -116,11 +132,11 @@ setup_tracer(Write, MangleArg) ->
ok.
%%%----------------------------------------------------------------
-shrink_bin(B) when is_binary(B), size(B)>100 -> {'*** SHRINKED BIN',
+shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN',
size(B),
- element(1,split_binary(B,20)),
+ element(1,split_binary(B,64)),
'...',
- element(2,split_binary(B,size(B)-20))
+ element(2,split_binary(B,size(B)-64))
};
shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L);
shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T)));
diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl
index b739955836..9352046795 100644
--- a/lib/ssh/src/ssh_sftpd.erl
+++ b/lib/ssh/src/ssh_sftpd.erl
@@ -664,29 +664,25 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 ->
do_open(ReqId, State, Path, Flags).
do_open(ReqId, State0, Path, Flags) ->
- #state{file_handler = FileMod, file_state = FS0, root = Root, xf = #ssh_xfer{vsn = Vsn}} = State0,
- XF = State0#state.xf,
- F = [binary | Flags],
- {IsDir, _FS1} = FileMod:is_dir(Path, FS0),
+ #state{file_handler = FileMod, file_state = FS0, xf = #ssh_xfer{vsn = Vsn}} = State0,
+ AbsPath = relate_file_name(Path, State0),
+ {IsDir, _FS1} = FileMod:is_dir(AbsPath, FS0),
case IsDir of
true when Vsn > 5 ->
ssh_xfer:xf_send_status(State0#state.xf, ReqId,
- ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory");
+ ?SSH_FX_FILE_IS_A_DIRECTORY, "File is a directory"),
+ State0;
true ->
ssh_xfer:xf_send_status(State0#state.xf, ReqId,
- ?SSH_FX_FAILURE, "File is a directory");
+ ?SSH_FX_FAILURE, "File is a directory"),
+ State0;
false ->
- AbsPath = case Root of
- "" ->
- Path;
- _ ->
- relate_file_name(Path, State0)
- end,
- {Res, FS1} = FileMod:open(AbsPath, F, FS0),
+ OpenFlags = [binary | Flags],
+ {Res, FS1} = FileMod:open(AbsPath, OpenFlags, FS0),
State1 = State0#state{file_state = FS1},
case Res of
{ok, IoDevice} ->
- add_handle(State1, XF, ReqId, file, {Path,IoDevice});
+ add_handle(State1, State0#state.xf, ReqId, file, {Path,IoDevice});
{error, Error} ->
ssh_xfer:xf_send_status(State1#state.xf, ReqId,
ssh_xfer:encode_erlang_status(Error)),
@@ -742,6 +738,10 @@ resolve_symlinks_2([], State, _LinkCnt, AccPath) ->
{{ok, AccPath}, State}.
+%% The File argument is always in a user visible file system, i.e.
+%% is under Root and is relative to CWD or Root, if starts with "/".
+%% The result of the function is always an absolute path in a
+%% "backend" file system.
relate_file_name(File, State) ->
relate_file_name(File, State, _Canonicalize=true).
@@ -749,19 +749,20 @@ relate_file_name(File, State, Canonicalize) when is_binary(File) ->
relate_file_name(unicode:characters_to_list(File), State, Canonicalize);
relate_file_name(File, #state{cwd = CWD, root = ""}, Canonicalize) ->
relate_filename_to_path(File, CWD, Canonicalize);
-relate_file_name(File, #state{root = Root}, Canonicalize) ->
- case is_within_root(Root, File) of
- true ->
- File;
- false ->
- RelFile = make_relative_filename(File),
- NewFile = relate_filename_to_path(RelFile, Root, Canonicalize),
- case is_within_root(Root, NewFile) of
- true ->
- NewFile;
- false ->
- Root
- end
+relate_file_name(File, #state{cwd = CWD, root = Root}, Canonicalize) ->
+ CWD1 = case is_within_root(Root, CWD) of
+ true -> CWD;
+ false -> Root
+ end,
+ AbsFile = case make_relative_filename(File) of
+ File ->
+ relate_filename_to_path(File, CWD1, Canonicalize);
+ RelFile ->
+ relate_filename_to_path(RelFile, Root, Canonicalize)
+ end,
+ case is_within_root(Root, AbsFile) of
+ true -> AbsFile;
+ false -> Root
end.
is_within_root(Root, File) ->
diff --git a/lib/ssh/src/ssh_sftpd_file_api.erl b/lib/ssh/src/ssh_sftpd_file_api.erl
index 78f452df67..e444e52ac0 100644
--- a/lib/ssh/src/ssh_sftpd_file_api.erl
+++ b/lib/ssh/src/ssh_sftpd_file_api.erl
@@ -36,7 +36,7 @@
-callback list_dir(file:name(), State::term()) ->
{{ok, Filenames::term()}, State::term()} | {{error, Reason::term()}, State::term()}.
-callback make_dir(Dir::term(), State::term()) ->
- {{ok, State::term()},State::term()} | {{error, Reason::term()}, State::term()}.
+ {ok, State::term()} | {{error, Reason::term()}, State::term()}.
-callback make_symlink(Path2::term(), Path::term(), State::term()) ->
{ok, State::term()} | {{error, Reason::term()}, State::term()}.
-callback open(Path::term(), Flags::term(), State::term()) ->
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 21ba34506a..a7cc4cd52c 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -44,6 +44,7 @@
handle_kexdh_reply/2,
handle_kex_ecdh_init/2,
handle_kex_ecdh_reply/2,
+ parallell_gen_key/1,
extract_public_key/1,
ssh_packet/2, pack/2,
sha/1, sign/3, verify/4]).
@@ -296,9 +297,6 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own,
end.
-%% TODO: diffie-hellman-group14-sha1 should also be supported.
-%% Maybe check more things ...
-
verify_algorithm(#alg{kex = undefined}) -> false;
verify_algorithm(#alg{hkey = undefined}) -> false;
verify_algorithm(#alg{send_mac = undefined}) -> false;
@@ -316,17 +314,29 @@ verify_algorithm(#alg{kex = Kex}) -> lists:member(Kex, supported_algorithms(kex)
key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ;
Kex == 'diffie-hellman-group14-sha1' ->
{G, P} = dh_group(Kex),
- {Public, Private} = generate_key(dh, [P,G]),
+ Sz = dh_bits(Ssh0#ssh.algorithms),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
{SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0),
{ok, SshPacket,
Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}};
key_exchange_first_msg(Kex, Ssh0=#ssh{opts=Opts}) when Kex == 'diffie-hellman-group-exchange-sha1' ;
Kex == 'diffie-hellman-group-exchange-sha256' ->
- {Min,NBits,Max} =
+ {Min,NBits0,Max} =
proplists:get_value(dh_gex_limits, Opts, {?DEFAULT_DH_GROUP_MIN,
?DEFAULT_DH_GROUP_NBITS,
?DEFAULT_DH_GROUP_MAX}),
+ DhBits = dh_bits(Ssh0#ssh.algorithms),
+ NBits1 =
+ %% NIST Special Publication 800-57 Part 1 Revision 4: Recommendation for Key Management
+ if
+ DhBits =< 112 -> 2048;
+ DhBits =< 128 -> 3072;
+ DhBits =< 192 -> 7680;
+ true -> 8192
+ end,
+ NBits = min(max(max(NBits0,NBits1),Min), Max),
+
{SshPacket, Ssh1} =
ssh_packet(#ssh_msg_kex_dh_gex_request{min = Min,
n = NBits,
@@ -350,12 +360,13 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'ecdh-sha2-nistp256' ;
%%% diffie-hellman-group14-sha1
%%%
handle_kexdh_init(#ssh_msg_kexdh_init{e = E},
- Ssh0 = #ssh{algorithms = #alg{kex=Kex}}) ->
+ Ssh0 = #ssh{algorithms = #alg{kex=Kex} = Algs}) ->
%% server
{G, P} = dh_group(Kex),
if
1=<E, E=<(P-1) ->
- {Public, Private} = generate_key(dh, [P,G]),
+ Sz = dh_bits(Algs),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
K = compute_key(dh, E, Private, [P,G]),
MyPrivHostKey = get_host_key(Ssh0),
MyPubHostKey = extract_public_key(MyPrivHostKey),
@@ -426,13 +437,12 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0,
{Min, Max} = adjust_gex_min_max(Min0, Max0, Opts),
case public_key:dh_gex_group(Min, NBits, Max,
proplists:get_value(dh_gex_groups,Opts)) of
- {ok, {_Sz, {G,P}}} ->
- {Public, Private} = generate_key(dh, [P,G]),
+ {ok, {_, {G,P}}} ->
{SshPacket, Ssh} =
ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0),
{ok, SshPacket,
- Ssh#ssh{keyex_key = {{Private, Public}, {G, P}},
- keyex_info = {Min, Max, NBits}
+ Ssh#ssh{keyex_key = {x, {G, P}},
+ keyex_info = {Min0, Max0, NBits}
}};
{error,_} ->
ssh_connection_handler:disconnect(
@@ -461,12 +471,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits},
{Min, Max} = adjust_gex_min_max(Min0, Max0, Opts),
case public_key:dh_gex_group(Min, NBits, Max,
proplists:get_value(dh_gex_groups,Opts)) of
- {ok, {_Sz, {G,P}}} ->
- {Public, Private} = generate_key(dh, [P,G]),
+ {ok, {_, {G,P}}} ->
{SshPacket, Ssh} =
ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0),
{ok, SshPacket,
- Ssh#ssh{keyex_key = {{Private, Public}, {G, P}},
+ Ssh#ssh{keyex_key = {x, {G, P}},
keyex_info = {-1, -1, NBits} % flag for kex_h hash calc
}};
{error,_} ->
@@ -507,7 +516,8 @@ adjust_gex_min_max(Min0, Max0, Opts) ->
handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) ->
%% client
- {Public, Private} = generate_key(dh, [P,G]),
+ Sz = dh_bits(Ssh0#ssh.algorithms),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
{SshPacket, Ssh1} =
ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), % Pub = G^Priv mod P (def)
@@ -1117,6 +1127,51 @@ verify(PlainText, Hash, Sig, Key) ->
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Unit: bytes
+
+-record(cipher_data, {
+ key_bytes,
+ iv_bytes,
+ block_bytes
+ }).
+
+%%% Start of a more parameterized crypto handling.
+cipher('AEAD_AES_128_GCM') ->
+ #cipher_data{key_bytes = 16,
+ iv_bytes = 12,
+ block_bytes = 16};
+
+cipher('AEAD_AES_256_GCM') ->
+ #cipher_data{key_bytes = 32,
+ iv_bytes = 12,
+ block_bytes = 16};
+
+cipher('3des-cbc') ->
+ #cipher_data{key_bytes = 24,
+ iv_bytes = 8,
+ block_bytes = 8};
+
+cipher('aes128-cbc') ->
+ #cipher_data{key_bytes = 16,
+ iv_bytes = 16,
+ block_bytes = 16};
+
+cipher('aes128-ctr') ->
+ #cipher_data{key_bytes = 16,
+ iv_bytes = 16,
+ block_bytes = 16};
+
+cipher('aes192-ctr') ->
+ #cipher_data{key_bytes = 24,
+ iv_bytes = 16,
+ block_bytes = 16};
+
+cipher('aes256-ctr') ->
+ #cipher_data{key_bytes = 32,
+ iv_bytes = 16,
+ block_bytes = 16}.
+
+
encrypt_init(#ssh{encrypt = none} = Ssh) ->
{ok, Ssh};
encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) ->
@@ -1497,11 +1552,11 @@ send_mac_init(SSH) ->
common ->
case SSH#ssh.role of
client ->
- KeySize = mac_key_size(SSH#ssh.send_mac),
+ KeySize = 8*mac_key_bytes(SSH#ssh.send_mac),
Key = hash(SSH, "E", KeySize),
{ok, SSH#ssh { send_mac_key = Key }};
server ->
- KeySize = mac_key_size(SSH#ssh.send_mac),
+ KeySize = 8*mac_key_bytes(SSH#ssh.send_mac),
Key = hash(SSH, "F", KeySize),
{ok, SSH#ssh { send_mac_key = Key }}
end;
@@ -1520,10 +1575,10 @@ recv_mac_init(SSH) ->
common ->
case SSH#ssh.role of
client ->
- Key = hash(SSH, "F", mac_key_size(SSH#ssh.recv_mac)),
+ Key = hash(SSH, "F", 8*mac_key_bytes(SSH#ssh.recv_mac)),
{ok, SSH#ssh { recv_mac_key = Key }};
server ->
- Key = hash(SSH, "E", mac_key_size(SSH#ssh.recv_mac)),
+ Key = hash(SSH, "E", 8*mac_key_bytes(SSH#ssh.recv_mac)),
{ok, SSH#ssh { recv_mac_key = Key }}
end;
aead ->
@@ -1640,13 +1695,15 @@ sha(?'secp384r1') -> sha(secp384r1);
sha(?'secp521r1') -> sha(secp521r1).
-mac_key_size('hmac-sha1') -> 20*8;
-mac_key_size('hmac-sha1-96') -> 20*8;
-mac_key_size('hmac-md5') -> 16*8;
-mac_key_size('hmac-md5-96') -> 16*8;
-mac_key_size('hmac-sha2-256')-> 32*8;
-mac_key_size('hmac-sha2-512')-> 512;
-mac_key_size(none) -> 0.
+mac_key_bytes('hmac-sha1') -> 20;
+mac_key_bytes('hmac-sha1-96') -> 20;
+mac_key_bytes('hmac-md5') -> 16;
+mac_key_bytes('hmac-md5-96') -> 16;
+mac_key_bytes('hmac-sha2-256')-> 32;
+mac_key_bytes('hmac-sha2-512')-> 64;
+mac_key_bytes('AEAD_AES_128_GCM') -> 0;
+mac_key_bytes('AEAD_AES_256_GCM') -> 0;
+mac_key_bytes(none) -> 0.
mac_digest_size('hmac-sha1') -> 20;
mac_digest_size('hmac-sha1-96') -> 12;
@@ -1671,6 +1728,13 @@ dh_group('diffie-hellman-group1-sha1') -> ?dh_group1;
dh_group('diffie-hellman-group14-sha1') -> ?dh_group14.
%%%----------------------------------------------------------------
+parallell_gen_key(Ssh = #ssh{keyex_key = {x, {G, P}},
+ algorithms = Algs}) ->
+ Sz = dh_bits(Algs),
+ {Public, Private} = generate_key(dh, [P,G,2*Sz]),
+ Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}}.
+
+
generate_key(Algorithm, Args) ->
{Public,Private} = crypto:generate_key(Algorithm, Args),
{crypto:bytes_to_integer(Public), crypto:bytes_to_integer(Private)}.
@@ -1681,6 +1745,15 @@ compute_key(Algorithm, OthersPublic, MyPrivate, Args) ->
crypto:bytes_to_integer(Shared).
+dh_bits(#alg{encrypt = Encrypt,
+ send_mac = SendMac}) ->
+ C = cipher(Encrypt),
+ 8 * lists:max([C#cipher_data.key_bytes,
+ C#cipher_data.block_bytes,
+ C#cipher_data.iv_bytes,
+ mac_key_bytes(SendMac)
+ ]).
+
ecdh_curve('ecdh-sha2-nistp256') -> secp256r1;
ecdh_curve('ecdh-sha2-nistp384') -> secp384r1;
ecdh_curve('ecdh-sha2-nistp521') -> secp521r1.
diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl
index dc3b7dc7e6..8ca29b9399 100644
--- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl
+++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl
@@ -54,15 +54,18 @@
-endif.
-endif.
+%% Public key records:
+-include_lib("public_key/include/public_key.hrl").
%%% Properties:
prop_ssh_decode() ->
- ?FORALL(Msg, ssh_msg(),
- try ssh_message:decode(Msg)
+ ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ),
+ try ssh_message:decode(decode_state(Msg,KexFam))
of
_ -> true
catch
+
C:E -> io:format('~p:~p~n',[C,E]),
false
end
@@ -71,122 +74,101 @@ prop_ssh_decode() ->
%%% This fails because ssh_message is not symmetric in encode and decode regarding data types
prop_ssh_decode_encode() ->
- ?FORALL(Msg, ssh_msg(),
- Msg == ssh_message:encode(ssh_message:decode(Msg))
+ ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ),
+ Msg == ssh_message:encode(
+ fix_asym(
+ ssh_message:decode(decode_state(Msg,KexFam))))
).
%%%================================================================
%%%
-%%% Scripts to generate message generators
-%%%
-
-%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt
-
-%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt
-
-%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt
-
-%%%================================================================
-%%%
%%% Generators
%%%
-ssh_msg() -> ?LET(M,oneof(
-[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()],
- [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()],
- [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()],
- [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()],
-%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )],
-%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
-%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
-%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()],
- [msg_code('SSH_MSG_IGNORE'),gen_string( )],
- %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()],
- %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )],
- %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()],
- [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()],
- [msg_code('SSH_MSG_NEWKEYS')],
- [msg_code('SSH_MSG_REQUEST_FAILURE')],
- [msg_code('SSH_MSG_REQUEST_SUCCESS')],
- [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()],
- [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )],
- [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )],
- [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()],
- [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()],
- [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )],
- [msg_code('SSH_MSG_USERAUTH_SUCCESS')]
-]
-
-), list_to_binary(M)).
-
-
-%%%================================================================
-%%%
-%%% Generator
-%%%
-
-do() ->
- io_lib:format('[~s~n]',
- [write_gen(
- files(["rfc4254.txt",
- "rfc4253.txt",
- "rfc4419.txt",
- "rfc4252.txt",
- "rfc4256.txt"]))]).
-
-
-write_gen(L) when is_list(L) ->
- string:join(lists:map(fun write_gen/1, L), ",\n ");
-write_gen({MsgName,Args}) ->
- lists:flatten(["[",generate_args([MsgName|Args]),"]"]).
-
-generate_args(As) -> string:join([generate_arg(A) || A <- As], ",").
-
-generate_arg({<<"string">>, <<"\"",B/binary>>}) ->
- S = get_string($",B),
- ["gen_string(\"",S,"\")"];
-generate_arg({<<"string">>, _}) -> "gen_string( )";
-generate_arg({<<"byte[",B/binary>>, _}) ->
- io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]);
-generate_arg({<<"byte">> ,_}) -> "gen_byte()";
-generate_arg({<<"uint16">>,_}) -> "gen_uint16()";
-generate_arg({<<"uint32">>,_}) -> "gen_uint32()";
-generate_arg({<<"uint64">>,_}) -> "gen_uint64()";
-generate_arg({<<"mpint">>,_}) -> "gen_mpint()";
-generate_arg({<<"name-list">>,_}) -> "gen_name_list()";
-generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0";
-generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1";
-generate_arg({<<"boolean">>,_}) -> "gen_boolean()";
-generate_arg({<<"....">>,_}) -> ""; %% FIXME
-generate_arg(Name) when is_binary(Name) ->
- lists:flatten(["msg_code('",binary_to_list(Name),"')"]).
-
+ssh_msg(<<"dh">>) ->
+ ?LET(M,oneof(
+ [
+ [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], % 30
+ [msg_code('SSH_MSG_KEXDH_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)] % 31
+ | rest_ssh_msgs()
+ ]),
+ list_to_binary(M));
+
+ssh_msg(<<"dh_gex">>) ->
+ ?LET(M,oneof(
+ [
+ [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST_OLD'),gen_uint32()], % 30
+ [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()] % 31
+ | rest_ssh_msgs()
+ ]),
+ list_to_binary(M));
+
+ ssh_msg(<<"ecdh">>) ->
+ ?LET(M,oneof(
+ [
+ [msg_code('SSH_MSG_KEX_ECDH_INIT'),gen_mpint()], % 30
+ [msg_code('SSH_MSG_KEX_ECDH_REPLY'),gen_pubkey_string(ecdsa),gen_mpint(),gen_signature_string(ecdsa)] % 31
+ | rest_ssh_msgs()
+ ]),
+ list_to_binary(M)).
+
+
+rest_ssh_msgs() ->
+ [%% SSH_MSG_USERAUTH_INFO_RESPONSE
+ %% hard args SSH_MSG_USERAUTH_INFO_REQUEST
+ %% rfc4252 p12 error SSH_MSG_USERAUTH_REQUEST
+ [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST'),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_KEX_DH_GEX_INIT'),gen_mpint()],
+ [msg_code('SSH_MSG_KEX_DH_GEX_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)],
+ [msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()],
+ [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()],
+ [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()],
+ [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()],
+ [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()],
+ [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()],
+ [msg_code('SSH_MSG_IGNORE'),gen_string( )],
+ [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()],
+ [msg_code('SSH_MSG_NEWKEYS')],
+ [msg_code('SSH_MSG_REQUEST_FAILURE')],
+ [msg_code('SSH_MSG_REQUEST_SUCCESS')],
+ [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()],
+ [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )],
+ [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )],
+ [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()],
+ [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()],
+ [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )],
+ [msg_code('SSH_MSG_USERAUTH_SUCCESS')]
+ ].
+
+kex_family() -> oneof([<<"dh">>, <<"dh_gex">>, <<"ecdh">>]).
gen_boolean() -> choose(0,1).
@@ -202,10 +184,7 @@ gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)].
gen_char() -> choose($a,$z).
-gen_mpint() -> ?LET(Size, choose(1,20),
- ?LET(Str, vector(Size, gen_byte()),
- gen_string( strip_0s(Str) )
- )).
+gen_mpint() -> ?LET(I, largeint(), ssh_bits:mpint(I)).
strip_0s([0|T]) -> strip_0s(T);
strip_0s(X) -> X.
@@ -230,13 +209,22 @@ gen_name() -> gen_string().
uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>).
-%%%----
-get_string(Delim, B) ->
- binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ).
-
-count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc;
-count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1).
+gen_pubkey_string(Type) ->
+ PubKey = case Type of
+ rsa -> #'RSAPublicKey'{modulus = 12345,publicExponent = 2};
+ ecdsa -> {#'ECPoint'{point=[1,2,3,4,5]},
+ {namedCurve,{1,2,840,10045,3,1,7}}} % 'secp256r1' nistp256
+ end,
+ gen_string(public_key:ssh_encode(PubKey, ssh2_pubkey)).
+
+gen_signature_string(Type) ->
+ Signature = <<"hejhopp">>,
+ Id = case Type of
+ rsa -> "ssh-rsa";
+ ecdsa -> "ecdsa-sha2-nistp256"
+ end,
+ gen_string(gen_string(Id) ++ gen_string(Signature)).
-define(MSG_CODE(Name,Num),
msg_code(Name) -> Num;
@@ -273,124 +261,34 @@ msg_code(Num) -> Name
?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100);
?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60);
?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61);
+?MSG_CODE('SSH_MSG_KEXDH_INIT', 30);
+?MSG_CODE('SSH_MSG_KEXDH_REPLY', 31);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31);
?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32);
-?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33).
-
-%%%=============================================================================
-%%%=============================================================================
-%%%=============================================================================
-
-files(Fs) ->
- Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))),
- DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]),
- WantedIDs = lists:usort(wanted_messages()),
- Missing = WantedIDs -- DefinedIDs,
- case Missing of
- [] -> ok;
- _ -> io:format('%% Warning: missing ~p~n', [Missing])
- end,
- Defs.
-
-
-file(F) ->
- {ok,B} = file:read_file(F),
- hunt_msg_def(B).
-
-
-hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B));
-hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B);
-hunt_msg_def(<<>>) -> [].
-
-some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B));
-some_hope(B) -> hunt_msg_def(B).
-
-try_message(B = <<"SSH_MSG_",_/binary>>) ->
- {ID,Rest} = get_id(B),
- case lists:member(binary_to_list(ID), wanted_messages()) of
- true ->
- {Lines,More} = get_def_lines(skip_blanks(Rest), []),
- [{ID,lists:reverse(Lines)} | hunt_msg_def(More)];
- false ->
- hunt_msg_def(Rest)
- end;
-try_message(B) -> hunt_msg_def(B).
-
-
-skip_blanks(<<32, B/binary>>) -> skip_blanks(B);
-skip_blanks(<< 9, B/binary>>) -> skip_blanks(B);
-skip_blanks(B) -> B.
-
-get_def_lines(B0 = <<"\n",B/binary>>, Acc) ->
- {ID,Rest} = get_id(skip_blanks(B)),
- case {size(ID), skip_blanks(Rest)} of
- {0,<<"....",More/binary>>} ->
- {Text,LineEnd} = get_to_eol(skip_blanks(More)),
- get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]);
- {0,_} ->
- {Acc,B0};
- {_,Rest1} ->
- {Text,LineEnd} = get_to_eol(Rest1),
- get_def_lines(LineEnd, [{ID,Text}|Acc])
- end;
-get_def_lines(B, Acc) ->
- {Acc,B}.
-
-
-get_to_eol(B) -> split_binary(B, count_to_eol(B,0)).
-
-count_to_eol(<<"\n",_/binary>>, Acc) -> Acc;
-count_to_eol(<<>>, Acc) -> Acc;
-count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1).
-
-
-get_id(B) -> split_binary(B, count_id_chars(B,0)).
-
-count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1);
-count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1);
-count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1);
-count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1);
-count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list
-count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16]
-count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16]
-count_id_chars(_, Acc) -> Acc.
-
-wanted_messages() ->
- ["SSH_MSG_CHANNEL_CLOSE",
- "SSH_MSG_CHANNEL_DATA",
- "SSH_MSG_CHANNEL_EOF",
- "SSH_MSG_CHANNEL_EXTENDED_DATA",
- "SSH_MSG_CHANNEL_FAILURE",
- "SSH_MSG_CHANNEL_OPEN",
- "SSH_MSG_CHANNEL_OPEN_CONFIRMATION",
- "SSH_MSG_CHANNEL_OPEN_FAILURE",
- "SSH_MSG_CHANNEL_REQUEST",
- "SSH_MSG_CHANNEL_SUCCESS",
- "SSH_MSG_CHANNEL_WINDOW_ADJUST",
- "SSH_MSG_DEBUG",
- "SSH_MSG_DISCONNECT",
- "SSH_MSG_GLOBAL_REQUEST",
- "SSH_MSG_IGNORE",
- "SSH_MSG_KEXDH_INIT",
- "SSH_MSG_KEXDH_REPLY",
- "SSH_MSG_KEXINIT",
- "SSH_MSG_KEX_DH_GEX_GROUP",
- "SSH_MSG_KEX_DH_GEX_REQUEST",
- "SSH_MSG_KEX_DH_GEX_REQUEST_OLD",
- "SSH_MSG_NEWKEYS",
- "SSH_MSG_REQUEST_FAILURE",
- "SSH_MSG_REQUEST_SUCCESS",
- "SSH_MSG_SERVICE_ACCEPT",
- "SSH_MSG_SERVICE_REQUEST",
- "SSH_MSG_UNIMPLEMENTED",
- "SSH_MSG_USERAUTH_BANNER",
- "SSH_MSG_USERAUTH_FAILURE",
-%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST",
-%% "SSH_MSG_USERAUTH_INFO_RESPONSE",
- "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ",
- "SSH_MSG_USERAUTH_PK_OK",
-%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST",
- "SSH_MSG_USERAUTH_SUCCESS"].
+?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33);
+?MSG_CODE('SSH_MSG_KEX_ECDH_INIT', 30);
+?MSG_CODE('SSH_MSG_KEX_ECDH_REPLY', 31).
+
+%%%====================================================
+%%%=== WARNING: Knowledge of the test object ahead! ===
+%%%====================================================
+
+%% SSH message records:
+-include_lib("ssh/src/ssh_connect.hrl").
+-include_lib("ssh/src/ssh_transport.hrl").
+
+%%% Encoding and decodeing is asymetric so out=binary in=string. Sometimes. :(
+fix_asym(#ssh_msg_global_request{name=N} = M) -> M#ssh_msg_global_request{name = binary_to_list(N)};
+fix_asym(#ssh_msg_debug{message=D,language=L} = M) -> M#ssh_msg_debug{message = binary_to_list(D),
+ language = binary_to_list(L)};
+fix_asym(#ssh_msg_kexinit{cookie=C} = M) -> M#ssh_msg_kexinit{cookie = <<C:128>>};
+fix_asym(M) -> M.
+
+%%% Message codes 30 and 31 are overloaded depending on kex family so arrange the decoder
+%%% input as the test object does
+decode_state(<<30,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>;
+decode_state(<<31,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>;
+decode_state(Msg, _) -> Msg.
diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl
index 8b2db0e1a8..6f75d83c4a 100644
--- a/lib/ssh/test/ssh_algorithms_SUITE.erl
+++ b/lib/ssh/test/ssh_algorithms_SUITE.erl
@@ -58,9 +58,11 @@ groups() ->
|| {Tag,Algs} <- ErlAlgos,
lists:member(Tag,tags())
],
+
+ TypeSSH = ssh_test_lib:ssh_type(),
AlgoTcSet =
- [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos)}
+ [{Alg, [parallel], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos,TypeSSH)}
|| {Tag,Algs} <- ErlAlgos ++ DoubleAlgos,
Alg <- Algs],
@@ -198,18 +200,17 @@ try_exec_simple_group(Group, Config) ->
%%--------------------------------------------------------------------
%% Testing all default groups
-simple_exec_groups() -> [{timetrap,{minutes,5}}].
-
+simple_exec_groups() ->
+ [{timetrap,{seconds,120}}].
+
simple_exec_groups(Config) ->
Sizes = interpolate( public_key:dh_gex_group_sizes() ),
lists:foreach(
fun(Sz) ->
ct:log("Try size ~p",[Sz]),
ct:comment(Sz),
- case simple_exec_group(Sz, Config) of
- expected -> ct:log("Size ~p ok",[Sz]);
- _ -> ct:log("Size ~p not ok",[Sz])
- end
+ simple_exec_group(Sz, Config),
+ ct:log("Size ~p ok",[Sz])
end, Sizes),
ct:comment("~p",[lists:map(fun({_,I,_}) -> I;
(I) -> I
@@ -317,18 +318,13 @@ concat(A1, A2) -> list_to_atom(lists:concat([A1," + ",A2])).
split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")).
-specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos) ->
+specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) ->
[simple_exec, simple_sftp] ++
case supports(Tag, Alg, SshcAlgos) of
- true ->
- case ssh_test_lib:ssh_type() of
- openSSH ->
- [sshc_simple_exec_os_cmd];
- _ ->
- []
- end;
- false ->
- []
+ true when TypeSSH == openSSH ->
+ [sshc_simple_exec_os_cmd];
+ _ ->
+ []
end ++
case supports(Tag, Alg, SshdAlgos) of
true ->
diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl
index c2bfc48449..c5a6447839 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE.erl
+++ b/lib/ssh/test/ssh_benchmark_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]},
- {timetrap,{minutes,3}}
+ {timetrap,{minutes,6}}
].
%%suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl
index 8f060bebd8..d07c596411 100644
--- a/lib/ssh/test/ssh_options_SUITE.erl
+++ b/lib/ssh/test/ssh_options_SUITE.erl
@@ -67,7 +67,8 @@
hostkey_fingerprint_check_sha/1,
hostkey_fingerprint_check_sha256/1,
hostkey_fingerprint_check_sha384/1,
- hostkey_fingerprint_check_sha512/1
+ hostkey_fingerprint_check_sha512/1,
+ hostkey_fingerprint_check_list/1
]).
%%% Common test callbacks
@@ -112,6 +113,7 @@ all() ->
hostkey_fingerprint_check_sha256,
hostkey_fingerprint_check_sha384,
hostkey_fingerprint_check_sha512,
+ hostkey_fingerprint_check_list,
id_string_no_opt_client,
id_string_own_string_client,
id_string_random_client,
@@ -812,6 +814,8 @@ hostkey_fingerprint_check_sha384(Config) ->
hostkey_fingerprint_check_sha512(Config) ->
do_hostkey_fingerprint_check(Config, sha512).
+hostkey_fingerprint_check_list(Config) ->
+ do_hostkey_fingerprint_check(Config, [sha,md5,sha256]).
%%%----
do_hostkey_fingerprint_check(Config, HashAlg) ->
@@ -824,20 +828,24 @@ do_hostkey_fingerprint_check(Config, HashAlg) ->
supported_hash(old) -> true;
supported_hash(HashAlg) ->
- proplists:get_value(HashAlg,
- proplists:get_value(hashs, crypto:supports(), []),
- false).
+ Hs = if is_atom(HashAlg) -> [HashAlg];
+ is_list(HashAlg) -> HashAlg
+ end,
+ [] == (Hs -- proplists:get_value(hashs, crypto:supports(), [])).
really_do_hostkey_fingerprint_check(Config, HashAlg) ->
PrivDir = proplists:get_value(priv_dir, Config),
- UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
- file:make_dir(UserDir),
+ UserDirServer = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDirServer),
SysDir = proplists:get_value(data_dir, Config),
+ UserDirClient =
+ ssh_test_lib:create_random_dir(Config), % Ensure no 'known_hosts' disturbs
+
%% All host key fingerprints. Trust that public_key has checked the ssh_hostkey_fingerprint
%% function since that function is used by the ssh client...
- FPs = [case HashAlg of
+ FPs0 = [case HashAlg of
old -> public_key:ssh_hostkey_fingerprint(Key);
_ -> public_key:ssh_hostkey_fingerprint(HashAlg, Key)
end
@@ -853,18 +861,25 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->
_:_ -> []
end
end],
+ FPs = if is_atom(HashAlg) -> FPs0;
+ is_list(HashAlg) -> lists:concat(FPs0)
+ end,
ct:log("Fingerprints(~p) = ~p",[HashAlg,FPs]),
%% Start daemon with the public keys that we got fingerprints from
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, UserDir},
+ {user_dir, UserDirServer},
{password, "morot"}]),
FP_check_fun = fun(PeerName, FP) ->
ct:pal("PeerName = ~p, FP = ~p",[PeerName,FP]),
HostCheck = (Host == PeerName),
- FPCheck = lists:member(FP, FPs),
- ct:log("check ~p == ~p (~p) and ~n~p in ~p (~p)~n",
+ FPCheck =
+ if is_atom(HashAlg) -> lists:member(FP, FPs);
+ is_list(HashAlg) -> lists:all(fun(FP1) -> lists:member(FP1,FPs) end,
+ FP)
+ end,
+ ct:log("check ~p == ~p (~p) and ~n~p~n in ~p (~p)~n",
[PeerName,Host,HostCheck,FP,FPs,FPCheck]),
HostCheck and FPCheck
end,
@@ -876,7 +891,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) ->
end},
{user, "foo"},
{password, "morot"},
- {user_dir, UserDir},
+ {user_dir, UserDirClient},
{user_interaction, false}]),
ssh:stop_daemon(Pid).
diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl
index 7ba2732a88..9b2a84d8e4 100644
--- a/lib/ssh/test/ssh_property_test_SUITE.erl
+++ b/lib/ssh/test/ssh_property_test_SUITE.erl
@@ -68,9 +68,6 @@ init_per_group(_, Config) ->
end_per_group(_, Config) ->
Config.
-%%% Always skip the testcase that is not quite in phase with the
-%%% ssh_message.erl code
-init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"};
init_per_testcase(_TestCase, Config) -> Config.
end_per_testcase(_TestCase, Config) -> Config.
diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index 93d0bc2eb0..f9edc5bfc2 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -107,7 +107,10 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ;
TC == gex_client_old_request_noexact ->
Opts = case TC of
gex_client_init_option_groups ->
- [{dh_gex_groups, [{2345, 3, 41}]}];
+ [{dh_gex_groups,
+ [{1023, 5,
+ 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F
+ }]}];
gex_client_init_option_groups_file ->
DataDir = proplists:get_value(data_dir, Config),
F = filename:join(DataDir, "dh_group_test"),
@@ -119,10 +122,12 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ;
_ when TC == gex_server_gex_limit ;
TC == gex_client_old_request_exact ;
TC == gex_client_old_request_noexact ->
- [{dh_gex_groups, [{ 500, 3, 17},
- {1000, 7, 91},
- {3000, 5, 61}]},
- {dh_gex_limits,{500,1500}}
+ [{dh_gex_groups,
+ [{1023, 2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323},
+ {1535, 5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827},
+ {3071, 2, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9429825A2B}
+ ]},
+ {dh_gex_limits, {1023,2000}}
];
_ ->
[]
@@ -351,20 +356,25 @@ no_common_alg_client_disconnects(Config) ->
%%%--------------------------------------------------------------------
gex_client_init_option_groups(Config) ->
- do_gex_client_init(Config, {2000, 2048, 4000},
- {3,41}).
+ do_gex_client_init(Config, {512, 2048, 4000},
+ {5,16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F}
+ ).
gex_client_init_option_groups_file(Config) ->
do_gex_client_init(Config, {2000, 2048, 4000},
- {5,61}).
+ {5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F}
+ ).
gex_client_init_option_groups_moduli_file(Config) ->
do_gex_client_init(Config, {2000, 2048, 4000},
- {5,16#B7}).
+ {5, 16#DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F}
+ ).
gex_server_gex_limit(Config) ->
do_gex_client_init(Config, {1000, 3000, 4000},
- {7,91}).
+ %% {7,91}).
+ {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827}
+ ).
do_gex_client_init(Config, {Min,N,Max}, {G,P}) ->
@@ -390,8 +400,15 @@ do_gex_client_init(Config, {Min,N,Max}, {G,P}) ->
).
%%%--------------------------------------------------------------------
-gex_client_old_request_exact(Config) -> do_gex_client_init_old(Config, 500, {3,17}).
-gex_client_old_request_noexact(Config) -> do_gex_client_init_old(Config, 800, {7,91}).
+gex_client_old_request_exact(Config) ->
+ do_gex_client_init_old(Config, 1023,
+ {2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323}
+ ).
+
+gex_client_old_request_noexact(Config) ->
+ do_gex_client_init_old(Config, 1400,
+ {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827}
+ ).
do_gex_client_init_old(Config, N, {G,P}) ->
{ok,_} =
diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
index 2887bb4b60..87c4b4afc8 100644
--- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
+++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
@@ -1,3 +1,3 @@
-{2222, 5, 61}.
-{1111, 7, 91}.
+{1023, 5, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F}.
+{3071, 5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F}.
diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli
index f6995ba4c9..6d2b4bcb59 100644
--- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli
+++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli
@@ -1,3 +1,2 @@
-20151021104105 2 6 100 2222 5 B7
-20151021104106 2 6 100 1111 5 4F
-
+20120821044046 2 6 100 1023 2 D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A7711F2C6B
+20120821050554 2 6 100 2047 5 DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F
diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl
index 70662f5d93..acf76157a2 100644
--- a/lib/ssh/test/ssh_sftp_SUITE.erl
+++ b/lib/ssh/test/ssh_sftp_SUITE.erl
@@ -1038,7 +1038,7 @@ oldprep(Config) ->
prepare(Config0) ->
PrivDir = proplists:get_value(priv_dir, Config0),
- Dir = filename:join(PrivDir, random_chars(10)),
+ Dir = filename:join(PrivDir, ssh_test_lib:random_chars(10)),
file:make_dir(Dir),
Keys = [filename,
testfile,
@@ -1058,8 +1058,6 @@ prepare(Config0) ->
[{sftp_priv_dir,Dir} | Config2].
-random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)].
-
foldl_keydelete(Keys, L) ->
lists:foldl(fun(K,E) -> lists:keydelete(K,1,E) end,
L,
diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl
index 52a26110c4..6d18a980ee 100644
--- a/lib/ssh/test/ssh_sftpd_SUITE.erl
+++ b/lib/ssh/test/ssh_sftpd_SUITE.erl
@@ -65,7 +65,12 @@ all() ->
ver3_open_flags,
relpath,
sshd_read_file,
- ver6_basic].
+ ver6_basic,
+ access_outside_root,
+ root_with_cwd,
+ relative_path,
+ open_file_dir_v5,
+ open_file_dir_v6].
groups() ->
[].
@@ -117,6 +122,31 @@ init_per_testcase(TestCase, Config) ->
ver6_basic ->
SubSystems = [ssh_sftpd:subsystem_spec([{sftpd_vsn, 6}])],
ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ access_outside_root ->
+ %% Build RootDir/access_outside_root/a/b and set Root and CWD
+ BaseDir = filename:join(PrivDir, access_outside_root),
+ RootDir = filename:join(BaseDir, a),
+ CWD = filename:join(RootDir, b),
+ %% Make the directory chain:
+ ok = filelib:ensure_dir(filename:join(CWD, tmp)),
+ SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir},
+ {cwd, CWD}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ root_with_cwd ->
+ RootDir = filename:join(PrivDir, root_with_cwd),
+ CWD = filename:join(RootDir, home),
+ SubSystems = [ssh_sftpd:subsystem_spec([{root, RootDir}, {cwd, CWD}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ relative_path ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ open_file_dir_v5 ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
+ open_file_dir_v6 ->
+ SubSystems = [ssh_sftpd:subsystem_spec([{cwd, PrivDir},
+ {sftpd_vsn, 6}])],
+ ssh:daemon(0, [{subsystems, SubSystems}|Options]);
_ ->
SubSystems = [ssh_sftpd:subsystem_spec([])],
ssh:daemon(0, [{subsystems, SubSystems}|Options])
@@ -646,6 +676,133 @@ ver6_basic(Config) when is_list(Config) ->
open_file(PrivDir, Cm, Channel, ReqId,
?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+access_outside_root() ->
+ [{doc, "Try access files outside the tree below RootDir"}].
+access_outside_root(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ BaseDir = filename:join(PrivDir, access_outside_root),
+ %% A file outside the tree below RootDir which is BaseDir/a
+ %% Make the file BaseDir/bad :
+ BadFilePath = filename:join([BaseDir, bad]),
+ ok = file:write_file(BadFilePath, <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ %% Try to access a file parallell to the RootDir:
+ try_access("/../bad", Cm, Channel, 0),
+ %% Try to access the same file via the CWD which is /b relative to the RootDir:
+ try_access("../../bad", Cm, Channel, 1).
+
+
+try_access(Path, Cm, Channel, ReqId) ->
+ Return =
+ open_file(Path, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ct:log("Try open ~p -> ~p",[Path,Return]),
+ case Return of
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle0/binary>>, _} ->
+ ct:fail("Could open a file outside the root tree!");
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(Code), Rest/binary>>, <<>>} ->
+ case Code of
+ ?SSH_FX_FILE_IS_A_DIRECTORY ->
+ ct:pal("Got the expected SSH_FX_FILE_IS_A_DIRECTORY status",[]),
+ ok;
+ ?SSH_FX_FAILURE ->
+ ct:pal("Got the expected SSH_FX_FAILURE status",[]),
+ ok;
+ _ ->
+ case Rest of
+ <<?UINT32(Len), Txt:Len/binary, _/binary>> ->
+ ct:fail("Got unexpected SSH_FX_code: ~p (~p)",[Code,Txt]);
+ _ ->
+ ct:fail("Got unexpected SSH_FX_code: ~p",[Code])
+ end
+ end;
+ _ ->
+ ct:fail("Completly unexpected return: ~p", [Return])
+ end.
+
+%%--------------------------------------------------------------------
+root_with_cwd() ->
+ [{doc, "Check if files are found, if the CWD and Root are specified"}].
+root_with_cwd(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ RootDir = filename:join(PrivDir, root_with_cwd),
+ CWD = filename:join(RootDir, home),
+ FileName = "root_with_cwd.txt",
+ FilePath = filename:join(CWD, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:write_file(FilePath ++ "0", <<>>),
+ ok = file:write_file(FilePath ++ "1", <<>>),
+ ok = file:write_file(FilePath ++ "2", <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId0 = 0,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId0), _Handle0/binary>>, _} =
+ open_file(FileName ++ "0", Cm, Channel, ReqId0,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ReqId1 = 1,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId1), _Handle1/binary>>, _} =
+ open_file("./" ++ FileName ++ "1", Cm, Channel, ReqId1,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING),
+ ReqId2 = 2,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId2), _Handle2/binary>>, _} =
+ open_file("/home/" ++ FileName ++ "2", Cm, Channel, ReqId2,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+relative_path() ->
+ [{doc, "Test paths relative to CWD when opening a file handle."}].
+relative_path(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "test_relative_path.txt",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:write_file(FilePath, <<>>),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), _Handle/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+open_file_dir_v5() ->
+ [{doc, "Test if open_file fails when opening existing directory."}].
+open_file_dir_v5(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "open_file_dir_v5",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:make_dir(FilePath),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId),
+ ?UINT32(?SSH_FX_FAILURE), _/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
+%%--------------------------------------------------------------------
+open_file_dir_v6() ->
+ [{doc, "Test if open_file fails when opening existing directory."}].
+open_file_dir_v6(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ FileName = "open_file_dir_v6",
+ FilePath = filename:join(PrivDir, FileName),
+ ok = filelib:ensure_dir(FilePath),
+ ok = file:make_dir(FilePath),
+ {Cm, Channel} = proplists:get_value(sftp, Config),
+ ReqId = 0,
+ {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId),
+ ?UINT32(?SSH_FX_FILE_IS_A_DIRECTORY), _/binary>>, _} =
+ open_file(FileName, Cm, Channel, ReqId,
+ ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES,
+ ?SSH_FXF_OPEN_EXISTING).
+
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
@@ -688,9 +845,7 @@ reply(Cm, Channel, RBuf) ->
30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE])
end.
-
open_file(File, Cm, Channel, ReqId, Access, Flags) ->
-
Data = list_to_binary([?uint32(ReqId),
?binary(list_to_binary(File)),
?uint32(Access),
diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl
index f93237f3e7..1673f52821 100644
--- a/lib/ssh/test/ssh_test_lib.erl
+++ b/lib/ssh/test/ssh_test_lib.erl
@@ -113,19 +113,27 @@ std_simple_exec(Host, Port, Config) ->
std_simple_exec(Host, Port, Config, []).
std_simple_exec(Host, Port, Config, Opts) ->
+ ct:log("~p:~p std_simple_exec",[?MODULE,?LINE]),
ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts),
+ ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]),
{ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
- success = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity),
- Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"42\n">>}},
- case ssh_test_lib:receive_exec_result(Data) of
- expected ->
- ok;
- Other ->
- ct:fail(Other)
- end,
- ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId),
- ssh:close(ConnectionRef).
-
+ ct:log("~p:~p session_channel ok ~p",[?MODULE,?LINE,ChannelId]),
+ ExecResult = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity),
+ ct:log("~p:~p exec ~p",[?MODULE,?LINE,ExecResult]),
+ case ExecResult of
+ success ->
+ Expected = {ssh_cm, ConnectionRef, {data,ChannelId,0,<<"42\n">>}},
+ case receive_exec_result(Expected) of
+ expected ->
+ ok;
+ Other ->
+ ct:fail(Other)
+ end,
+ receive_exec_end(ConnectionRef, ChannelId),
+ ssh:close(ConnectionRef);
+ _ ->
+ ct:fail(ExecResult)
+ end.
start_shell(Port, IOServer) ->
start_shell(Port, IOServer, []).
@@ -682,13 +690,16 @@ ssh_type() ->
ssh_type1() ->
try
+ ct:log("~p:~p os:find_executable(\"ssh\")",[?MODULE,?LINE]),
case os:find_executable("ssh") of
false ->
ct:log("~p:~p Executable \"ssh\" not found",[?MODULE,?LINE]),
not_found;
- _ ->
+ Path ->
+ ct:log("~p:~p Found \"ssh\" at ~p",[?MODULE,?LINE,Path]),
case os:cmd("ssh -V") of
- "OpenSSH" ++ _ ->
+ Version = "OpenSSH" ++ _ ->
+ ct:log("~p:~p Found OpenSSH ~p",[?MODULE,?LINE,Version]),
openSSH;
Str ->
ct:log("ssh client ~p is unknown",[Str]),
@@ -834,3 +845,20 @@ get_kex_init(Conn, Ref, TRef) ->
end
end.
+%%%----------------------------------------------------------------
+%%% Return a string with N random characters
+%%%
+random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)].
+
+
+create_random_dir(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Name = filename:join(PrivDir, random_chars(15)),
+ case file:make_dir(Name) of
+ ok ->
+ Name;
+ {error,eexist} ->
+ %% The Name already denotes an existing file system object, try again.
+ %% The likelyhood of always generating an existing file name is low
+ create_random_dir(Config)
+ end.
diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl
index 86c3d5de26..0b9b7acde8 100644
--- a/lib/ssh/test/ssh_to_openssh_SUITE.erl
+++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl
@@ -36,7 +36,7 @@
%%--------------------------------------------------------------------
suite() ->
- [{timetrap,{seconds,20}}].
+ [{timetrap,{seconds,60}}].
all() ->
case os:find_executable("ssh") of
@@ -464,6 +464,7 @@ erlang_client_openssh_server_renegotiate(_Config) ->
{silently_accept_hosts,true}],
group_leader(IO, self()),
{ok, ConnRef} = ssh:connect(Host, ?SSH_DEFAULT_PORT, Options),
+ ct:pal("Parent = ~p, IO = ~p, Shell = ~p, ConnRef = ~p~n",[Parent, IO, self(), ConnRef]),
case ssh_connection:session_channel(ConnRef, infinity) of
{ok,ChannelId} ->
success = ssh_connection:ptty_alloc(ConnRef, ChannelId, []),
diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl
index b5b27c369a..7b9b109fa1 100644
--- a/lib/ssh/test/ssh_upgrade_SUITE.erl
+++ b/lib/ssh/test/ssh_upgrade_SUITE.erl
@@ -199,6 +199,4 @@ close(#state{server = Server,
connection = undefined}.
-random_contents() -> list_to_binary( random_chars(3) ).
-
-random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)].
+random_contents() -> list_to_binary( ssh_test_lib:random_chars(3) ).
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index edc7e0d8b2..916b41742e 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -424,6 +424,14 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid
</taglist>
</item>
+
+ <tag><c>max_handshake_size</c></tag>
+ <item>
+ <p>Integer (24 bits unsigned). Used to limit the size of
+ valid TLS handshake packets to avoid DoS attacks.
+ Defaults to 256*1024.</p>
+ </item>
+
</taglist>
</item>
diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml
index b85d8fb284..1b41eae89d 100644
--- a/lib/ssl/doc/src/ssl_session_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_session_cache_api.xml
@@ -11,7 +11,7 @@
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
-
+
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
@@ -62,8 +62,8 @@
</taglist>
</section>
-
- <funcs>
+
+ <funcs>
<func>
<name>delete(Cache, Key) -> _</name>
@@ -134,7 +134,7 @@
</p>
</desc>
</func>
-
+
<func>
<name>select_session(Cache, PartialKey) -> [session()]</name>
<fsummary>Selects sessions that can be reused.</fsummary>
@@ -151,6 +151,21 @@
</func>
<func>
+ <name>size(Cache) -> integer()</name>
+ <fsummary>Returns the number of sessions in the cache.</fsummary>
+ <type>
+ <v>Cache = cache_ref()</v>
+ </type>
+ <desc>
+ <p>Returns the number of sessions in the cache. If size
+ exceeds the maximum number of sessions, the current cache
+ entries will be invalidated regardless of their remaining
+ lifetime. Is to be callable from any process.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name>terminate(Cache) -> _</name>
<fsummary>Called by the process that handles the cache when it
is about to terminate.</fsummary>
@@ -178,7 +193,7 @@
</p>
</desc>
</func>
-
- </funcs>
-
+
+ </funcs>
+
</erlref>
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 3dda1a3316..2e7df9792e 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -48,9 +48,17 @@ MODULES= \
dtls \
ssl_alert \
ssl_app \
- ssl_dist_sup\
ssl_sup \
+ ssl_admin_sup\
+ tls_connection_sup \
+ ssl_connection_sup \
+ ssl_listen_tracker_sup\
+ dtls_connection_sup \
+ dtls_udp_listener\
dtls_udp_sup \
+ ssl_dist_sup\
+ ssl_dist_admin_sup\
+ ssl_dist_connection_sup\
inet_tls_dist \
inet6_tls_dist \
ssl_certificate\
@@ -61,21 +69,18 @@ MODULES= \
dtls_connection \
ssl_config \
ssl_connection \
- tls_connection_sup \
- dtls_connection_sup \
tls_handshake \
dtls_handshake\
ssl_handshake\
ssl_manager \
ssl_session \
ssl_session_cache \
+ ssl_pem_cache \
ssl_crl\
ssl_crl_cache \
ssl_crl_hash_dir \
tls_socket \
dtls_socket \
- dtls_udp_listener\
- 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 070a90d481..f607c86ae3 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -39,7 +39,7 @@
-export([start_fsm/8, start_link/7, init/1]).
%% State transition handling
--export([next_record/1, next_event/3]).
+-export([next_record/1, next_event/3, next_event/4]).
%% Handshake handling
-export([renegotiate/2,
@@ -53,7 +53,7 @@
%% Data handling
-export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4,
- send/3]).
+ send/3, socket/5]).
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
@@ -77,20 +77,6 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker}
catch
error:{badmatch, {error, _} = Error} ->
Error
- end;
-
-start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts,
- User, {CbModule, _,_, _} = CbInfo,
- Timeout) ->
- try
- {ok, Pid} = dtls_connection_sup:start_child_dist([Role, Host, Port, Socket,
- Opts, User, CbInfo]),
- {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker),
- ok = ssl_connection:handshake(SslSocket, Timeout),
- {ok, SslSocket}
- catch
- error:{badmatch, {error, _} = Error} ->
- Error
end.
send_handshake(Handshake, #state{connection_states = ConnectionStates} = States) ->
@@ -201,6 +187,7 @@ reinit_handshake_data(#state{protocol_buffers = Buffers} = State) ->
State#state{premaster_secret = undefined,
public_key_info = undefined,
tls_handshake_history = ssl_handshake:init_handshake_history(),
+ flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT},
protocol_buffers =
Buffers#protocol_buffers{
dtls_handshake_next_seq = 0,
@@ -213,6 +200,9 @@ select_sni_extension(#client_hello{extensions = HelloExtensions}) ->
select_sni_extension(_) ->
undefined.
+socket(Pid, Transport, Socket, Connection, _) ->
+ dtls_socket:socket(Pid, Transport, Socket, Connection).
+
%%====================================================================
%% tls_connection_sup API
%%====================================================================
@@ -243,7 +233,7 @@ callback_mode() ->
state_functions.
%%--------------------------------------------------------------------
-%% State functionsconnection/2
+%% State functions
%%--------------------------------------------------------------------
init({call, From}, {start, Timeout},
@@ -262,17 +252,19 @@ init({call, From}, {start, Timeout},
Version = Hello#client_hello.client_version,
HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions),
State1 = prepare_flight(State0#state{negotiated_version = Version}),
- State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
+ {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
State3 = State2#state{negotiated_version = Version, %% Requested version
session =
Session0#session{session_id = Hello#client_hello.session_id},
start_or_recv_from = From,
- timer = Timer},
+ timer = Timer,
+ flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}
+ },
{Record, State} = next_record(State3),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) ->
ssl_connection:init(Type, Event,
- State#state{flight_state = {waiting, undefined, ?INITIAL_RETRANSMIT_TIMEOUT}},
+ State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}},
?MODULE);
init({call, _} = Type, Event, #state{role = server} = State) ->
%% I.E. DTLS over sctp
@@ -302,9 +294,9 @@ hello(internal, #client_hello{cookie = <<>>,
Cookie = dtls_handshake:cookie(<<"secret">>, IP, Port, Hello),
VerifyRequest = dtls_handshake:hello_verify_request(Cookie, Version),
State1 = prepare_flight(State0#state{negotiated_version = Version}),
- State2 = send_handshake(VerifyRequest, State1),
+ {State2, Actions} = send_handshake(VerifyRequest, State1),
{Record, State} = next_record(State2),
- next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()});
+ next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions);
hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server,
transport_cb = Transport,
socket = Socket} = State0) ->
@@ -333,13 +325,13 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client,
Cache, CacheCb, Renegotiation, OwnCert),
Version = Hello#client_hello.client_version,
HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions),
- State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
+ {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
State3 = State2#state{negotiated_version = Version, %% Requested version
session =
Session0#session{session_id =
Hello#client_hello.session_id}},
{Record, State} = next_record(State3),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
hello(internal, #server_hello{} = Hello,
#state{connection_states = ConnectionStates0,
negotiated_version = ReqVersion,
@@ -356,13 +348,13 @@ hello(internal, #server_hello{} = Hello,
hello(internal, {handshake, {#client_hello{cookie = <<>>} = Handshake, _}}, State) ->
%% Initial hello should not be in handshake history
{next_state, hello, State, [{next_event, internal, Handshake}]};
-
hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) ->
%% hello_verify should not be in handshake history
{next_state, hello, State, [{next_event, internal, Handshake}]};
-
hello(info, Event, State) ->
handle_info(Event, hello, State);
+hello(state_timeout, Event, State) ->
+ handle_state_timeout(Event, hello, State);
hello(Type, Event, State) ->
ssl_connection:hello(Type, Event, State, ?MODULE).
@@ -375,7 +367,11 @@ abbreviated(internal = Type,
ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read),
ssl_connection:abbreviated(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE);
abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) ->
- ssl_connection:cipher(Type, Event, prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE);
+ ssl_connection:abbreviated(Type, Event,
+ prepare_flight(State#state{connection_states = ConnectionStates,
+ flight_state = connection}), ?MODULE);
+abbreviated(state_timeout, Event, State) ->
+ handle_state_timeout(Event, abbreviated, State);
abbreviated(Type, Event, State) ->
ssl_connection:abbreviated(Type, Event, State, ?MODULE).
@@ -383,6 +379,8 @@ certify(info, Event, State) ->
handle_info(Event, certify, State);
certify(internal = Type, #server_hello_done{} = Event, State) ->
ssl_connection:certify(Type, Event, prepare_flight(State), ?MODULE);
+certify(state_timeout, Event, State) ->
+ handle_state_timeout(Event, certify, State);
certify(Type, Event, State) ->
ssl_connection:certify(Type, Event, State, ?MODULE).
@@ -395,7 +393,11 @@ cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event,
ssl_connection:cipher(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE);
cipher(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) ->
ssl_connection:cipher(Type, Event,
- prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE);
+ prepare_flight(State#state{connection_states = ConnectionStates,
+ flight_state = connection}),
+ ?MODULE);
+cipher(state_timeout, Event, State) ->
+ handle_state_timeout(Event, cipher, State);
cipher(Type, Event, State) ->
ssl_connection:cipher(Type, Event, State, ?MODULE).
@@ -409,12 +411,12 @@ connection(internal, #hello_request{}, #state{host = Host, port = Port,
renegotiation = {Renegotiation, _}} = State0) ->
Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert),
- State1 = send_handshake(Hello, State0),
+ {State1, Actions} = send_handshake(Hello, State0),
{Record, State} =
next_record(
State1#state{session = Session0#session{session_id
= Hello#client_hello.session_id}}),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) ->
%% Mitigate Computational DoS attack
%% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html
@@ -434,7 +436,6 @@ connection(Type, Event, State) ->
downgrade(Type, Event, State) ->
ssl_connection:downgrade(Type, Event, State, ?MODULE).
-
%%--------------------------------------------------------------------
%% Description: This function is called by a gen_fsm when it receives any
%% other message than a synchronous or asynchronous event
@@ -442,16 +443,6 @@ downgrade(Type, Event, State) ->
%%--------------------------------------------------------------------
%% raw data from socket, unpack records
-handle_info({_,flight_retransmission_timeout}, connection, _) ->
- {next_state, keep_state_and_data};
-handle_info({Ref, flight_retransmission_timeout}, StateName,
- #state{flight_state = {waiting, Ref, NextTimeout}} = State0) ->
- State1 = send_handshake_flight(State0#state{flight_state = {retransmit_timer, NextTimeout}},
- retransmit_epoch(StateName, State0)),
- {Record, State} = next_record(State1),
- next_event(StateName, Record, State);
-handle_info({_, flight_retransmission_timeout}, _, _) ->
- {next_state, keep_state_and_data};
handle_info({Protocol, _, _, _, Data}, StateName,
#state{data_tag = Protocol} = State0) ->
case next_dtls_record(Data, State0) of
@@ -489,7 +480,6 @@ handle_call(Event, From, StateName, State) ->
handle_common_event(internal, #alert{} = Alert, StateName,
#state{negotiated_version = Version} = State) ->
ssl_connection:handle_own_alert(Alert, Version, StateName, State);
-
%%% DTLS record protocol level handshake messages
handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE,
fragment = Data},
@@ -498,19 +488,14 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE,
negotiated_version = Version} = State0) ->
try
case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of
- {more_data, Buffers} ->
+ {[], Buffers} ->
{Record, State} = next_record(State0#state{protocol_buffers = Buffers}),
next_event(StateName, Record, State);
{Packets, Buffers} ->
State = State0#state{protocol_buffers = Buffers},
Events = dtls_handshake_events(Packets),
- case StateName of
- connection ->
- ssl_connection:hibernate_after(StateName, State, Events);
- _ ->
- {next_state, StateName,
- State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
- end
+ {next_state, StateName,
+ State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
end
catch throw:#alert{} = Alert ->
ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
@@ -534,6 +519,13 @@ handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, Sta
handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) ->
{next_state, StateName, State}.
+handle_state_timeout(flight_retransmission_timeout, StateName,
+ #state{flight_state = {retransmit, NextTimeout}} = State0) ->
+ {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}},
+ retransmit_epoch(StateName, State0)),
+ {Record, State} = next_record(State1),
+ next_event(StateName, Record, State, Actions).
+
send(Transport, {_, {{_,_}, _} = Socket}, Data) ->
send(Transport, Socket, Data);
send(Transport, Socket, Data) ->
@@ -645,7 +637,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User,
allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
start_or_recv_from = undefined,
protocol_cb = ?MODULE,
- flight_buffer = new_flight()
+ flight_buffer = new_flight(),
+ flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}
}.
next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{
@@ -714,14 +707,14 @@ next_event(connection = StateName, no_record,
#state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
case next_record_if_active(State0) of
{no_record, State} ->
- ssl_connection:hibernate_after(StateName, State, Actions);
+ ssl_connection:hibernate_after(StateName, State, Actions);
{#ssl_tls{epoch = CurrentEpoch} = Record, State} ->
{next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
{#ssl_tls{epoch = Epoch,
type = ?HANDSHAKE,
version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
- State = send_handshake_flight(State1, Epoch),
- {next_state, StateName, State, Actions};
+ {State, MoreActions} = send_handshake_flight(State1, Epoch),
+ {next_state, StateName, State, Actions ++ MoreActions};
{#ssl_tls{epoch = _Epoch,
version = _Version}, State} ->
%% TODO maybe buffer later epoch
@@ -772,17 +765,20 @@ next_flight(Flight) ->
Flight#{handshakes => [],
change_cipher_spec => undefined,
handshakes_after_change_cipher_spec => []}.
-
start_flight(#state{transport_cb = gen_udp,
- flight_state = {retransmit_timer, Timeout}} = State) ->
- Ref = erlang:make_ref(),
- _ = erlang:send_after(Timeout, self(), {Ref, flight_retransmission_timeout}),
- State#state{flight_state = {waiting, Ref, new_timeout(Timeout)}};
-
+ flight_state = {retransmit, Timeout}} = State) ->
+ start_retransmision_timer(Timeout, State);
+start_flight(#state{transport_cb = gen_udp,
+ flight_state = connection} = State) ->
+ {State, []};
start_flight(State) ->
%% No retransmision needed i.e DTLS over SCTP
- State#state{flight_state = reliable}.
+ {State#state{flight_state = reliable}, []}.
+
+start_retransmision_timer(Timeout, State) ->
+ {State#state{flight_state = {retransmit, new_timeout(Timeout)}},
+ [{state_timeout, Timeout, flight_retransmission_timeout}]}.
new_timeout(N) when N =< 30 ->
N * 2;
@@ -806,13 +802,13 @@ renegotiate(#state{role = server,
connection_states = CS0} = State0, Actions) ->
HelloRequest = ssl_handshake:hello_request(),
CS = CS0#{write_msg_seq => 0},
- State1 = send_handshake(HelloRequest,
- State0#state{connection_states =
- CS}),
+ {State1, MoreActions} = send_handshake(HelloRequest,
+ State0#state{connection_states =
+ CS}),
Hs0 = ssl_handshake:init_handshake_history(),
{Record, State} = next_record(State1#state{tls_handshake_history = Hs0,
protocol_buffers = #protocol_buffers{}}),
- next_event(hello, Record, State, Actions).
+ next_event(hello, Record, State, Actions ++ MoreActions).
handle_alerts([], Result) ->
Result;
@@ -823,15 +819,11 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) ->
handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)).
-retransmit_epoch(StateName, #state{connection_states = ConnectionStates}) ->
+retransmit_epoch(_StateName, #state{connection_states = ConnectionStates}) ->
#{epoch := Epoch} =
ssl_record:current_connection_state(ConnectionStates, write),
- case StateName of
- connection ->
- Epoch-1;
- _ ->
- Epoch
- end.
+ Epoch.
+
update_handshake_history(#hello_verify_request{}, _, Hist) ->
Hist;
@@ -846,3 +838,4 @@ unprocessed_events(Events) ->
%% handshake events left to process before we should
%% process more TLS-records received on the socket.
erlang:length(Events)-1.
+
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
index af3708ddb7..fd1f9698fe 100644
--- a/lib/ssl/src/dtls_handshake.erl
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -136,9 +136,11 @@ handshake_bin([Type, Length, Data], Seq) ->
%%--------------------------------------------------------------------
-spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) ->
- {[{dtls_handshake(), binary()}], #protocol_buffers{}} | {more_data, #protocol_buffers{}}.
+ {[dtls_handshake()], #protocol_buffers{}}.
%%
-%% Description: ...
+%% Description: Given buffered and new data from dtls_record, collects
+%% and returns it as a list of handshake messages, also returns
+%% possible leftover data in the new "protocol_buffers".
%%--------------------------------------------------------------------
get_dtls_handshake(Version, Fragment, ProtocolBuffers) ->
handle_fragments(Version, Fragment, ProtocolBuffers, []).
@@ -288,8 +290,6 @@ do_handle_fragments(_, [], Buffers, Acc) ->
{lists:reverse(Acc), Buffers};
do_handle_fragments(Version, [Fragment | Fragments], Buffers0, Acc) ->
case reassemble(Version, Fragment, Buffers0) of
- {more_data, _} = More when Acc == []->
- More;
{more_data, Buffers} when Fragments == [] ->
{lists:reverse(Acc), Buffers};
{more_data, Buffers} ->
diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl
index 570b3ae83a..ac1a7b37c6 100644
--- a/lib/ssl/src/dtls_socket.erl
+++ b/lib/ssl/src/dtls_socket.erl
@@ -71,11 +71,14 @@ connect(Address, Port, #config{transport_info = {Transport, _, _, _} = CbInfo,
close(gen_udp, {_Client, _Socket}) ->
ok.
+socket(Pid, gen_udp = Transport, {{_, _}, Socket}, ConnectionCb) ->
+ #sslsocket{pid = Pid,
+ %% "The name "fd" is keept for backwards compatibility
+ fd = {Transport, Socket, ConnectionCb}};
socket(Pid, Transport, Socket, ConnectionCb) ->
#sslsocket{pid = Pid,
%% "The name "fd" is keept for backwards compatibility
- fd = {Transport, Socket, ConnectionCb}}.
-
+ fd = {Transport, Socket, ConnectionCb}}.
%% Vad göra med emulerade
setopts(gen_udp, #sslsocket{pid = {Socket, _}}, Options) ->
{SockOpts, _} = tls_socket:split_options(Options),
@@ -108,11 +111,15 @@ getstat(gen_udp, {_,Socket}, Options) ->
inet:getstat(Socket, Options);
getstat(Transport, Socket, Options) ->
Transport:getstat(Socket, Options).
+peername(udp, _) ->
+ {error, enotconn};
peername(gen_udp, {_, {Client, _Socket}}) ->
{ok, Client};
peername(Transport, Socket) ->
Transport:peername(Socket).
-sockname(gen_udp, {_,Socket}) ->
+sockname(gen_udp, {_, {_,Socket}}) ->
+ inet:sockname(Socket);
+sockname(gen_udp, Socket) ->
inet:sockname(Socket);
sockname(Transport, Socket) ->
Transport:sockname(Socket).
diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl
index b7f115582e..ab3d0783bd 100644
--- a/lib/ssl/src/dtls_udp_listener.erl
+++ b/lib/ssl/src/dtls_udp_listener.erl
@@ -24,7 +24,8 @@
-behaviour(gen_server).
%% API
--export([start_link/4, active_once/3, accept/2, sockname/1]).
+-export([start_link/4, active_once/3, accept/2, sockname/1, close/1,
+ get_all_opts/1]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
@@ -39,7 +40,8 @@
clients = set_new(),
dtls_processes = kv_new(),
accepters = queue:new(),
- first
+ first,
+ close
}).
%%%===================================================================
@@ -53,10 +55,14 @@ active_once(UDPConnection, Client, Pid) ->
gen_server:cast(UDPConnection, {active_once, Client, Pid}).
accept(UDPConnection, Accepter) ->
- gen_server:call(UDPConnection, {accept, Accepter}, infinity).
+ call(UDPConnection, {accept, Accepter}).
sockname(UDPConnection) ->
- gen_server:call(UDPConnection, sockname, infinity).
+ call(UDPConnection, sockname).
+close(UDPConnection) ->
+ call(UDPConnection, close).
+get_all_opts(UDPConnection) ->
+ call(UDPConnection, get_all_opts).
%%%===================================================================
%%% gen_server callbacks
@@ -69,10 +75,13 @@ init([Port, EmOpts, InetOptions, DTLSOptions]) ->
first = true,
dtls_options = DTLSOptions,
emulated_options = EmOpts,
- listner = Socket}}
+ listner = Socket,
+ close = false}}
catch _:_ ->
{error, closed}
end.
+handle_call({accept, _}, _, #state{close = true} = State) ->
+ {reply, {error, closed}, State};
handle_call({accept, Accepter}, From, #state{first = true,
accepters = Accepters,
@@ -87,7 +96,21 @@ handle_call({accept, Accepter}, From, #state{accepters = Accepters} = State0) ->
{noreply, State};
handle_call(sockname, _, #state{listner = Socket} = State) ->
Reply = inet:sockname(Socket),
- {reply, Reply, State}.
+ {reply, Reply, State};
+handle_call(close, _, #state{dtls_processes = Processes,
+ accepters = Accepters} = State) ->
+ case kv_empty(Processes) of
+ true ->
+ {stop, normal, ok, State#state{close=true}};
+ false ->
+ lists:foreach(fun({_, From}) ->
+ gen_server:reply(From, {error, closed})
+ end, queue:to_list(Accepters)),
+ {reply, ok, State#state{close = true, accepters = queue:new()}}
+ end;
+handle_call(get_all_opts, _, #state{dtls_options = DTLSOptions,
+ emulated_options = EmOpts} = State) ->
+ {reply, {ok, EmOpts, DTLSOptions}, State}.
handle_cast({active_once, Client, Pid}, State0) ->
State = handle_active_once(Client, Pid, State0),
@@ -99,11 +122,17 @@ handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = Sta
{noreply, State};
handle_info({'DOWN', _, process, Pid, _}, #state{clients = Clients,
- dtls_processes = Processes0} = State) ->
+ dtls_processes = Processes0,
+ close = ListenClosed} = State) ->
Client = kv_get(Pid, Processes0),
Processes = kv_delete(Pid, Processes0),
- {noreply, State#state{clients = set_delete(Client, Clients),
- dtls_processes = Processes}}.
+ case ListenClosed andalso kv_empty(Processes) of
+ true ->
+ {stop, normal, State};
+ false ->
+ {noreply, State#state{clients = set_delete(Client, Clients),
+ dtls_processes = Processes}}
+ end.
terminate(_Reason, _State) ->
ok.
@@ -182,6 +211,7 @@ setup_new_connection(User, From, Client, Msg, #state{dtls_processes = Processes,
gen_server:reply(From, {error, Reason}),
State
end.
+
kv_update(Key, Value, Store) ->
gb_trees:update(Key, Value, Store).
kv_lookup(Key, Store) ->
@@ -194,6 +224,8 @@ kv_delete(Key, Store) ->
gb_trees:delete(Key, Store).
kv_new() ->
gb_trees:empty().
+kv_empty(Store) ->
+ gb_trees:is_empty(Store).
set_new() ->
gb_sets:empty().
@@ -203,3 +235,15 @@ set_delete(Item, Set) ->
gb_sets:delete(Item, Set).
set_is_member(Item, Set) ->
gb_sets:is_member(Item, Set).
+
+call(Server, Msg) ->
+ try
+ gen_server:call(Server, Msg, infinity)
+ catch
+ exit:{noproc, _} ->
+ {error, closed};
+ exit:{normal, _} ->
+ {error, closed};
+ exit:{{shutdown, _},_} ->
+ {error, closed}
+ end.
diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl
index ffd3e4b833..dd0d35d404 100644
--- a/lib/ssl/src/dtls_v1.erl
+++ b/lib/ssl/src/dtls_v1.erl
@@ -21,12 +21,21 @@
-include("ssl_cipher.hrl").
--export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1, corresponding_dtls_version/1]).
+-export([suites/1, all_suites/1, mac_hash/7, ecc_curves/1,
+ corresponding_tls_version/1, corresponding_dtls_version/1]).
-spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()].
suites(Minor) ->
- tls_v1:suites(corresponding_minor_tls_version(Minor)).
+ lists:filter(fun(Cipher) ->
+ is_acceptable_cipher(ssl_cipher:suite_definition(Cipher))
+ end,
+ tls_v1:suites(corresponding_minor_tls_version(Minor))).
+all_suites(Version) ->
+ lists:filter(fun(Cipher) ->
+ is_acceptable_cipher(ssl_cipher:suite_definition(Cipher))
+ end,
+ ssl_cipher:all_suites(corresponding_tls_version(Version))).
mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) ->
tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version,
@@ -50,3 +59,5 @@ corresponding_minor_dtls_version(2) ->
255;
corresponding_minor_dtls_version(3) ->
253.
+is_acceptable_cipher(Suite) ->
+ not ssl_cipher:is_stream_ciphersuite(Suite).
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index 9c5d795848..064dcd6892 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -10,12 +10,14 @@
tls_v1,
ssl_v3,
ssl_v2,
+ tls_connection_sup,
%% DTLS
dtls_connection,
dtls_handshake,
dtls_record,
dtls_socket,
dtls_v1,
+ dtls_connection_sup,
dtls_udp_listener,
dtls_udp_sup,
%% API
@@ -31,16 +33,19 @@
ssl_cipher,
ssl_srp_primes,
ssl_alert,
- ssl_listen_tracker_sup,
+ ssl_listen_tracker_sup, %% may be used by DTLS over SCTP
%% Erlang Distribution over SSL/TLS
inet_tls_dist,
inet6_tls_dist,
ssl_tls_dist_proxy,
ssl_dist_sup,
- %% SSL/TLS session handling
+ ssl_dist_connection_sup,
+ ssl_dist_admin_sup,
+ %% SSL/TLS session and cert handling
ssl_session,
ssl_session_cache,
ssl_manager,
+ ssl_pem_cache,
ssl_pkix_db,
ssl_certificate,
%% CRL handling
@@ -51,14 +56,14 @@
%% App structure
ssl_app,
ssl_sup,
- tls_connection_sup,
- dtls_connection_sup
+ ssl_admin_sup,
+ ssl_connection_sup
]},
{registered, [ssl_sup, ssl_manager]},
{applications, [crypto, public_key, kernel, stdlib]},
{env, []},
{mod, {ssl_app, []}},
- {runtime_dependencies, ["stdlib-3.1","public_key-1.2","kernel-3.0",
+ {runtime_dependencies, ["stdlib-3.2","public_key-1.2","kernel-3.0",
"erts-7.0","crypto-3.3", "inets-5.10.7"]}]}.
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index 32252386b4..bfdd0c205b 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,11 +1,19 @@
%% -*- erlang -*-
{"%VSN%",
[
- {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]},
- {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]}
+ {<<"8\\..*">>, [{restart_application, ssl}]},
+ {<<"7\\..*">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{restart_application, ssl}]},
+ {<<"4\\..*">>, [{restart_application, ssl}]},
+ {<<"3\\..*">>, [{restart_application, ssl}]}
],
[
- {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]},
- {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]}
- ]
+ {<<"8\\..*">>, [{restart_application, ssl}]},
+ {<<"7\\..*">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{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 c72ee44a95..ed04c7e67b 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -187,16 +187,24 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
ssl_accept(Socket, Timeout);
-ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when
+ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
try
- {ok, EmOpts, InheritedSslOpts} = tls_socket:get_all_opts(Tracker),
- SslOpts = handle_options(SslOpts0, InheritedSslOpts),
+ {ok, EmOpts, _} = tls_socket:get_all_opts(Tracker),
ssl_connection:handshake(Socket, {SslOpts,
tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout)
catch
Error = {error, _Reason} -> Error
end;
+ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when
+ (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
+ try
+ {ok, EmOpts, _} = dtls_udp_listener:get_all_opts(Pid),
+ ssl_connection:handshake(Socket, {SslOpts,
+ tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout)
+ catch
+ Error = {error, _Reason} -> Error
+ end;
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
{Transport,_,_,_} =
@@ -215,7 +223,6 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
catch
Error = {error, _Reason} -> Error
end.
-
%%--------------------------------------------------------------------
-spec close(#sslsocket{}) -> term().
%%
@@ -223,6 +230,8 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
%%--------------------------------------------------------------------
close(#sslsocket{pid = Pid}) when is_pid(Pid) ->
ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT});
+close(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) ->
+ dtls_udp_listener:close(Pid);
close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}) ->
Transport:close(ListenSocket).
@@ -251,6 +260,8 @@ send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) ->
ssl_connection:send(Pid, Data);
send(#sslsocket{pid = {_, #config{transport_info={gen_udp, _, _, _}}}}, _) ->
{error,enotconn}; %% Emulate connection behaviour
+send(#sslsocket{pid = {udp,_}}, _) ->
+ {error,enotconn};
send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}}}}, Data) ->
Transport:send(ListenSocket, Data). %% {error,enotconn}
@@ -265,6 +276,8 @@ recv(Socket, Length) ->
recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid),
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
ssl_connection:recv(Pid, Length, Timeout);
+recv(#sslsocket{pid = {udp,_}}, _, _) ->
+ {error,enotconn};
recv(#sslsocket{pid = {Listen,
#config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)->
Transport:recv(Listen, 0). %% {error,enotconn}
@@ -277,10 +290,14 @@ recv(#sslsocket{pid = {Listen,
%%--------------------------------------------------------------------
controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) ->
ssl_connection:new_user(Pid, NewOwner);
+controlling_process(#sslsocket{pid = {udp, _}},
+ NewOwner) when is_pid(NewOwner) ->
+ ok; %% Meaningless but let it be allowed to conform with TLS
controlling_process(#sslsocket{pid = {Listen,
#config{transport_info = {Transport, _, _, _}}}},
NewOwner) when is_port(Listen),
is_pid(NewOwner) ->
+ %% Meaningless but let it be allowed to conform with normal sockets
Transport:controlling_process(Listen, NewOwner).
@@ -297,7 +314,9 @@ connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) ->
Error
end;
connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
- {error, enotconn}.
+ {error, enotconn};
+connection_information(#sslsocket{pid = {udp,_}}) ->
+ {error,enotconn}.
%%--------------------------------------------------------------------
-spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}.
@@ -333,10 +352,18 @@ connection_info(#sslsocket{} = SSLSocket) ->
%%
%% Description: same as inet:peername/1.
%%--------------------------------------------------------------------
+peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)->
+ dtls_socket:peername(Transport, Socket);
peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)->
tls_socket:peername(Transport, Socket);
+peername(#sslsocket{pid = {udp = Transport, #config{udp_handler = {_Pid, _}}}}) ->
+ dtls_socket:peername(Transport, undefined);
+peername(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) ->
+ dtls_socket:peername(Transport, Socket);
peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) ->
- tls_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn}
+ tls_socket:peername(Transport, ListenSocket); %% Will return {error, enotconn}
+peername(#sslsocket{pid = {udp,_}}) ->
+ {error,enotconn}.
%%--------------------------------------------------------------------
-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}.
@@ -350,6 +377,8 @@ peercert(#sslsocket{pid = Pid}) when is_pid(Pid) ->
Result ->
Result
end;
+peercert(#sslsocket{pid = {udp, _}}) ->
+ {error, enotconn};
peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) ->
{error, enotconn}.
@@ -506,6 +535,8 @@ getstat(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}, Options) when is_
shutdown(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}},
How) when is_port(Listen) ->
Transport:shutdown(Listen, How);
+shutdown(#sslsocket{pid = {udp,_}},_) ->
+ {error, enotconn};
shutdown(#sslsocket{pid = Pid}, How) ->
ssl_connection:shutdown(Pid, How).
@@ -518,7 +549,7 @@ sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _
tls_socket:sockname(Transport, Listen);
sockname(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) ->
dtls_udp_listener:sockname(Pid);
-sockname(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) ->
+sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) ->
dtls_socket:sockname(Transport, Socket);
sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) ->
tls_socket:sockname(Transport, Socket).
@@ -531,6 +562,8 @@ sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)
%%--------------------------------------------------------------------
session_info(#sslsocket{pid = Pid}) when is_pid(Pid) ->
ssl_connection:session_info(Pid);
+session_info(#sslsocket{pid = {udp,_}}) ->
+ {error, enotconn};
session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
{error, enotconn}.
@@ -555,6 +588,8 @@ versions() ->
%%--------------------------------------------------------------------
renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) ->
ssl_connection:renegotiation(Pid);
+renegotiate(#sslsocket{pid = {udp,_}}) ->
+ {error, enotconn};
renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
{error, enotconn}.
@@ -568,6 +603,8 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
prf(#sslsocket{pid = Pid},
Secret, Label, Seed, WantedLength) when is_pid(Pid) ->
ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength);
+prf(#sslsocket{pid = {udp,_}}, _,_,_,_) ->
+ {error, enotconn};
prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) ->
{error, enotconn}.
@@ -577,7 +614,7 @@ prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) ->
%% Description: Clear the PEM cache
%%--------------------------------------------------------------------
clear_pem_cache() ->
- ssl_manager:clear_pem_cache().
+ ssl_pem_cache:clear().
%%---------------------------------------------------------------
-spec format_error({error, term()}) -> list().
@@ -696,7 +733,7 @@ handle_options(Opts0, Role) ->
[RecordCb:protocol_version(Vsn) || Vsn <- Vsns]
end,
- Protocol = proplists:get_value(protocol, Opts, tls),
+ Protocol = handle_option(protocol, Opts, tls),
SSLOptions = #ssl_options{
versions = Versions,
@@ -755,7 +792,7 @@ handle_options(Opts0, Role) ->
honor_ecc_order = handle_option(honor_ecc_order, Opts,
default_option_role(server, false, Role),
server, Role),
- protocol = Protocol,
+ protocol = Protocol,
padding_check = proplists:get_value(padding_check, Opts, true),
beast_mitigation = handle_option(beast_mitigation, Opts, one_n_minus_one),
fallback = handle_option(fallback, Opts,
@@ -765,7 +802,8 @@ handle_options(Opts0, Role) ->
client, Role),
crl_check = handle_option(crl_check, Opts, false),
crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}),
- v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false)
+ v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false),
+ max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE)
},
CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)),
@@ -780,7 +818,8 @@ handle_options(Opts0, Role) ->
alpn_preferred_protocols, next_protocols_advertised,
client_preferred_next_protocols, log_alert,
server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache,
- fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible],
+ fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible,
+ max_handshake_size],
SockOpts = lists:foldl(fun(Key, PropList) ->
proplists:delete(Key, PropList)
@@ -1028,6 +1067,12 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse
Value;
validate_option(v2_hello_compatible, Value) when is_boolean(Value) ->
Value;
+validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 ->
+ Value;
+validate_option(protocol, Value = tls) ->
+ Value;
+validate_option(protocol, Value = dtls) ->
+ Value;
validate_option(Opt, Value) ->
throw({error, {options, {Opt, Value}}}).
@@ -1065,17 +1110,37 @@ validate_binary_list(Opt, List) ->
(Bin) ->
throw({error, {options, {Opt, {invalid_protocol, Bin}}}})
end, List).
-
validate_versions([], Versions) ->
Versions;
validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2';
Version == 'tlsv1.1';
Version == tlsv1;
Version == sslv3 ->
- validate_versions(Rest, Versions);
+ tls_validate_versions(Rest, Versions);
+validate_versions([Version | Rest], Versions) when Version == 'dtlsv1';
+ Version == 'dtlsv2'->
+ dtls_validate_versions(Rest, Versions);
validate_versions([Ver| _], Versions) ->
throw({error, {options, {Ver, {versions, Versions}}}}).
+tls_validate_versions([], Versions) ->
+ Versions;
+tls_validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2';
+ Version == 'tlsv1.1';
+ Version == tlsv1;
+ Version == sslv3 ->
+ tls_validate_versions(Rest, Versions);
+tls_validate_versions([Ver| _], Versions) ->
+ throw({error, {options, {Ver, {versions, Versions}}}}).
+
+dtls_validate_versions([], Versions) ->
+ Versions;
+dtls_validate_versions([Version | Rest], Versions) when Version == 'dtlsv1';
+ Version == 'dtlsv2'->
+ dtls_validate_versions(Rest, Versions);
+dtls_validate_versions([Ver| _], Versions) ->
+ throw({error, {options, {Ver, {versions, Versions}}}}).
+
validate_inet_option(mode, Value)
when Value =/= list, Value =/= binary ->
throw({error, {options, {mode,Value}}});
@@ -1147,18 +1212,18 @@ handle_cipher_option(Value, Version) when is_list(Value) ->
binary_cipher_suites(Version, []) ->
%% Defaults to all supported suites that does
%% not require explicit configuration
- ssl_cipher:filter_suites(ssl_cipher:suites(Version));
+ ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version)));
binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) ->
Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0],
binary_cipher_suites(Version, Ciphers);
binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) ->
- All = ssl_cipher:all_suites(Version),
+ All = ssl_cipher:all_suites(tls_version(Version)),
case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of
[] ->
%% Defaults to all supported suites that does
%% not require explicit configuration
- ssl_cipher:filter_suites(ssl_cipher:suites(Version));
+ ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version)));
Ciphers ->
Ciphers
end;
@@ -1171,7 +1236,8 @@ binary_cipher_suites(Version, Ciphers0) ->
Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")],
binary_cipher_suites(Version, Ciphers).
-handle_eccs_option(Value, {_Major, Minor}) when is_list(Value) ->
+handle_eccs_option(Value, Version) when is_list(Value) ->
+ {_Major, Minor} = tls_version(Version),
try tls_v1:ecc_curves(Minor, Value) of
Curves -> #elliptic_curves{elliptic_curve_list = Curves}
catch
@@ -1344,7 +1410,10 @@ new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordC
handle_hashsigns_option(Value,
tls_version(RecordCB:highest_protocol_version()))},
RecordCB);
-
+new_ssl_options([{protocol, dtls = Value} | Rest], #ssl_options{} = Opts, dtls_record = RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB);
+new_ssl_options([{protocol, tls = Value} | Rest], #ssl_options{} = Opts, tls_record = RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB);
new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) ->
throw({error, {options, {Key, Value}}}).
diff --git a/lib/ssl/src/ssl_admin_sup.erl b/lib/ssl/src/ssl_admin_sup.erl
new file mode 100644
index 0000000000..9c96435753
--- /dev/null
+++ b/lib/ssl/src/ssl_admin_sup.erl
@@ -0,0 +1,95 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssl_admin_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0, manager_opts/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+ PEMCache = pem_cache_child_spec(),
+ SessionCertManager = session_and_cert_manager_child_spec(),
+ {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}.
+
+manager_opts() ->
+ CbOpts = case application:get_env(ssl, session_cb) of
+ {ok, Cb} when is_atom(Cb) ->
+ InitArgs = session_cb_init_args(),
+ [{session_cb, Cb}, {session_cb_init_args, InitArgs}];
+ _ ->
+ []
+ end,
+ case application:get_env(ssl, session_lifetime) of
+ {ok, Time} when is_integer(Time) ->
+ [{session_lifetime, Time}| CbOpts];
+ _ ->
+ CbOpts
+ end.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+pem_cache_child_spec() ->
+ Name = ssl_pem_cache,
+ StartFunc = {ssl_pem_cache, start_link, [[]]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_pem_cache],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+session_and_cert_manager_child_spec() ->
+ Opts = manager_opts(),
+ Name = ssl_manager,
+ StartFunc = {ssl_manager, start_link, [Opts]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_manager],
+ Type = worker,
+ {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) ->
+ Args;
+ _ ->
+ []
+ end.
diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index f359655d85..8aa2aa4081 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -125,21 +125,21 @@ file_to_crls(File, DbHandle) ->
%% Description: Validates ssl/tls specific extensions
%%--------------------------------------------------------------------
validate(_,{extension, #'Extension'{extnID = ?'id-ce-extKeyUsage',
- extnValue = KeyUse}}, {Role, _,_, _, _}) ->
+ extnValue = KeyUse}}, UserState = {Role, _,_, _, _}) ->
case is_valid_extkey_usage(KeyUse, Role) of
true ->
- {valid, Role};
+ {valid, UserState};
false ->
{fail, {bad_cert, invalid_ext_key_usage}}
end;
-validate(_, {extension, _}, Role) ->
- {unknown, Role};
+validate(_, {extension, _}, UserState) ->
+ {unknown, UserState};
validate(_, {bad_cert, _} = Reason, _) ->
{fail, Reason};
-validate(_, valid, Role) ->
- {valid, Role};
-validate(_, valid_peer, Role) ->
- {valid, Role}.
+validate(_, valid, UserState) ->
+ {valid, UserState};
+validate(_, valid_peer, UserState) ->
+ {valid, UserState}.
%%--------------------------------------------------------------------
-spec is_valid_key_usage(list(), term()) -> boolean().
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 32fec03b8e..8e6860e9dc 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -40,7 +40,8 @@
ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0,
rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1,
- random_bytes/1, calc_aad/3, calc_mac_hash/4]).
+ random_bytes/1, calc_aad/3, calc_mac_hash/4,
+ is_stream_ciphersuite/1]).
-export_type([cipher_suite/0,
erl_cipher_suite/0, openssl_cipher_suite/0,
@@ -310,18 +311,21 @@ aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState,
%%--------------------------------------------------------------------
suites({3, 0}) ->
ssl_v3:suites();
-suites({3, N}) ->
- tls_v1:suites(N);
-suites(Version) ->
- suites(dtls_v1:corresponding_tls_version(Version)).
+suites({3, Minor}) ->
+ tls_v1:suites(Minor);
+suites({_, Minor}) ->
+ dtls_v1:suites(Minor).
-all_suites(Version) ->
+all_suites({3, _} = Version) ->
suites(Version)
++ anonymous_suites(Version)
++ psk_suites(Version)
++ srp_suites()
++ rc4_suites(Version)
- ++ des_suites(Version).
+ ++ des_suites(Version);
+all_suites(Version) ->
+ dtls_v1:all_suites(Version).
+
%%--------------------------------------------------------------------
-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()].
%%
@@ -1541,6 +1545,10 @@ calc_mac_hash(Type, Version,
MacSecret, SeqNo, Type,
Length, PlainFragment).
+is_stream_ciphersuite({_, rc4_128, _, _}) ->
+ true;
+is_stream_ciphersuite(_) ->
+ false.
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl
index 0652d029c3..09d4c3e678 100644
--- a/lib/ssl/src/ssl_config.erl
+++ b/lib/ssl/src/ssl_config.erl
@@ -32,18 +32,20 @@ init(SslOpts, Role) ->
init_manager_name(SslOpts#ssl_options.erl_dist),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbHandle, OwnCert}
+ {ok, #{pem_cache := PemCache} = Config}
= init_certificates(SslOpts, Role),
PrivateKey =
- init_private_key(PemCacheHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile,
+ init_private_key(PemCache, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile,
SslOpts#ssl_options.password, Role),
- DHParams = init_diffie_hellman(PemCacheHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, PrivateKey, DHParams}.
+ DHParams = init_diffie_hellman(PemCache, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role),
+ {ok, Config#{private_key => PrivateKey, dh_params => DHParams}}.
init_manager_name(false) ->
- put(ssl_manager, ssl_manager:manager_name(normal));
+ put(ssl_manager, ssl_manager:name(normal)),
+ put(ssl_pem_cache, ssl_pem_cache:name(normal));
init_manager_name(true) ->
- put(ssl_manager, ssl_manager:manager_name(dist)).
+ put(ssl_manager, ssl_manager:name(dist)),
+ put(ssl_pem_cache, ssl_pem_cache:name(dist)).
init_certificates(#ssl_options{cacerts = CaCerts,
cacertfile = CACertFile,
@@ -51,7 +53,7 @@ init_certificates(#ssl_options{cacerts = CaCerts,
cert = Cert,
crl_cache = CRLCache
}, Role) ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo} =
+ {ok, Config} =
try
Certs = case CaCerts of
undefined ->
@@ -59,41 +61,37 @@ init_certificates(#ssl_options{cacerts = CaCerts,
_ ->
{der, CaCerts}
end,
- {ok, _, _, _, _, _, _} = ssl_manager:connection_init(Certs, Role, CRLCache)
+ {ok,_} = ssl_manager:connection_init(Certs, Role, CRLCache)
catch
_:Reason ->
file_error(CACertFile, {cacertfile, Reason})
end,
- init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle,
- CacheHandle, CRLDbInfo, CertFile, Role).
+ init_certificates(Cert, Config, CertFile, Role).
-init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle,
- CRLDbInfo, <<>>, _) ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined};
+init_certificates(undefined, Config, <<>>, _) ->
+ {ok, Config#{own_certificate => undefined}};
-init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle,
- CacheHandle, CRLDbInfo, CertFile, client) ->
+init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, client) ->
try
%% Ignoring potential proxy-certificates see:
%% http://dev.globus.org/wiki/Security/ProxyFileFormat
- [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, OwnCert}
+ [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache),
+ {ok, Config#{own_certificate => OwnCert}}
catch _Error:_Reason ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined}
- end;
+ {ok, Config#{own_certificate => undefined}}
+ end;
-init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle,
- PemCacheHandle, CacheRef, CRLDbInfo, CertFile, server) ->
+init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, server) ->
try
- [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle),
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, OwnCert}
+ [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache),
+ {ok, Config#{own_certificate => OwnCert}}
catch
_:Reason ->
file_error(CertFile, {certfile, Reason})
end;
-init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, _, _) ->
- {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, Cert}.
-
+init_certificates(Cert, Config, _, _) ->
+ {ok, Config#{own_certificate => Cert}}.
+
init_private_key(_, undefined, <<>>, _Password, _Client) ->
undefined;
init_private_key(DbHandle, undefined, KeyFile, Password, _) ->
@@ -135,6 +133,8 @@ file_error(File, Throw) ->
case Throw of
{Opt,{badmatch, {error, {badmatch, Error}}}} ->
throw({options, {Opt, binary_to_list(File), Error}});
+ {Opt, {badmatch, Error}} ->
+ throw({options, {Opt, binary_to_list(File), Error}});
_ ->
throw(Throw)
end.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 6e7c8c5ddd..5244db31af 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -148,19 +148,19 @@ socket_control(Connection, Socket, Pid, Transport) ->
%%--------------------------------------------------------------------
socket_control(Connection, Socket, Pid, Transport, udp_listner) ->
%% dtls listner process must have the socket control
- {ok, dtls_socket:socket(Pid, Transport, Socket, Connection)};
+ {ok, Connection:socket(Pid, Transport, Socket, Connection, undefined)};
socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) ->
case Transport:controlling_process(Socket, Pid) of
ok ->
- {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)};
+ {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)};
{error, Reason} ->
{error, Reason}
end;
socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, ListenTracker) ->
case Transport:controlling_process(Socket, Pid) of
ok ->
- {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)};
+ {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)};
{error, Reason} ->
{error, Reason}
end.
@@ -323,8 +323,14 @@ handle_session(#server_hello{cipher_suite = CipherSuite,
-spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}.
%%--------------------------------------------------------------------
ssl_config(Opts, Role, State) ->
- {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo,
- OwnCert, Key, DHParams} =
+ {ok, #{cert_db_ref := Ref,
+ cert_db_handle := CertDbHandle,
+ fileref_db_handle := FileRefHandle,
+ session_cache := CacheHandle,
+ crl_db_info := CRLDbHandle,
+ private_key := Key,
+ dh_params := DHParams,
+ own_certificate := OwnCert}} =
ssl_config:init(Opts, Role),
Handshake = ssl_handshake:init_handshake_history(),
TimeStamp = erlang:monotonic_time(),
@@ -335,7 +341,7 @@ ssl_config(Opts, Role, State) ->
file_ref_db = FileRefHandle,
cert_db_ref = Ref,
cert_db = CertDbHandle,
- crl_db = CRLDbInfo,
+ crl_db = CRLDbHandle,
session_cache = CacheHandle,
private_key = Key,
diffie_hellman_params = DHParams,
@@ -357,11 +363,13 @@ init({call, From}, {start, Timeout}, State0, Connection) ->
timer = Timer}),
Connection:next_event(hello, Record, State);
init({call, From}, {start, {Opts, EmOpts}, Timeout},
- #state{role = Role} = State0, Connection) ->
+ #state{role = Role, ssl_options = OrigSSLOptions,
+ socket_options = SockOpts} = State0, Connection) ->
try
- State = ssl_config(Opts, Role, State0),
+ SslOpts = ssl:handle_options(Opts, OrigSSLOptions),
+ State = ssl_config(SslOpts, Role, State0),
init({call, From}, {start, Timeout},
- State#state{ssl_options = Opts, socket_options = EmOpts}, Connection)
+ State#state{ssl_options = SslOpts, socket_options = new_emulated(EmOpts, SockOpts)}, Connection)
catch throw:Error ->
{stop_and_reply, normal, {reply, From, {error, Error}}}
end;
@@ -426,11 +434,11 @@ abbreviated(internal, #finished{verify_data = Data} = Finished,
verified ->
ConnectionStates1 =
ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0),
- State1 =
+ {State1, Actions} =
finalize_handshake(State0#state{connection_states = ConnectionStates1},
abbreviated, Connection),
{Record, State} = prepare_connection(State1#state{expecting_finished = false}, Connection),
- Connection:next_event(connection, Record, State);
+ Connection:next_event(connection, Record, State, Actions);
#alert{} = Alert ->
handle_own_alert(Alert, Version, abbreviated, State0)
end;
@@ -850,6 +858,7 @@ handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName,
StateName, State);
handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State,
_) ->
+ ct:pal("Unexpected msg ~p", [Msg]),
Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE),
handle_own_alert(Alert, Version, {StateName, Msg}, State).
@@ -864,11 +873,11 @@ handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when i
%% When downgrading an TLS connection to a transport connection
%% we must recive the close alert from the peer before releasing the
%% transport socket.
- {next_state, downgrade, State, [{timeout, Timeout, downgrade}]};
+ {next_state, downgrade, State#state{terminated = true}, [{timeout, Timeout, downgrade}]};
handle_call({close, _} = Close, From, StateName, State, Connection) ->
%% Run terminate before returning so that the reuseaddr
- %% inet-option
- Result = Connection:terminate(Close, StateName, State),
+ %% inet-option works properly
+ Result = Connection:terminate(Close, StateName, State#state{terminated = true}),
{stop_and_reply, {shutdown, normal},
{reply, From, Result}, State};
handle_call({shutdown, How0}, From, _,
@@ -1010,7 +1019,10 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) ->
terminate(_, _, #state{terminated = true}) ->
%% Happens when user closes the connection using ssl:close/1
%% we want to guarantee that Transport:close has been called
- %% when ssl:close/1 returns.
+ %% when ssl:close/1 returns unless it is a downgrade where
+ %% we want to guarantee that close alert is recived before
+ %% returning. In both cases terminate has been run manually
+ %% before run by gen_statem which will end up here
ok;
terminate({shutdown, transport_closed} = Reason,
@@ -1227,13 +1239,13 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite,
negotiated_version = Version} = State0, Connection) ->
try server_certify_and_key_exchange(State0, Connection) of
#state{} = State1 ->
- State2 = server_hello_done(State1, Connection),
+ {State2, Actions} = server_hello_done(State1, Connection),
Session =
Session0#session{session_id = SessionId,
cipher_suite = CipherSuite,
compression_method = Compression},
{Record, State} = Connection:next_record(State2#state{session = Session}),
- Connection:next_event(certify, Record, State)
+ Connection:next_event(certify, Record, State, Actions)
catch
#alert{} = Alert ->
handle_own_alert(Alert, Version, hello, State0)
@@ -1248,10 +1260,10 @@ resumed_server_hello(#state{session = Session,
{_, ConnectionStates1} ->
State1 = State0#state{connection_states = ConnectionStates1,
session = Session},
- State2 =
+ {State2, Actions} =
finalize_handshake(State1, abbreviated, Connection),
{Record, State} = Connection:next_record(State2),
- Connection:next_event(abbreviated, Record, State);
+ Connection:next_event(abbreviated, Record, State, Actions);
#alert{} = Alert ->
handle_own_alert(Alert, Version, hello, State0)
end.
@@ -1334,12 +1346,12 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} =
State0, Connection) ->
try do_client_certify_and_key_exchange(State0, Connection) of
State1 = #state{} ->
- State2 = finalize_handshake(State1, certify, Connection),
+ {State2, Actions} = finalize_handshake(State1, certify, Connection),
State3 = State2#state{
%% Reinitialize
client_certificate_requested = false},
{Record, State} = Connection:next_record(State3),
- Connection:next_event(cipher, Record, State)
+ Connection:next_event(cipher, Record, State, Actions)
catch
throw:#alert{} = Alert ->
handle_own_alert(Alert, Version, certify, State0)
@@ -1861,11 +1873,11 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0
Connection) ->
ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data,
ConnectionStates0),
- State1 =
+ {State1, Actions} =
finalize_handshake(State0#state{connection_states = ConnectionStates1,
session = Session}, cipher, Connection),
{Record, State} = prepare_connection(State1, Connection),
- Connection:next_event(connection, Record, State).
+ Connection:next_event(connection, Record, State, Actions).
is_anonymous(Algo) when Algo == dh_anon;
Algo == ecdh_anon;
@@ -2296,7 +2308,7 @@ format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet,
{ok, do_format_reply(Mode, Packet, Header, Data)};
format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet,
header = Header}, Data, Tracker, Connection) ->
- {ssl, tls_socket:socket(self(), Transport, Socket, Connection, Tracker),
+ {ssl, Connection:socket(self(), Transport, Socket, Connection, Tracker),
do_format_reply(Mode, Packet, Header, Data)}.
deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker, Connection) ->
@@ -2305,7 +2317,7 @@ deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Da
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, Tracker, Connection) ->
- {ssl_error, tls_socket:socket(self(), Transport, Socket, Connection, Tracker),
+ {ssl_error, Connection:socket(self(), Transport, Socket, Connection, Tracker),
{invalid_packet, do_format_reply(Mode, raw, 0, Data)}}.
do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode
@@ -2360,11 +2372,11 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio
case ssl_alert:reason_code(Alert, Role) of
closed ->
send_or_reply(Active, Pid, From,
- {ssl_closed, tls_socket:socket(self(),
+ {ssl_closed, Connection:socket(self(),
Transport, Socket, Connection, Tracker)});
ReasonCode ->
send_or_reply(Active, Pid, From,
- {ssl_error, tls_socket:socket(self(),
+ {ssl_error, Connection:socket(self(),
Transport, Socket, Connection, Tracker), ReasonCode})
end.
@@ -2425,16 +2437,23 @@ handle_sni_extension(#sni{hostname = Hostname}, State0) ->
undefined ->
State0;
_ ->
- {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, Key, DHParams} =
- ssl_config:init(NewOptions, State0#state.role),
- State0#state{
- session = State0#state.session#session{own_certificate = OwnCert},
- file_ref_db = FileRefHandle,
- cert_db_ref = Ref,
- cert_db = CertDbHandle,
- crl_db = CRLDbHandle,
- session_cache = CacheHandle,
- private_key = Key,
+ {ok, #{cert_db_ref := Ref,
+ cert_db_handle := CertDbHandle,
+ fileref_db_handle := FileRefHandle,
+ session_cache := CacheHandle,
+ crl_db_info := CRLDbHandle,
+ private_key := Key,
+ dh_params := DHParams,
+ own_certificate := OwnCert}} =
+ ssl_config:init(NewOptions, State0#state.role),
+ State0#state{
+ session = State0#state.session#session{own_certificate = OwnCert},
+ file_ref_db = FileRefHandle,
+ cert_db_ref = Ref,
+ cert_db = CertDbHandle,
+ crl_db = CRLDbHandle,
+ session_cache = CacheHandle,
+ private_key = Key,
diffie_hellman_params = DHParams,
ssl_options = NewOptions,
sni_hostname = Hostname
@@ -2456,3 +2475,8 @@ update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) ->
_ ->
ssl:handle_options(SSLOption, OrigSSLOptions)
end.
+
+new_emulated([], EmOpts) ->
+ EmOpts;
+new_emulated(NewEmOpts, _) ->
+ NewEmOpts.
diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl
new file mode 100644
index 0000000000..1a1f43e683
--- /dev/null
+++ b/lib/ssl/src/ssl_connection_sup.erl
@@ -0,0 +1,101 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssl_connection_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+
+ TLSConnetionManager = tls_connection_manager_child_spec(),
+ %% 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(),
+
+ DTLSConnetionManager = dtls_connection_manager_child_spec(),
+ DTLSUdpListeners = dtls_udp_listeners_spec(),
+
+ {ok, {{one_for_one, 10, 3600}, [TLSConnetionManager,
+ ListenOptionsTracker,
+ DTLSConnetionManager,
+ DTLSUdpListeners
+ ]}}.
+
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+tls_connection_manager_child_spec() ->
+ Name = tls_connection,
+ StartFunc = {tls_connection_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_connection_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+dtls_connection_manager_child_spec() ->
+ Name = dtls_connection,
+ StartFunc = {dtls_connection_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [dtls_connection_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+listen_options_tracker_child_spec() ->
+ Name = tls_socket,
+ StartFunc = {ssl_listen_tracker_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+dtls_udp_listeners_spec() ->
+ Name = dtls_udp_listener,
+ StartFunc = {dtls_udp_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl
index fc60bdba67..33375b5e09 100644
--- a/lib/ssl/src/ssl_crl.erl
+++ b/lib/ssl/src/ssl_crl.erl
@@ -29,7 +29,7 @@
-export([trusted_cert_and_path/3]).
-trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) ->
+trusted_cert_and_path(CRL, {SerialNumber, Issuer},{_, {Db, DbRef}} = DbHandle) ->
case ssl_pkix_db:lookup_trusted_cert(Db, DbRef, SerialNumber, Issuer) of
undefined ->
trusted_cert_and_path(CRL, issuer_not_found, DbHandle);
@@ -37,17 +37,34 @@ trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) ->
{ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef),
{ok, Root, lists:reverse(Chain)}
end;
-
-trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbHandle) ->
- case find_issuer(CRL, DbHandle) of
+trusted_cert_and_path(CRL, issuer_not_found, {CertPath, {Db, DbRef}}) ->
+ case find_issuer(CRL, {certpath,
+ [{Der, public_key:pkix_decode_cert(Der,otp)} || Der <- CertPath]}) of
{ok, OtpCert} ->
{ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef),
{ok, Root, lists:reverse(Chain)};
{error, issuer_not_found} ->
- {ok, unknown_crl_ca, []}
- end.
+ trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef})
+ end;
+trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbInfo) ->
+ case find_issuer(CRL, DbInfo) of
+ {ok, OtpCert} ->
+ {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef),
+ {ok, Root, lists:reverse(Chain)};
+ {error, issuer_not_found} ->
+ {error, unknown_ca}
+ end.
-find_issuer(CRL, {Db,DbRef}) ->
+find_issuer(CRL, {certpath = Db, DbRef}) ->
+ Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)),
+ IsIssuerFun =
+ fun({_Der,ErlCertCandidate}, Acc) ->
+ verify_crl_issuer(CRL, ErlCertCandidate, Issuer, Acc);
+ (_, Acc) ->
+ Acc
+ end,
+ find_issuer(IsIssuerFun, Db, DbRef);
+find_issuer(CRL, {Db, DbRef}) ->
Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)),
IsIssuerFun =
fun({_Key, {_Der,ErlCertCandidate}}, Acc) ->
@@ -55,26 +72,33 @@ find_issuer(CRL, {Db,DbRef}) ->
(_, Acc) ->
Acc
end,
- if is_reference(DbRef) -> % actual DB exists
- try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of
- issuer_not_found ->
- {error, issuer_not_found}
- catch
- {ok, _} = Result ->
- Result
- end;
- is_tuple(DbRef), element(1,DbRef) =:= extracted -> % cache bypass byproduct
- {extracted, CertsData} = DbRef,
- Certs = [Entry || {decoded, Entry} <- CertsData],
- try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of
- issuer_not_found ->
- {error, issuer_not_found}
- catch
- {ok, _} = Result ->
- Result
- end
- end.
+ find_issuer(IsIssuerFun, Db, DbRef).
+find_issuer(IsIssuerFun, certpath, Certs) ->
+ try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of
+ issuer_not_found ->
+ {error, issuer_not_found}
+ catch
+ {ok, _} = Result ->
+ Result
+ end;
+find_issuer(IsIssuerFun, extracted, CertsData) ->
+ Certs = [Entry || {decoded, Entry} <- CertsData],
+ try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of
+ issuer_not_found ->
+ {error, issuer_not_found}
+ catch
+ {ok, _} = Result ->
+ Result
+ end;
+find_issuer(IsIssuerFun, Db, _) ->
+ try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of
+ issuer_not_found ->
+ {error, issuer_not_found}
+ catch
+ {ok, _} = Result ->
+ Result
+ end.
verify_crl_issuer(CRL, ErlCertCandidate, Issuer, NotIssuer) ->
TBSCert = ErlCertCandidate#'OTPCertificate'.tbsCertificate,
diff --git a/lib/ssl/src/ssl_dist_admin_sup.erl b/lib/ssl/src/ssl_dist_admin_sup.erl
new file mode 100644
index 0000000000..f60806c4cb
--- /dev/null
+++ b/lib/ssl/src/ssl_dist_admin_sup.erl
@@ -0,0 +1,74 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssl_dist_admin_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+ PEMCache = pem_cache_child_spec(),
+ SessionCertManager = session_and_cert_manager_child_spec(),
+ {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}.
+
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+pem_cache_child_spec() ->
+ Name = ssl_pem_cache_dist,
+ StartFunc = {ssl_pem_cache, start_link_dist, [[]]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_pem_cache],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+session_and_cert_manager_child_spec() ->
+ Opts = ssl_admin_sup:manager_opts(),
+ Name = ssl_dist_manager,
+ StartFunc = {ssl_manager, start_link_dist, [Opts]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_manager],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
diff --git a/lib/ssl/src/ssl_dist_connection_sup.erl b/lib/ssl/src/ssl_dist_connection_sup.erl
new file mode 100644
index 0000000000..e5842c866e
--- /dev/null
+++ b/lib/ssl/src/ssl_dist_connection_sup.erl
@@ -0,0 +1,79 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssl_dist_connection_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([]) ->
+
+ TLSConnetionManager = tls_connection_manager_child_spec(),
+ %% 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_one, 10, 3600}, [TLSConnetionManager,
+ ListenOptionsTracker
+ ]}}.
+
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+tls_connection_manager_child_spec() ->
+ Name = dist_tls_connection,
+ StartFunc = {tls_connection_sup, start_link_dist, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_connection_sup],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+listen_options_tracker_child_spec() ->
+ Name = dist_tls_socket,
+ StartFunc = {ssl_listen_tracker_sup, start_link_dist, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [tls_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl
index d47cd76bf5..690b896919 100644
--- a/lib/ssl/src/ssl_dist_sup.erl
+++ b/lib/ssl/src/ssl_dist_sup.erl
@@ -44,34 +44,29 @@ start_link() ->
%%%=========================================================================
init([]) ->
- SessionCertManager = session_and_cert_manager_child_spec(),
- ConnetionManager = connection_manager_child_spec(),
- ListenOptionsTracker = listen_options_tracker_child_spec(),
+ AdminSup = ssl_admin_child_spec(),
+ ConnectionSup = ssl_connection_sup(),
ProxyServer = proxy_server_child_spec(),
-
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager,
- ListenOptionsTracker,
- ProxyServer]}}.
+ {ok, {{one_for_all, 10, 3600}, [AdminSup, ProxyServer, ConnectionSup]}}.
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-session_and_cert_manager_child_spec() ->
- Opts = ssl_sup:manager_opts(),
- Name = ssl_manager_dist,
- StartFunc = {ssl_manager, start_link_dist, [Opts]},
+ssl_admin_child_spec() ->
+ Name = ssl_dist_admin_sup,
+ StartFunc = {ssl_dist_admin_sup, start_link , []},
Restart = permanent,
Shutdown = 4000,
- Modules = [ssl_manager],
- Type = worker,
+ Modules = [ssl_admin_sup],
+ Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-connection_manager_child_spec() ->
- Name = ssl_connection_dist,
- StartFunc = {tls_connection_sup, start_link_dist, []},
- Restart = permanent,
- Shutdown = infinity,
- Modules = [tls_connection_sup],
+ssl_connection_sup() ->
+ Name = ssl_dist_connection_sup,
+ StartFunc = {ssl_dist_connection_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_connection_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
@@ -83,12 +78,3 @@ proxy_server_child_spec() ->
Modules = [ssl_tls_dist_proxy],
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-listen_options_tracker_child_spec() ->
- Name = tls_socket_dist,
- StartFunc = {ssl_listen_tracker_sup, start_link_dist, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [tls_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 4acc745c5f..cb61c82334 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -397,14 +397,13 @@ verify_signature(_, Hash, {HashAlgo, _SignAlg}, Signature,
%%--------------------------------------------------------------------
certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
MaxPathLen, _Verify, ValidationFunAndState0, PartialChain, CRLCheck, CRLDbHandle, Role) ->
- [PeerCert | _] = ASN1Certs,
-
- ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role,
- CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle),
-
+ [PeerCert | _] = ASN1Certs,
try
{TrustedCert, CertPath} =
ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef, PartialChain),
+ ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role,
+ CertDbHandle, CertDbRef,
+ CRLCheck, CRLDbHandle, CertPath),
case public_key:pkix_path_validation(TrustedCert,
CertPath,
[{max_path_length, MaxPathLen},
@@ -1541,7 +1540,8 @@ sni1(Hostname) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) ->
+validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef,
+ CRLCheck, CRLDbHandle, CertPath) ->
{fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) ->
case ssl_certificate:validate(OtpCert,
Extension,
@@ -1550,22 +1550,25 @@ validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLC
{valid, {NewSslState, UserState}};
{fail, Reason} ->
apply_user_fun(Fun, OtpCert, Reason, UserState,
- SslState);
+ SslState, CertPath);
{unknown, _} ->
apply_user_fun(Fun, OtpCert,
- Extension, UserState, SslState)
+ Extension, UserState, SslState, CertPath)
end;
(OtpCert, VerifyResult, {SslState, UserState}) ->
apply_user_fun(Fun, OtpCert, VerifyResult, UserState,
- SslState)
+ SslState, CertPath)
end, {{Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}, UserState0}};
-validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) ->
+validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef,
+ CRLCheck, CRLDbHandle, CertPath) ->
{fun(OtpCert, {extension, _} = Extension, SslState) ->
ssl_certificate:validate(OtpCert,
Extension,
SslState);
- (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or (VerifyResult == valid_peer) ->
- case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of
+ (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or
+ (VerifyResult == valid_peer) ->
+ case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef,
+ CRLDbHandle, VerifyResult, CertPath) of
valid ->
{VerifyResult, SslState};
Reason ->
@@ -1578,20 +1581,21 @@ validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRL
end, {Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}}.
apply_user_fun(Fun, OtpCert, VerifyResult, UserState0,
- {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState) when
+ {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState, CertPath) when
(VerifyResult == valid) or (VerifyResult == valid_peer) ->
case Fun(OtpCert, VerifyResult, UserState0) of
{Valid, UserState} when (Valid == valid) or (Valid == valid_peer) ->
- case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of
+ case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef,
+ CRLDbHandle, VerifyResult, CertPath) of
valid ->
{Valid, {SslState, UserState}};
Result ->
- apply_user_fun(Fun, OtpCert, Result, UserState, SslState)
+ apply_user_fun(Fun, OtpCert, Result, UserState, SslState, CertPath)
end;
{fail, _} = Fail ->
Fail
end;
-apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) ->
+apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState, _CertPath) ->
case Fun(OtpCert, ExtensionOrError, UserState0) of
{Valid, UserState} when (Valid == valid) or (Valid == valid_peer)->
{Valid, {SslState, UserState}};
@@ -2187,13 +2191,14 @@ handle_psk_identity(_PSKIdentity, LookupFun)
handle_psk_identity(PSKIdentity, {Fun, UserState}) ->
Fun(psk, PSKIdentity, UserState).
-crl_check(_, false, _,_,_, _) ->
+crl_check(_, false, _,_,_, _, _) ->
valid;
-crl_check(_, peer, _, _,_, valid) -> %% Do not check CAs with this option.
+crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option.
valid;
-crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _) ->
+crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, CertPath) ->
Options = [{issuer_fun, {fun(_DP, CRL, Issuer, DBInfo) ->
- ssl_crl:trusted_cert_and_path(CRL, Issuer, DBInfo)
+ ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath,
+ DBInfo})
end, {CertDbHandle, CertDbRef}}},
{update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end}
],
@@ -2229,7 +2234,8 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) ->
no_dps;
DistPoints ->
Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer,
- distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle)
+ CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle),
+ dps_and_crls(DistPoints, CRLs, [])
end;
dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) ->
@@ -2242,7 +2248,13 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) ->
end, GenNames),
[{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs].
-distpoints_lookup([], _, _, _) ->
+dps_and_crls([], _, Acc) ->
+ Acc;
+dps_and_crls([DP | Rest], CRLs, Acc) ->
+ DpCRL = [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs],
+ dps_and_crls(Rest, CRLs, DpCRL ++ Acc).
+
+distpoints_lookup([],_, _, _) ->
[];
distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) ->
Result =
@@ -2257,7 +2269,7 @@ distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) ->
not_available ->
distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle);
CRLs ->
- [{DistPoint, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs]
+ CRLs
end.
sign_algo(?rsaEncryption) ->
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index fde92035a2..324b7dbde3 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -80,6 +80,9 @@
-define(CLIENT_KEY_EXCHANGE, 16).
-define(FINISHED, 20).
+-define(MAX_UNIT24, 8388607).
+-define(DEFAULT_MAX_HANDSHAKE_SIZE, (256*1024)).
+
-record(random, {
gmt_unix_time, % uint32
random_bytes % opaque random_bytes[28]
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 98b89bb811..c10ec3a2d6 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -76,7 +76,7 @@
-define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]).
-define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]).
-define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]).
--define(MIN_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]).
+-define(MIN_DATAGRAM_SUPPORTED_VERSIONS, [dtlsv1]).
-define('24H_in_msec', 86400000).
-define('24H_in_sec', 86400).
@@ -142,7 +142,8 @@
signature_algs,
eccs,
honor_ecc_order :: boolean(),
- v2_hello_compatible :: boolean()
+ v2_hello_compatible :: boolean(),
+ max_handshake_size :: integer()
}).
-record(socket_options,
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index 5bd9521de7..2b82f18bb5 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -32,10 +32,9 @@
new_session_id/1, clean_cert_db/2,
register_session/2, register_session/3, invalidate_session/2,
insert_crls/2, insert_crls/3, delete_crls/1, delete_crls/2,
- invalidate_session/3, invalidate_pem/1, clear_pem_cache/0, manager_name/1]).
+ invalidate_session/3, name/1]).
-% Spawn export
--export([init_session_validator/1, init_pem_cache_validator/1]).
+-export([init_session_validator/1]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
@@ -52,9 +51,7 @@
session_lifetime :: integer(),
certificate_db :: db_handle(),
session_validation_timer :: reference(),
- last_delay_timer = {undefined, undefined},%% Keep for testing purposes
- last_pem_check :: erlang:timestamp(),
- clear_pem_cache :: integer(),
+ last_delay_timer = {undefined, undefined},%% Keep for testing purposes
session_cache_client_max :: integer(),
session_cache_server_max :: integer(),
session_server_invalidator :: undefined | pid(),
@@ -63,7 +60,6 @@
-define(GEN_UNIQUE_ID_MAX_TRIES, 10).
-define(SESSION_VALIDATION_INTERVAL, 60000).
--define(CLEAR_PEM_CACHE, 120000).
-define(CLEAN_SESSION_DB, 60000).
-define(CLEAN_CERT_DB, 500).
-define(DEFAULT_MAX_SESSION_CACHE, 1000).
@@ -74,14 +70,14 @@
%%====================================================================
%%--------------------------------------------------------------------
--spec manager_name(normal | dist) -> atom().
+-spec name(normal | dist) -> atom().
%%
%% Description: Returns the registered name of the ssl manager process
%% in the operation modes 'normal' and 'dist'.
%%--------------------------------------------------------------------
-manager_name(normal) ->
+name(normal) ->
?MODULE;
-manager_name(dist) ->
+name(dist) ->
list_to_atom(atom_to_list(?MODULE) ++ "dist").
%%--------------------------------------------------------------------
@@ -91,9 +87,10 @@ manager_name(dist) ->
%% and certificate caching.
%%--------------------------------------------------------------------
start_link(Opts) ->
- DistMangerName = manager_name(normal),
- gen_server:start_link({local, DistMangerName},
- ?MODULE, [DistMangerName, Opts], []).
+ MangerName = name(normal),
+ CacheName = ssl_pem_cache:name(normal),
+ gen_server:start_link({local, MangerName},
+ ?MODULE, [MangerName, CacheName, Opts], []).
%%--------------------------------------------------------------------
-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}.
@@ -102,38 +99,23 @@ start_link(Opts) ->
%% be used by the erlang distribution. Note disables soft upgrade!
%%--------------------------------------------------------------------
start_link_dist(Opts) ->
- DistMangerName = manager_name(dist),
+ DistMangerName = name(dist),
+ DistCacheName = ssl_pem_cache:name(dist),
gen_server:start_link({local, DistMangerName},
- ?MODULE, [DistMangerName, Opts], []).
+ ?MODULE, [DistMangerName, DistCacheName, Opts], []).
%%--------------------------------------------------------------------
-spec connection_init(binary()| {der, list()}, client | server,
{Cb :: atom(), Handle:: term()}) ->
- {ok, certdb_ref(), db_handle(), db_handle(),
- db_handle(), db_handle(), CRLInfo::term()}.
+ {ok, map()}.
%%
%% Description: Do necessary initializations for a new connection.
%%--------------------------------------------------------------------
connection_init({der, _} = Trustedcerts, Role, CRLCache) ->
- case bypass_pem_cache() of
- true ->
- {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts),
- call({connection_init, Extracted, Role, CRLCache});
- false ->
- call({connection_init, Trustedcerts, Role, CRLCache})
- end;
-
-connection_init(<<>> = Trustedcerts, Role, CRLCache) ->
- call({connection_init, Trustedcerts, Role, CRLCache});
-
+ {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts),
+ call({connection_init, Extracted, Role, CRLCache});
connection_init(Trustedcerts, Role, CRLCache) ->
- case bypass_pem_cache() of
- true ->
- {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts),
- call({connection_init, Extracted, Role, CRLCache});
- false ->
- call({connection_init, Trustedcerts, Role, CRLCache})
- end.
+ call({connection_init, Trustedcerts, Role, CRLCache}).
%%--------------------------------------------------------------------
-spec cache_pem_file(binary(), term()) -> {ok, term()} | {error, reason()}.
@@ -141,31 +123,14 @@ connection_init(Trustedcerts, Role, CRLCache) ->
%% Description: Cache a pem file and return its content.
%%--------------------------------------------------------------------
cache_pem_file(File, DbHandle) ->
- case bypass_pem_cache() of
- true ->
- ssl_pkix_db:decode_pem_file(File);
- false ->
- case ssl_pkix_db:lookup_cached_pem(DbHandle, File) of
- [{Content,_}] ->
- {ok, Content};
- [Content] ->
- {ok, Content};
- undefined ->
- call({cache_pem, File})
- end
+ case ssl_pkix_db:lookup(File, DbHandle) of
+ [Content] ->
+ {ok, Content};
+ undefined ->
+ ssl_pem_cache:insert(File)
end.
%%--------------------------------------------------------------------
--spec clear_pem_cache() -> ok.
-%%
-%% Description: Clear the PEM cache
-%%--------------------------------------------------------------------
-clear_pem_cache() ->
- %% Not supported for distribution at the moement, should it be?
- put(ssl_manager, manager_name(normal)),
- call(unconditionally_clear_pem_cache).
-
-%%--------------------------------------------------------------------
-spec lookup_trusted_cert(term(), reference(), serialnumber(), issuer()) ->
undefined |
{ok, {der_cert(), #'OTPCertificate'{}}}.
@@ -222,26 +187,22 @@ invalidate_session(Port, Session) ->
load_mitigation(),
cast({invalidate_session, Port, Session}).
--spec invalidate_pem(File::binary()) -> ok.
-invalidate_pem(File) ->
- cast({invalidate_pem, File}).
-
insert_crls(Path, CRLs)->
insert_crls(Path, CRLs, normal).
insert_crls(?NO_DIST_POINT_PATH = Path, CRLs, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
cast({insert_crls, Path, CRLs});
insert_crls(Path, CRLs, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
call({insert_crls, Path, CRLs}).
delete_crls(Path)->
delete_crls(Path, normal).
delete_crls(?NO_DIST_POINT_PATH = Path, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
cast({delete_crls, Path});
delete_crls(Path, ManagerType)->
- put(ssl_manager, manager_name(ManagerType)),
+ put(ssl_manager, name(ManagerType)),
call({delete_crls, Path}).
%%====================================================================
@@ -255,13 +216,14 @@ delete_crls(Path, ManagerType)->
%%
%% Description: Initiates the server
%%--------------------------------------------------------------------
-init([Name, Opts]) ->
- put(ssl_manager, Name),
+init([ManagerName, PemCacheName, Opts]) ->
+ put(ssl_manager, ManagerName),
+ put(ssl_pem_cache, PemCacheName),
process_flag(trap_exit, true),
CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache),
SessionLifeTime =
proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'),
- CertDb = ssl_pkix_db:create(),
+ CertDb = ssl_pkix_db:create(PemCacheName),
ClientSessionCache =
CacheCb:init([{role, client} |
proplists:get_value(session_cb_init_args, Opts, [])]),
@@ -270,16 +232,12 @@ init([Name, Opts]) ->
proplists:get_value(session_cb_init_args, Opts, [])]),
Timer = erlang:send_after(SessionLifeTime * 1000 + 5000,
self(), validate_sessions),
- Interval = pem_check_interval(),
- erlang:send_after(Interval, self(), clear_pem_cache),
{ok, #state{certificate_db = CertDb,
session_cache_client = ClientSessionCache,
session_cache_server = ServerSessionCache,
session_cache_cb = CacheCb,
session_lifetime = SessionLifeTime,
session_validation_timer = Timer,
- last_pem_check = os:timestamp(),
- clear_pem_cache = Interval,
session_cache_client_max =
max_session_cache_size(session_cache_client_max),
session_cache_server_max =
@@ -302,18 +260,25 @@ init([Name, Opts]) ->
handle_call({{connection_init, <<>>, Role, {CRLCb, UserCRLDb}}, _Pid}, _From,
#state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) ->
Ref = make_ref(),
- Result = {ok, Ref, CertDb, FileRefDb, PemChace,
- session_cache(Role, State), {CRLCb, crl_db_info(Db, UserCRLDb)}},
- {reply, Result, State#state{certificate_db = Db}};
+ {reply, {ok, #{cert_db_ref => Ref,
+ cert_db_handle => CertDb,
+ fileref_db_handle => FileRefDb,
+ pem_cache => PemChace,
+ session_cache => session_cache(Role, State),
+ crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State};
handle_call({{connection_init, Trustedcerts, Role, {CRLCb, UserCRLDb}}, Pid}, _From,
#state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) ->
case add_trusted_certs(Pid, Trustedcerts, Db) of
{ok, Ref} ->
- {reply, {ok, Ref, CertDb, FileRefDb, PemChace, session_cache(Role, State),
- {CRLCb, crl_db_info(Db, UserCRLDb)}}, State};
- {error, _} = Error ->
- {reply, Error, State}
+ {reply, {ok, #{cert_db_ref => Ref,
+ cert_db_handle => CertDb,
+ fileref_db_handle => FileRefDb,
+ pem_cache => PemChace,
+ session_cache => session_cache(Role, State),
+ crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State};
+ {error, _} = Error ->
+ {reply, Error, State}
end;
handle_call({{insert_crls, Path, CRLs}, _}, _From,
@@ -330,21 +295,7 @@ handle_call({{new_session_id, Port}, _},
_, #state{session_cache_cb = CacheCb,
session_cache_server = Cache} = State) ->
Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb),
- {reply, Id, State};
-
-handle_call({{cache_pem,File}, _Pid}, _,
- #state{certificate_db = Db} = State) ->
- try ssl_pkix_db:cache_pem_file(File, Db) of
- Result ->
- {reply, Result, State}
- catch
- _:Reason ->
- {reply, {error, Reason}, State}
- end;
-handle_call({unconditionally_clear_pem_cache, _},_,
- #state{certificate_db = [_,_,PemChace | _]} = State) ->
- ssl_pkix_db:clear(PemChace),
- {reply, ok, State}.
+ {reply, Id, State}.
%%--------------------------------------------------------------------
-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}.
@@ -382,11 +333,6 @@ handle_cast({insert_crls, Path, CRLs},
handle_cast({delete_crls, CRLsOrPath},
#state{certificate_db = Db} = State) ->
ssl_pkix_db:remove_crls(Db, CRLsOrPath),
- {noreply, State};
-
-handle_cast({invalidate_pem, File},
- #state{certificate_db = [_, _, PemCache | _]} = State) ->
- ssl_pkix_db:remove(File, PemCache),
{noreply, State}.
%%--------------------------------------------------------------------
@@ -418,22 +364,14 @@ handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = Cache
CacheCb:delete(Cache, Key),
{noreply, State};
-handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace | _],
- clear_pem_cache = Interval,
- last_pem_check = CheckPoint} = State) ->
- NewCheckPoint = os:timestamp(),
- start_pem_cache_validator(PemChace, CheckPoint),
- erlang:send_after(Interval, self(), clear_pem_cache),
- {noreply, State#state{last_pem_check = NewCheckPoint}};
-
handle_info({clean_cert_db, Ref, File},
- #state{certificate_db = [CertDb,RefDb, PemCache | _]} = State) ->
+ #state{certificate_db = [CertDb, {RefDb, FileMapDb} | _]} = State) ->
case ssl_pkix_db:lookup(Ref, RefDb) of
undefined -> %% Alredy cleaned
ok;
_ ->
- clean_cert_db(Ref, CertDb, RefDb, PemCache, File)
+ clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File)
end,
{noreply, State};
@@ -523,14 +461,6 @@ delay_time() ->
?CLEAN_SESSION_DB
end.
-bypass_pem_cache() ->
- case application:get_env(ssl, bypass_pem_cache) of
- {ok, Bool} when is_boolean(Bool) ->
- Bool;
- _ ->
- false
- end.
-
max_session_cache_size(CacheType) ->
case application:get_env(ssl, CacheType) of
{ok, Size} when is_integer(Size) ->
@@ -594,16 +524,11 @@ new_id(Port, Tries, Cache, CacheCb) ->
new_id(Port, Tries - 1, Cache, CacheCb)
end.
-clean_cert_db(Ref, CertDb, RefDb, PemCache, File) ->
+clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) ->
case ssl_pkix_db:ref_count(Ref, RefDb, 0) of
0 ->
- case ssl_pkix_db:lookup_cached_pem(PemCache, File) of
- [{Content, Ref}] ->
- ssl_pkix_db:insert(File, Content, PemCache);
- _ ->
- ok
- end,
ssl_pkix_db:remove(Ref, RefDb),
+ ssl_pkix_db:remove(File, FileMapDb),
ssl_pkix_db:remove_trusted_certs(Ref, CertDb);
_ ->
ok
@@ -687,42 +612,6 @@ exists_equivalent(#session{
exists_equivalent(Session, [ _ | Rest]) ->
exists_equivalent(Session, Rest).
-start_pem_cache_validator(PemCache, CheckPoint) ->
- spawn_link(?MODULE, init_pem_cache_validator,
- [[get(ssl_manager), PemCache, CheckPoint]]).
-
-init_pem_cache_validator([SslManagerName, PemCache, CheckPoint]) ->
- put(ssl_manager, SslManagerName),
- ssl_pkix_db:foldl(fun pem_cache_validate/2,
- CheckPoint, PemCache).
-
-pem_cache_validate({File, _}, CheckPoint) ->
- case file:read_file_info(File, []) of
- {ok, #file_info{mtime = Time}} ->
- case is_before_checkpoint(Time, CheckPoint) of
- true ->
- ok;
- false ->
- invalidate_pem(File)
- end;
- _ ->
- invalidate_pem(File)
- end,
- CheckPoint.
-
-pem_check_interval() ->
- case application:get_env(ssl, ssl_pem_cache_clean) of
- {ok, Interval} when is_integer(Interval) ->
- Interval;
- _ ->
- ?CLEAR_PEM_CACHE
- end.
-
-is_before_checkpoint(Time, CheckPoint) ->
- calendar:datetime_to_gregorian_seconds(
- calendar:now_to_datetime(CheckPoint)) -
- calendar:datetime_to_gregorian_seconds(Time) > 0.
-
add_trusted_certs(Pid, Trustedcerts, Db) ->
try
ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db)
diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl
new file mode 100644
index 0000000000..f63a301f69
--- /dev/null
+++ b/lib/ssl/src/ssl_pem_cache.erl
@@ -0,0 +1,266 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 20016-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%----------------------------------------------------------------------
+%% Purpose: Manages ssl sessions and trusted certifacates
+%%----------------------------------------------------------------------
+
+-module(ssl_pem_cache).
+-behaviour(gen_server).
+
+%% Internal application API
+-export([start_link/1,
+ start_link_dist/1,
+ name/1,
+ insert/1,
+ clear/0]).
+
+% Spawn export
+-export([init_pem_cache_validator/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-include("ssl_handshake.hrl").
+-include("ssl_internal.hrl").
+-include_lib("kernel/include/file.hrl").
+
+-record(state, {
+ pem_cache,
+ last_pem_check :: erlang:timestamp(),
+ clear :: integer()
+ }).
+
+-define(CLEAR_PEM_CACHE, 120000).
+-define(DEFAULT_MAX_SESSION_CACHE, 1000).
+
+%%====================================================================
+%% API
+%%====================================================================
+
+%%--------------------------------------------------------------------
+-spec name(normal | dist) -> atom().
+%%
+%% Description: Returns the registered name of the ssl cache process
+%% in the operation modes 'normal' and 'dist'.
+%%--------------------------------------------------------------------
+name(normal) ->
+ ?MODULE;
+name(dist) ->
+ list_to_atom(atom_to_list(?MODULE) ++ "dist").
+
+%%--------------------------------------------------------------------
+-spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}.
+%%
+%% Description: Starts the ssl pem cache handler
+%%--------------------------------------------------------------------
+start_link(_) ->
+ CacheName = name(normal),
+ gen_server:start_link({local, CacheName},
+ ?MODULE, [CacheName], []).
+
+%%--------------------------------------------------------------------
+-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}.
+%%
+%% Description: Starts a special instance of the ssl manager to
+%% be used by the erlang distribution. Note disables soft upgrade!
+%%--------------------------------------------------------------------
+start_link_dist(_) ->
+ DistCacheName = name(dist),
+ gen_server:start_link({local, DistCacheName},
+ ?MODULE, [DistCacheName], []).
+
+
+%%--------------------------------------------------------------------
+-spec insert(binary()) -> {ok, term()} | {error, reason()}.
+%%
+%% Description: Cache a pem file and return its content.
+%%--------------------------------------------------------------------
+insert(File) ->
+ {ok, PemBin} = file:read_file(File),
+ Content = public_key:pem_decode(PemBin),
+ case bypass_cache() of
+ true ->
+ {ok, Content};
+ false ->
+ cast({cache_pem, File, Content}),
+ {ok, Content}
+ end.
+
+%%--------------------------------------------------------------------
+-spec clear() -> ok.
+%%
+%% Description: Clear the PEM cache
+%%--------------------------------------------------------------------
+clear() ->
+ %% Not supported for distribution at the moement, should it be?
+ put(ssl_pem_cache, name(normal)),
+ call(unconditionally_clear_pem_cache).
+
+-spec invalidate_pem(File::binary()) -> ok.
+invalidate_pem(File) ->
+ cast({invalidate_pem, File}).
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+-spec init(list()) -> {ok, #state{}}.
+%% Possible return values not used now.
+%% | {ok, #state{}, timeout()} | ignore | {stop, term()}.
+%%
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([Name]) ->
+ put(ssl_pem_cache, Name),
+ process_flag(trap_exit, true),
+ PemCache = ssl_pkix_db:create_pem_cache(Name),
+ Interval = pem_check_interval(),
+ erlang:send_after(Interval, self(), clear_pem_cache),
+ {ok, #state{pem_cache = PemCache,
+ last_pem_check = os:timestamp(),
+ clear = Interval
+ }}.
+
+%%--------------------------------------------------------------------
+-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({unconditionally_clear_pem_cache, _},_,
+ #state{pem_cache = PemCache} = State) ->
+ ssl_pkix_db:clear(PemCache),
+ {reply, ok, 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({cache_pem, File, Content}, #state{pem_cache = Db} = State) ->
+ ssl_pkix_db:insert(File, Content, Db),
+ {noreply, State};
+
+handle_cast({invalidate_pem, File}, #state{pem_cache = Db} = State) ->
+ ssl_pkix_db:remove(File, Db),
+ {noreply, State}.
+
+
+%%--------------------------------------------------------------------
+-spec handle_info(msg(), #state{}) -> {noreply, #state{}}.
+%% Possible return values not used now.
+%% |{noreply, #state{}, timeout()} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling all non call/cast messages
+%%-------------------------------------------------------------------
+handle_info(clear_pem_cache, #state{pem_cache = PemCache,
+ clear = Interval,
+ last_pem_check = CheckPoint} = State) ->
+ NewCheckPoint = os:timestamp(),
+ start_pem_cache_validator(PemCache, CheckPoint),
+ erlang:send_after(Interval, self(), clear_pem_cache),
+ {noreply, State#state{last_pem_check = NewCheckPoint}};
+
+handle_info(_Info, State) ->
+ {noreply, 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(Msg) ->
+ gen_server:call(get(ssl_pem_cache), {Msg, self()}, infinity).
+
+cast(Msg) ->
+ gen_server:cast(get(ssl_pem_cache), Msg).
+
+start_pem_cache_validator(PemCache, CheckPoint) ->
+ spawn_link(?MODULE, init_pem_cache_validator,
+ [[get(ssl_pem_cache), PemCache, CheckPoint]]).
+
+init_pem_cache_validator([CacheName, PemCache, CheckPoint]) ->
+ put(ssl_pem_cache, CacheName),
+ ssl_pkix_db:foldl(fun pem_cache_validate/2,
+ CheckPoint, PemCache).
+
+pem_cache_validate({File, _}, CheckPoint) ->
+ case file:read_file_info(File, []) of
+ {ok, #file_info{mtime = Time}} ->
+ case is_before_checkpoint(Time, CheckPoint) of
+ true ->
+ ok;
+ false ->
+ invalidate_pem(File)
+ end;
+ _ ->
+ invalidate_pem(File)
+ end,
+ CheckPoint.
+
+is_before_checkpoint(Time, CheckPoint) ->
+ calendar:datetime_to_gregorian_seconds(
+ calendar:now_to_datetime(CheckPoint)) -
+ calendar:datetime_to_gregorian_seconds(Time) > 0.
+
+pem_check_interval() ->
+ case application:get_env(ssl, ssl_pem_cache_clean) of
+ {ok, Interval} when is_integer(Interval) ->
+ Interval;
+ _ ->
+ ?CLEAR_PEM_CACHE
+ end.
+
+bypass_cache() ->
+ case application:get_env(ssl, bypass_pem_cache) of
+ {ok, Bool} when is_boolean(Bool) ->
+ Bool;
+ _ ->
+ false
+ end.
diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl
index b4299969e4..cde05bb16f 100644
--- a/lib/ssl/src/ssl_pkix_db.erl
+++ b/lib/ssl/src/ssl_pkix_db.erl
@@ -28,11 +28,11 @@
-include_lib("public_key/include/public_key.hrl").
-include_lib("kernel/include/file.hrl").
--export([create/0, add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3,
+-export([create/1, create_pem_cache/1,
+ add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3,
extract_trusted_certs/1,
remove_trusted_certs/2, insert/3, remove/2, clear/1, db_size/1,
ref_count/3, lookup_trusted_cert/4, foldl/3, select_cert_by_issuer/2,
- lookup_cached_pem/2, cache_pem_file/2, cache_pem_file/3,
decode_pem_file/1, lookup/2]).
%%====================================================================
@@ -40,25 +40,31 @@
%%====================================================================
%%--------------------------------------------------------------------
--spec create() -> [db_handle(),...].
+-spec create(atom()) -> [db_handle(),...].
%%
%% Description: Creates a new certificate db.
%% Note: lookup_trusted_cert/4 may be called from any process but only
%% the process that called create may call the other functions.
%%--------------------------------------------------------------------
-create() ->
+create(PEMCacheName) ->
[%% Let connection process delete trusted certs
%% that can only belong to one connection. (Supplied directly
%% on DER format to ssl:connect/listen.)
ets:new(ssl_otp_cacertificate_db, [set, public]),
%% Let connection processes call ref_count/3 directly
- ets:new(ssl_otp_ca_file_ref, [set, public]),
- ets:new(ssl_otp_pem_cache, [set, protected]),
+ {ets:new(ssl_otp_ca_file_ref, [set, public]),
+ ets:new(ssl_otp_ca_ref_file_mapping, [set, protected])
+ },
+ %% Lookups in named table owned by ssl_pem_cache process
+ PEMCacheName,
%% Default cache
{ets:new(ssl_otp_crl_cache, [set, protected]),
ets:new(ssl_otp_crl_issuer_mapping, [bag, protected])}
].
+create_pem_cache(Name) ->
+ ets:new(Name, [named_table, set, protected]).
+
%%--------------------------------------------------------------------
-spec remove([db_handle()]) -> ok.
%%
@@ -70,6 +76,10 @@ remove(Dbs) ->
true = ets:delete(Db1);
(undefined) ->
ok;
+ (ssl_pem_cache) ->
+ ok;
+ (ssl_pem_cache_dist) ->
+ ok;
(Db) ->
true = ets:delete(Db)
end, Dbs).
@@ -101,11 +111,6 @@ lookup_trusted_cert(_DbHandle, {extracted,Certs}, SerialNumber, Issuer) ->
{ok, Cert}
end.
-lookup_cached_pem([_, _, PemChache | _], File) ->
- lookup_cached_pem(PemChache, File);
-lookup_cached_pem(PemChache, File) ->
- lookup(File, PemChache).
-
%%--------------------------------------------------------------------
-spec add_trusted_certs(pid(), {erlang:timestamp(), string()} |
{der, list()}, [db_handle()]) -> {ok, [db_handle()]}.
@@ -122,17 +127,11 @@ add_trusted_certs(_Pid, {der, DerList}, [CertDb, _,_ | _]) ->
add_certs_from_der(DerList, NewRef, CertDb),
{ok, NewRef};
-add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache | _] = Db) ->
- case lookup_cached_pem(Db, File) of
- [{_Content, Ref}] ->
+add_trusted_certs(_Pid, File, [ _, {RefDb, FileMapDb} | _] = Db) ->
+ case lookup(File, FileMapDb) of
+ [Ref] ->
ref_count(Ref, RefDb, 1),
{ok, Ref};
- [Content] ->
- Ref = make_ref(),
- update_counter(Ref, 1, RefDb),
- insert(File, {Content, Ref}, PemChache),
- add_certs_from_pem(Content, Ref, CertsDb),
- {ok, Ref};
undefined ->
new_trusted_cert_entry(File, Db)
end.
@@ -151,25 +150,6 @@ extract_trusted_certs(File) ->
{error, {badmatch, Error}}
end.
-%%--------------------------------------------------------------------
-%%
-%% Description: Cache file as binary in DB
-%%--------------------------------------------------------------------
--spec cache_pem_file(binary(), [db_handle()]) -> {ok, term()}.
-cache_pem_file(File, [_CertsDb, _RefDb, PemChache | _]) ->
- {ok, PemBin} = file:read_file(File),
- Content = public_key:pem_decode(PemBin),
- insert(File, Content, PemChache),
- {ok, Content}.
-
-
--spec cache_pem_file(reference(), binary(), [db_handle()]) -> {ok, term()}.
-cache_pem_file(Ref, File, [_CertsDb, _RefDb, PemChache| _]) ->
- {ok, PemBin} = file:read_file(File),
- Content = public_key:pem_decode(PemBin),
- insert(File, {Content, Ref}, PemChache),
- {ok, Content}.
-
-spec decode_pem_file(binary()) -> {ok, term()}.
decode_pem_file(File) ->
case file:read_file(File) of
@@ -246,6 +226,8 @@ select_cert_by_issuer(Cache, Issuer) ->
%%--------------------------------------------------------------------
ref_count({extracted, _}, _Db, _N) ->
not_cached;
+ref_count(Key, {Db, _}, N) ->
+ ref_count(Key, Db, N);
ref_count(Key, Db, N) ->
ets:update_counter(Db,Key,N).
@@ -278,9 +260,9 @@ insert(Key, Data, Db) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-update_counter(Key, Count, Db) ->
- true = ets:insert(Db, {Key, Count}),
- ok.
+init_ref_db(Ref, File, {RefDb, FileMapDb}) ->
+ true = ets:insert(RefDb, {Ref, 1}),
+ true = ets:insert(FileMapDb, {File, Ref}).
remove_certs(Ref, CertsDb) ->
true = ets:match_delete(CertsDb, {{Ref, '_', '_'}, '_'}),
@@ -326,10 +308,10 @@ decode_certs(Ref, Cert) ->
undefined
end.
-new_trusted_cert_entry(File, [CertsDb, RefDb, _ | _] = Db) ->
+new_trusted_cert_entry(File, [CertsDb, RefsDb, _ | _]) ->
Ref = make_ref(),
- update_counter(Ref, 1, RefDb),
- {ok, Content} = cache_pem_file(Ref, File, Db),
+ init_ref_db(Ref, File, RefsDb),
+ {ok, Content} = ssl_pem_cache:insert(File),
add_certs_from_pem(Content, Ref, CertsDb),
{ok, Ref}.
diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl
index 8245801139..05a7aaaa82 100644
--- a/lib/ssl/src/ssl_sup.erl
+++ b/lib/ssl/src/ssl_sup.erl
@@ -25,7 +25,7 @@
-behaviour(supervisor).
%% API
--export([start_link/0, manager_opts/0]).
+-export([start_link/0]).
%% Supervisor callback
-export([init/1]).
@@ -44,90 +44,28 @@ start_link() ->
%%%=========================================================================
init([]) ->
- SessionCertManager = session_and_cert_manager_child_spec(),
- TLSConnetionManager = tls_connection_manager_child_spec(),
- %% 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(),
-
- DTLSConnetionManager = dtls_connection_manager_child_spec(),
- DTLSUdpListeners = dtls_udp_listeners_spec(),
+ {ok, {{rest_for_one, 10, 3600}, [ssl_admin_child_spec(),
+ ssl_connection_sup()
+ ]}}.
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager,
- ListenOptionsTracker,
- DTLSConnetionManager, DTLSUdpListeners
- ]}}.
-
-
-manager_opts() ->
- CbOpts = case application:get_env(ssl, session_cb) of
- {ok, Cb} when is_atom(Cb) ->
- InitArgs = session_cb_init_args(),
- [{session_cb, Cb}, {session_cb_init_args, InitArgs}];
- _ ->
- []
- end,
- case application:get_env(ssl, session_lifetime) of
- {ok, Time} when is_integer(Time) ->
- [{session_lifetime, Time}| CbOpts];
- _ ->
- CbOpts
- end.
-
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-
-session_and_cert_manager_child_spec() ->
- Opts = manager_opts(),
- Name = ssl_manager,
- StartFunc = {ssl_manager, start_link, [Opts]},
+ssl_admin_child_spec() ->
+ Name = ssl_admin_sup,
+ StartFunc = {ssl_admin_sup, start_link, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [ssl_manager],
- Type = worker,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-tls_connection_manager_child_spec() ->
- Name = tls_connection,
- StartFunc = {tls_connection_sup, start_link, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [tls_connection_sup],
+ Modules = [ssl_admin_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-dtls_connection_manager_child_spec() ->
- Name = dtls_connection,
- StartFunc = {dtls_connection_sup, start_link, []},
+ssl_connection_sup() ->
+ Name = ssl_connection_sup,
+ StartFunc = {ssl_connection_sup, start_link, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [dtls_connection_sup],
- Type = supervisor,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-listen_options_tracker_child_spec() ->
- Name = tls_socket,
- StartFunc = {ssl_listen_tracker_sup, start_link, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [tls_socket],
- Type = supervisor,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
-dtls_udp_listeners_spec() ->
- Name = dtls_udp_listener,
- StartFunc = {dtls_udp_sup, start_link, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [],
+ Modules = [ssl_connection_sup],
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) ->
- Args;
- _ ->
- []
- end.
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 32991d3079..c6e530e164 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -48,7 +48,7 @@
-export([encode_data/3, encode_alert/3]).
%% State transition handling
--export([next_record/1, next_event/3]).
+-export([next_record/1, next_event/3, next_event/4]).
%% Handshake handling
-export([renegotiate/2, send_handshake/2,
@@ -59,7 +59,8 @@
-export([send_alert/2, close/5]).
%% Data handling
--export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3]).
+-export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3,
+ socket/5]).
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
@@ -117,7 +118,7 @@ send_handshake_flight(#state{socket = Socket,
transport_cb = Transport,
flight_buffer = Flight} = State0) ->
send(Transport, Socket, Flight),
- State0#state{flight_buffer = []}.
+ {State0#state{flight_buffer = []}, []}.
queue_change_cipher(Msg, #state{negotiated_version = Version,
flight_buffer = Flight0,
@@ -191,6 +192,10 @@ init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
callback_mode() ->
state_functions.
+socket(Pid, Transport, Socket, Connection, Tracker) ->
+ tls_socket:socket(Pid, Transport, Socket, Connection, Tracker).
+
+
%%--------------------------------------------------------------------
%% State functions
%%--------------------------------------------------------------------
@@ -340,12 +345,12 @@ connection(internal, #hello_request{},
renegotiation = {Renegotiation, _}} = State0) ->
Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert),
- State1 = send_handshake(Hello, State0),
+ {State1, Actions} = send_handshake(Hello, State0),
{Record, State} =
next_record(
State1#state{session = Session0#session{session_id
= Hello#client_hello.session_id}}),
- next_event(hello, Record, State);
+ next_event(hello, Record, State, Actions);
connection(internal, #client_hello{} = Hello,
#state{role = server, allow_renegotiate = true} = State0) ->
%% Mitigate Computational DoS attack
@@ -424,18 +429,26 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
ssl_options = Options} = State0) ->
try
{Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options),
- State =
+ State1 =
State0#state{protocol_buffers =
Buffers#protocol_buffers{tls_handshake_buffer = Buf}},
- Events = tls_handshake_events(Packets),
- case StateName of
- connection ->
- ssl_connection:hibernate_after(StateName, State, Events);
- _ ->
- {next_state, StateName, State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
- end
+ case Packets of
+ [] ->
+ assert_buffer_sanity(Buf, Options),
+ {Record, State} = next_record(State1),
+ next_event(StateName, Record, State);
+ _ ->
+ Events = tls_handshake_events(Packets),
+ case StateName of
+ connection ->
+ ssl_connection:hibernate_after(StateName, State1, Events);
+ _ ->
+ {next_state, StateName,
+ State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
+ end
+ end
catch throw:#alert{} = Alert ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
end;
%%% TLS record protocol level application data messages
handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) ->
@@ -615,8 +628,6 @@ next_event(StateName, Record, State, Actions) ->
{next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
end.
-tls_handshake_events([]) ->
- throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake));
tls_handshake_events(Packets) ->
lists:map(fun(Packet) ->
{next_event, internal, {handshake, Packet}}
@@ -735,3 +746,25 @@ unprocessed_events(Events) ->
%% handshake events left to process before we should
%% process more TLS-records received on the socket.
erlang:length(Events)-1.
+
+
+assert_buffer_sanity(<<?BYTE(_Type), ?UINT24(Length), Rest/binary>>, #ssl_options{max_handshake_size = Max}) when
+ Length =< Max ->
+ case size(Rest) of
+ N when N < Length ->
+ true;
+ N when N > Length ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ too_big_handshake_data));
+ _ ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ malformed_handshake_data))
+ end;
+assert_buffer_sanity(Bin, _) ->
+ case size(Bin) of
+ N when N < 3 ->
+ true;
+ _ ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ malformed_handshake_data))
+ end.
diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index 2800ee6537..f4803ce19f 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -192,7 +192,8 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId,
end.
get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length),
- Body:Length/binary,Rest/binary>>, #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) ->
+ Body:Length/binary,Rest/binary>>,
+ #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) ->
Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>,
try decode_handshake(Version, Type, Body, V2Hello) of
Handshake ->
@@ -207,27 +208,17 @@ get_tls_handshake_aux(_Version, Data, _, Acc) ->
decode_handshake(_, ?HELLO_REQUEST, <<>>, _) ->
#hello_request{};
-%% Client hello v2.
-%% The server must be able to receive such messages, from clients that
-%% are willing to use ssl v3 or higher, but have ssl v2 compatibility.
-decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>, true) ->
- #client_hello{client_version = {Major, Minor},
- random = ssl_v2:client_random(ChallengeData, CDLength),
- session_id = 0,
- cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites),
- compression_methods = [?NULL],
- extensions = #hello_extensions{}
- };
-decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(_), ?BYTE(_),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- _CipherSuites:CSLength/binary,
- _ChallengeData:CDLength/binary>>, false) ->
- throw(?ALERT_REC(?FATAL, ?PROTOCOL_VERSION, ssl_v2_client_hello_no_supported));
+decode_handshake(_Version, ?CLIENT_HELLO, Bin, true) ->
+ try decode_hello(Bin) of
+ Hello ->
+ Hello
+ catch
+ _:_ ->
+ decode_v2_hello(Bin)
+ end;
+decode_handshake(_Version, ?CLIENT_HELLO, Bin, false) ->
+ decode_hello(Bin);
+
decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
?UINT16(Cs_length), CipherSuites:Cs_length/binary,
@@ -244,10 +235,40 @@ decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:3
compression_methods = Comp_methods,
extensions = DecodedExtensions
};
-
decode_handshake(Version, Tag, Msg, _) ->
ssl_handshake:decode_handshake(Version, Tag, Msg).
+
+decode_hello(<<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
+ ?BYTE(SID_length), Session_ID:SID_length/binary,
+ ?UINT16(Cs_length), CipherSuites:Cs_length/binary,
+ ?BYTE(Cm_length), Comp_methods:Cm_length/binary,
+ Extensions/binary>>) ->
+ DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}),
+
+ #client_hello{
+ client_version = {Major,Minor},
+ random = Random,
+ session_id = Session_ID,
+ cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites),
+ compression_methods = Comp_methods,
+ extensions = DecodedExtensions
+ }.
+%% The server must be able to receive such messages, from clients that
+%% are willing to use ssl v3 or higher, but have ssl v2 compatibility.
+decode_v2_hello(<<?BYTE(Major), ?BYTE(Minor),
+ ?UINT16(CSLength), ?UINT16(0),
+ ?UINT16(CDLength),
+ CipherSuites:CSLength/binary,
+ ChallengeData:CDLength/binary>>) ->
+ #client_hello{client_version = {Major, Minor},
+ random = ssl_v2:client_random(ChallengeData, CDLength),
+ session_id = 0,
+ cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites),
+ compression_methods = [?NULL],
+ extensions = #hello_extensions{}
+ }.
+
enc_handshake(#hello_request{}, _Version) ->
{?HELLO_REQUEST, <<>>};
enc_handshake(#client_hello{client_version = {Major, Minor},
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index 7f24ce5192..32bcdf71c3 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -204,21 +204,21 @@ suites(Minor) when Minor == 1; Minor == 2 ->
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA,
?TLS_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_WITH_3DES_EDE_CBC_SHA,
-
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_CBC_SHA
+ ?TLS_RSA_WITH_AES_128_CBC_SHA,
+
+ ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_RSA_WITH_3DES_EDE_CBC_SHA
];
suites(3) ->
[
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index d85be6c69e..e14f7f60c4 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -172,8 +172,8 @@ revoke(Root, CA, User, C) ->
gencrl(Root, CA, C).
gencrl(Root, CA, C) ->
- %% By default, the CRL is valid for 24 hours from now.
- gencrl(Root, CA, C, 24).
+ %% By default, the CRL is valid for a week from now.
+ gencrl(Root, CA, C, 24*7).
gencrl(Root, CA, C, CrlHours) ->
CACnfFile = filename:join([Root, CA, "ca.cnf"]),
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 52c1af5b4c..bff6d254f1 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -53,7 +53,8 @@ all() ->
{group, options_tls},
{group, session},
{group, 'dtlsv1.2'},
- %%{group, 'dtlsv1'},
+ %% {group, 'dtlsv1'}, Breaks dtls in cert_verify_SUITE enable later when
+ %% problem is identified and fixed
{group, 'tlsv1.2'},
{group, 'tlsv1.1'},
{group, 'tlsv1'},
@@ -65,15 +66,15 @@ groups() ->
{basic_tls, [], basic_tests_tls()},
{options, [], options_tests()},
{options_tls, [], options_tests_tls()},
- %%{'dtlsv1.2', [], all_versions_groups()},
- {'dtlsv1.2', [], [connection_information]},
- %%{'dtlsv1', [], all_versions_groups()},
+ {'dtlsv1.2', [], all_versions_groups()},
+ {'dtlsv1', [], all_versions_groups()},
{'tlsv1.2', [], all_versions_groups() ++ tls_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]},
{'tlsv1.1', [], all_versions_groups() ++ tls_versions_groups()},
{'tlsv1', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests()},
{'sslv3', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests() ++ [tls_ciphersuite_vs_version]},
{api,[], api_tests()},
{api_tls,[], api_tests_tls()},
+ {tls_ciphers,[], tls_cipher_tests()},
{session, [], session_tests()},
{renegotiate, [], renegotiate_tests()},
{ciphers, [], cipher_tests()},
@@ -83,12 +84,13 @@ groups() ->
].
tls_versions_groups ()->
- [{group, api_tls},
+ [{group, renegotiate}, %% Should be in all_versions_groups not fixed for DTLS yet
+ {group, api_tls},
+ {group, tls_ciphers},
{group, error_handling_tests_tls}].
all_versions_groups ()->
[{group, api},
- {group, renegotiate},
{group, ciphers},
{group, ciphers_ec},
{group, error_handling_tests}].
@@ -136,7 +138,8 @@ options_tests() ->
honor_server_cipher_order,
honor_client_cipher_order,
unordered_protocol_versions_server,
- unordered_protocol_versions_client
+ unordered_protocol_versions_client,
+ max_handshake_size
].
options_tests_tls() ->
@@ -146,10 +149,8 @@ options_tests_tls() ->
api_tests() ->
[connection_info,
connection_information,
- peername,
peercert,
peercert_with_client_cert,
- sockname,
versions,
eccs,
controlling_process,
@@ -161,7 +162,6 @@ api_tests() ->
ssl_recv_timeout,
server_name_indication_option,
accept_pool,
- new_options_in_accept,
prf
].
@@ -174,7 +174,10 @@ api_tests_tls() ->
tls_shutdown,
tls_shutdown_write,
tls_shutdown_both,
- tls_shutdown_error
+ tls_shutdown_error,
+ peername,
+ sockname,
+ new_options_in_accept
].
session_tests() ->
@@ -196,6 +199,11 @@ renegotiate_tests() ->
renegotiate_dos_mitigate_passive,
renegotiate_dos_mitigate_absolute].
+tls_cipher_tests() ->
+ [rc4_rsa_cipher_suites,
+ rc4_ecdh_rsa_cipher_suites,
+ rc4_ecdsa_cipher_suites].
+
cipher_tests() ->
[cipher_suites,
cipher_suites_mix,
@@ -211,9 +219,6 @@ cipher_tests() ->
srp_cipher_suites,
srp_anon_cipher_suites,
srp_dsa_cipher_suites,
- rc4_rsa_cipher_suites,
- rc4_ecdh_rsa_cipher_suites,
- rc4_ecdsa_cipher_suites,
des_rsa_cipher_suites,
des_ecdh_rsa_cipher_suites,
default_reject_anonymous].
@@ -225,15 +230,15 @@ cipher_tests_ec() ->
ciphers_ecdh_rsa_signed_certs_openssl_names].
error_handling_tests()->
- [controller_dies,
- close_transport_accept,
+ [close_transport_accept,
recv_active,
recv_active_once,
recv_error_handling
].
error_handling_tests_tls()->
- [tls_client_closes_socket,
+ [controller_dies,
+ tls_client_closes_socket,
tls_tcp_error_propagation_in_active_mode,
tls_tcp_connect,
tls_tcp_connect_big,
@@ -842,8 +847,7 @@ controller_dies(Config) when is_list(Config) ->
Server ! listen,
Tester = self(),
Connect = fun(Pid) ->
- {ok, Socket} = ssl:connect(Hostname, Port,
- [{reuseaddr,true},{ssl_imp,new}]),
+ {ok, Socket} = ssl:connect(Hostname, Port, ClientOpts),
%% Make sure server finishes and verification
%% and is in coonection state before
%% killing client
@@ -960,9 +964,9 @@ clear_pem_cache(Config) when is_list(Config) ->
{status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
- [_,FilRefDb |_] = element(6, State),
+ [_,{FilRefDb, _} |_] = element(6, State),
{Server, Client} = basic_verify_test_no_close(Config),
- CountReferencedFiles = fun({_,-1}, Acc) ->
+ CountReferencedFiles = fun({_, -1}, Acc) ->
Acc;
({_, N}, Acc) ->
N + Acc
@@ -2193,8 +2197,9 @@ ciphers_dsa_signed_certs() ->
[{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_dsa_signed_certs(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)),
+ Ciphers = ssl_test_lib:dsa_suites(NVersion),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
run_suites(Ciphers, Version, Config, dsa).
%%-------------------------------------------------------------------
@@ -2217,29 +2222,33 @@ anonymous_cipher_suites(Config) when is_list(Config) ->
psk_cipher_suites() ->
[{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_suites(),
+ Ciphers = ssl_test_lib:psk_suites(NVersion),
run_suites(Ciphers, Version, Config, psk).
%%-------------------------------------------------------------------
psk_with_hint_cipher_suites()->
[{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}].
psk_with_hint_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_suites(),
+ Ciphers = ssl_test_lib:psk_suites(NVersion),
run_suites(Ciphers, Version, Config, psk_with_hint).
%%-------------------------------------------------------------------
psk_anon_cipher_suites() ->
[{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_anon_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_anon_suites(),
+ Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
run_suites(Ciphers, Version, Config, psk_anon).
%%-------------------------------------------------------------------
psk_anon_with_hint_cipher_suites()->
[{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}].
psk_anon_with_hint_cipher_suites(Config) when is_list(Config) ->
+ NVersion = tls_record:highest_protocol_version([]),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:psk_anon_suites(),
+ Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
run_suites(Ciphers, Version, Config, psk_anon_with_hint).
%%-------------------------------------------------------------------
srp_cipher_suites()->
@@ -2290,18 +2299,17 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) ->
%%-------------------------------------------------------------------
des_rsa_cipher_suites()->
- [{doc, "Test the RC4 ciphersuites"}].
+ [{doc, "Test the des_rsa ciphersuites"}].
des_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:des_suites(NVersion),
+ Version = ssl_test_lib:protocol_version(Config),
+ Ciphers = ssl_test_lib:des_suites(Config),
run_suites(Ciphers, Version, Config, des_rsa).
%-------------------------------------------------------------------
des_ecdh_rsa_cipher_suites()->
- [{doc, "Test the RC4 ciphersuites"}].
+ [{doc, "Test ECDH rsa signed ciphersuites"}].
des_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:des_suites(NVersion),
run_suites(Ciphers, Version, Config, des_dhe_rsa).
@@ -2312,9 +2320,11 @@ default_reject_anonymous(Config) when is_list(Config) ->
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- Version = tls_record:highest_protocol_version(tls_record:supported_protocol_versions()),
- [CipherSuite | _] = ssl_test_lib:anonymous_suites(Version),
-
+ Version = ssl_test_lib:protocol_version(Config),
+ TLSVersion = ssl_test_lib:tls_version(Version),
+
+ [CipherSuite | _] = ssl_test_lib:anonymous_suites(TLSVersion),
+
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
{from, self()},
{options, ServerOpts}]),
@@ -2334,8 +2344,9 @@ ciphers_ecdsa_signed_certs() ->
[{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdsa_signed_certs(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:ecdsa_suites(tls_record:protocol_version(Version)),
+ Ciphers = ssl_test_lib:ecdsa_suites(NVersion),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
run_suites(Ciphers, Version, Config, ecdsa).
%%--------------------------------------------------------------------
@@ -2352,8 +2363,9 @@ ciphers_ecdh_rsa_signed_certs() ->
[{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:ecdh_rsa_suites(tls_record:protocol_version(Version)),
+ Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion),
ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
run_suites(Ciphers, Version, Config, ecdh_rsa).
%%--------------------------------------------------------------------
@@ -3325,11 +3337,11 @@ hibernate(Config) ->
process_info(Pid, current_function),
ssl_test_lib:check_result(Server, ok, Client, ok),
- timer:sleep(1100),
-
+
+ timer:sleep(1500),
{current_function, {erlang, hibernate, 3}} =
process_info(Pid, current_function),
-
+
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
@@ -3362,13 +3374,12 @@ hibernate_right_away(Config) ->
[{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]),
ssl_test_lib:check_result(Server1, ok, Client1, ok),
-
- {current_function, {erlang, hibernate, 3}} =
+
+ {current_function, {erlang, hibernate, 3}} =
process_info(Pid1, current_function),
-
ssl_test_lib:close(Server1),
ssl_test_lib:close(Client1),
-
+
Server2 = ssl_test_lib:start_server(StartServerOpts),
Port2 = ssl_test_lib:inet_port(Server2),
{Client2, #sslsocket{pid = Pid2}} = ssl_test_lib:start_client(StartClientOpts ++
@@ -3376,8 +3387,8 @@ hibernate_right_away(Config) ->
ssl_test_lib:check_result(Server2, ok, Client2, ok),
- ct:sleep(100), %% Schedule out
-
+ ct:sleep(1000), %% Schedule out
+
{current_function, {erlang, hibernate, 3}} =
process_info(Pid2, current_function),
@@ -3860,6 +3871,29 @@ unordered_protocol_versions_client(Config) when is_list(Config) ->
ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg).
%%--------------------------------------------------------------------
+max_handshake_size() ->
+ [{doc,"Test that we can set max_handshake_size to max value."}].
+
+max_handshake_size(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(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, [{max_handshake_size, 8388607} |ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, [{max_handshake_size, 8388607} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok).
+
+%%--------------------------------------------------------------------
server_name_indication_option() ->
[{doc,"Test API server_name_indication option to connect."}].
@@ -4483,16 +4517,21 @@ run_suites(Ciphers, Version, Config, Type) ->
[{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(Version)}]};
psk ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk, Config)};
+ [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk, Config)]};
psk_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk_hint, Config)};
+ [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk_hint, Config)
+ ]};
psk_anon ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk_anon, Config)};
+ [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk_anon, Config)]};
psk_anon_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- ssl_test_lib:ssl_options(server_psk_anon_hint, Config)};
+ [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]};
srp ->
{ssl_test_lib:ssl_options(client_srp, Config),
ssl_test_lib:ssl_options(server_srp, Config)};
@@ -4532,7 +4571,7 @@ run_suites(Ciphers, Version, Config, Type) ->
Result = lists:map(fun(Cipher) ->
cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end,
- ssl_test_lib:filter_suites(Ciphers)),
+ ssl_test_lib:filter_suites(Ciphers, Version)),
case lists:flatten(Result) of
[] ->
ok;
diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
index 5265c87e29..4552a4f57d 100644
--- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl
+++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
@@ -39,17 +39,26 @@
%% Common Test interface functions -----------------------------------
%%--------------------------------------------------------------------
all() ->
- [{group, active},
- {group, passive},
- {group, active_once},
- {group, error_handling}].
-
+ [
+ {group, tls},
+ {group, dtls}
+ ].
groups() ->
- [{active, [], tests()},
+ [
+ {tls, [], all_protocol_groups()},
+ {dtls, [], all_protocol_groups()},
+ {active, [], tests()},
{active_once, [], tests()},
{passive, [], tests()},
- {error_handling, [],error_handling_tests()}].
+ {error_handling, [],error_handling_tests()}
+ ].
+
+all_protocol_groups() ->
+ [{group, active},
+ {group, passive},
+ {group, active_once},
+ {group, error_handling}].
tests() ->
[verify_peer,
@@ -85,7 +94,7 @@ init_per_suite(Config0) ->
catch crypto:stop(),
try crypto:start() of
ok ->
- ssl_test_lib:clean_start(),
+ ssl_test_lib:clean_start(),
%% make rsa certs using oppenssl
{ok, _} = make_certs:all(proplists:get_value(data_dir, Config0),
proplists:get_value(priv_dir, Config0)),
@@ -99,6 +108,26 @@ end_per_suite(_Config) ->
ssl:stop(),
application:stop(crypto).
+init_per_group(tls, Config) ->
+ Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
+ ssl:stop(),
+ application:load(ssl),
+ application:set_env(ssl, protocol_version, Version),
+ application:set_env(ssl, bypass_pem_cache, Version),
+ ssl:start(),
+ NewConfig = proplists:delete(protocol, Config),
+ [{protocol, tls}, {version, tls_record:protocol_version(Version)} | NewConfig];
+
+init_per_group(dtls, Config) ->
+ Version = dtls_record:protocol_version(dtls_record:highest_protocol_version([])),
+ ssl:stop(),
+ application:load(ssl),
+ application:set_env(ssl, protocol_version, Version),
+ application:set_env(ssl, bypass_pem_cache, Version),
+ ssl:start(),
+ NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)),
+ [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}, {version, dtls_record:protocol_version(Version)} | NewConfig];
+
init_per_group(active, Config) ->
[{active, true}, {receive_function, send_recv_result_active} | Config];
init_per_group(active_once, Config) ->
@@ -262,7 +291,7 @@ server_require_peer_cert_fail() ->
server_require_peer_cert_fail(Config) when is_list(Config) ->
ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}
| ssl_test_lib:ssl_options(server_verification_opts, Config)],
- BadClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ BadClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
@@ -411,7 +440,7 @@ server_require_peer_cert_partial_chain_fun_fail() ->
server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) ->
ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}
| ssl_test_lib:ssl_options(server_verification_opts, Config)],
- ClientOpts = proplists:get_value(client_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
{ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)),
@@ -1091,6 +1120,7 @@ client_with_cert_cipher_suites_handshake() ->
client_with_cert_cipher_suites_handshake(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_verification_opts_digital_signature_only, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
@@ -1098,7 +1128,7 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) ->
send_recv_result_active, []}},
{options, [{active, true},
{ciphers,
- ssl_test_lib:rsa_non_signed_suites(tls_record:highest_protocol_version([]))}
+ ssl_test_lib:rsa_non_signed_suites(proplists:get_value(version, Config))}
| ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
@@ -1132,7 +1162,7 @@ server_verify_no_cacerts(Config) when is_list(Config) ->
unknown_server_ca_fail() ->
[{doc,"Test that the client fails if the ca is unknown in verify_peer mode"}].
unknown_server_ca_fail(Config) when is_list(Config) ->
- ClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
@@ -1176,7 +1206,7 @@ unknown_server_ca_fail(Config) when is_list(Config) ->
unknown_server_ca_accept_verify_none() ->
[{doc,"Test that the client succeds if the ca is unknown in verify_none mode"}].
unknown_server_ca_accept_verify_none(Config) when is_list(Config) ->
- ClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
@@ -1201,8 +1231,8 @@ unknown_server_ca_accept_verify_peer() ->
[{doc, "Test that the client succeds if the ca is unknown in verify_peer mode"
" with a verify_fun that accepts the unknown ca error"}].
unknown_server_ca_accept_verify_peer(Config) when is_list(Config) ->
- ClientOpts =ssl_test_lib:ssl_options(client_opts, []),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
@@ -1240,7 +1270,7 @@ unknown_server_ca_accept_verify_peer(Config) when is_list(Config) ->
unknown_server_ca_accept_backwardscompatibility() ->
[{doc,"Test that old style verify_funs will work"}].
unknown_server_ca_accept_backwardscompatibility(Config) when is_list(Config) ->
- ClientOpts = ssl_test_lib:ssl_options(client_opts, []),
+ ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl
index 74b14145dd..0a50c98a28 100644
--- a/lib/ssl/test/ssl_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_handshake_SUITE.erl
@@ -33,6 +33,7 @@
%% Common Test interface functions -----------------------------------
%%--------------------------------------------------------------------
all() -> [decode_hello_handshake,
+ decode_hello_handshake_version_confusion,
decode_single_hello_extension_correctly,
decode_supported_elliptic_curves_hello_extension_correctly,
decode_unknown_hello_extension_correctly,
@@ -106,6 +107,14 @@ decode_hello_handshake(_Config) ->
#renegotiation_info{renegotiated_connection = <<0>>}
= (Hello#server_hello.extensions)#hello_extensions.renegotiation_info.
+
+decode_hello_handshake_version_confusion(_) ->
+ HelloPacket = <<3,3,0,0,0,0,0,63,210,235,149,6,244,140,108,13,177,74,16,218,33,108,219,41,73,228,3,82,132,123,73,144,118,100,0,0,32,192,4,0,10,192,45,192,38,0,47,192,18,0,163,0,22,0,165,192,29,192,18,192,30,0,103,0,57,192,48,0,47,1,0>>,
+ Version = {3,3},
+ ClientHello = 1,
+ Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, false),
+ Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, true).
+
decode_single_hello_extension_correctly(_Config) ->
Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>,
Extensions = ssl_handshake:decode_hello_extensions(Renegotiation),
diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl
index 69aeea10c5..0b1de1dc1c 100644
--- a/lib/ssl/test/ssl_npn_hello_SUITE.erl
+++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl
@@ -50,6 +50,10 @@ init_per_suite(Config) ->
{skip, "Crypto did not start"}
end.
+end_per_suite(_Config) ->
+ %% This function is required since init_per_suite/1 exists.
+ ok.
+
init_per_testcase(_TestCase, Config) ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
ct:timetrap({seconds, 5}),
diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl
index f10d27fbc6..96b15d9b51 100644
--- a/lib/ssl/test/ssl_pem_cache_SUITE.erl
+++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl
@@ -82,8 +82,8 @@ pem_cleanup() ->
[{doc, "Test pem cache invalidate mechanism"}].
pem_cleanup(Config)when is_list(Config) ->
process_flag(trap_exit, true),
- ClientOpts = proplists:get_value(client_opts, Config),
- ServerOpts = proplists:get_value(server_opts, Config),
+ ClientOpts = proplists:get_value(client_verification_opts, Config),
+ ServerOpts = proplists:get_value(server_verification_opts, Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server =
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 9632103696..7a644968f2 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -278,8 +278,11 @@ check_result(Server, ServerMsg, Client, ClientMsg) ->
check_result(Server, ServerMsg);
{Port, {data,Debug}} when is_port(Port) ->
- ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]),
+ ct:log("~p:~p~n Openssl ~s~n",[?MODULE,?LINE, Debug]),
check_result(Server, ServerMsg, Client, ClientMsg);
+ {Port,closed} when is_port(Port) ->
+ ct:log("~p:~p~n Openssl port ~n",[?MODULE,?LINE]),
+ check_result(Server, ServerMsg, Client, ClientMsg);
Unexpected ->
Reason = {{expected, {Client, ClientMsg}},
{expected, {Server, ServerMsg}}, {got, Unexpected}},
@@ -291,11 +294,11 @@ check_result(Pid, Msg) ->
{Pid, Msg} ->
ok;
{Port, {data,Debug}} when is_port(Port) ->
- ct:log("~p:~p~nopenssl ~s~n",[?MODULE,?LINE, Debug]),
+ ct:log("~p:~p~n Openssl ~s~n",[?MODULE,?LINE, Debug]),
check_result(Pid,Msg);
- %% {Port, {exit_status, Status}} when is_port(Port) ->
- %% ct:log("~p:~p Exit status: ~p~n",[?MODULE,?LINE, Status]),
- %% check_result(Pid, Msg);
+ {Port,closed} when is_port(Port)->
+ ct:log("~p:~p Openssl port closed ~n",[?MODULE,?LINE]),
+ check_result(Pid, Msg);
Unexpected ->
Reason = {{expected, {Pid, Msg}},
{got, Unexpected}},
@@ -398,27 +401,22 @@ cert_options(Config) ->
{ssl_imp, new}]},
{server_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
- %%{server_anon, [{ssl_imp, new},{reuseaddr, true}, {ciphers, anonymous_suites()}]},
- {client_psk, [{ssl_imp, new},{reuseaddr, true},
+ {client_psk, [{ssl_imp, new},
{psk_identity, "Test-User"},
{user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk, [{ssl_imp, new},{reuseaddr, true},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_suites()}]},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk_hint, [{ssl_imp, new},{reuseaddr, true},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{psk_identity, "HINT"},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_suites()}]},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk_anon, [{ssl_imp, new},{reuseaddr, true},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_anon_suites()}]},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
{server_psk_anon_hint, [{ssl_imp, new},{reuseaddr, true},
{psk_identity, "HINT"},
- {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}},
- {ciphers, psk_anon_suites()}]},
- {client_srp, [{ssl_imp, new},{reuseaddr, true},
+ {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]},
+ {client_srp, [{ssl_imp, new},
{srp_identity, {"Test-User", "secret"}}]},
{server_srp, [{ssl_imp, new},{reuseaddr, true},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
@@ -473,7 +471,7 @@ make_dsa_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_dsa_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_dsa_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]},
{server_srp_dsa, [{ssl_imp, new},{reuseaddr, true},
@@ -481,7 +479,7 @@ make_dsa_cert(Config) ->
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{user_lookup_fun, {fun user_lookup/3, undefined}},
{ciphers, srp_dss_suites()}]},
- {client_srp_dsa, [{ssl_imp, new},{reuseaddr, true},
+ {client_srp_dsa, [{ssl_imp, new},
{srp_identity, {"Test-User", "secret"}},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
@@ -502,7 +500,7 @@ make_ecdsa_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_ecdsa_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
| Config];
@@ -537,7 +535,7 @@ make_ecdh_rsa_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_ecdh_rsa_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
| Config];
@@ -557,7 +555,7 @@ make_mix_cert(Config) ->
{cacertfile, ClientCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile},
{verify, verify_peer}]},
- {client_mix_opts, [{ssl_imp, new},{reuseaddr, true},
+ {client_mix_opts, [{ssl_imp, new},
{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
| Config].
@@ -827,17 +825,17 @@ rsa_suites(CounterPart) ->
({dhe_rsa, des_cbc, sha}) when FIPS == true ->
false;
({rsa, Cipher, _}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({dhe_rsa, Cipher, _}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({ecdhe_rsa, Cipher, _}) when ECC == true ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({rsa, Cipher, _, _}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({dhe_rsa, Cipher, _,_}) ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
({ecdhe_rsa, Cipher, _,_}) when ECC == true ->
- lists:member(Cipher, Ciphers);
+ lists:member(cipher_atom(Cipher), Ciphers);
(_) ->
false
end,
@@ -930,44 +928,12 @@ anonymous_suites(Version) ->
Suites = ssl_cipher:anonymous_suites(Version),
ssl_cipher:filter_suites(Suites).
-psk_suites() ->
- Suites =
- [{psk, rc4_128, sha},
- {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_128_cbc, sha256},
- {rsa_psk, aes_256_cbc, sha384},
- {psk, aes_128_gcm, null, sha256},
- {psk, aes_256_gcm, null, sha384},
- {dhe_psk, aes_128_gcm, null, sha256},
- {dhe_psk, aes_256_gcm, null, sha384},
- {rsa_psk, aes_128_gcm, null, sha256},
- {rsa_psk, aes_256_gcm, null, sha384}],
+psk_suites(Version) ->
+ Suites = ssl_cipher:psk_suites(Version),
ssl_cipher:filter_suites(Suites).
-psk_anon_suites() ->
- 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}],
+psk_anon_suites(Version) ->
+ Suites = [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)],
ssl_cipher:filter_suites(Suites).
srp_suites() ->
@@ -1089,14 +1055,16 @@ init_tls_version(Version, Config)
application:load(ssl),
application:set_env(ssl, dtls_protocol_version, Version),
ssl:start(),
- [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}|Config];
+ NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)),
+ [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]} | NewConfig];
init_tls_version(Version, Config) ->
ssl:stop(),
application:load(ssl),
application:set_env(ssl, protocol_version, Version),
ssl:start(),
- [{protocol, tls}|Config].
+ NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)),
+ [{protocol, tls} | NewConfig].
sufficient_crypto_support(Version)
when Version == 'tlsv1.2'; Version == 'dtlsv1.2' ->
@@ -1231,19 +1199,37 @@ check_sane_openssl_version(Version) ->
enough_openssl_crl_support("OpenSSL 0." ++ _) -> false;
enough_openssl_crl_support(_) -> true.
-wait_for_openssl_server(Port) ->
- wait_for_openssl_server(Port, 10).
-wait_for_openssl_server(_, 0) ->
+wait_for_openssl_server(Port, tls) ->
+ do_wait_for_openssl_tls_server(Port, 10);
+wait_for_openssl_server(Port, dtls) ->
+ do_wait_for_openssl_dtls_server(Port, 10).
+
+do_wait_for_openssl_tls_server(_, 0) ->
exit(failed_to_connect_to_openssl);
-wait_for_openssl_server(Port, N) ->
+do_wait_for_openssl_tls_server(Port, N) ->
case gen_tcp:connect("localhost", Port, []) of
{ok, S} ->
gen_tcp:close(S);
_ ->
ct:sleep(?SLEEP),
- wait_for_openssl_server(Port, N-1)
+ do_wait_for_openssl_tls_server(Port, N-1)
end.
+do_wait_for_openssl_dtls_server(_, 0) ->
+ %%exit(failed_to_connect_to_openssl);
+ ok;
+do_wait_for_openssl_dtls_server(Port, N) ->
+ %% case gen_udp:open(0) of
+ %% {ok, S} ->
+ %% gen_udp:connect(S, "localhost", Port),
+ %% gen_udp:close(S);
+ %% _ ->
+ %% ct:sleep(?SLEEP),
+ %% do_wait_for_openssl_dtls_server(Port, N-1)
+ %% end.
+ ct:sleep(500),
+ do_wait_for_openssl_dtls_server(Port, N-1).
+
version_flag(tlsv1) ->
"-tls1";
version_flag('tlsv1.1') ->
@@ -1253,10 +1239,14 @@ version_flag('tlsv1.2') ->
version_flag(sslv3) ->
"-ssl3";
version_flag(sslv2) ->
- "-ssl2".
-
-filter_suites(Ciphers0) ->
- Version = tls_record:highest_protocol_version([]),
+ "-ssl2";
+version_flag('dtlsv1.2') ->
+ "-dtls1_2";
+version_flag('dtlsv1') ->
+ "-dtls1".
+
+filter_suites(Ciphers0, AtomVersion) ->
+ Version = tls_version(AtomVersion),
Supported0 = ssl_cipher:suites(Version)
++ ssl_cipher:anonymous_suites(Version)
++ ssl_cipher:psk_suites(Version)
@@ -1338,7 +1328,7 @@ protocol_version(Config) ->
protocol_version(Config, tuple) ->
case proplists:get_value(protocol, Config) of
dtls ->
- dtls_record:protocol_version(dtls_record:highest_protocol_version([]));
+ dtls_record:highest_protocol_version(dtls_record:supported_protocol_versions());
_ ->
tls_record:highest_protocol_version(tls_record:supported_protocol_versions())
end;
@@ -1372,6 +1362,7 @@ clean_env() ->
application:unset_env(ssl, session_cache_client_max),
application:unset_env(ssl, session_cache_server_max),
application:unset_env(ssl, ssl_pem_cache_clean),
+ application:unset_env(ssl, bypass_pem_cache),
application:unset_env(ssl, alert_timeout).
clean_start() ->
@@ -1379,3 +1370,105 @@ clean_start() ->
application:load(ssl),
clean_env(),
ssl:start().
+
+is_psk_anon_suite({psk, _,_}) ->
+ true;
+is_psk_anon_suite({dhe_psk,_,_}) ->
+ true;
+is_psk_anon_suite({psk, _,_,_}) ->
+ true;
+is_psk_anon_suite({dhe_psk, _,_,_}) ->
+ true;
+is_psk_anon_suite(_) ->
+ false.
+
+cipher_atom(aes_256_cbc) ->
+ aes_cbc256;
+cipher_atom(aes_128_cbc) ->
+ aes_cbc128;
+cipher_atom('3des_ede_cbc') ->
+ des_ede3;
+cipher_atom(Atom) ->
+ Atom.
+tls_version('dtlsv1' = Atom) ->
+ dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom));
+tls_version('dtlsv1.2' = Atom) ->
+ dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom));
+tls_version(Atom) ->
+ tls_record:protocol_version(Atom).
+
+dtls_hello() ->
+ [1,
+ <<0,1,4>>,
+ <<0,0>>,
+ <<0,0,0>>,
+ <<0,1,4>>,
+ <<254,253,88,
+ 156,129,61,
+ 131,216,15,
+ 131,194,242,
+ 46,154,190,
+ 20,228,234,
+ 234,150,44,
+ 62,96,96,103,
+ 127,95,103,
+ 23,24,42,138,
+ 13,142,32,57,
+ 230,177,32,
+ 210,154,152,
+ 188,121,134,
+ 136,53,105,
+ 118,96,106,
+ 103,231,223,
+ 133,10,165,
+ 50,32,211,
+ 227,193,14,
+ 181,143,48,
+ 66,0,0,100,0,
+ 255,192,44,
+ 192,48,192,
+ 36,192,40,
+ 192,46,192,
+ 50,192,38,
+ 192,42,0,159,
+ 0,163,0,107,
+ 0,106,0,157,
+ 0,61,192,43,
+ 192,47,192,
+ 35,192,39,
+ 192,45,192,
+ 49,192,37,
+ 192,41,0,158,
+ 0,162,0,103,
+ 0,64,0,156,0,
+ 60,192,10,
+ 192,20,0,57,
+ 0,56,192,5,
+ 192,15,0,53,
+ 192,8,192,18,
+ 0,22,0,19,
+ 192,3,192,13,
+ 0,10,192,9,
+ 192,19,0,51,
+ 0,50,192,4,
+ 192,14,0,47,
+ 1,0,0,86,0,0,
+ 0,14,0,12,0,
+ 0,9,108,111,
+ 99,97,108,
+ 104,111,115,
+ 116,0,10,0,
+ 58,0,56,0,14,
+ 0,13,0,25,0,
+ 28,0,11,0,12,
+ 0,27,0,24,0,
+ 9,0,10,0,26,
+ 0,22,0,23,0,
+ 8,0,6,0,7,0,
+ 20,0,21,0,4,
+ 0,5,0,18,0,
+ 19,0,1,0,2,0,
+ 3,0,15,0,16,
+ 0,17,0,11,0,
+ 2,1,0>>].
+
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index e99340822d..7a1dce70c2 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -42,7 +42,9 @@ all() ->
{group, 'tlsv1.2'},
{group, 'tlsv1.1'},
{group, 'tlsv1'},
- {group, 'sslv3'}
+ {group, 'sslv3'},
+ {group, 'dtlsv1.2'},
+ {group, 'dtlsv1'}
].
groups() ->
@@ -50,7 +52,10 @@ groups() ->
{'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
{'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
- {'sslv3', [], all_versions_tests()}].
+ {'sslv3', [], all_versions_tests()},
+ {'dtlsv1.2', [], dtls_all_versions_tests()},
+ {'dtlsv1', [], dtls_all_versions_tests()}
+ ].
basic_tests() ->
[basic_erlang_client_openssl_server,
@@ -78,6 +83,25 @@ all_versions_tests() ->
expired_session,
ssl2_erlang_server_openssl_client
].
+dtls_all_versions_tests() ->
+ [
+ %%erlang_client_openssl_server,
+ erlang_server_openssl_client,
+ %%erlang_client_openssl_server_dsa_cert,
+ erlang_server_openssl_client_dsa_cert
+ %% This one works but gets port EXIT first some times
+ %%erlang_server_openssl_client_reuse_session
+ %%erlang_client_openssl_server_renegotiate,
+ %%erlang_client_openssl_server_nowrap_seqnum,
+ %%erlang_server_openssl_client_nowrap_seqnum,
+ %%erlang_client_openssl_server_no_server_ca_cert,
+ %%erlang_client_openssl_server_client_cert,
+ %%erlang_server_openssl_client_client_cert
+ %%ciphers_rsa_signed_certs,
+ %%ciphers_dsa_signed_certs,
+ %%erlang_client_bad_openssl_server,
+ %%expired_session
+ ].
alpn_tests() ->
[erlang_client_alpn_openssl_server_alpn,
@@ -284,7 +308,8 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+
+ ssl_test_lib:wait_for_openssl_server(Port, tls),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -357,7 +382,7 @@ erlang_client_openssl_server(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -431,7 +456,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -551,7 +576,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -600,7 +625,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -681,7 +706,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -724,7 +749,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -856,7 +881,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) ->
"-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -911,7 +936,7 @@ expired_session(Config) when is_list(Config) ->
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, tls),
Client0 =
ssl_test_lib:start_client([{node, ClientNode},
@@ -1399,7 +1424,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
ConnectionInfo = {ok, {Version, CipherSuite}},
@@ -1469,7 +1494,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -1505,7 +1530,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba
Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version),
"-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -1574,7 +1599,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
@@ -1639,7 +1664,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac
"-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
- ssl_test_lib:wait_for_openssl_server(Port),
+ ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index 2cdb825d75..415a47949d 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 8.1
+SSL_VSN = 8.1.1
diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml
index 2a413835d0..f7f3f7b504 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -511,6 +511,33 @@ true
</func>
<func>
+ <name name="safe_relative_path" arity="1"/>
+ <fsummary>Sanitize a relative path to avoid directory traversal attacks.</fsummary>
+ <desc>
+ <p>Sanitizes the relative path by eliminating ".." and "."
+ components to protect against directory traversal attacks.
+ Either returns the sanitized path name, or the atom
+ <c>unsafe</c> if the path is unsafe.
+ The path is considered unsafe in the following circumstances:</p>
+ <list type="bulleted">
+ <item><p>The path is not relative.</p></item>
+ <item><p>A ".." component would climb up above the root of
+ the relative path.</p></item>
+ </list>
+ <p><em>Examples:</em></p>
+ <pre>
+1> <input>filename:safe_relative_path("dir/sub_dir/..").</input>
+"dir"
+2> <input>filename:safe_relative_path("dir/..").</input>
+[]
+3> <input>filename:safe_relative_path("dir/../..").</input>
+unsafe
+4> <input>filename:safe_relative_path("/abs/path").</input>
+unsafe</pre>
+ </desc>
+ </func>
+
+ <func>
<name name="split" arity="1"/>
<fsummary>Split a filename into its path components.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index fd498ee82e..5eb13db1aa 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2016</year>
+ <year>2016-2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -587,8 +587,8 @@ handle_event(_, _, State, Data) ->
<name name="state_enter"/>
<desc>
<p>
- If the state machine should use <em>state enter calls</em>
- is selected when starting the <c>gen_statem</c>
+ Whether the state machine should use <em>state enter calls</em>
+ or not is selected when starting the <c>gen_statem</c>
and after code change using the return value from
<seealso marker="#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>.
</p>
@@ -606,7 +606,16 @@ handle_event(_, _, State, Data) ->
See
<seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso>
and
- <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ Such a call can be repeated by returning a
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ tuple from the state callback.
</p>
<p>
If
@@ -625,7 +634,8 @@ handle_event(_, _, State, Data) ->
right before entering the initial state even though this
formally is not a state change.
In this case <c>OldState</c> will be the same as <c>State</c>,
- which can not happen for a subsequent state change.
+ which can not happen for a subsequent state change,
+ but will happen when repeating the state enter call.
</p>
</desc>
</datatype>
@@ -640,7 +650,15 @@ handle_event(_, _, State, Data) ->
<list type="ordered">
<item>
<p>
- If the state changes or is the initial state, and
+ If the state changes, is the initial state,
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ is used, and also
<seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
are used, the <c>gen_statem</c> calls
the new state callback with arguments
@@ -983,6 +1001,33 @@ handle_event(_, _, State, Data) ->
</desc>
</datatype>
<datatype>
+ <name name="init_result"/>
+ <desc>
+ <p>
+ For a succesful initialization,
+ <c><anno>State</anno></c> is the initial
+ <seealso marker="#type-state"><c>state()</c></seealso>
+ and <c><anno>Data</anno></c> the initial server
+ <seealso marker="#type-data"><c>data()</c></seealso>
+ of the <c>gen_statem</c>.
+ </p>
+ <p>
+ The <seealso marker="#type-action"><c>Actions</c></seealso>
+ are executed when entering the first
+ <seealso marker="#type-state">state</seealso> just as for a
+ <seealso marker="#state callback">state callback</seealso>,
+ except that the action <c>postpone</c> is forced to
+ <c>false</c> since there is no event to postpone.
+ </p>
+ <p>
+ For an unsuccesful initialization,
+ <c>{stop,<anno>Reason</anno>}</c>
+ or <c>ignore</c> should be used; see
+ <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
<name name="state_enter_result"/>
<desc>
<p>
@@ -1068,6 +1113,37 @@ handle_event(_, _, State, Data) ->
<c>{next_state,CurrentState,CurrentData,<anno>Actions</anno>}</c>.
</p>
</item>
+ <tag><c>repeat_state</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state, or
+ does a state transition to the current state if you like,
+ sets <c><anno>NewData</anno></c>,
+ and executes all <c><anno>Actions</anno></c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state</c> is the same as
+ <c>keep_state</c>.
+ </p>
+ </item>
+ <tag><c>repeat_state_and_data</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state and data, or
+ does a state transition to the current state if you like,
+ and executes all <c><anno>Actions</anno></c>.
+ This is the same as
+ <c>{repeat_state,CurrentData,<anno>Actions</anno>}</c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state_and_data</c> is the same as
+ <c>keep_state_and_data</c>.
+ </p>
+ </item>
<tag><c>stop</c></tag>
<item>
<p>
@@ -1609,29 +1685,33 @@ handle_event(_, _, State, Data) ->
It is recommended to use an atom as <c>Reason</c> since
it will be wrapped in an <c>{error,Reason}</c> tuple.
</p>
+ <p>
+ Also note when upgrading a <c>gen_statem</c>,
+ this function and hence
+ the <c>Change={advanced,Extra}</c> parameter in the
+ <seealso marker="sasl:appup"><c>appup</c></seealso> file
+ is not only needed to update the internal state
+ or to act on the <c>Extra</c> argument.
+ It is also needed if an upgrade or downgrade should change
+ <seealso marker="#type-callback_mode"><em>callback mode</em></seealso>,
+ or else the callback mode after the code change
+ will not be honoured,
+ most probably causing a server crash.
+ </p>
</desc>
</func>
<func>
- <name>Module:init(Args) -> Result</name>
+ <name>Module:init(Args) -> Result(StateType)</name>
<fsummary>
Optional function for initializing process and internal state.
</fsummary>
<type>
<v>Args = term()</v>
- <v>Result = {ok,State,Data}</v>
- <v>&nbsp;| {ok,State,Data,Actions}</v>
- <v>&nbsp;| {stop,Reason} | ignore</v>
- <v>State = <seealso marker="#type-state">state()</seealso></v>
- <v>
- Data = <seealso marker="#type-data">data()</seealso>
- </v>
<v>
- Actions =
- [<seealso marker="#type-action">action()</seealso>] |
- <seealso marker="#type-action">action()</seealso>
+ Result(StateType) =
+ <seealso marker="#type-init_result">init_result(StateType)</seealso>
</v>
- <v>Reason = term()</v>
</type>
<desc>
<marker id="Module:init-1"/>
@@ -1644,30 +1724,9 @@ handle_event(_, _, State, Data) ->
the implementation state and server data.
</p>
<p>
- <c>Args</c> is the <c>Args</c> argument provided to the start
+ <c>Args</c> is the <c>Args</c> argument provided to that start
function.
</p>
- <p>
- If the initialization is successful, the function is to
- return <c>{ok,State,Data}</c> or
- <c>{ok,State,Data,Actions}</c>.
- <c>State</c> is the initial
- <seealso marker="#type-state"><c>state()</c></seealso>
- and <c>Data</c> the initial server
- <seealso marker="#type-data"><c>data()</c></seealso>.
- </p>
- <p>
- The <seealso marker="#type-action"><c>Actions</c></seealso>
- are executed when entering the first
- <seealso marker="#type-state">state</seealso> just as for a
- <seealso marker="#state callback">state callback</seealso>.
- </p>
- <p>
- If the initialization fails,
- the function is to return <c>{stop,Reason}</c>
- or <c>ignore</c>; see
- <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
- </p>
<note>
<p>
This callback is optional, so a callback module does not need
@@ -1873,22 +1932,33 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-enter_action">actions</seealso>
that may be returned:
<seealso marker="#type-postpone"><c>postpone()</c></seealso>
- and
+ is not allowed since a <em>state enter call</em> is not
+ an event so there is no event to postpone, and
<seealso marker="#type-action"><c>{next_event,_,_}</c></seealso>
- are not allowed.
+ is not allowed since using <em>state enter calls</em>
+ should not affect how events are consumed and produced.
You may also not change states from this call.
Should you return <c>{next_state,NextState, ...}</c>
with <c>NextState =/= State</c> the <c>gen_statem</c> crashes.
- You are advised to use <c>{keep_state,...}</c> or
- <c>keep_state_and_data</c>.
+ It is possible to use <c>{repeat_state, ...}</c>,
+ <c>{repeat_state_and_data,_}</c> or
+ <c>repeat_state_and_data</c> but all of them makes little
+ sense since you immediately will be called again with a new
+ <em>state enter call</em> making this just a weird way
+ of looping, and there are better ways to loop in Erlang.
+ You are advised to use <c>{keep_state,...}</c>,
+ <c>{keep_state_and_data,_}</c> or
+ <c>keep_state_and_data</c> since you can not change states
+ from a <em>state enter call</em> anyway.
</p>
<p>
Note the fact that you can use
<seealso marker="erts:erlang#throw/1"><c>throw</c></seealso>
to return the result, which can be useful.
For example to bail out with <c>throw(keep_state_and_data)</c>
- from deep within complex code that is in no position to
- return <c>{next_state,State,Data}</c>.
+ from deep within complex code that can not
+ return <c>{next_state,State,Data}</c> because
+ <c>State</c> or <c>Data</c> is no longer in scope.
</p>
</desc>
</func>
@@ -1903,6 +1973,11 @@ handle_event(_, _, State, Data) ->
<v>Ignored = term()</v>
</type>
<desc>
+ <note>
+ <p>This callback is optional, so callback modules need not
+ export it. The <c>gen_statem</c> module provides a default
+ implementation without cleanup.</p>
+ </note>
<p>
This function is called by a <c>gen_statem</c>
when it is about to terminate. It is to be the opposite of
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 9091a46df9..45171f814d 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -83,8 +83,8 @@
<p>If the modules used to implement the process change dynamically
during runtime, the process must understand one more message. An
example is the <seealso marker="gen_event"><c>gen_event</c></seealso>
- processes. The message is <c>{get_modules, From}</c>.
- The reply to this message is <c>From ! {modules, Modules}</c>, where
+ processes. The message is <c>{_Label, {From, Ref}, get_modules}</c>.
+ The reply to this message is <c>From ! {Ref, Modules}</c>, where
<c>Modules</c> is a list of the currently active modules in the
process.</p>
<p>This message is used by the release handler to find which
diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl
index 5f821caef0..a1a97af4c5 100644
--- a/lib/stdlib/src/edlin_expand.erl
+++ b/lib/stdlib/src/edlin_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -101,44 +101,77 @@ match(Prefix, Alts, Extra0) ->
%% Return the list of names L in multiple columns.
format_matches(L) ->
- S = format_col(lists:sort(L), []),
+ {S1, Dots} = format_col(lists:sort(L), []),
+ S = case Dots of
+ true ->
+ {_, Prefix} = longest_common_head(vals(L)),
+ PrefixLen = length(Prefix),
+ case PrefixLen =< 3 of
+ true -> S1; % Do not replace the prefix with "...".
+ false ->
+ LeadingDotsL = leading_dots(L, PrefixLen),
+ {S2, _} = format_col(lists:sort(LeadingDotsL), []),
+ S2
+ end;
+ false -> S1
+ end,
["\n" | S].
format_col([], _) -> [];
-format_col(L, Acc) -> format_col(L, field_width(L), 0, Acc).
-
-format_col(X, Width, Len, Acc) when Width + Len > 79 ->
- format_col(X, Width, 0, ["\n" | Acc]);
-format_col([A|T], Width, Len, Acc0) ->
- H = case A of
- %% If it's a tuple {string(), integer()}, we assume it's an
- %% arity, and meant to be printed.
- {H0, I} when is_integer(I) ->
- H0 ++ "/" ++ integer_to_list(I);
- {H1, _} -> H1;
- H2 -> H2
- end,
- Acc = [io_lib:format("~-*ts", [Width,H]) | Acc0],
- format_col(T, Width, Len+Width, Acc);
-format_col([], _, _, Acc) ->
- lists:reverse(Acc, "\n").
-
-field_width(L) -> field_width(L, 0).
-
-field_width([{H,_}|T], W) ->
+format_col(L, Acc) ->
+ LL = 79,
+ format_col(L, field_width(L, LL), 0, Acc, LL, false).
+
+format_col(X, Width, Len, Acc, LL, Dots) when Width + Len > LL ->
+ format_col(X, Width, 0, ["\n" | Acc], LL, Dots);
+format_col([A|T], Width, Len, Acc0, LL, Dots) ->
+ {H0, R} = format_val(A),
+ Hmax = LL - length(R),
+ {H, NewDots} =
+ case length(H0) > Hmax of
+ true -> {io_lib:format("~-*ts", [Hmax - 3, H0]) ++ "...", true};
+ false -> {H0, Dots}
+ end,
+ Acc = [io_lib:format("~-*ts", [Width, H ++ R]) | Acc0],
+ format_col(T, Width, Len+Width, Acc, LL, NewDots);
+format_col([], _, _, Acc, _LL, Dots) ->
+ {lists:reverse(Acc, "\n"), Dots}.
+
+format_val({H, I}) when is_integer(I) ->
+ %% If it's a tuple {string(), integer()}, we assume it's an
+ %% arity, and meant to be printed.
+ {H, "/" ++ integer_to_list(I)};
+format_val({H, _}) ->
+ {H, ""};
+format_val(H) ->
+ {H, ""}.
+
+field_width(L, LL) -> field_width(L, 0, LL).
+
+field_width([{H,_}|T], W, LL) ->
case length(H) of
- L when L > W -> field_width(T, L);
- _ -> field_width(T, W)
+ L when L > W -> field_width(T, L, LL);
+ _ -> field_width(T, W, LL)
end;
-field_width([H|T], W) ->
+field_width([H|T], W, LL) ->
case length(H) of
- L when L > W -> field_width(T, L);
- _ -> field_width(T, W)
+ L when L > W -> field_width(T, L, LL);
+ _ -> field_width(T, W, LL)
end;
-field_width([], W) when W < 40 ->
+field_width([], W, LL) when W < LL - 3 ->
W + 4;
-field_width([], _) ->
- 40.
+field_width([], _, LL) ->
+ LL.
+
+vals([]) -> [];
+vals([{S, _}|L]) -> [S|vals(L)];
+vals([S|L]) -> [S|vals(L)].
+
+leading_dots([], _Len) -> [];
+leading_dots([{H, I}|L], Len) ->
+ [{"..." ++ nthtail(Len, H), I}|leading_dots(L, Len)];
+leading_dots([H|L], Len) ->
+ ["..." ++ nthtail(Len, H)|leading_dots(L, Len)].
longest_common_head([]) ->
no;
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 40a34aa30f..eafee346eb 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -1306,6 +1306,7 @@ partial_eval(Expr) ->
ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R));
ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A));
ev_expr({integer,_,X}) -> X;
+ev_expr({char,_,X}) -> X;
ev_expr({float,_,X}) -> X;
ev_expr({atom,_,X}) -> X;
ev_expr({tuple,_,Es}) ->
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 4f38256e6b..d2dd2848b5 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -156,6 +156,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'),
record, ['$2'|'$4']}.
type -> binary_type : '$1'.
type -> integer : '$1'.
+type -> char : '$1'.
type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}.
type -> 'fun' '(' fun_type_100 ')' : '$3'.
@@ -1557,13 +1558,17 @@ new_anno(Term) ->
Abstr :: erl_parse_tree().
anno_to_term(Abstract) ->
- map_anno(fun erl_anno:to_term/1, Abstract).
+ F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end,
+ {NewAbstract, []} = modify_anno1(Abstract, [], F),
+ NewAbstract.
-spec anno_from_term(Term) -> erl_parse_tree() when
Term :: term().
anno_from_term(Term) ->
- map_anno(fun erl_anno:from_term/1, Term).
+ F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end,
+ {NewTerm, []} = modify_anno1(Term, [], F),
+ NewTerm.
%% Forms.
%% Recognize what sys_pre_expand does:
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index 7f5ef4df42..c42ae981e7 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -481,46 +481,49 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) ->
%% Look for special comment on second line
Line2 = get_line(Fd),
{ok, HeaderSz2} = file:position(Fd, cur),
- case classify_line(Line2) of
- emu_args ->
- %% Skip special comment on second line
- Line3 = get_line(Fd),
- {HeaderSz2, LineNo + 2, Fd,
- Sections#sections{type = guess_type(Line3),
- comment = undefined,
- emu_args = Line2}};
- Line2Type ->
- %% Look for special comment on third line
- Line3 = get_line(Fd),
- {ok, HeaderSz3} = file:position(Fd, cur),
- Line3Type = classify_line(Line3),
- if
- Line3Type =:= emu_args ->
- %% Skip special comment on third line
- Line4 = get_line(Fd),
- {HeaderSz3, LineNo + 3, Fd,
- Sections#sections{type = guess_type(Line4),
- comment = Line2,
- emu_args = Line3}};
- Sections#sections.shebang =:= undefined,
- KeepFirst =:= true ->
- %% No shebang. Use the entire file
- {HeaderSz0, LineNo, Fd,
- Sections#sections{type = guess_type(Line2)}};
- Sections#sections.shebang =:= undefined ->
- %% No shebang. Skip the first line
- {HeaderSz1, LineNo, Fd,
- Sections#sections{type = guess_type(Line2)}};
- Line2Type =:= comment ->
- %% Skip shebang on first line and comment on second
- {HeaderSz2, LineNo + 2, Fd,
- Sections#sections{type = guess_type(Line3),
- comment = Line2}};
- true ->
- %% Just skip shebang on first line
- {HeaderSz1, LineNo + 1, Fd,
- Sections#sections{type = guess_type(Line2)}}
- end
+ if
+ Sections#sections.shebang =:= undefined,
+ KeepFirst =:= true ->
+ %% No shebang. Use the entire file
+ {HeaderSz0, LineNo, Fd,
+ Sections#sections{type = guess_type(Line2)}};
+ Sections#sections.shebang =:= undefined ->
+ %% No shebang. Skip the first line
+ {HeaderSz1, LineNo, Fd,
+ Sections#sections{type = guess_type(Line2)}};
+ true ->
+ case classify_line(Line2) of
+ emu_args ->
+ %% Skip special comment on second line
+ Line3 = get_line(Fd),
+ {HeaderSz2, LineNo + 2, Fd,
+ Sections#sections{type = guess_type(Line3),
+ comment = undefined,
+ emu_args = Line2}};
+ comment ->
+ %% Look for special comment on third line
+ Line3 = get_line(Fd),
+ {ok, HeaderSz3} = file:position(Fd, cur),
+ Line3Type = classify_line(Line3),
+ if
+ Line3Type =:= emu_args ->
+ %% Skip special comment on third line
+ Line4 = get_line(Fd),
+ {HeaderSz3, LineNo + 3, Fd,
+ Sections#sections{type = guess_type(Line4),
+ comment = Line2,
+ emu_args = Line3}};
+ true ->
+ %% Skip shebang on first line and comment on second
+ {HeaderSz2, LineNo + 2, Fd,
+ Sections#sections{type = guess_type(Line3),
+ comment = Line2}}
+ end;
+ _ ->
+ %% Just skip shebang on first line
+ {HeaderSz1, LineNo + 1, Fd,
+ Sections#sections{type = guess_type(Line2)}}
+ end
end.
classify_line(Line) ->
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index c4586171ca..5d60b3837e 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -34,7 +34,8 @@
-export([absname/1, absname/2, absname_join/2,
basename/1, basename/2, dirname/1,
extension/1, join/1, join/2, pathtype/1,
- rootname/1, rootname/2, split/1, nativename/1]).
+ rootname/1, rootname/2, split/1, nativename/1,
+ safe_relative_path/1]).
-export([find_src/1, find_src/2, flatten/1]).
-export([basedir/2, basedir/3]).
@@ -750,6 +751,39 @@ separators() ->
_ -> {false, false}
end.
+-spec safe_relative_path(Filename) -> 'unsafe' | SafeFilename when
+ Filename :: file:name_all(),
+ SafeFilename :: file:name_all().
+
+safe_relative_path(Path) ->
+ case pathtype(Path) of
+ relative ->
+ Cs0 = split(Path),
+ safe_relative_path_1(Cs0, []);
+ _ ->
+ unsafe
+ end.
+
+safe_relative_path_1(["."|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([<<".">>|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([".."|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([<<"..">>|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([H|T], Acc) ->
+ safe_relative_path_1(T, [H|Acc]);
+safe_relative_path_1([], []) ->
+ [];
+safe_relative_path_1([], Acc) ->
+ join(lists:reverse(Acc)).
+
+climb(_, []) ->
+ unsafe;
+climb(T, [_|Acc]) ->
+ safe_relative_path_1(T, Acc).
+
%% find_src(Module) --
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index ccacf658e9..e55cdddb9a 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -742,7 +742,7 @@ stop_handlers([], _) ->
[].
%% Message from the release_handler.
-%% The list of modules got to be a set !
+%% The list of modules got to be a set, i.e. no duplicate elements!
get_modules(MSL) ->
Mods = [Handler#handler.module || Handler <- MSL],
ordsets:to_list(ordsets:from_list(Mods)).
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 018aca90e6..cacc932ec4 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2016. All Rights Reserved.
+%% Copyright Ericsson AB 2016-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -47,15 +47,17 @@
%% Type exports for templates and callback modules
-export_type(
[event_type/0,
- init_result/0,
callback_mode_result/0,
- state_function_result/0,
- handle_event_result/0,
+ init_result/1,
state_enter_result/1,
event_handler_result/1,
reply_action/0,
enter_action/0,
action/0]).
+%% Old types, not advertised
+-export_type(
+ [state_function_result/0,
+ handle_event_result/0]).
%% Type that is exported just to be documented
-export_type([transition_option/0]).
@@ -143,9 +145,10 @@
{'reply', % Reply to a caller
From :: from(), Reply :: term()}.
--type init_result() ::
- {ok, state(), data()} |
- {ok, state(), data(), [action()] | action()} |
+-type init_result(StateType) ::
+ {ok, State :: StateType, Data :: data()} |
+ {ok, State :: StateType, Data :: data(),
+ Actions :: [action()] | action()} |
'ignore' |
{'stop', Reason :: term()}.
@@ -182,12 +185,23 @@
'keep_state_and_data' | % {keep_state_and_data,[]}
{'keep_state_and_data', % Keep state and data -> only actions
Actions :: [ActionType] | ActionType} |
+ %%
+ {'repeat_state', % {repeat_state,NewData,[]}
+ NewData :: data()} |
+ {'repeat_state', % Repeat state, change data
+ NewData :: data(),
+ Actions :: [ActionType] | ActionType} |
+ 'repeat_state_and_data' | % {repeat_state_and_data,[]}
+ {'repeat_state_and_data', % Repeat state and data -> only actions
+ Actions :: [ActionType] | ActionType} |
+ %%
'stop' | % {stop,normal}
{'stop', % Stop the server
Reason :: term()} |
{'stop', % Stop the server
Reason :: term(),
NewData :: data()} |
+ %%
{'stop_and_reply', % Reply then stop the server
Reason :: term(),
Replies :: [reply_action()] | reply_action()} |
@@ -201,7 +215,7 @@
%% the server is not running until this function has returned
%% an {ok, ...} tuple. Thereafter the state callbacks are called
%% for all events to this server.
--callback init(Args :: term()) -> init_result().
+-callback init(Args :: term()) -> init_result(state()).
%% This callback shall return the callback mode of the callback module.
%%
@@ -275,6 +289,8 @@
-optional_callbacks(
[init/1, % One may use enter_loop/5,6,7 instead
format_status/2, % Has got a default implementation
+ terminate/3, % Has got a default implementation
+ code_change/4, % Only needed by advanced soft upgrade
%%
state_name/3, % Example for callback_mode() =:= state_functions:
%% there has to be a StateName/3 callback function
@@ -304,12 +320,16 @@ event_type({call,From}) ->
from(From);
event_type(Type) ->
case Type of
+ {call,From} ->
+ from(From);
cast ->
true;
info ->
true;
timeout ->
true;
+ state_timeout ->
+ true;
internal ->
true;
_ ->
@@ -588,6 +608,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
true ->
[Actions,{postpone,false}]
end,
+ TimerRefs = #{},
+ %% Key: timer ref
+ %% Value: the timer type i.e the timer's event type
+ %%
+ TimerTypes = #{},
+ %% Key: timer type i.e the timer's event type
+ %% Value: timer ref
+ %%
+ %% We add a timer to both timer_refs and timer_types
+ %% when we start it. When we request an asynchronous
+ %% timer cancel we remove it from timer_types. When
+ %% the timer cancel message arrives we remove it from
+ %% timer_refs.
+ %%
+ Hibernate = false,
+ CancelTimers = 0,
S = #{
callback_mode => undefined,
state_enter => false,
@@ -596,25 +632,25 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
state => State,
data => Data,
postponed => P,
- %% The rest of the fields are set from to the arguments to
- %% loop_event_actions/10 when it finally loops back to loop/3
- %% in loop_events/10
%%
- %% Marker for initial state, cleared immediately when used
- init_state => true
+ %% The following fields are finally set from to the arguments to
+ %% loop_event_actions/9 when it finally loops back to loop/3
+ %% in loop_event_result/11
+ timer_refs => TimerRefs,
+ timer_types => TimerTypes,
+ hibernate => Hibernate,
+ cancel_timers => CancelTimers
},
NewDebug = sys_debug(Debug, S, State, {enter,Event,State}),
case call_callback_mode(S) of
{ok,NewS} ->
- TimerRefs = #{},
- TimerTypes = #{},
loop_event_actions(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, State, Data, NewActions);
+ Parent, NewDebug, NewS,
+ Events, Event, State, Data, NewActions, true);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- NewDebug, S, [Event|Events])
+ Class, Reason, Stacktrace, NewDebug,
+ S, [Event|Events])
end.
%%%==========================================================================
@@ -683,9 +719,7 @@ system_continue(Parent, Debug, S) ->
loop(Parent, Debug, S).
system_terminate(Reason, _Parent, Debug, S) ->
- terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, []).
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, []).
system_code_change(
#{module := Module,
@@ -796,23 +830,22 @@ wakeup_from_hibernate(Parent, Debug, S) ->
%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3
%% Entry point for system_continue/3
-loop(Parent, Debug, #{hibernate := Hibernate} = S) ->
- case Hibernate of
- true ->
- %% Does not return but restarts process at
- %% wakeup_from_hibernate/3 that jumps to loop_receive/3
- proc_lib:hibernate(
- ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
- error(
- {should_not_have_arrived_here_but_instead_in,
- {wakeup_from_hibernate,3}});
- false ->
- loop_receive(Parent, Debug, S)
- end.
+loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) ->
+ loop_hibernate(Parent, Debug, S);
+loop(Parent, Debug, S) ->
+ loop_receive(Parent, Debug, S).
+
+loop_hibernate(Parent, Debug, S) ->
+ %% Does not return but restarts process at
+ %% wakeup_from_hibernate/3 that jumps to loop_receive/3
+ proc_lib:hibernate(
+ ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
+ error(
+ {should_not_have_arrived_here_but_instead_in,
+ {wakeup_from_hibernate,3}}).
%% Entry point for wakeup_from_hibernate/3
-loop_receive(
- Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) ->
+loop_receive(Parent, Debug, S) ->
receive
Msg ->
case Msg of
@@ -821,30 +854,87 @@ loop_receive(
%% Does not return but tail recursively calls
%% system_continue/3 that jumps to loop/3
sys:handle_system_msg(
- Req, Pid, Parent, ?MODULE, Debug, S, Hibernate);
+ Req, Pid, Parent, ?MODULE, Debug, S,
+ Hibernate);
{'EXIT',Parent,Reason} = EXIT ->
- %% EXIT is not a 2-tuple and therefore
- %% not an event and has no event_type(),
- %% but this will stand out in the crash report...
- terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]);
+ %% EXIT is not a 2-tuple therefore
+ %% not an event but this will stand out
+ %% in the crash report...
+ Q = [EXIT],
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q);
{timeout,TimerRef,TimerMsg} ->
+ #{timer_refs := TimerRefs,
+ timer_types := TimerTypes,
+ hibernate := Hibernate} = S,
case TimerRefs of
#{TimerRef := TimerType} ->
- Event = {TimerType,TimerMsg},
- %% Unregister the triggered timeout
+ %% We know of this timer; is it a running
+ %% timer or a timer being cancelled that
+ %% managed to send a late timeout message?
+ case TimerTypes of
+ #{TimerType := TimerRef} ->
+ %% The timer type maps back to this
+ %% timer ref, so it was a running timer
+ Event = {TimerType,TimerMsg},
+ %% Unregister the triggered timeout
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewTimerTypes =
+ maps:remove(TimerType, TimerTypes),
+ loop_receive_result(
+ Parent, Debug,
+ S#{
+ timer_refs := NewTimerRefs,
+ timer_types := NewTimerTypes},
+ Hibernate,
+ Event);
+ _ ->
+ %% This was a late timeout message
+ %% from timer being cancelled, so
+ %% ignore it and expect a cancel_timer
+ %% msg shortly
+ loop_receive(Parent, Debug, S)
+ end;
+ _ ->
+ %% Not our timer; present it as an event
+ Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes),
- Event);
+ Parent, Debug, S, Hibernate, Event)
+ end;
+ {cancel_timer,TimerRef,_} ->
+ #{timer_refs := TimerRefs,
+ cancel_timers := CancelTimers,
+ hibernate := Hibernate} = S,
+ case TimerRefs of
+ #{TimerRef := _} ->
+ %% We must have requested a cancel
+ %% of this timer so it is already
+ %% removed from TimerTypes
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewCancelTimers = CancelTimers - 1,
+ NewS =
+ S#{
+ timer_refs := NewTimerRefs,
+ cancel_timers := NewCancelTimers},
+ if
+ Hibernate =:= true, NewCancelTimers =:= 0 ->
+ %% No more cancel_timer msgs to expect;
+ %% we can hibernate
+ loop_hibernate(Parent, Debug, NewS);
+ NewCancelTimers >= 0 -> % Assert
+ loop_receive(Parent, Debug, NewS)
+ end;
_ ->
+ %% Not our cancel_timer msg;
+ %% present it as an event
Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end;
_ ->
+ %% External msg
+ #{hibernate := Hibernate} = S,
Event =
case Msg of
{'$gen_call',From,Request} ->
@@ -855,208 +945,212 @@ loop_receive(
{info,Msg}
end,
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end
end.
loop_receive_result(
- Parent, Debug, #{state := State} = S,
- TimerRefs, TimerTypes, Event) ->
- %% The fields 'timer_refs', 'timer_types' and 'hibernate'
- %% are now invalid in state map S - they will be recalculated
- %% and restored when we return to loop/3
- %%
+ Parent, Debug,
+ #{state := State,
+ timer_types := TimerTypes, cancel_timers := CancelTimers} = S,
+ Hibernate, Event) ->
+ %% From now the 'hibernate' field in S is invalid
+ %% and will be restored when looping back
+ %% in loop_event_result/11
NewDebug = sys_debug(Debug, S, State, {in,Event}),
- %% Here the queue of not yet handled events is created
+ %% Here is the queue of not yet handled events created
Events = [],
- Hibernate = false,
- loop_event(
- Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate).
+ %% Cancel any running event timer
+ case
+ cancel_timer_by_type(timeout, TimerTypes, CancelTimers)
+ of
+ {_,CancelTimers} ->
+ %% No timer cancelled
+ loop_event(Parent, NewDebug, S, Events, Event, Hibernate);
+ {NewTimerTypes,NewCancelTimers} ->
+ %% The timer is removed from NewTimerTypes but
+ %% remains in TimerRefs until we get
+ %% the cancel_timer msg
+ NewS =
+ S#{
+ timer_types := NewTimerTypes,
+ cancel_timers := NewCancelTimers},
+ loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate)
+ end.
%% Entry point for handling an event, received or enqueued
loop_event(
- Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes,
+ Parent, Debug,
+ #{state := State, data := Data} = S,
Events, {Type,Content} = Event, Hibernate) ->
%%
- %% If Hibernate is true here it can only be
+ %% If (this old) Hibernate is true here it can only be
%% because it was set from an event action
- %% and we did not go into hibernation since there
- %% were events in queue, so we do what the user
+ %% and we did not go into hibernation since there were
+ %% events in queue, so we do what the user
%% might rely on i.e collect garbage which
%% would have happened if we actually hibernated
%% and immediately was awakened
Hibernate andalso garbage_collect(),
case call_state_function(S, Type, Content, State, Data) of
{ok,Result,NewS} ->
- %% Cancel event timeout
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(
- timeout, TimerRefs, TimerTypes),
- {NewData,NextState,Actions} =
+ {NextState,NewData,Actions,EnterCall} =
parse_event_result(
- true, Debug, NewS, Result,
- Events, Event, State, Data),
+ true, Debug, NewS,
+ Events, Event, State, Data, Result),
loop_event_actions(
- Parent, Debug, S, NewTimerRefs, NewTimerTypes,
- Events, Event, NextState, NewData, Actions);
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewData, Actions, EnterCall);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_actions(
Parent, Debug,
- #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData, Actions) ->
+ #{state := State, state_enter := StateEnter} = S,
+ Events, Event, NextState, NewData,
+ Actions, EnterCall) ->
+ %% Hibernate is reborn here as false being
+ %% the default value from parse_actions/4
case parse_actions(Debug, S, State, Actions) of
{ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} ->
if
- StateEnter, NextState =/= State ->
+ StateEnter, EnterCall ->
loop_event_enter(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR);
- StateEnter ->
- case maps:is_key(init_state, S) of
- true ->
- %% Avoid infinite loop in initial state
- %% with state entry events
- NewS = maps:remove(init_state, S),
- loop_event_enter(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- false ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR)
- end;
true ->
loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR)
end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{data := NewData}, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_enter(
- Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state := State} = S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
case call_state_function(S, enter, State, NextState, NewData) of
{ok,Result,NewS} ->
- {NewerData,_,Actions} =
- parse_event_result(
- false, Debug, NewS, Result,
- Events, Event, NextState, NewData),
- loop_event_enter_actions(
- Parent, Debug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewerData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions);
+ case parse_event_result(
+ false, Debug, NewS,
+ Events, Event, NextState, NewData, Result) of
+ {_,NewerData,Actions,EnterCall} ->
+ loop_event_enter_actions(
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewerData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_enter_actions(
- Parent, Debug, S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state_enter := StateEnter} = S,
Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall) ->
case
parse_enter_actions(
- Debug, S, NextState, Actions,
- Hibernate, TimeoutsR)
+ Debug, S, NextState, Actions, Hibernate, TimeoutsR)
of
{ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ if
+ StateEnter, EnterCall ->
+ loop_event_enter(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ true ->
+ loop_event_result(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_result(
- Parent, Debug,
- #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0,
- Events, Event, NextState, NewData,
+ Parent, Debug_0,
+ #{state := State, postponed := P_0,
+ timer_refs := TimerRefs_0, timer_types := TimerTypes_0,
+ cancel_timers := CancelTimers_0} = S_0,
+ Events_0, Event_0, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
%%
%% All options have been collected and next_events are buffered.
%% Do the actual state transition.
%%
- {NewDebug,P_1} = % Move current event to postponed if Postpone
+ {Debug_1,P_1} = % Move current event to postponed if Postpone
case Postpone of
true ->
- {sys_debug(Debug, S, State, {postpone,Event,State}),
- [Event|P_0]};
+ {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}),
+ [Event_0|P_0]};
false ->
- {sys_debug(Debug, S, State, {consume,Event,State}),
+ {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}),
P_0}
end,
- {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} =
+ {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} =
%% Move all postponed events to queue and cancel the
%% state timeout if the state changes
if
NextState =:= State ->
- {Events,P_1,{TimerRefs_0,TimerTypes_0}};
+ {Events_0,P_1,{TimerTypes_0,CancelTimers_0}};
true ->
- {lists:reverse(P_1, Events),[],
+ {lists:reverse(P_1, Events_0),
+ [],
cancel_timer_by_type(
- state_timeout, TimerRefs_0, TimerTypes_0)}
+ state_timeout, TimerTypes_0, CancelTimers_0)}
+ %% The state timer is removed from TimerTypes_1
+ %% but remains in TimerRefs_0 until we get
+ %% the cancel_timer msg
end,
- {TimerRefs_2,TimerTypes_2,TimeoutEvents} =
- %% Stop and start timers non-event timers
- parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR),
+ {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} =
+ %% Stop and start non-event timers
+ parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR),
%% Place next events last in reversed queue
Events_2R = lists:reverse(Events_1, NextEventsR),
%% Enqueue immediate timeout events and start event timer
- {NewTimerRefs,NewTimerTypes,Events_3R} =
- process_timeout_events(
- TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R),
- NewEvents = lists:reverse(Events_3R),
- loop_events(
- Parent, NewDebug, S, NewTimerRefs, NewTimerTypes,
- NewEvents, Hibernate, NextState, NewData, NewP).
-
-%% Loop until out of enqueued events
-%%
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [] = _Events, Hibernate, State, Data, P) ->
- %% Update S and loop back to loop/3 to receive a new event
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P,
- hibernate => Hibernate,
- timer_refs => TimerRefs,
- timer_types => TimerTypes},
- loop(Parent, Debug, NewS);
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [Event|Events], Hibernate, State, Data, P) ->
- %% Update S and continue with enqueued events
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P},
- loop_event(
- Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate).
-
+ Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R),
+ S_1 =
+ S_0#{
+ state := NextState,
+ data := NewData,
+ postponed := P_2,
+ timer_refs := TimerRefs_2,
+ timer_types := TimerTypes_2,
+ cancel_timers := CancelTimers_2,
+ hibernate := Hibernate},
+ case lists:reverse(Events_3R) of
+ [] ->
+ %% Get a new event
+ loop(Parent, Debug_1, S_1);
+ [Event|Events] ->
+ %% Loop until out of enqueued events
+ loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate)
+ end.
%%---------------------------------------------------------------------------
@@ -1069,19 +1163,6 @@ call_callback_mode(#{module := Module} = S) ->
catch
CallbackMode ->
callback_mode_result(S, CallbackMode);
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,callback_mode,[]=Args,_}
- |Stacktrace] ->
- {error,
- {undef_callback,{Module,callback_mode,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1126,8 +1207,7 @@ parse_callback_mode(_, _CBMode, StateEnter) ->
call_state_function(
- #{callback_mode := undefined} = S,
- Type, Content, State, Data) ->
+ #{callback_mode := undefined} = S, Type, Content, State, Data) ->
case call_callback_mode(S) of
{ok,NewS} ->
call_state_function(NewS, Type, Content, State, Data);
@@ -1135,13 +1215,12 @@ call_state_function(
Error
end;
call_state_function(
- #{callback_mode := CallbackMode,
- module := Module} = S,
+ #{callback_mode := CallbackMode, module := Module} = S,
Type, Content, State, Data) ->
try
case CallbackMode of
state_functions ->
- erlang:apply(Module, State, [Type,Content,Data]);
+ Module:State(Type, Content, Data);
handle_event_function ->
Module:handle_event(Type, Content, State, Data)
end
@@ -1151,41 +1230,6 @@ call_state_function(
catch
Result ->
{ok,Result,S};
- error:badarg ->
- case erlang:get_stacktrace() of
- [{erlang,apply,
- [Module,State,[Type,Content,Data]=Args],
- _}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- %% We get here e.g if apply fails
- %% due to State not being an atom
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- Stacktrace ->
- {error,badarg,Stacktrace}
- end;
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,State,[Type,Content,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- [{Module,handle_event,[Type,Content,State,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= handle_event_function ->
- {error,
- {undef_state_function,{Module,handle_event,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1193,65 +1237,83 @@ call_state_function(
%% Interpret all callback return variants
parse_event_result(
- AllowStateChange, Debug, S, Result, Events, Event, State, Data) ->
+ AllowStateChange, Debug, S,
+ Events, Event, State, Data, Result) ->
case Result of
stop ->
terminate(
- exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, normal, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason} ->
terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason,NewData} ->
terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events]);
+ %%
{stop_and_reply,Reason,Replies} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events], Replies);
{stop_and_reply,Reason,Replies,NewData} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events], Replies);
+ %%
{next_state,State,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{next_state,NextState,NewData} when AllowStateChange ->
- {NewData,NextState,[]};
+ {NextState,NewData,[],true};
{next_state,State,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
{next_state,NextState,NewData,Actions} when AllowStateChange ->
- {NewData,NextState,Actions};
+ {NextState,NewData,Actions,true};
+ %%
{keep_state,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{keep_state,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
keep_state_and_data ->
- {Data,State,[]};
+ {State,Data,[],false};
{keep_state_and_data,Actions} ->
- {Data,State,Actions};
+ {State,Data,Actions,false};
+ %%
+ {repeat_state,NewData} ->
+ {State,NewData,[],true};
+ {repeat_state,NewData,Actions} ->
+ {State,NewData,Actions,true};
+ repeat_state_and_data ->
+ {State,Data,[],true};
+ {repeat_state_and_data,Actions} ->
+ {State,Data,Actions,true};
+ %%
_ ->
terminate(
error,
{bad_return_from_state_function,Result},
- ?STACKTRACE(),
- Debug, S, [Event|Events])
+ ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events])
end.
-parse_enter_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR) ->
+parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) ->
Postpone = forbidden,
NextEventsR = forbidden,
parse_actions(
Debug, S, State, listify(Actions),
Hibernate, TimeoutsR, Postpone, NextEventsR).
-
+
parse_actions(Debug, S, State, Actions) ->
Hibernate = false,
- TimeoutsR = [],
+ TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer
Postpone = false,
NextEventsR = [],
parse_actions(
@@ -1279,64 +1341,29 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
+ %%
%% Actions that set options
{hibernate,NewHibernate} when is_boolean(NewHibernate) ->
parse_actions(
Debug, S, State, Actions,
NewHibernate, TimeoutsR, Postpone, NextEventsR);
- {hibernate,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
hibernate ->
+ NewHibernate = true,
parse_actions(
Debug, S, State, Actions,
- true, TimeoutsR, Postpone, NextEventsR);
- {state_timeout,Time,_} = StateTimeout
- when is_integer(Time), Time >= 0;
- Time =:= infinity ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR);
- {state_timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- {timeout,infinity,_} ->
- %% Ignore - timeout will never happen and already cancelled
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
- {timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- infinity -> % Ignore - timeout will never happen
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- Time when is_integer(Time), Time >= 0 ->
- Timeout = {timeout,Time,Time},
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
+ NewHibernate, TimeoutsR, Postpone, NextEventsR);
+ %%
{postpone,NewPostpone}
when is_boolean(NewPostpone), Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
Hibernate, TimeoutsR, NewPostpone, NextEventsR);
- {postpone,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
postpone when Postpone =/= forbidden ->
+ NewPostpone = true,
parse_actions(
Debug, S, State, Actions,
- Hibernate, TimeoutsR, true, NextEventsR);
+ Hibernate, TimeoutsR, NewPostpone, NextEventsR);
+ %%
{next_event,Type,Content} ->
case event_type(Type) of
true when NextEventsR =/= forbidden ->
@@ -1351,96 +1378,150 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
- _ ->
+ %%
+ {state_timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ {timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ Time ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Time)
+ end.
+
+parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) ->
+ Time =
+ case Timeout of
+ {_,T,_} -> T;
+ T -> T
+ end,
+ case validate_time(Time) of
+ true ->
+ parse_actions(
+ Debug, S, State, Actions,
+ Hibernate, [Timeout|TimeoutsR],
+ Postpone, NextEventsR);
+ false ->
{error,
- {bad_action_from_state_function,Action},
+ {bad_action_from_state_function,Timeout},
?STACKTRACE()}
end.
+validate_time(Time) when is_integer(Time), Time >= 0 -> true;
+validate_time(infinity) -> true;
+validate_time(_) -> false.
%% Stop and start timers as well as create timeout zero events
%% and pending event timer
%%
%% Stop and start timers non-event timers
-parse_timers(TimerRefs, TimerTypes, TimeoutsR) ->
- parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []).
+parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) ->
+ parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []).
%%
-parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) ->
- {TimerRefs,TimerTypes,TimeoutEvents};
parse_timers(
- TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) ->
- {TimerType,Time,TimerMsg} = Timeout,
+ TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) ->
+ {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents};
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR],
+ Seen, TimeoutEvents) ->
+ case Timeout of
+ {TimerType,Time,TimerMsg} ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg);
+ Time ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ timeout, Time, Time)
+ end.
+
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg) ->
case Seen of
#{TimerType := _} ->
%% Type seen before - ignore
parse_timers(
- TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents);
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents);
#{} ->
%% Unseen type - handle
NewSeen = Seen#{TimerType => true},
- %% Cancel any running timer
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(TimerType, TimerRefs, TimerTypes),
- if
- Time =:= infinity ->
- %% Ignore - timer will never fire
+ case Time of
+ infinity ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, TimeoutEvents);
- TimerType =:= timeout ->
- %% Handle event timer later
- parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
- NewSeen, [Timeout|TimeoutEvents]);
- Time =:= 0 ->
+ 0 ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
%% Handle zero time timeouts later
TimeoutEvent = {TimerType,TimerMsg},
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, [TimeoutEvent|TimeoutEvents]);
- true ->
- %% Start a new timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- parse_timers(
- NewTimerRefs#{TimerRef => TimerType},
- NewTimerTypes#{TimerType => TimerRef},
- TimeoutsR, NewSeen, TimeoutEvents)
+ _ ->
+ %% (Re)start the timer
+ TimerRef =
+ erlang:start_timer(Time, self(), TimerMsg),
+ case TimerTypes of
+ #{TimerType := OldTimerRef} ->
+ %% Cancel the running timer
+ cancel_timer(OldTimerRef),
+ NewCancelTimers = CancelTimers + 1,
+ %% Insert the new timer into
+ %% both TimerRefs and TimerTypes
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ NewCancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents);
+ #{} ->
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ CancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents)
+ end
end
end.
-%% Enqueue immediate timeout events and start event timer
-process_timeout_events(TimerRefs, TimerTypes, [], EventsR) ->
- {TimerRefs, TimerTypes, EventsR};
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,0,TimerMsg}|TimeoutEvents], []) ->
- %% No enqueued events - insert a timeout zero event
- TimeoutEvent = {timeout,TimerMsg},
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent]);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,Time,TimerMsg}], []) ->
- %% No enqueued events - start event timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- process_timeout_events(
- TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef},
- [], []);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) ->
- %% There will be some other event so optimize by not starting
- %% an event timer to just have to cancel it again
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, EventsR);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) ->
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent|EventsR]).
+%% Enqueue immediate timeout events (timeout 0 events)
+%%
+%% Event timer timeout 0 events gets special treatment since
+%% an event timer is cancelled by any received event,
+%% so if there are enqueued events before the event timer
+%% timeout 0 event - the event timer is cancelled hence no event.
+%%
+%% Other (state_timeout) timeout 0 events that are after
+%% the event timer timeout 0 events are considered to
+%% belong to timers that were started after the event timer
+%% timeout 0 event fired, so they do not cancel the event timer.
+%%
+prepend_timeout_events([], EventsR) ->
+ EventsR;
+prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent]);
+prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) ->
+ prepend_timeout_events(TimeoutEvents, EventsR);
+prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) ->
+ %% Just prepend all others
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]).
@@ -1448,18 +1529,11 @@ process_timeout_events(
%% Server helpers
reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, #{state := State} = S, Q, Replies) ->
- if
- is_list(Replies) ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, Replies, State);
- true ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, [Replies], State)
- end.
+ Class, Reason, Stacktrace, Debug,
+ #{state := State} = S, Q, Replies) ->
+ do_reply_then_terminate(
+ Class, Reason, Stacktrace, Debug,
+ S, Q, listify(Replies), State).
%%
do_reply_then_terminate(
Class, Reason, Stacktrace, Debug, S, Q, [], _State) ->
@@ -1485,21 +1559,25 @@ do_reply(Debug, S, State, From, Reply) ->
terminate(
- Class, Reason, Stacktrace,
- Debug,
+ Class, Reason, Stacktrace, Debug,
#{module := Module, state := State, data := Data, postponed := P} = S,
Q) ->
- try Module:terminate(Reason, State, Data) of
- _ -> ok
- catch
- _ -> ok;
- C:R ->
- ST = erlang:get_stacktrace(),
- error_info(
- C, R, ST, S, Q, P,
- format_status(terminate, get(), S)),
- sys:print_log(Debug),
- erlang:raise(C, R, ST)
+ case erlang:function_exported(Module, terminate, 3) of
+ true ->
+ try Module:terminate(Reason, State, Data) of
+ _ -> ok
+ catch
+ _ -> ok;
+ C:R ->
+ ST = erlang:get_stacktrace(),
+ error_info(
+ C, R, ST, S, Q, P,
+ format_status(terminate, get(), S)),
+ sys:print_log(Debug),
+ erlang:raise(C, R, ST)
+ end;
+ false ->
+ ok
end,
_ =
case Reason of
@@ -1637,28 +1715,21 @@ listify(Item) ->
[Item].
%% Cancel timer if running, otherwise no op
-cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) ->
+%%
+%% This is an asynchronous cancel so the timer is not really cancelled
+%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}.
+%% In the mean time we might get a timeout message.
+%%
+%% Remove the timer from TimerTypes.
+%% When we get the cancel_timer msg we remove it from TimerRefs.
+cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) ->
case TimerTypes of
#{TimerType := TimerRef} ->
cancel_timer(TimerRef),
- {maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes)};
+ {maps:remove(TimerType, TimerTypes),CancelTimers + 1};
#{} ->
- {TimerRefs,TimerTypes}
+ {TimerTypes,CancelTimers}
end.
-%%cancel_timer(undefined) ->
-%% ok;
-cancel_timer(TRef) ->
- case erlang:cancel_timer(TRef) of
- false ->
- %% We have to assume that TRef is the ref of a running timer
- %% and if so the timer has expired
- %% hence we must wait for the timeout message
- receive
- {timeout,TRef,_} ->
- ok
- end;
- _TimeLeft ->
- ok
- end.
+cancel_timer(TimerRef) ->
+ ok = erlang:cancel_timer(TimerRef, [{async,true}]).
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 16ca2f41dc..ba2cffdcb3 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -128,6 +128,10 @@ max_cs(M, _Len) ->
M.
-define(ATM(T), is_list(element(1, T))).
+-define(ATM_PAIR(Pair),
+ ?ATM(element(2, element(1, Pair))) % Key
+ andalso
+ ?ATM(element(3, element(1, Pair)))). % Value
-define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))).
pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W)
@@ -140,9 +144,8 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}];
pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}];
-pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)];
+ [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1),
+ $}];
pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}];
pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) ->
@@ -166,6 +169,46 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
[Tag, S | pp_list(L, Tcol, Ll, M, TInd, Indent, LD, S, W+Tlen+1)]
end.
+pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "...";
+pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) ->
+ {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W),
+ [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)].
+
+pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+ ",...";
+pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ [$,, write_pair(P) |
+ pp_pairs_tail(Ps, Col0, Col+ELen, Ll, M, TInd, Ind, LD, W+ELen)];
+ true ->
+ {PS, PW} = pp_pair(P, Col0, Ll, M, TInd, Ind, LD1, 0),
+ [$,, $\n, Ind, PS |
+ pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)]
+ end.
+
+pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ {write_pair(Pair), if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll % force nl
+ end};
+pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
+ I = map_value_indent(TInd),
+ Ind = indent(I, Ind0),
+ {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n",
+ Ind | pp(V, Col0 + I, Ll, M, TInd, Ind, LD, 0)], Ll}. % force nl
+
pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
@@ -204,7 +247,11 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
end};
pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL),
- {[Name, " = ", S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
+ Sep = case S of
+ [$\n | _] -> " =";
+ _ -> " = "
+ end,
+ {[Name, Sep, S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
rec_indent(RInd, TInd, Col0, Ind0, W0) ->
Nl = (TInd > 0) and (RInd > TInd),
@@ -291,8 +338,8 @@ write({{list, L}, _}) ->
[$[, write_list(L, $|), $]];
write({{map, Pairs}, _}) ->
[$#,${, write_list(Pairs, $,), $}];
-write({{map_pair, K, V}, _}) ->
- [write(K)," => ",write(V)];
+write({{map_pair, _K, _V}, _}=Pair) ->
+ write_pair(Pair);
write({{record, [{Name,_} | L]}, _}) ->
[Name, ${, write_fields(L), $}];
write({{bin, S}, _}) ->
@@ -300,6 +347,9 @@ write({{bin, S}, _}) ->
write({S, _}) ->
S.
+write_pair({{map_pair, K, V}, _}) ->
+ [write(K), " => ", write(V)].
+
write_fields([]) ->
"";
write_fields({dots, _}) ->
@@ -333,7 +383,7 @@ write_tail(E, S) ->
%% The depth (D) is used for extracting and counting the characters to
%% print. The structure is kept so that the returned intermediate
-%% format can be formatted. The separators (list, tuple, record) are
+%% format can be formatted. The separators (list, tuple, record, map) are
%% counted but need to be added later.
%% D =/= 0
@@ -406,21 +456,32 @@ print_length(Term, _D, _RF, _Enc, _Str) ->
print_length_map(_Map, 1, _RF, _Enc, _Str) ->
{"#{...}", 6};
print_length_map(Map, D, RF, Enc, Str) when is_map(Map) ->
- Pairs = print_length_map_pairs(maps:to_list(Map), D, RF, Enc, Str),
+ Pairs = print_length_map_pairs(maps_to_list(Map, D), D, RF, Enc, Str),
{{map, Pairs}, list_length(Pairs, 3)}.
+maps_to_list(Map, D) when D < 0; map_size(Map) =< D ->
+ maps:to_list(Map);
+maps_to_list(Map, D) ->
+ F = fun(_K, _V, {N, L}) when N =:= D ->
+ throw(L);
+ (K, V, {N, L}) ->
+ {N+1, [{K, V} | L]}
+ end,
+ lists:reverse(catch maps:fold(F, {0, []}, Map)).
+
print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
[];
print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) ->
{dots, 3};
-print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) ->
- [print_length_map_pair(K,V,D-1,RF,Enc,Str) |
- print_length_map_pairs(Pairs,D-1,RF,Enc,Str)].
+print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) ->
+ [print_length_map_pair(K, V, D - 1, RF, Enc, Str) |
+ print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)].
print_length_map_pair(K, V, D, RF, Enc, Str) ->
{KS, KL} = print_length(K, D, RF, Enc, Str),
{VS, VL} = print_length(V, D, RF, Enc, Str),
- {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}.
+ KL1 = KL + 4,
+ {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}.
print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) ->
{"{...}", 5};
@@ -612,6 +673,8 @@ cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1);
cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
+cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) ->
+ cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2);
cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1);
cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
@@ -637,6 +700,48 @@ cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) ->
throw(no_good)
end.
+cind_map([P | Ps], Col, Ll, M, Ind, LD, W) ->
+ PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W),
+ cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW);
+cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ cind_pairs_tail(Ps, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen);
+ true ->
+ PW = cind_pair(P, Col0, Ll, M, Ind, LD1, 0),
+ cind_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, Ind, LD, PW)
+ end;
+cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll
+ end;
+cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+ cind(K, Col0, Ll, M, Ind, LD, W0),
+ I = map_value_indent(Ind),
+ cind(V, Col0 + I, Ll, M, Ind, LD, 0),
+ Ll.
+
+map_value_indent(TInd) ->
+ case TInd > 0 of
+ true ->
+ TInd;
+ false ->
+ 4
+ end.
+
cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) ->
Nind = Nlen + 1,
{Col, W} = cind_rec(Nind, Col0, Ll, M, Ind, W0),
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index f3665824f2..8c4d835432 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1292,6 +1292,10 @@ abstr_term(Fun, Line) when is_function(Fun) ->
end;
abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) ->
{special, Line, lists:flatten(io_lib:write(PPR))};
+abstr_term(Map, Line) when is_map(Map) ->
+ {map,Line,
+ [{map_field_assoc,Line,abstr_term(K, Line),abstr_term(V, Line)} ||
+ {K,V} <- maps:to_list(Map)]};
abstr_term(Simple, Line) ->
erl_parse:abstract(Simple, erl_anno:line(Line)).
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index 340cc21390..fadf96146e 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -179,19 +179,6 @@
external_attr,
local_header_offset}).
-%% Unix extra fields (not yet supported)
--define(UNIX_EXTRA_FIELD_TAG, 16#000d).
--record(unix_extra_field, {atime,
- mtime,
- uid,
- gid}).
-
-%% extended timestamps (not yet supported)
--define(EXTENDED_TIMESTAMP_TAG, 16#5455).
-%% -record(extended_timestamp, {mtime,
-%% atime,
-%% ctime}).
-
-define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50).
-define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)).
@@ -381,9 +368,12 @@ do_unzip(F, Options) ->
{Info, In1} = get_central_dir(In0, RawIterator, Input),
%% get rid of zip-comment
Z = zlib:open(),
- Files = get_z_files(Info, Z, In1, Opts, []),
- zlib:close(Z),
- Input(close, In1),
+ Files = try
+ get_z_files(Info, Z, In1, Opts, [])
+ after
+ zlib:close(Z),
+ Input(close, In1)
+ end,
{ok, Files}.
%% Iterate over all files in a zip archive
@@ -460,11 +450,20 @@ do_zip(F, Files, Options) ->
#zip_opts{output = Output, open_opts = OpO} = Opts,
Out0 = Output({open, F, OpO}, []),
Z = zlib:open(),
- {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
- zlib:close(Z),
- Out2 = put_central_dir(LHS, Pos, Out1, Opts),
- Out3 = Output({close, F}, Out2),
- {ok, Out3}.
+ try
+ {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
+ zlib:close(Z),
+ Out2 = put_central_dir(LHS, Pos, Out1, Opts),
+ Out3 = Output({close, F}, Out2),
+ {ok, Out3}
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ zlib:close(Z),
+ Output({close, F}, Out0),
+ erlang:raise(C, R, Stk)
+ end.
+
%% List zip directory contents
%%
@@ -1379,12 +1378,7 @@ cd_file_header_to_file_info(FileName,
gid = 0},
add_extra_info(FI, ExtraField).
-%% add extra info to file (some day when we implement it)
-add_extra_info(FI, <<?EXTENDED_TIMESTAMP_TAG:16/little, _Rest/binary>>) ->
- FI; % not yet supported, some other day...
-add_extra_info(FI, <<?UNIX_EXTRA_FIELD_TAG:16/little, Rest/binary>>) ->
- _UnixExtra = unix_extra_field_and_var_from_bin(Rest),
- FI; % not yet supported, and not widely used
+%% Currently, we ignore all the extra fields.
add_extra_info(FI, _) ->
FI.
@@ -1572,20 +1566,6 @@ dos_date_time_from_datetime({{Year, Month, Day}, {Hour, Min, Sec}}) ->
<<DosDate:16>> = <<YearFrom1980:7, Month:4, Day:5>>,
{DosDate, DosTime}.
-unix_extra_field_and_var_from_bin(<<TSize:16/little,
- ATime:32/little,
- MTime:32/little,
- UID:16/little,
- GID:16/little,
- Var:TSize/binary>>) ->
- {#unix_extra_field{atime = ATime,
- mtime = MTime,
- uid = UID,
- gid = GID},
- Var};
-unix_extra_field_and_var_from_bin(_) ->
- throw(bad_unix_extra_field).
-
%% A pwrite-like function for iolists (used by memory-option)
pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos ->
diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl
index 718d91c6a3..1f694ea549 100644
--- a/lib/stdlib/test/edlin_expand_SUITE.erl
+++ b/lib/stdlib/test/edlin_expand_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,7 +21,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_testcase/2, end_per_testcase/2,
init_per_group/2,end_per_group/2]).
--export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1]).
+-export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1,
+ erl_352/1]).
-include_lib("common_test/include/ct.hrl").
@@ -36,7 +37,7 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [normal, quoted_fun, quoted_module, quoted_both, erl_1152].
+ [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352].
groups() ->
[].
@@ -153,6 +154,78 @@ erl_1152(Config) when is_list(Config) ->
"\n"++"foo"++" "++[1089]++_ = do_format(["foo",[1089]]),
ok.
+erl_352(Config) when is_list(Config) ->
+ erl_352_test(3, 3),
+
+ erl_352_test(3, 75),
+ erl_352_test(3, 76, [trailing]),
+ erl_352_test(4, 74),
+ erl_352_test(4, 75, [leading]),
+ erl_352_test(4, 76, [leading, trailing]),
+
+ erl_352_test(75, 3),
+ erl_352_test(76, 3, [leading]),
+ erl_352_test(74, 4),
+ erl_352_test(75, 4, [leading]),
+ erl_352_test(76, 4, [leading]),
+
+ erl_352_test(74, 74, [leading]),
+ erl_352_test(74, 75, [leading]),
+ erl_352_test(74, 76, [leading, trailing]).
+
+erl_352_test(PrefixLen, SuffixLen) ->
+ erl_352_test(PrefixLen, SuffixLen, []).
+
+erl_352_test(PrefixLen, SuffixLen, Dots) ->
+ io:format("\nPrefixLen = ~w, SuffixLen = ~w\n", [PrefixLen, SuffixLen]),
+
+ PrefixM = lists:duplicate(PrefixLen, $p),
+ SuffixM = lists:duplicate(SuffixLen, $s),
+ LM = [PrefixM ++ S ++ SuffixM || S <- ["1", "2"]],
+ StrM = do_format(LM),
+ check_leading(StrM, "", PrefixM, SuffixM, Dots),
+
+ PrefixF = lists:duplicate(PrefixLen, $p),
+ SuffixF = lists:duplicate(SuffixLen-2, $s),
+ LF = [{PrefixF ++ S ++ SuffixF, 1} || S <- ["1", "2"]],
+ StrF = do_format(LF),
+ true = check_leading(StrF, "/1", PrefixF, SuffixF, Dots),
+
+ ok.
+
+check_leading(FormStr, ArityStr, Prefix, Suffix, Dots) ->
+ List = string:tokens(FormStr, "\n "),
+ io:format("~p\n", [List]),
+ true = lists:all(fun(L) -> length(L) < 80 end, List),
+ case lists:member(leading, Dots) of
+ true ->
+ true = lists:all(fun(L) ->
+ {"...", Rest} = lists:split(3, L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List);
+ false ->
+ true = lists:all(fun(L) ->
+ {Prefix, Rest} =
+ lists:split(length(Prefix), L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List)
+ end.
+
+check_trailing([I|Str], ArityStr, Suffix, Dots) ->
+ true = lists:member(I, [$1, $2]),
+ case lists:member(trailing, Dots) of
+ true ->
+ {Rest, "..." ++ ArityStr} =
+ lists:split(length(Str) - (3 + length(ArityStr)), Str),
+ true = lists:prefix(Rest, Suffix);
+ false ->
+ {Rest, ArityStr} =
+ lists:split(length(Str) - length(ArityStr), Str),
+ Rest =:= Suffix
+ end.
+
do_expand(String) ->
edlin_expand:expand(lists:reverse(String)).
diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl
index 28d69232a0..0b9106a99c 100644
--- a/lib/stdlib/test/escript_SUITE.erl
+++ b/lib/stdlib/test/escript_SUITE.erl
@@ -28,6 +28,7 @@
strange_name/1,
emulator_flags/1,
emulator_flags_no_shebang/1,
+ two_lines/1,
module_script/1,
beam_script/1,
archive_script/1,
@@ -49,7 +50,7 @@ suite() ->
all() ->
[basic, errors, strange_name, emulator_flags,
- emulator_flags_no_shebang,
+ emulator_flags_no_shebang, two_lines,
module_script, beam_script, archive_script, epp,
create_and_extract, foldl, overflow,
archive_script_file_access, unicode].
@@ -153,6 +154,18 @@ emulator_flags(Config) when is_list(Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+two_lines(Config) when is_list(Config) ->
+ Data = proplists:get_value(data_dir, Config),
+ Dir = filename:absname(Data), %Get rid of trailing slash.
+ run(Dir, "two_lines -arg1 arg2 arg3",
+ [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n"
+ "ERL_FLAGS=false\n"
+ "unknown:[]\n"
+ "ExitCode:0">>]),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
emulator_flags_no_shebang(Config) when is_list(Config) ->
Data = proplists:get_value(data_dir, Config),
Dir = filename:absname(Data), %Get rid of trailing slash.
diff --git a/lib/stdlib/test/escript_SUITE_data/two_lines b/lib/stdlib/test/escript_SUITE_data/two_lines
new file mode 100755
index 0000000000..cf4e99639c
--- /dev/null
+++ b/lib/stdlib/test/escript_SUITE_data/two_lines
@@ -0,0 +1,2 @@
+#! /usr/bin/env escript
+main(MainArgs) -> io:format("main:~p\n", [MainArgs]), ErlArgs = init:get_arguments(), io:format("ERL_FLAGS=~p\n", [os:getenv("ERL_FLAGS")]), io:format("unknown:~p\n",[[E || E <- ErlArgs, element(1, E) =:= unknown]]).
diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl
index b7c4d3a6e5..f64ec6acb7 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -29,6 +29,7 @@
dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]).
-export([pathtype_bin/1,rootname_bin/1,split_bin/1]).
-export([t_basedir_api/1, t_basedir_xdg/1, t_basedir_windows/1]).
+-export([safe_relative_path/1]).
-include_lib("common_test/include/ct.hrl").
@@ -41,7 +42,8 @@ all() ->
find_src,
absname_bin, absname_bin_2,
{group,p},
- t_basedir_xdg, t_basedir_windows].
+ t_basedir_xdg, t_basedir_windows,
+ safe_relative_path].
groups() ->
[{p, [parallel],
@@ -768,6 +770,71 @@ t_nativename_bin(Config) when is_list(Config) ->
filename:nativename(<<"/usr/tmp//arne/">>)
end.
+safe_relative_path(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Root = filename:join(PrivDir, ?FUNCTION_NAME),
+ ok = file:make_dir(Root),
+ ok = file:set_cwd(Root),
+
+ ok = file:make_dir("a"),
+ ok = file:set_cwd("a"),
+ ok = file:make_dir("b"),
+ ok = file:set_cwd("b"),
+ ok = file:make_dir("c"),
+
+ ok = file:set_cwd(Root),
+
+ "a" = test_srp("a"),
+ "a/b" = test_srp("a/b"),
+ "a/b" = test_srp("a/./b"),
+ "a/b" = test_srp("a/./b/."),
+
+ "" = test_srp("a/.."),
+ "" = test_srp("a/./.."),
+ "" = test_srp("a/../."),
+ "a" = test_srp("a/b/.."),
+ "a" = test_srp("a/../a"),
+ "a" = test_srp("a/../a/../a"),
+ "a/b/c" = test_srp("a/../a/b/c"),
+
+ unsafe = test_srp("a/../.."),
+ unsafe = test_srp("a/../../.."),
+ unsafe = test_srp("a/./../.."),
+ unsafe = test_srp("a/././../../.."),
+ unsafe = test_srp("a/b/././../../.."),
+
+ unsafe = test_srp(PrivDir), %Absolute path.
+
+ ok.
+
+test_srp(RelPath) ->
+ Res = do_test_srp(RelPath),
+ Res = case do_test_srp(list_to_binary(RelPath)) of
+ Bin when is_binary(Bin) ->
+ binary_to_list(Bin);
+ Other ->
+ Other
+ end.
+
+do_test_srp(RelPath) ->
+ {ok,Root} = file:get_cwd(),
+ ok = file:set_cwd(RelPath),
+ {ok,Cwd} = file:get_cwd(),
+ ok = file:set_cwd(Root),
+ case filename:safe_relative_path(RelPath) of
+ unsafe ->
+ true = length(Cwd) < length(Root),
+ unsafe;
+ "" ->
+ "";
+ SafeRelPath ->
+ ok = file:set_cwd(SafeRelPath),
+ {ok,Cwd} = file:get_cwd(),
+ true = length(Cwd) >= length(Root),
+ ok = file:set_cwd(Root),
+ SafeRelPath
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% basedirs
t_basedir_api(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 119546be98..24f0864b3c 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -38,7 +38,7 @@ all() ->
{group, abnormal},
{group, abnormal_handle_event},
shutdown, stop_and_reply, state_enter, event_order,
- state_timeout, code_change,
+ state_timeout, event_types, code_change,
{group, sys},
hibernate, enter_loop].
@@ -600,15 +600,26 @@ state_enter(_Config) ->
(internal, Prev, N) ->
Self ! {internal,start,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state,N + 1,
+ [{reply,From,{repeat,start,N}}]};
({call,From}, echo, N) ->
- {next_state,wait,N + 1,{reply,From,{echo,start,N}}};
+ {next_state,wait,N + 1,
+ {reply,From,{echo,start,N}}};
({call,From}, {stop,Reason}, N) ->
- {stop_and_reply,Reason,[{reply,From,{stop,N}}],N + 1}
+ {stop_and_reply,Reason,
+ [{reply,From,{stop,N}}],N + 1}
end,
wait =>
- fun (enter, Prev, N) ->
+ fun (enter, Prev, N) when N < 5 ->
+ {repeat_state,N + 1,
+ {reply,{Self,N},{enter,Prev}}};
+ (enter, Prev, N) ->
Self ! {enter,wait,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state_and_data,
+ [{reply,From,{repeat,wait,N}}]};
({call,From}, echo, N) ->
{next_state,start,N + 1,
[{next_event,internal,wait},
@@ -620,11 +631,15 @@ state_enter(_Config) ->
[{enter,start,start,1}] = flush(),
{echo,start,2} = gen_statem:call(STM, echo),
- [{enter,wait,start,3}] = flush(),
- {wait,[4|_]} = sys:get_state(STM),
- {echo,wait,4} = gen_statem:call(STM, echo),
- [{enter,start,wait,5},{internal,start,wait,6}] = flush(),
- {stop,7} = gen_statem:call(STM, {stop,bye}),
+ [{3,{enter,start}},{4,{enter,start}},{enter,wait,start,5}] = flush(),
+ {wait,[6|_]} = sys:get_state(STM),
+ {repeat,wait,6} = gen_statem:call(STM, repeat),
+ [{enter,wait,wait,6}] = flush(),
+ {echo,wait,7} = gen_statem:call(STM, echo),
+ [{enter,start,wait,8},{internal,start,wait,9}] = flush(),
+ {repeat,start,10} = gen_statem:call(STM, repeat),
+ [{enter,start,start,11}] = flush(),
+ {stop,12} = gen_statem:call(STM, {stop,bye}),
[{'EXIT',STM,bye}] = flush(),
{noproc,_} =
@@ -801,6 +816,74 @@ state_timeout(_Config) ->
+%% Test that all event types can be sent with {next_event,EventType,_}
+event_types(_Config) ->
+ process_flag(trap_exit, true),
+
+ Machine =
+ %% Abusing the internal format of From...
+ #{init =>
+ fun () ->
+ {ok, start, undefined}
+ end,
+ start =>
+ fun ({call,_} = Call, Req, undefined) ->
+ {next_state, state1, undefined,
+ [{next_event,internal,1},
+ {next_event,state_timeout,2},
+ {next_event,timeout,3},
+ {next_event,info,4},
+ {next_event,cast,5},
+ {next_event,Call,Req}]}
+ end,
+ state1 =>
+ fun (internal, 1, undefined) ->
+ {next_state, state2, undefined}
+ end,
+ state2 =>
+ fun (state_timeout, 2, undefined) ->
+ {next_state, state3, undefined}
+ end,
+ state3 =>
+ fun (timeout, 3, undefined) ->
+ {next_state, state4, undefined}
+ end,
+ state4 =>
+ fun (info, 4, undefined) ->
+ {next_state, state5, undefined}
+ end,
+ state5 =>
+ fun (cast, 5, undefined) ->
+ {next_state, state6, undefined}
+ end,
+ state6 =>
+ fun ({call,From}, stop, undefined) ->
+ {stop_and_reply, shutdown,
+ [{reply,From,stopped}]}
+ end},
+ {ok,STM} =
+ gen_statem:start_link(
+ ?MODULE, {map_statem,Machine,[]}, [{debug,[trace]}]),
+
+ stopped = gen_statem:call(STM, stop),
+ receive
+ {'EXIT',STM,shutdown} ->
+ ok
+ after 500 ->
+ ct:fail(did_not_stop)
+ end,
+
+ {noproc,_} =
+ ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason),
+ case flush() of
+ [] ->
+ ok;
+ Other2 ->
+ ct:fail({unexpected,Other2})
+ end.
+
+
+
sys1(Config) ->
{ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []),
{status, Pid, {module,gen_statem}, _} = sys:get_status(Pid),
@@ -1722,6 +1805,10 @@ handle_event(
{keep_state,[NewData|Machine]};
{keep_state,NewData,Ops} ->
{keep_state,[NewData|Machine],Ops};
+ {repeat_state,NewData} ->
+ {repeat_state,[NewData|Machine]};
+ {repeat_state,NewData,Ops} ->
+ {repeat_state,[NewData|Machine],Ops};
Other ->
Other
end;
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 7d48cbc97c..6e99619324 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,7 @@
io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
otp_10836/1, io_lib_width_too_small/1,
io_with_huge_message_queue/1, format_string/1,
- maps/1, coverage/1]).
+ maps/1, coverage/1, otp_14175/1]).
-export([pretty/2]).
@@ -61,7 +61,7 @@ all() ->
printable_range, bad_printable_range,
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
- format_string, maps, coverage].
+ format_string, maps, coverage, otp_14175].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -415,13 +415,13 @@ otp_6354(Config) when is_list(Config) ->
bt(<<"#rrrrr{\n"
" f1 = 1,\n"
" f2 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = h,f2 = i,\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = aa,\n"
- " f2 = \n"
+ " f2 =\n"
" #rrrrr{\n"
" f1 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
" f2 = 2,f3 = 3},\n"
@@ -431,17 +431,17 @@ otp_6354(Config) when is_list(Config) ->
2,3},bb}}},
-1)),
bt(<<"#d{aaaaaaaaaaaaaaaaaaaa = 1,\n"
- " bbbbbbbbbbbbbbbbbbbb = \n"
+ " bbbbbbbbbbbbbbbbbbbb =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = a,bbbbbbbbbbbbbbbbbbbb = b,\n"
" cccccccccccccccccccc = c,dddddddddddddddddddd = d,\n"
" eeeeeeeeeeeeeeeeeeee = e},\n"
" cccccccccccccccccccc = 3,\n"
- " dddddddddddddddddddd = \n"
+ " dddddddddddddddddddd =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = h,bbbbbbbbbbbbbbbbbbbb = i,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = aa,"
"bbbbbbbbbbbbbbbbbbbb = bb,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = 1,"
"bbbbbbbbbbbbbbbbbbbb = 2,\n"
" cccccccccccccccccccc = 3,"
@@ -534,21 +534,21 @@ otp_6354(Config) when is_list(Config) ->
p({A,{A,{A,{A,{A,{A,{A,
{g,{h,{i,{j,{k,{l,{m,{n,{o,{a}}}}}}}}}}}}}}}}}, 100)),
bt(<<"#c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
" f1 = #c{f1 = #c{f1 = #c{f1 = a,"
"f2 = b},f2 = b},f2 = b},\n"
@@ -564,13 +564,13 @@ otp_6354(Config) when is_list(Config) ->
p({c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
b},b},b},b},b},b}, -1)),
bt(<<"#rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" {rrrrr,{rrrrr,a,#rrrrr{f1 = {rrrrr,1,2},f2 = a,"
"f3 = b}},b},\n"
" f2 = {rrrrr,c,d},\n"
@@ -2106,3 +2106,200 @@ coverage(_Config) ->
io:format("~s\n", [S2]),
ok.
+
+otp_14175(_Config) ->
+ "..." = p(#{}, 0),
+ "#{}" = p(#{}, 1),
+ "#{...}" = p(#{a => 1}, 1),
+ "#{#{} => a}" = p(#{#{} => a}, 2),
+ "#{a => 1,...}" = p(#{a => 1, b => 2}, 2),
+ "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1),
+
+ M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,
+ kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,
+ keeeeeeeeeeeeeeeeeee => v5},
+ "#{...}" = p(M, 1),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => v1,...}", p(M, 2)),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => 1,kbbbbbbbbbbbbbbbbbbbb => 2,...}",
+ p(M, 3)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,...}", p(M, 4)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,...}",
+ p(M, 5)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,\n"
+ " keeeeeeeeeeeeeeeeeee => v5}", p(M, 6)),
+
+ weak("#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,\n"
+ " cccccccccccccccccccc => {3},\n"
+ " dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}",
+ p(#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,
+ cccccccccccccccccccc => {3},
+ dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}, -1)),
+
+ M2 = #{dddddddddddddddddddd => {1}, {aaaaaaaaaaaaaaaaaaaa} => 2,
+ {bbbbbbbbbbbbbbbbbbbb} => 3,{cccccccccccccccccccc} => 4,
+ {eeeeeeeeeeeeeeeeeeee} => 5},
+ "#{...}" = p(M2, 1),
+ weak("#{dddddddddddddddddddd => {...},...}", p(M2, 2)),
+ weak("#{dddddddddddddddddddd => {1},{...} => 2,...}", p(M2, 3)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {...} => 3,...}", p(M2, 4)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {...} => 4,...}", p(M2, 5)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {...} => 5}", p(M2, 6)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {eeeeeeeeeeeeeeeeeeee} => 5}", p(M2, 7)),
+
+ M3 = #{kaaaaaaaaaaaaaaaaaaa => vuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,
+ kbbbbbbbbbbbbbbbbbbb => vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,
+ kccccccccccccccccccc => vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,
+ kddddddddddddddddddd => vyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,
+ keeeeeeeeeeeeeeeeeee => vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz},
+
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,\n"
+ " bbbbbbbbbbbbbbbbbbbb =>\n"
+ " vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,\n"
+ " cccccccccccccccccccc =>\n"
+ " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,\n"
+ " dddddddddddddddddddd =>\n"
+ " yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,\n"
+ " eeeeeeeeeeeeeeeeeeee =>\n"
+ " zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}", p(M3, -1)),
+
+ R4 = {c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
+ b},b},b},b},b},b},
+ M4 = #{aaaaaaaaaaaaaaaaaaaa => R4,
+ bbbbbbbbbbbbbbbbbbbb => R4,
+ cccccccccccccccccccc => R4,
+ dddddddddddddddddddd => R4,
+ eeeeeeeeeeeeeeeeeeee => R4},
+
+ weak("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{f1 = #c{f1 = #c{...},f2 = b},f2 = b},\n"
+ " bbbbbbbbbbbbbbbbbbbb => #c{f1 = #c{f1 = {...},...},f2 = b},\n"
+ " cccccccccccccccccccc => #c{f1 = #c{...},f2 = b},\n"
+ " dddddddddddddddddddd => #c{f1 = {...},...},\n"
+ " eeeeeeeeeeeeeeeeeeee => #c{...}}", p(M4, 7)),
+
+ M5 = #{aaaaaaaaaaaaaaaaaaaa => R4},
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 = #c{f1 = #c{f1 = #c{f1 = a,f2 = b},f2 = b},"
+ "f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b}}", p(M5, -1)),
+ ok.
+
+%% Just check number of newlines and dots ('...').
+-define(WEAK, true).
+
+-ifdef(WEAK).
+
+weak(S, R) ->
+ (nl(S) =:= nl(R) andalso
+ dots(S) =:= dots(S)).
+
+nl(S) ->
+ [C || C <- S, C =:= $\n].
+
+dots(S) ->
+ [C || C <- S, C =:= $\.].
+
+-else. % WEAK
+
+weak(S, R) ->
+ mt(S, R).
+
+-endif. % WEAK
+
+%% If EXACT is defined: mt() matches strings exactly.
+%%
+%% if EXACT is not defined: do not match the strings exactly, but
+%% compare them assuming that all map keys and all map values are
+%% equal (by assuming all map keys and all map values have the same
+%% length and begin with $k and $v respectively).
+
+%-define(EXACT, true).
+
+-ifdef(EXACT).
+
+mt(S, R) ->
+ S =:= R.
+
+-else. % EXACT
+
+mt(S, R) ->
+ anon(S) =:= anon(R).
+
+anon(S) ->
+ {ok, Ts0, _} = erl_scan:string(S, 1, [text]),
+ Ts = anon1(Ts0),
+ text(Ts).
+
+anon1([]) -> [];
+anon1([{atom,Anno,Atom}=T|Ts]) ->
+ case erl_anno:text(Anno) of
+ "k" ++ _ ->
+ NewAnno = erl_anno:set_text("key", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ "v" ++ _ ->
+ NewAnno = erl_anno:set_text("val", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ _ ->
+ [T|anon1(Ts)]
+ end;
+anon1([T|Ts]) ->
+ [T|anon1(Ts)].
+
+text(Ts) ->
+ lists:append(text1(Ts)).
+
+text1([]) -> [];
+text1([T|Ts]) ->
+ Anno = element(2, T),
+ [erl_anno:text(Anno) | text1(Ts)].
+
+-endif. % EXACT
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 2bd940020c..846c2c56f4 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -869,11 +869,12 @@ eval_unique(Config) when is_list(Config) ->
[a] = qlc:e(Q2, {unique_all, true})
">>,
- <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1]],unique)],
+ <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1,#{a => 1}]],
+ unique)],
unique),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
qlc:info(Q, [{format,abstract_code},unique_all]),
- [1,2] = qlc:e(Q)">>,
+ [1,2,#{a := 1}] = qlc:e(Q)">>,
<<"Q = qlc:q([X || X <- [1,2,1]]),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
@@ -2620,7 +2621,16 @@ info(Config) when is_list(Config) ->
{cons, _, _, _}]},
{nil,_}}]}]} = i(QH, {format, abstract_code}),
[{5},{6}] = qlc:e(QH),
- [{4},{5},{6}] = qlc:e(F(3))">>
+ [{4},{5},{6}] = qlc:e(F(3))">>,
+
+ <<"Fun = fun ?MODULE:i/2,
+ L = [{#{k => #{v => Fun}}, Fun}],
+ H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]),
+ L = qlc:e(H),
+ {call,_,_,[{lc,_,{var,_,'Q'},
+ [{generate,_,_,_},
+ {op,_,_,_,_}]}]} =
+ qlc:info(H, [{format,abstract_code}])">>
],
run(Config, Ts),
diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl
index 02b7cb10c2..47e7c4f03d 100644
--- a/lib/stdlib/test/rand_SUITE.erl
+++ b/lib/stdlib/test/rand_SUITE.erl
@@ -275,13 +275,13 @@ gen(_, _, Acc) -> lists:reverse(Acc).
%% Check that the algorithms generate sound values.
basic_stats_uniform_1(Config) when is_list(Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
[basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}]))
|| Alg <- algs()],
ok.
basic_stats_uniform_2(Config) when is_list(Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
[basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}]))
|| Alg <- algs()],
ok.
@@ -388,7 +388,7 @@ crypto_uniform_n(N, State0) ->
%% Not a test but measures the time characteristics of the different algorithms
measure(Suite) when is_atom(Suite) -> [];
measure(_Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
Algos = [crypto64|algs()],
io:format("RNG uniform integer performance~n",[]),
_ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end),
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index c409a6949b..80585ca359 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -2325,7 +2325,7 @@ otp_6554(Config) when is_list(Config) ->
"[unproper | list]).">>),
%% Cheating:
"exception error: no function clause matching "
- "erl_eval:do_apply(4)" ++ _ =
+ "shell:apply_fun(4)" ++ _ =
comm_err(<<"erlang:error(function_clause, [4]).">>),
"exception error: no function clause matching "
"lists:reverse(" ++ _ =
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index 7d90795c9e..f0feda217a 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -27,7 +27,7 @@
openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1,
unzip_traversal_exploit/1,
compress_control/1,
- foldl/1]).
+ foldl/1,fd_leak/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -40,7 +40,7 @@ all() ->
unzip_to_binary, zip_to_binary, unzip_options,
zip_options, list_dir_options, aliases, openzip_api,
zip_api, open_leak, unzip_jar, compress_control, foldl,
- unzip_traversal_exploit].
+ unzip_traversal_exploit,fd_leak].
groups() ->
[].
@@ -882,3 +882,35 @@ foldl(Config) ->
{error, enoent} = zip:foldl(ZipFun, [], File),
ok.
+
+fd_leak(Config) ->
+ ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
+ DataDir = proplists:get_value(data_dir, Config),
+ Name = filename:join(DataDir, "bad_file_header.zip"),
+ BadExtract = fun() ->
+ {error,bad_file_header} = zip:extract(Name),
+ ok
+ end,
+ do_fd_leak(BadExtract, 1),
+
+ BadCreate = fun() ->
+ {error,enoent} = zip:zip("failed.zip",
+ ["none"]),
+ ok
+ end,
+ do_fd_leak(BadCreate, 1),
+
+ ok.
+
+do_fd_leak(_Bad, 10000) ->
+ ok;
+do_fd_leak(Bad, N) ->
+ try Bad() of
+ ok ->
+ do_fd_leak(Bad, N + 1)
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ io:format("Bad error after ~p attempts\n", [N]),
+ erlang:raise(C, R, Stk)
+ end.
diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el
index 2801aa8ae7..241590b850 100644
--- a/lib/tools/emacs/erlang-edoc.el
+++ b/lib/tools/emacs/erlang-edoc.el
@@ -36,7 +36,7 @@
"Tags that can be used anywhere within a module.")
(defvar erlang-edoc-overview-tags
- '("author" "copyright" "reference" "see" "since" "title" "version")
+ '("author" "copyright" "doc" "reference" "see" "since" "title" "version")
"Tags that can be used in an overview file.")
(defvar erlang-edoc-module-tags
@@ -45,8 +45,8 @@
"Tags that can be used before a module declaration.")
(defvar erlang-edoc-function-tags
- '("deprecated" "doc" "equiv" "hidden" "private" "see" "since" "spec"
- "throws" "type")
+ '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns"
+ "see" "since" "spec" "throws" "type")
"Tags that can be used before a function definition.")
(defvar erlang-edoc-predefined-macros
diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el
index eeba7f34e9..bdb3d9ad4a 100644
--- a/lib/tools/emacs/erlang-skels.el
+++ b/lib/tools/emacs/erlang-skels.el
@@ -1,7 +1,7 @@
;;
;; %CopyrightBegin%
;;
-;; Copyright Ericsson AB 2010-2016. All Rights Reserved.
+;; Copyright Ericsson AB 2010-2017. All Rights Reserved.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
@@ -915,11 +915,7 @@ Please see the function `tempo-define-template'.")
"%% process to initialize." n
(erlang-skel-separator-end 2)
"-spec init(Args :: term()) ->" n>
- "{ok, State :: term(), Data :: term()} |" n>
- "{ok, State :: term(), Data :: term()," n>
- "[gen_statem:action()] | gen_statem:action()} |" n>
- "ignore |" n>
- "{stop, Reason :: term()}." n
+ "gen_statem:init_result(atom())." n
"init([]) ->" n>
"process_flag(trap_exit, true)," n>
"{ok, state_name, #data{}}." n
@@ -1028,11 +1024,7 @@ Please see the function `tempo-define-template'.")
"%% process to initialize." n
(erlang-skel-separator-end 2)
"-spec init(Args :: term()) ->" n>
- "{ok, State :: term(), Data :: term()} |" n>
- "{ok, State :: term(), Data :: term()," n>
- "[gen_statem:action()] | gen_statem:action()} |" n>
- "ignore |" n>
- "{stop, Reason :: term()}." n
+ "gen_statem:init_result(term())." n
"init([]) ->" n>
"process_flag(trap_exit, true)," n>
"{ok, state_name, #data{}}." n
diff --git a/lib/tools/examples/xref_examples.erl b/lib/tools/examples/xref_examples.erl
index 4c082195a2..f7e71c9708 100644
--- a/lib/tools/examples/xref_examples.erl
+++ b/lib/tools/examples/xref_examples.erl
@@ -7,7 +7,7 @@
%% ${HOME}/unused_locals.txt.
script() ->
Root = code:root_dir(),
- Dir = os:getenv("HOME"),
+ {ok,[[Dir]]} = init:get_argument(home),
Server = s,
xref:start(Server),
{ok, _Relname} = xref:add_release(Server, code:lib_dir(), {name,otp}),
diff --git a/lib/typer/src/typer.app.src b/lib/typer/src/typer.app.src
index 974091b44c..e0be937cc3 100644
--- a/lib/typer/src/typer.app.src
+++ b/lib/typer/src/typer.app.src
@@ -7,5 +7,5 @@
{registered, []},
{applications, [compiler, dialyzer, hipe, kernel, stdlib]},
{env, []},
- {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0",
- "dialyzer-2.7","compiler-5.0"]}]}.
+ {runtime_dependencies, ["stdlib-3.0","kernel-5.0","hipe-3.15.4","erts-8.0",
+ "dialyzer-3.1","compiler-7.0"]}]}.
diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl
index 5c82750a21..cd67af41ed 100644
--- a/lib/typer/src/typer.erl
+++ b/lib/typer/src/typer.erl
@@ -143,8 +143,9 @@ extract(#analysis{macros = Macros,
MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords),
CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1),
CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2),
- CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3),
- dialyzer_contracts:process_contract_remote_types(CodeServer4)
+ {CodeServer4, RecordDict} =
+ dialyzer_utils:process_record_remote_types(CodeServer3),
+ dialyzer_contracts:process_contract_remote_types(CodeServer4, RecordDict)
catch
throw:{error, ErrorMsg} ->
compile_error(ErrorMsg)
@@ -156,7 +157,7 @@ extract(#analysis{macros = Macros,
fun(Module, TmpPlt) ->
{ok, ModuleContracts} = dict:find(Module, Contracts),
SpecList = [{MFA, Contract}
- || {MFA, {_FileLine, Contract}} <- dict:to_list(ModuleContracts)],
+ || {MFA, {_FileLine, Contract}} <- maps:to_list(ModuleContracts)],
dialyzer_plt:insert_contract_list(TmpPlt, SpecList)
end,
NewTrustPLT = lists:foldl(FoldFun, TrustPLT, Modules),
@@ -172,8 +173,10 @@ get_type_info(#analysis{callgraph = CallGraph,
StrippedCallGraph = remove_external(CallGraph, TrustPLT),
%% io:format("--- Analyzing callgraph... "),
try
- NewPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph,
- TrustPLT, CodeServer),
+ NewMiniPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph,
+ TrustPLT,
+ CodeServer),
+ NewPlt = dialyzer_plt:restore_full_plt(NewMiniPlt),
Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt}
catch
error:What ->
@@ -224,7 +227,7 @@ get_external(Exts, Plt) ->
-type fa() :: {atom(), arity()}.
-type func_info() :: {line(), atom(), arity()}.
--record(info, {records = map__new() :: map_dict(),
+-record(info, {records = maps:new() :: erl_types:type_table(),
functions = [] :: [func_info()],
types = map__new() :: map_dict(),
edoc = false :: boolean()}).
@@ -267,7 +270,7 @@ write_inc_files(Inc) ->
Functions = [Key || {Key, _} <- Val],
Val1 = [{{F,A},Type} || {{_Line,F,A},Type} <- Val],
Info = #info{types = map__from_list(Val1),
- records = map__new(),
+ records = maps:new(),
%% Note we need to sort functions here!
functions = lists:keysort(1, Functions)},
%% io:format("Types ~p\n", [Info#info.types]),
@@ -849,8 +852,9 @@ collect_info(Analysis) ->
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer),
TmpCServer2 =
dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
- TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2),
- dialyzer_contracts:process_contract_remote_types(TmpCServer3)
+ {TmpCServer3, RecordDict} =
+ dialyzer_utils:process_record_remote_types(TmpCServer2),
+ dialyzer_contracts:process_contract_remote_types(TmpCServer3, RecordDict)
catch
throw:{error, ErrorMsg} ->
fatal_error(ErrorMsg)
diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl
index 318a0cf7f4..1aef6c58c4 100644
--- a/lib/xmerl/src/xmerl_sax_parser.erl
+++ b/lib/xmerl/src/xmerl_sax_parser.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -33,6 +33,7 @@
%% External exports
%%----------------------------------------------------------------------
-export([file/2,
+ stream/3,
stream/2]).
%%----------------------------------------------------------------------
@@ -72,11 +73,12 @@ file(Name,Options) ->
File = filename:basename(Name),
ContinuationFun = fun default_continuation_cb/1,
Res = stream(<<>>,
- [{continuation_fun, ContinuationFun},
- {continuation_state, FD},
- {current_location, CL},
- {entity, File}
- |Options]),
+ [{continuation_fun, ContinuationFun},
+ {continuation_state, FD},
+ {current_location, CL},
+ {entity, File}
+ |Options],
+ file),
ok = file:close(FD),
Res
end.
@@ -92,19 +94,22 @@ file(Name,Options) ->
%% EventState = term()
%% Description: Parse a stream containing an XML document.
%%----------------------------------------------------------------------
-stream(Xml, Options) when is_list(Xml), is_list(Options) ->
+stream(Xml, Options) ->
+ stream(Xml, Options, stream).
+
+stream(Xml, Options, InputType) when is_list(Xml), is_list(Options) ->
State = parse_options(Options, initial_state()),
- case State#xmerl_sax_parser_state.file_type of
+ case State#xmerl_sax_parser_state.file_type of
dtd ->
xmerl_sax_parser_list:parse_dtd(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream});
+ input_type = InputType});
normal ->
xmerl_sax_parser_list:parse(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream})
+ input_type = InputType})
end;
-stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
+stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) ->
case parse_options(Options, initial_state()) of
{error, Reason} -> {error, Reason};
State ->
@@ -127,7 +132,7 @@ stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
State#xmerl_sax_parser_state.event_state};
{Xml1, State1} ->
parse_binary(Xml1,
- State1#xmerl_sax_parser_state{input_type = stream},
+ State1#xmerl_sax_parser_state{input_type = InputType},
ParseFunction)
end
end.
@@ -226,12 +231,12 @@ check_encoding_option(E) ->
%% Description: Detects which character set is used in a binary stream.
%%----------------------------------------------------------------------
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = _) ->
- throw({error, "Can't detect character encoding due to no indata"});
+ {error, "Can't detect character encoding due to no indata"};
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = CFun,
continuation_state = CState} = State) ->
case CFun(CState) of
{<<>>, _} ->
- throw({error, "Can't detect character encoding due to lack of indata"});
+ {error, "Can't detect character encoding due to lack of indata"};
{NewBytes, NewContState} ->
detect_charset(NewBytes, State#xmerl_sax_parser_state{continuation_state = NewContState})
end;
diff --git a/lib/xmerl/src/xmerl_sax_parser.hrl b/lib/xmerl/src/xmerl_sax_parser.hrl
index 932ab0cec5..7f9bf6c4d3 100644
--- a/lib/xmerl/src/xmerl_sax_parser.hrl
+++ b/lib/xmerl/src/xmerl_sax_parser.hrl
@@ -88,14 +88,7 @@
current_location, % Location of the currently parsed XML entity
entity, % Parsed XML entity
skip_external_dtd = false,% If true the external DTD is skipped during parsing
- input_type % Source type: file | stream.
- % This field is a preparation for an fix in R17 of a bug in
- % the conformance against the standard.
- % Today a file which contains two XML documents will be considered
- % well-formed and the second is placed in the rest part of the
- % return tuple, according to the conformance tests this should fail.
- % In the future this will fail if xmerl_sax_aprser:file/2 is used but
- % left to the user in the xmerl_sax_aprser:stream/2 case.
+ input_type % Source type: file | stream
}).
diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
index 4d75805b9b..f3470b2809 100644
--- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
@@ -1,7 +1,7 @@
%%-*-erlang-*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -72,7 +72,12 @@ parse(Xml, State) ->
{ok, Rest, State2} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ case check_if_rest_ok(State3#xmerl_sax_parser_state.input_type, Rest) of
+ true ->
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ false ->
+ format_error(fatal_error, State3, "Input found after legal document")
+ end;
{fatal_error, {State2, Reason}} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -81,10 +86,14 @@ parse(Xml, State) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
format_error(Tag, State3, Reason);
+ {endDocument, Rest, State2} ->
+ State3 = event_callback(endDocument, State2),
+ ets:delete(RefTable),
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
%%----------------------------------------------------------------------
@@ -111,7 +120,7 @@ parse_dtd(Xml, State) ->
{Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
{endDocument, Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -119,7 +128,7 @@ parse_dtd(Xml, State) ->
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
@@ -136,10 +145,11 @@ parse_dtd(Xml, State) ->
%% [1] document ::= prolog element Misc*
%%----------------------------------------------------------------------
parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) ->
- {Rest1, State1} = parse_xml_decl(Rest, State),
+ {Rest1, State1} = parse_byte_order_mark(Rest, State),
{Rest2, State2} = parse_misc(Rest1, State1, true),
{ok, Rest2, State2}.
+?PARSE_BYTE_ORDER_MARK(Bytes, State).
%%----------------------------------------------------------------------
%% Function: parse_xml_decl(Rest, State) -> Result
@@ -150,15 +160,8 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) ->
%% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
%% [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'
%%----------------------------------------------------------------------
--dialyzer({[no_fail_call, no_match], parse_xml_decl/2}).
parse_xml_decl(?STRING_EMPTY, State) ->
cf(?STRING_EMPTY, State, fun parse_xml_decl/2);
-parse_xml_decl(?BYTE_ORDER_MARK_1, State) ->
- cf(?BYTE_ORDER_MARK_1, State, fun parse_xml_decl/2);
-parse_xml_decl(?BYTE_ORDER_MARK_2, State) ->
- cf(?BYTE_ORDER_MARK_2, State, fun parse_xml_decl/2);
-parse_xml_decl(?BYTE_ORDER_MARK_REST(Rest), State) ->
- cf(Rest, State, fun parse_xml_decl/2);
parse_xml_decl(?STRING("<") = Bytes, State) ->
cf(Bytes, State, fun parse_xml_decl/2);
parse_xml_decl(?STRING("<?") = Bytes, State) ->
@@ -170,31 +173,19 @@ parse_xml_decl(?STRING("<?xm") = Bytes, State) ->
parse_xml_decl(?STRING("<?xml") = Bytes, State) ->
cf(Bytes, State, fun parse_xml_decl/2);
parse_xml_decl(?STRING_REST("<?xml", Rest1), State) ->
- parse_xml_decl_1(Rest1, State);
-parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
- case unicode:characters_to_list(Bytes, Enc) of
- {incomplete, _, _} ->
- cf(Bytes, State, fun parse_xml_decl/2);
- {error, _Encoded, _Rest} ->
- ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
- _ ->
- parse_prolog(Bytes, State)
- end;
-parse_xml_decl(Bytes, State) ->
- parse_prolog(Bytes, State).
-
+ parse_xml_decl_rest(Rest1, State);
+?PARSE_XML_DECL(Bytes, State).
-parse_xml_decl_1(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) ->
+parse_xml_decl_rest(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) ->
if
?is_whitespace(C) ->
{_XmlAttributes, Rest1, State1} = parse_version_info(Rest, State, []),
- %State2 = event_callback({processingInstruction, "xml", XmlAttributes}, State1),% The XML decl. should not be reported as a PI
parse_prolog(Rest1, State1);
true ->
parse_prolog(?STRING_REST("<?xml", Bytes), State)
end;
-parse_xml_decl_1(Bytes, State) ->
- unicode_incomplete_check([Bytes, State, fun parse_xml_decl_1/2], undefined).
+parse_xml_decl_rest(Bytes, State) ->
+ unicode_incomplete_check([Bytes, State, fun parse_xml_decl_rest/2], undefined).
@@ -216,8 +207,6 @@ parse_prolog(?STRING_REST("<?", Rest), State) ->
parse_prolog(Rest1, State1);
{endDocument, Rest1, State1} ->
parse_prolog(Rest1, State1)
- % IValue = ?TO_INPUT_FORMAT("<?"),
- % {?APPEND_STRING(IValue, Rest1), State1}
end;
parse_prolog(?STRING_REST("<!", Rest), State) ->
parse_prolog_1(Rest, State);
@@ -230,7 +219,6 @@ parse_prolog(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_prolog/2],
"expecting < or whitespace").
-
parse_prolog_1(?STRING_EMPTY, State) ->
cf(?STRING_EMPTY, State, fun parse_prolog_1/2);
parse_prolog_1(?STRING("D") = Bytes, State) ->
@@ -442,6 +430,15 @@ check_if_new_doc_allowed(stream, []) ->
check_if_new_doc_allowed(_, _) ->
false.
+check_if_rest_ok(file, []) ->
+ true;
+check_if_rest_ok(file, <<>>) ->
+ true;
+check_if_rest_ok(stream, _) ->
+ true;
+check_if_rest_ok(_, _) ->
+ false.
+
%%----------------------------------------------------------------------
%% Function: parse_pi_1(Rest, State) -> Result
%% Input: Rest = string() | binary()
@@ -1024,16 +1021,21 @@ parse_etag(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_etag/2],
undefined).
-
parse_etag_1(?STRING_REST(">", Rest),
#xmerl_sax_parser_state{end_tags=[{_ETag, Uri, LocalName, QName, OldNsList, NewNsList}
- |RestOfETags]} = State, _Tag) ->
+ |RestOfETags],
+ input_type=InputType} = State, _Tag) ->
State1 = event_callback({endElement, Uri, LocalName, QName}, State),
State2 = send_end_prefix_mapping_event(NewNsList, State1),
- parse_content(Rest,
- State2#xmerl_sax_parser_state{end_tags=RestOfETags,
- ns = OldNsList},
- [], true);
+ case check_if_new_doc_allowed(InputType, RestOfETags) of
+ true ->
+ throw({endDocument, Rest, State2#xmerl_sax_parser_state{ns = OldNsList}});
+ false ->
+ parse_content(Rest,
+ State2#xmerl_sax_parser_state{end_tags=RestOfETags,
+ ns = OldNsList},
+ [], true)
+ end;
parse_etag_1(?STRING_UNBOUND_REST(_C, _), State, Tag) ->
{P,TN} = Tag,
?fatal_error(State, "Bad EndTag: " ++ P ++ ":" ++ TN);
@@ -1051,21 +1053,26 @@ parse_etag_1(Bytes, State, Tag) ->
%% Description: Parsing the content part of tags
%% [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
%%----------------------------------------------------------------------
-
parse_content(?STRING_EMPTY, State, Acc, IgnorableWS) ->
- case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
- {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
- {Rest, State1};
- {fatal_error, {State1, Msg}} ->
- case check_if_document_complete(State1, Msg) of
- true ->
- State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
- {?STRING_EMPTY, State2};
- false ->
- ?fatal_error(State1, Msg)
- end;
- Other ->
- throw(Other)
+ case check_if_document_complete(State, "No more bytes") of
+ true ->
+ State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
+ {?STRING_EMPTY, State1};
+ false ->
+ case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
+ {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
+ {Rest, State1};
+ {fatal_error, {State1, Msg}} ->
+ case check_if_document_complete(State1, Msg) of
+ true ->
+ State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
+ {?STRING_EMPTY, State2};
+ false ->
+ ?fatal_error(State1, Msg)
+ end;
+ Other ->
+ throw(Other)
+ end
end;
parse_content(?STRING("\r") = Bytes, State, Acc, IgnorableWS) ->
cf(Bytes, State, Acc, IgnorableWS, fun parse_content/4);
@@ -1094,7 +1101,7 @@ parse_content(?STRING_REST("<?", Rest), State, Acc, IgnorableWS) ->
parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_cdata(Rest1, State1)
@@ -1102,7 +1109,7 @@ parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags
parse_content(?STRING_REST("<", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_stag(Rest1, State1)
@@ -1204,7 +1211,6 @@ send_character_event(_, true, String, State) ->
%% Description: Parse whitespaces.
%% [3] S ::= (#x20 | #x9 | #xD | #xA)+
%%----------------------------------------------------------------------
--dialyzer({no_fail_call, whitespace/3}).
whitespace(?STRING_EMPTY, State, Acc) ->
case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of
{?STRING_EMPTY, State} ->
@@ -1230,16 +1236,7 @@ whitespace(?STRING_REST("\r", Rest), State, Acc) ->
whitespace(Rest, State#xmerl_sax_parser_state{line_no=N+1}, [?lf |Acc]);
whitespace(?STRING_UNBOUND_REST(C, Rest), State, Acc) when ?is_whitespace(C) ->
whitespace(Rest, State, [C|Acc]);
-whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
- {lists:reverse(Acc), Bytes, State};
-whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
- case unicode:characters_to_list(Bytes, Enc) of
- {incomplete, _, _} ->
- cf(Bytes, State, Acc, fun whitespace/3);
- {error, _Encoded, _Rest} ->
- ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
- end.
-
+?WHITESPACE(Bytes, State, Acc).
%%----------------------------------------------------------------------
%% Function: parse_reference(Rest, State, HaveToExist) -> Result
@@ -1362,7 +1359,6 @@ parse_pe_reference_1(Bytes, State, Name) ->
"missing ; after reference " ++ Name).
-
%%----------------------------------------------------------------------
%% Function: insert_reference(Reference, State) -> Result
%% Parameters: Reference = string()
@@ -1378,7 +1374,6 @@ insert_reference({Name, Type, Value}, Table) ->
end.
-
%%----------------------------------------------------------------------
%% Function: look_up_reference(Reference, State) -> Result
%% Parameters: Reference = string()
@@ -1693,7 +1688,7 @@ handle_external_entity({http, Url}, State) ->
++ file:format_error(Reason));
{ok, FD} ->
{?STRING_EMPTY, EntityState} =
- parse_external_entity_1(<<>>,
+ parse_external_entity_byte_order_mark(<<>>,
State#xmerl_sax_parser_state{continuation_state=FD,
current_location=filename:dirname(Url),
entity=filename:basename(Url),
@@ -1709,6 +1704,8 @@ handle_external_entity({http, Url}, State) ->
handle_external_entity({Tag, _Url}, State) ->
?fatal_error(State, "Unsupported URI type: " ++ atom_to_list(Tag)).
+?PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State).
+
%%----------------------------------------------------------------------
%% Function : parse_external_entity_1(Rest, State) -> Result
%% Parameters: Rest = string() | binary()
@@ -1716,7 +1713,6 @@ handle_external_entity({Tag, _Url}, State) ->
%% Result : {Rest, State}
%% Description: Parse the external entity.
%%----------------------------------------------------------------------
--dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}).
parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) ->
case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of
{Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
@@ -1726,12 +1722,6 @@ parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} =
Other ->
throw(Other)
end;
-parse_external_entity_1(?BYTE_ORDER_MARK_1, State) ->
- cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_1/2);
-parse_external_entity_1(?BYTE_ORDER_MARK_2, State) ->
- cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_1/2);
-parse_external_entity_1(?BYTE_ORDER_MARK_REST(Rest), State) ->
- parse_external_entity_1(Rest, State);
parse_external_entity_1(?STRING("<") = Bytes, State) ->
cf(Bytes, State, fun parse_external_entity_1/2);
parse_external_entity_1(?STRING("<?") = Bytes, State) ->
@@ -3290,7 +3280,7 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C
catch
throw:ErrorTerm ->
?fatal_error(State, ErrorTerm);
- exit:Reason ->
+ exit:Reason ->
?fatal_error(State, {'EXIT', Reason})
end,
case Result of
diff --git a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc
index 961806bf4c..6e59347fb8 100644
--- a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -34,8 +34,36 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, latin1)).
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar, Rest/binary>>).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, undefined_bom2).
--define(BYTE_ORDER_MARK_REST(Rest), <<undefined, Rest/binary>>).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc
index 624a621d92..6a4435b1d9 100644
--- a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc
@@ -36,6 +36,19 @@
%% In the list case we can't use a '++' when matchin against an unbound variable
-define(STRING_UNBOUND_REST(MatchChar, Rest), [MatchChar | Rest]).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, undefined_bom2).
--define(BYTE_ORDER_MARK_REST(Rest), [undefined|Rest]).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State}).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc
index ff84ece97a..ec89024729 100644
--- a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -34,8 +34,50 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, big})).
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/big-utf16, Rest/binary>>).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, <<16#FE>>).
+-define(BYTE_ORDER_MARK_1, <<16#FE>>).
-define(BYTE_ORDER_MARK_REST(Rest), <<16#FE, 16#FF, Rest/binary>>).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_xml_decl(Rest, State);
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_external_entity_1(Rest, State);
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc
index a330fce8d0..566333a045 100644
--- a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -34,8 +34,50 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, little})).
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/little-utf16, Rest/binary>>).
--define(BYTE_ORDER_MARK_1, undefined_bom1).
--define(BYTE_ORDER_MARK_2, <<16#FF>>).
+-define(BYTE_ORDER_MARK_1, <<16#FF>>).
-define(BYTE_ORDER_MARK_REST(Rest), <<16#FF, 16#FE, Rest/binary>>).
+
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_xml_decl(Rest, State);
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_external_entity_1(Rest, State);
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc
index d46d60d237..f41d06d013 100644
--- a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -34,11 +34,55 @@
-define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>).
-define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, utf8)).
-
-%% STRING_REST and STRING_UNBOUND_REST is only different in the list case
-define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/utf8, Rest/binary>>).
-define(BYTE_ORDER_MARK_1, <<16#EF>>).
-define(BYTE_ORDER_MARK_2, <<16#EF, 16#BB>>).
-define(BYTE_ORDER_MARK_REST(Rest), <<16#EF, 16#BB, 16#BF, Rest/binary>>).
+-define(PARSE_BYTE_ORDER_MARK(Bytes, State),
+ parse_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_2, State) ->
+ cf(?BYTE_ORDER_MARK_2, State, fun parse_byte_order_mark/2);
+ parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_xml_decl(Rest, State);
+ parse_byte_order_mark(Bytes, State) ->
+ parse_xml_decl(Bytes, State)).
+
+-define(PARSE_XML_DECL(Bytes, State),
+ parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, fun parse_xml_decl/2);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])));
+ _ ->
+ parse_prolog(Bytes, State)
+ end;
+ parse_xml_decl(Bytes, State) ->
+ parse_prolog(Bytes, State)).
+
+-define(WHITESPACE(Bytes, State, Acc),
+ whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) ->
+ {lists:reverse(Acc), Bytes, State};
+ whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) ->
+ case unicode:characters_to_list(Bytes, Enc) of
+ {incomplete, _, _} ->
+ cf(Bytes, State, Acc, fun whitespace/3);
+ {error, _Encoded, _Rest} ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc])))
+ end).
+-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State),
+ parse_external_entity_byte_order_mark(?STRING_EMPTY, State) ->
+ cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) ->
+ cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_2, State) ->
+ cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_byte_order_mark/2);
+ parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) ->
+ parse_external_entity_1(Rest, State);
+ parse_external_entity_byte_order_mark(Bytes, State) ->
+ parse_external_entity_1(Bytes, State)).
diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl
index 5e0459ec21..95dc82e5c9 100644
--- a/lib/xmerl/src/xmerl_scan.erl
+++ b/lib/xmerl/src/xmerl_scan.erl
@@ -2225,16 +2225,18 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook,
AllAttrs =
case S#xmerl_scanner.default_attrs of
true ->
- [ #xmlAttribute{name = AttName,
- parents = [{Name, Pos} | Parents],
- language = Lang,
- nsinfo = NSI,
- namespace = Namespace,
- value = AttValue,
- normalized = true} ||
- {AttName, AttValue} <- get_default_attrs(S, Name),
- AttValue =/= no_value,
- not lists:keymember(AttName, #xmlAttribute.name, Attrs) ];
+ DefaultAttrs =
+ [ #xmlAttribute{name = AttName,
+ parents = [{Name, Pos} | Parents],
+ language = Lang,
+ nsinfo = NSI,
+ namespace = Namespace,
+ value = AttValue,
+ normalized = true} ||
+ {AttName, AttValue} <- get_default_attrs(S, Name),
+ AttValue =/= no_value,
+ not lists:keymember(AttName, #xmlAttribute.name, Attrs) ],
+ lists:append(Attrs, DefaultAttrs);
false ->
Attrs
end,
@@ -2307,7 +2309,9 @@ expanded_name(Name, [], #xmlNamespace{default = URI}, S) ->
expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) ->
{_, Value} = lists:keyfind(Local, 1, Ns),
case Name of
- 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' ->
+ 'xmlns:xml' when Value =:= 'http://www.w3.org/XML/1998/namespace' ->
+ N;
+ 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' ->
?fatal({xml_prefix_cannot_be_redeclared, Value}, S);
'xmlns:xmlns' ->
?fatal({xmlns_prefix_cannot_be_declared, Value}, S);
@@ -2321,6 +2325,8 @@ expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) ->
N
end
end;
+expanded_name(_Name, {"xml", Local}, _NS, _S) ->
+ {'http://www.w3.org/XML/1998/namespace', list_to_atom(Local)};
expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) ->
case lists:keysearch(Prefix, 1, Ns) of
{value, {_, URI}} ->
@@ -2331,9 +2337,6 @@ expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) ->
?fatal({namespace_prefix_not_declared, Prefix}, S)
end.
-
-
-
keyreplaceadd(K, Pos, [H|T], Obj) when K == element(Pos, H) ->
[Obj|T];
keyreplaceadd(K, Pos, [H|T], Obj) ->
diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile
index 7a326e334f..b13fee05b3 100644
--- a/lib/xmerl/test/Makefile
+++ b/lib/xmerl/test/Makefile
@@ -55,7 +55,8 @@ SUITE_FILES= \
xmerl_xsd_SUITE.erl \
xmerl_xsd_MS2002-01-16_SUITE.erl \
xmerl_xsd_NIST2002-01-16_SUITE.erl \
- xmerl_xsd_Sun2002-01-16_SUITE.erl
+ xmerl_xsd_Sun2002-01-16_SUITE.erl \
+ xmerl_sax_stream_SUITE.erl
XML_FILES= \
testcases.dtd \
@@ -125,4 +126,5 @@ release_tests_spec: opt
@tar cfh - xmerl_xsd_MS2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_NIST2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_Sun2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
+ @tar cfh - xmerl_sax_stream_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
chmod -R u+w "$(RELSYSDIR)"
diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl
index e97b8c6a4b..58c462483c 100644
--- a/lib/xmerl/test/xmerl_SUITE.erl
+++ b/lib/xmerl/test/xmerl_SUITE.erl
@@ -54,7 +54,8 @@ groups() ->
cpd_expl_provided_DTD]},
{misc, [],
[latin1_alias, syntax_bug1, syntax_bug2, syntax_bug3,
- pe_ref1, copyright, testXSEIF, export_simple1, export]},
+ pe_ref1, copyright, testXSEIF, export_simple1, export,
+ default_attrs_bug, xml_ns]},
{eventp_tests, [], [sax_parse_and_export]},
{ticket_tests, [],
[ticket_5998, ticket_7211, ticket_7214, ticket_7430,
@@ -223,6 +224,50 @@ syntax_bug3(Config) ->
Err -> Err
end.
+default_attrs_bug(Config) ->
+ file:set_cwd(datadir(Config)),
+ Doc = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n"
+ "<doc a=\"explicit\"/>",
+ {#xmlElement{attributes = [#xmlAttribute{name = a, value = "explicit"},
+ #xmlAttribute{name = b, value = "default"}]},
+ []
+ } = xmerl_scan:string(Doc, [{default_attrs, true}]),
+ Doc2 = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n"
+ "<doc b=\"also explicit\" a=\"explicit\"/>",
+ {#xmlElement{attributes = [#xmlAttribute{name = b, value = "also explicit"},
+ #xmlAttribute{name = a, value = "explicit"}]},
+ []
+ } = xmerl_scan:string(Doc2, [{default_attrs, true}]),
+ ok.
+
+
+xml_ns(Config) ->
+ Doc = "<?xml version='1.0'?>\n"
+ "<doc xml:attr1=\"implicit xml ns\"/>",
+ {#xmlElement{namespace=#xmlNamespace{default = [], nodes = []},
+ attributes = [#xmlAttribute{name = 'xml:attr1',
+ expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1},
+ nsinfo = {"xml","attr1"},
+ namespace = #xmlNamespace{default = [], nodes = []}}]},
+ []
+ } = xmerl_scan:string(Doc, [{namespace_conformant, true}]),
+ Doc2 = "<?xml version='1.0'?>\n"
+ "<doc xmlns:xml=\"http://www.w3.org/XML/1998/namespace\" xml:attr1=\"explicit xml ns\"/>",
+ {#xmlElement{namespace=#xmlNamespace{default = [], nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]},
+ attributes = [#xmlAttribute{name = 'xmlns:xml',
+ expanded_name = {"xmlns","xml"},
+ nsinfo = {"xmlns","xml"},
+ namespace = #xmlNamespace{default = [],
+ nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}},
+ #xmlAttribute{name = 'xml:attr1',
+ expanded_name = {'http://www.w3.org/XML/1998/namespace',attr1},
+ nsinfo = {"xml","attr1"},
+ namespace = #xmlNamespace{default = [],
+ nodes = [{"xml",'http://www.w3.org/XML/1998/namespace'}]}}]},
+ []
+ } = xmerl_scan:string(Doc2, [{namespace_conformant, true}]),
+ ok.
+
pe_ref1(Config) ->
file:set_cwd(datadir(Config)),
{#xmlElement{},[]} = xmerl_scan:file(datadir_join(Config,[misc,"PE_ref1.xml"]),[{validation,true}]).
diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl
index f5c0a783c4..7d1a70905c 100644
--- a/lib/xmerl/test/xmerl_sax_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_SUITE.erl
@@ -85,17 +85,17 @@ ticket_11551(_Config) ->
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
+ {ok, undefined, <<"\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
Stream2= <<"<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
+ {ok, undefined, <<"\n\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
Stream3= <<"<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
+ {ok, undefined, <<"\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
ok.
diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
index 525a3b175a..b8412206cc 100644
--- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
@@ -2,7 +2,7 @@
%%----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -507,11 +507,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-036'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/036.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -522,11 +519,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-037'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/037.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&#32;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -561,11 +555,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-040'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/040.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -576,11 +567,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-041'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/041.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -603,11 +591,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-043'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/043.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -618,11 +603,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-044'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/044.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc/>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -669,11 +651,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-048'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/048.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<![CDATA[]]>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1416,11 +1395,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-110'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/110.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&e;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1914,9 +1890,9 @@ end_per_testcase(_Func,_Config) ->
%% Special case becase we returns everything after a legal document
%% as an rest instead of giving and error to let the user handle
%% multipple docs on a stream.
- {ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ %{ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -7784,11 +7760,8 @@ end_per_testcase(_Func,_Config) ->
'o-p01fail3'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"oasis","p01fail3.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<bad/>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11417,12 +11390,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n02'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n02.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<?xml version=\"1.0\"?>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11433,11 +11402,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n03'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n03.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<title>Wrong combination!</title>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13027,11 +12993,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P27-ibm27n01'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P27/ibm27n01.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<!ELEMENT cat EMPTY>">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13461,11 +13424,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P39-ibm39n06'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P39/ibm39n06.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"content after end tag\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE.erl b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
new file mode 100644
index 0000000000..a306eb66a2
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
@@ -0,0 +1,245 @@
+%%-*-erlang-*-
+%%----------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%----------------------------------------------------------------------
+%% File : xmerl_sax_stream_SUITE.erl
+%%----------------------------------------------------------------------
+-module(xmerl_sax_stream_SUITE).
+-compile(export_all).
+
+%%----------------------------------------------------------------------
+%% Include files
+%%----------------------------------------------------------------------
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/file.hrl").
+
+%%======================================================================
+%% External functions
+%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+all() ->
+ [
+ one_document,
+ two_documents,
+ one_document_and_junk
+ ].
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_Func, _Config) ->
+ ok.
+
+%%----------------------------------------------------------------------
+%% Tests
+%%----------------------------------------------------------------------
+one_document(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n">> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+two_documents(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_two.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n<?x", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+one_document_and_junk(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one_junk.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\nth", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 10000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+%%----------------------------------------------------------------------
+%% Utility functions
+%%----------------------------------------------------------------------
+listen(Port) ->
+ case catch gen_tcp:listen(Port, [{active, false},
+ binary,
+ {keepalive, true},
+ {reuseaddr,true}]) of
+ {ok, ListenSocket} ->
+ {ok, ListenSocket};
+ {error, Reason} ->
+ {error, {listen, Reason}}
+ end.
+
+close(Socket) ->
+ (catch gen_tcp:close(Socket)).
+
+connect(Host, Port) ->
+ Timeout = 5000,
+ % Options1 = check_options(Options),
+ Options = [binary],
+ case catch gen_tcp:connect(Host, Port, Options, Timeout) of
+ {ok, Socket} ->
+ {ok, Socket};
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+send_chunks(Socket, Binary) ->
+ BSize = erlang:size(Binary),
+ if
+ BSize > 25 ->
+ <<Head:25/binary, Tail/binary>> = Binary,
+ case gen_tcp:send(Socket, Head) of
+ ok ->
+ timer:sleep(1000),
+ send_chunks(Socket, Tail);
+ {error,closed} ->
+ ok
+ end;
+ true ->
+ gen_tcp:send(Socket, Binary)
+ end.
+
+datadir(Config) ->
+ proplists:get_value(data_dir, Config).
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
new file mode 100644
index 0000000000..30328bb188
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
new file mode 100644
index 0000000000..f730a95865
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+this is junk ......
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
new file mode 100644
index 0000000000..e241a02190
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
@@ -0,0 +1,34 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+<?xml version="1.0"?>
+<person>
+<name>
+Bertil Bengtson
+</name>
+<address>
+<street>
+ New Road 4
+</street>
+<zip>
+12328
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>